d4d09cf · rowtype-yoga/purescript-native

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

Merge remote-tracking branch 'pure11/pure11' into native

commitd4d09cf34bef854dca6c2c363231c220ea4945b1 authorAndy Arvanitis <andyarvanitis@gmail.com> dateMon 3 Oct 2016, 20:47 (10 years ago) parent21d0ae2 fa67452

124 files changed+3124−1182

compare with golang

unifiedsplit

CONTRIBUTING.md+2−3

@@ -11,9 +11,8 @@ If you would like to contribute, please consider the issues in the current miles

1111Please follow the following guidelines:

1212

1313- Add at least a test to `examples/passing/` and possibly to `examples/failing`.

14−- Build the binaries and libs with `cabal build`

15−- Install the binaries and libs with `cabal install`.

16−- Run `cabal configure --enable-tests && cabal build && cabal test` to build the test suite. You will need `npm` and `node` on your PATH to run the tests.

14+- Build the binaries and libs with `stack build`

15+- Run the test suite with `stack test`. You will need `npm` and `node` on your PATH to run the tests.

1716- Build the core libraries by running the script in `core-tests`.

1817

1918## Code Review

CONTRIBUTORS.md+6

@@ -5,6 +5,7 @@ This file lists the contributors to the PureScript compiler project, and the ter

55### Individuals

77- [@5outh](https://github.com/5outh) (Benjamin Kovach) - My existing contributions and all future contributions until further notice are Copyright Benjamin Kovach, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.

8+- [@andreypopp](https://github.com/andreypopp) (Andrey Popp) My existing contributions and all future contributions until further notice are Copyright Andrey Popp, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.

89- [@andyarvanitis](https://github.com/andyarvanitis) (Andy Arvanitis) My existing contributions and all future contributions until further notice are Copyright Andy Arvanitis, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

910- [@anthok88](https://github.com/anthoq88) - My existing contributions and all future contributions until further notice are Copyright anthoq88, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license

1011- [@ardumont](https://github.com/ardumont) (Antoine R. Dumont) My existing contributions and all future contributions until further notice are Copyright Antoine R. Dumont, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

@@ -16,6 +17,8 @@ This file lists the contributors to the PureScript compiler project, and the ter

1617- [@Bogdanp](https://github.com/Bogdanp) (Bogdan Paul Popa) My existing contributions and all future contributions until further notice are Copyright Bogdan Paul Popa, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

1718- [@bsermons](https://github.com/bsermons) (Brian Sermons) My existing contributions and all future contributions until further notice are Copyright Brian Sermons, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

1819- [@cdepillabout](https://github.com/cdepillabout) (Dennis Gosnell) My existing contributions and all future contributions until further notice are Copyright Dennis Gosnell, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

20+- [@charleso](https://github.com/charleso) (Charles O'Farrell) My existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright Charles O'Farrell, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

21+- [@chrisdone](https://github.com/chrisdone) (Chris Done) - My existing contributions and all future contributions until further notice are Copyright Chris Done, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.

1922- [@chrissmoak](https://github.com/chrissmoak) (Chris Smoak) My existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright Chris Smoak, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

2023- [@codedmart](https://github.com/codedmart) (Brandon Martin) My existing contributions and all future contributions until further notice are Copyright Brandon Martin, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

2124- [@davidchambers](https://github.com/davidchambers) (David Chambers) My existing contributions and all future contributions until further notice are Copyright David Chambers, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

@@ -28,8 +31,10 @@ This file lists the contributors to the PureScript compiler project, and the ter

2831- [@etrepum](https://github.com/etrepum) (Bob Ippolito) My existing contributions and all future contributions until further notice are Copyright Bob Ippolito, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

2932- [@faineance](https://github.com/faineance) My existing contributions and all future contributions until further notice are Copyright faineance, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

3033- [@felixSchl](https://github.com/felixSchl) (Felix Schlitter) My existing contributions and all future contributions until further notice are Copyright Felix Schlitter, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

34+- [@FrigoEU](https://github.com/FrigoEU) (Simon Van Casteren) My existing contributions and all future contributions until further notice are Copyright Simon Van Casteren, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

3135- [@garyb](https://github.com/garyb) (Gary Burgess) My existing contributions and all future contributions until further notice are Copyright Gary Burgess, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

3236- [@hdgarrood](https://github.com/hdgarrood) (Harry Garrood) My existing contributions and all future contributions until further notice are Copyright Harry Garrood, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

37+- [@ianbollinger](https://github.com/ianbollinger) (Ian D. Bollinger) My existing contributions and all future contributions until further notice are Copyright Ian D. Bollinger, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

3338- [@ilovezfs](https://github.com/ilovezfs) - My existing contributions and all future contributions until further notice are Copyright ilovezfs, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license

3439- [@izgzhen](https://github.com/izgzhen) (Zhen Zhang) My existing contributions and all future contributions until further notice are Copyright Zhen Zhang, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

3540- [@jacereda](https://github.com/jacereda) (Jorge Acereda) My existing contributions and all future contributions until further notice are Copyright Jorge Acereda, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

@@ -61,6 +66,7 @@ This file lists the contributors to the PureScript compiler project, and the ter

6166- [@philopon](https://github.com/philopon) (Hirotomo Moriwaki) - My existing contributions and all future contributions until further notice are Copyright Hirotomo Moriwaki, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

6267- [@pseudonom](https://github.com/pseudonom) (Eric Easley) My existing contributions and all future contributions until further notice are Copyright Eric Easley, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

6368- [@puffnfresh](https://github.com/puffnfresh) (Brian McKenna) All contributions I made during June 2015 were during employment at [SlamData, Inc.](#companies) who owns the copyright. I assign copyright of all my personal contributions before June 2015 to the owners of the PureScript compiler.

69+- [@rightfold](https://github.com/rightfold) (rightfold) My existing contributions and all future contributions until further notice are Copyright rightfold, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](https://opensource.org/licenses/MIT).

6470- [@robdaemon](https://github.com/robdaemon) (Robert Roland) My existing contributions and all future contributions until further notice are Copyright Robert Roland, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

6571- [@RossMeikleham](https://github.com/RossMeikleham) (Ross Meikleham) My existing contributions and all future contributions until further notice are Copyright Ross Meikleham, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

6672- [@rvion](https://github.com/rvion) (Rémi Vion) My existing contributions and all future contributions until further notice are Copyright Rémi Vion, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).

INSTALL.md+6−3

@@ -27,16 +27,19 @@ GHC 7.10.1 or newer is required to compile from source. The easiest way is to

2727use stack:

2828

2929```

30−$ stack install --resolver=nightly purescript

30+$ stack update

31+$ stack unpack purescript

32+$ cd purescript-x.y.z # (replace x.y.z with whichever version you just downloaded)

33+$ stack install

3134```

3235

3336This will then copy the compiler and utilities into `~/.local/bin`.

3437

3538

36−If you don't have stack installed yet there are install instructions

39+If you don't have stack installed, there are install instructions

3740[here](https://github.com/commercialhaskell/stack/blob/master/doc/install_and_upgrade.md).

3841

39−If you don't have ghc installed yet, stack will prompt you to run `stack setup`

42+If you don't have ghc installed, stack will prompt you to run `stack setup`

4043which will install ghc for you.

4144

4245## The "curses" library

LICENSE+819−117

@@ -1,32 +1,27 @@

1−The MIT License (MIT)

2−

42contributors

5+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

6−Permission is hereby granted, free of charge, to any person obtaining a copy of

7−this software and associated documentation files (the "Software"), to deal in

8−the Software without restriction, including without limitation the rights to

9−use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of

10−the Software, and to permit persons to whom the Software is furnished to do so,

11−subject to the following conditions:

7+1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.

128

13−The above copyright notice and this permission notice shall be included in all

14−copies or substantial portions of the Software.

9+2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.

1510

16−THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR

17−IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS

18−FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR

19−COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER

20−IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN

21−CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

11+3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.

12+

13+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 HOLDER 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.

2214

2315PureScript uses the following Haskell library packages. Their license files follow.

2416

2517 Glob

18+ SHA

2619 aeson

2720 aeson-better-errors

21+ aeson-pretty

2822 ansi-terminal

2923 ansi-wl-pprint

24+ appar

3025 array

3126 asn1-encoding

3227 asn1-parse

@@ -39,14 +34,18 @@ PureScript uses the following Haskell library packages. Their license files foll

3934 base64-bytestring

4035 binary

4136 blaze-builder

37+ blaze-html

38+ blaze-markup

4239 bower-json

4340 boxes

4441 byteable

42+ byteorder

4543 bytestring

4644 bytestring-builder

4745 case-insensitive

4846 cereal

4947 clock

48+ cmdargs

5049 conduit

5150 conduit-extra

5251 connection

@@ -54,25 +53,32 @@ PureScript uses the following Haskell library packages. Their license files foll

5453 cookie

5554 cryptonite

5655 data-default-class

56+ data-ordlist

5757 deepseq

5858 directory

5959 dlist

6060 easy-file

6161 edit-distance

62+ entropy

6263 exceptions

6364 fail

6465 fast-logger

66+ file-embed

6567 filepath

6668 fsnotify

6769 ghc-prim

6870 hashable

6971 haskeline

70− hinotify

72+ hex

73+ hfsevents

7174 hourglass

7275 http-client

7376 http-client-tls

77+ http-date

7478 http-types

79+ http2

7580 integer-gmp

81+ iproute

7682 language-javascript

7783 lifted-base

7884 memory

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

96102 primitive

97103 process

98104 protolude

105+ psqueues

99106 random

100107 regex-base

101108 regex-tdfa

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

103110 safe

104111 scientific

105112 semigroups

113+ simple-sendfile

106114 socks

107115 sourcemap

108116 spdx

@@ -110,13 +118,14 @@ PureScript uses the following Haskell library packages. Their license files foll

110118 stm

111119 stm-chans

112120 streaming-commons

113− string-conv

121+ stringsearch

114122 syb

115123 tagged

116124 template-haskell

117125 terminfo

118126 text

119127 time

128+ time-locale-compat

120129 tls

121130 transformers

122131 transformers-base

@@ -126,8 +135,17 @@ PureScript uses the following Haskell library packages. Their license files foll

126135 unix-time

127136 unordered-containers

128137 utf8-string

138+ vault

129139 vector

130140 void

141+ wai

142+ wai-app-static

143+ wai-extra

144+ wai-logger

145+ wai-websockets

146+ warp

147+ websockets

148+ word8

131149 x509

132150 x509-store

133151 x509-system

@@ -140,7 +158,7 @@ Glob LICENSE file:

140158 the code are held by whoever wrote the code in question: see CREDITS.txt for a

141159 list of authors.

142160

145163

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

@@ -165,6 +183,38 @@ Glob LICENSE file:

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

166184 ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

167185

186+SHA LICENSE file:

187+

190+

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

192+ modification, are permitted provided that the following conditions

193+ are met:

194+

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

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

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

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

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

200+ distribution.

201+ * Neither the name of the Galois, Inc. nor the names of its

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

203+ from this software without specific prior written permission.

204+

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

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

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

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

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

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

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

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

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

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

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

216+ POSSIBILITY OF SUCH DAMAGE.

217+

168218aeson LICENSE file:

169219

@@ -221,6 +271,39 @@ aeson-better-errors LICENSE file:

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

222272 SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

223273

274+aeson-pretty LICENSE file:

275+

277+

279+

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

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

282+

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

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

285+

286+ * Redistributions in binary form must reproduce the above

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

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

289+ with the distribution.

290+

291+ * Neither the name of Falko Peters nor the names of other

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

293+ from this software without specific prior written permission.

294+

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

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

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

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

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

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

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

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

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

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

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

306+

224307ansi-terminal LICENSE file:

225308

@@ -274,6 +357,38 @@ ansi-wl-pprint LICENSE file:

274357 or otherwise) arising in any way out of the use of this software, even

275358 if advised of the possibility of such damage.

276359

360+appar LICENSE file:

361+

364+

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

366+ modification, are permitted provided that the following conditions

367+ are met:

368+

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

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

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

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

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

374+ distribution.

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

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

377+ from this software without specific prior written permission.

378+

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

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

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

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

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

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

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

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

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

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

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

390+ POSSIBILITY OF SUCH DAMAGE.

391+

277392array LICENSE file:

278393

279394 This library (libraries/base) is derived from code from several

@@ -746,6 +861,72 @@ blaze-builder LICENSE file:

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

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

748863

864+blaze-html LICENSE file:

865+

866+ Copyright Jasper Van der Jeugt 2010

867+

869+

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

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

872+

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

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

875+

876+ * Redistributions in binary form must reproduce the above

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

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

879+ with the distribution.

880+

881+ * Neither the name of Jasper Van der Jeugt nor the names of other

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

883+ from this software without specific prior written permission.

884+

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

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

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

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

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

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

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

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

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

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

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

896+

897+blaze-markup LICENSE file:

898+

899+ Copyright Jasper Van der Jeugt 2010

900+

902+

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

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

905+

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

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

908+

909+ * Redistributions in binary form must reproduce the above

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

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

912+ with the distribution.

913+

914+ * Neither the name of Jasper Van der Jeugt nor the names of other

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

916+ from this software without specific prior written permission.

917+

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

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

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

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

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

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

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

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

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

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

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

929+

749930bower-json LICENSE file:

750931

@@ -829,6 +1010,39 @@ byteable LICENSE file:

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

8301011 SUCH DAMAGE.

8311012

1013+byteorder LICENSE file:

1014+

1016+

1018+

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

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

1021+

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

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

1024+

1025+ * Redistributions in binary form must reproduce the above

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

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

1028+ with the distribution.

1029+

1030+ * Neither the name of the author nor the names of other

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

1032+ from this software without specific prior written permission.

1033+

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

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

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

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

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

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

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

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

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

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

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

1045+

8321046bytestring LICENSE file:

8331047

8341048 Copyright (c) Don Stewart 2005-2009

@@ -997,6 +1211,39 @@ clock LICENSE file:

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

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

9991213

1214+cmdargs LICENSE file:

1215+

1216+ Copyright Neil Mitchell 2009-2016.

1218+

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

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

1221+ met:

1222+

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

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

1225+

1226+ * Redistributions in binary form must reproduce the above

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

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

1229+ with the distribution.

1230+

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

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

1233+ from this software without specific prior written permission.

1234+

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

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

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

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

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

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

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

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

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

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

1246+

10001247conduit LICENSE file:

10011248

@@ -1109,31 +1356,26 @@ containers LICENSE file:

11091356

11101357cookie LICENSE file:

11111358

1112− The following license covers this documentation, and the source code, except

1113− where otherwise indicated.

1114−

1116−

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

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

11191360

1120− * Redistributions of source code must retain the above copyright notice, this

1121− list of conditions and the following disclaimer.

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

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

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

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

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

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

1367+ the following conditions:

11221368

1123− * Redistributions in binary form must reproduce the above copyright notice,

1124− this list of conditions and the following disclaimer in the documentation

1125− and/or other materials provided with the distribution.

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

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

11261371

1127− THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR

1128− IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF

1129− MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO

1130− EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,

1131− INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT

1132− NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,

1133− OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF

1134− LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE

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

1136− ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

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

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

1374+ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND

1375+ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE

1376+ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION

1377+ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION

1378+ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

11371379

11381380cryptonite LICENSE file:

11391381

@@ -1195,10 +1437,23 @@ data-default-class LICENSE file:

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

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

11971439

1198−deepseq LICENSE file:

1440+data-ordlist LICENSE file:

11991441

1200− This library (deepseq) is derived from code from the GHC project which

1201− is largely (c) The University of Glasgow, and distributable under a

1444+

1445+ Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

1446+

1447+ * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.

1448+ * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.

1449+ * Neither the name of Melding Monads nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.

1450+

1451+ 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 HOLDER 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.

1452+

1453+deepseq LICENSE file:

1454+

1455+ This library (deepseq) is derived from code from the GHC project which

1456+ is largely (c) The University of Glasgow, and distributable under a

12021457 BSD-style license (see below).

12031458

12041459 -----------------------------------------------------------------------------

@@ -1305,7 +1560,7 @@ directory LICENSE file:

13051560

13061561dlist LICENSE file:

13071562

13091564

13111566

@@ -1394,6 +1649,39 @@ edit-distance LICENSE file:

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

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

13961651

1652+entropy LICENSE file:

1653+

1654+ Copyright (c) Thomas DuBuisson

1655+

1657+

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

1659+ modification, are permitted provided that the following conditions

1660+ are met:

1661+

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

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

1664+

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

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

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

1668+

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

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

1671+ without specific prior written permission.

1672+

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

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

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

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

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

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

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

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

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

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

1683+ POSSIBILITY OF SUCH DAMAGE.

1684+

13971685exceptions LICENSE file:

13981686

@@ -1493,6 +1781,34 @@ fast-logger LICENSE file:

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

14941782 POSSIBILITY OF SUCH DAMAGE.

14951783

1784+file-embed LICENSE file:

1785+

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

1787+ where otherwise indicated.

1788+

1790+

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

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

1793+

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

1795+ list of conditions and the following disclaimer.

1796+

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

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

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

1800+

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

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

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

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

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

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

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

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

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

1810+ ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

1811+

14961812filepath LICENSE file:

14971813

14981814 Copyright Neil Mitchell 2005-2015.

@@ -1683,38 +1999,42 @@ haskeline LICENSE file:

16831999 OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE

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

16852001

1686−hinotify LICENSE file:

2002+hex LICENSE file:

16872003

1688− Copyright (c) Lennart Kolmodin

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

2005+

2006+hfsevents LICENSE file:

2007+

16892009

16912011

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

1693− modification, are permitted provided that the following conditions

1694− are met:

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

16952014

1696− 1. Redistributions of source code must retain the above copyright

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

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

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

16982017

1699− 2. Redistributions in binary form must reproduce the above copyright

1700− notice, this list of conditions and the following disclaimer in the

1701− documentation and/or other materials provided with the distribution.

2018+ * Redistributions in binary form must reproduce the above

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

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

2021+ with the distribution.

17022022

1703− 3. Neither the name of the author nor the names of his contributors

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

1705− without specific prior written permission.

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

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

2025+ from this software without specific prior written permission.

17062026

1707− THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS

1708− OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED

1709− WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE

1710− DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR

1711− ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

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

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

1714− HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,

1715− STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN

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

1717− POSSIBILITY OF SUCH DAMAGE.

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

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

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

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

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

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

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

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

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

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

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

17182038

17192039hourglass LICENSE file:

17202040

@@ -1792,6 +2112,38 @@ http-client-tls LICENSE file:

17922112 IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN

17932113 CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

17942114

2115+http-date LICENSE file:

2116+

2119+

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

2121+ modification, are permitted provided that the following conditions

2122+ are met:

2123+

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

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

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

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

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

2129+ distribution.

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

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

2132+ from this software without specific prior written permission.

2133+

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

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

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

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

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

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

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

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

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

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

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

2145+ POSSIBILITY OF SUCH DAMAGE.

2146+

17952147http-types LICENSE file:

17962148

@@ -1826,6 +2178,38 @@ http-types LICENSE file:

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

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

18282180

2181+http2 LICENSE file:

2182+

2185+

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

2187+ modification, are permitted provided that the following conditions

2188+ are met:

2189+

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

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

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

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

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

2195+ distribution.

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

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

2198+ from this software without specific prior written permission.

2199+

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

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

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

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

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

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

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

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

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

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

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

2211+ POSSIBILITY OF SUCH DAMAGE.

2212+

18292213integer-gmp LICENSE file:

18302214

@@ -1859,6 +2243,38 @@ integer-gmp LICENSE file:

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

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

18612245

2246+iproute LICENSE file:

2247+

2250+

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

2252+ modification, are permitted provided that the following conditions

2253+ are met:

2254+

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

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

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

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

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

2260+ distribution.

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

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

2263+ from this software without specific prior written permission.

2264+

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

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

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

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

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

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

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

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

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

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

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

2276+ POSSIBILITY OF SUCH DAMAGE.

2277+

18622278language-javascript LICENSE file:

18632279

@@ -2476,7 +2892,7 @@ pipes LICENSE file:

24762892

24772893pipes-http LICENSE file:

24782894

24812897

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

@@ -2622,6 +3038,40 @@ protolude LICENSE file:

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

26233039 IN THE SOFTWARE.

26243040

3041+psqueues LICENSE file:

3042+

3043+ The Glasgow Haskell Compiler License

3044+

3047+

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

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

3050+

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

3052+ this list of conditions and the following disclaimer.

3053+

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

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

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

3057+

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

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

3060+ specific prior written permission.

3061+

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

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

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

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

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

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

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

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

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

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

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

3073+ DAMAGE.

3074+

26253075random LICENSE file:

26263076

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

@@ -2846,29 +3296,61 @@ semigroups LICENSE file:

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

28473297 POSSIBILITY OF SUCH DAMAGE.

28483298

2849−socks LICENSE file:

2850−

3299+simple-sendfile LICENSE file:

28523300

28543303

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

28563305 modification, are permitted provided that the following conditions

28573306 are met:

2858− 1. Redistributions of source code must retain the above copyright

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

2860− 2. Redistributions in binary form must reproduce the above copyright

2861− notice, this list of conditions and the following disclaimer in the

2862− documentation and/or other materials provided with the distribution.

2863− 3. Neither the name of the author nor the names of his contributors

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

2865− without specific prior written permission.

28663307

2867− THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND

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

2869− IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE

2870− ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE

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

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

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

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

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

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

3313+ distribution.

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

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

3316+ from this software without specific prior written permission.

3317+

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

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

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

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

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

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

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

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

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

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

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

3329+ POSSIBILITY OF SUCH DAMAGE.

3330+

3331+socks LICENSE file:

3332+

3334+

3336+

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

3338+ modification, are permitted provided that the following conditions

3339+ are met:

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

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

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

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

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

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

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

3347+ without specific prior written permission.

3348+

3349+ THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND

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

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

3352+ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE

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

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

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

28743356 HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT

@@ -3068,38 +3550,9 @@ streaming-commons LICENSE file:

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

30693551 SOFTWARE.

30703552

3071−string-conv LICENSE file:

3072−

3074−

3076−

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

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

3079−

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

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

3553+stringsearch LICENSE file:

30823554

3083− * Redistributions in binary form must reproduce the above

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

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

3086− with the distribution.

3087−

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

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

3090− from this software without specific prior written permission.

3091−

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

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

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

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

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

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

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

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

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

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

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

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

31033556

31043557syb LICENSE file:

31053558

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

33243777

33253778 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.

33263779

3780+time-locale-compat LICENSE file:

3781+

3783+

3785+

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

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

3788+

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

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

3791+

3792+ * Redistributions in binary form must reproduce the above

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

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

3795+ with the distribution.

3796+

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

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

3799+ from this software without specific prior written permission.

3800+

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

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

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

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

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

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

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

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

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

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

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

3812+

33273813tls LICENSE file:

33283814

@@ -3609,6 +4095,39 @@ utf8-string LICENSE file:

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

36104096 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

36114097

4098+vault LICENSE file:

4099+

4101+

4103+

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

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

4106+

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

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

4109+

4110+ * Redistributions in binary form must reproduce the above

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

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

4113+ with the distribution.

4114+

4115+ * Neither the name of Heinrich Apfelmus nor the names of other

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

4117+ from this software without specific prior written permission.

4118+

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

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

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

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

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

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

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

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

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

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

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

4130+

36124131vector LICENSE file:

36134132

@@ -3675,6 +4194,189 @@ void LICENSE file:

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

36764195 POSSIBILITY OF SUCH DAMAGE.

36774196

4197+wai LICENSE file:

4198+

4200+

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

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

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

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

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

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

4207+ the following conditions:

4208+

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

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

4211+

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

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

4214+ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND

4215+ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE

4216+ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION

4217+ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION

4218+ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

4219+

4220+wai-app-static LICENSE file:

4221+

4223+

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

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

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

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

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

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

4230+ the following conditions:

4231+

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

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

4234+

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

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

4237+ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND

4238+ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE

4239+ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION

4240+ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION

4241+ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

4242+

4243+wai-extra LICENSE file:

4244+

4246+

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

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

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

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

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

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

4253+ the following conditions:

4254+

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

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

4257+

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

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

4260+ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND

4261+ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE

4262+ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION

4263+ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION

4264+ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

4265+

4266+wai-logger LICENSE file:

4267+

4270+

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

4272+ modification, are permitted provided that the following conditions

4273+ are met:

4274+

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

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

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

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

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

4280+ distribution.

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

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

4283+ from this software without specific prior written permission.

4284+

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

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

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

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

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

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

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

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

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

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

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

4296+ POSSIBILITY OF SUCH DAMAGE.

4297+

4298+wai-websockets LICENSE file:

4299+

4301+

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

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

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

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

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

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

4308+ the following conditions:

4309+

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

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

4312+

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

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

4315+ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND

4316+ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE

4317+ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION

4318+ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION

4319+ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

4320+

4321+warp LICENSE file:

4322+

4324+

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

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

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

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

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

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

4331+ the following conditions:

4332+

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

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

4335+

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

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

4338+ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND

4339+ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE

4340+ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION

4341+ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION

4342+ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

4343+

4344+websockets LICENSE file:

4345+

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

4347+

4348+word8 LICENSE file:

4349+

4352+

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

4354+ modification, are permitted provided that the following conditions

4355+ are met:

4356+

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

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

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

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

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

4362+ distribution.

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

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

4365+ from this software without specific prior written permission.

4366+

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

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

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

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

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

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

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

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

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

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

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

4378+ POSSIBILITY OF SUCH DAMAGE.

4379+

36784380x509 LICENSE file:

36794381

examples/docs/src/ExplicitTypeSignatures.purs+2

@@ -14,3 +14,5 @@ anInt = 0

1414

1515-- This should infer a type.

1616aNumber = 1.0

17+

18+foreign import nestedForAll :: forall c. (forall a b. c)

examples/failing/CannotDeriveNewtypeForData.pursnew file+8

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

1+-- @shouldFailWith CannotDeriveNewtypeForData

2+module CannotDeriveNewtypeForData where

4+import Data.Newtype

6+data Test = Test String

8+derive instance newtypeTest :: Newtype Test _

examples/failing/DoNotSuggestComposition2.purs+1−1

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

1−-- @shouldFailWith CannotApplyFunction

1+-- @shouldFailWith TypesDoNotUnify

22-- TODO: Check that this does not produce a "function composition is (<<<)"

33-- suggestion.

examples/failing/DuplicateModule.pursnew file+2

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

1+-- @shouldFailWith DuplicateModule

2+module M1 where

examples/failing/DuplicateModule/M1.pursnew file+1

@@ -0,0 +1 @@

1+module M1 where

examples/failing/NewtypeInstance.pursnew file+8

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

1+-- @shouldFailWith InvalidNewtypeInstance

2+module Main where

4+import Prelude

6+data X = X

8+derive newtype instance showX :: Show X

examples/failing/NewtypeInstance2.pursnew file+8

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

1+-- @shouldFailWith InvalidNewtypeInstance

2+module Main where

4+import Prelude

6+data X a = X a a

8+derive newtype instance showX :: Show a => Show (X a)

examples/failing/NewtypeInstance3.pursnew file+8

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

1+-- @shouldFailWith InvalidNewtypeInstance

2+module Main where

4+import Prelude

6+class Nullary

8+derive newtype instance nullary :: Nullary

examples/failing/NewtypeInstance4.pursnew file+8

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

1+-- @shouldFailWith InvalidNewtypeInstance

2+module Main where

4+import Prelude

6+data X = X | Y

8+derive newtype instance showX :: Show X

examples/failing/NewtypeInstance5.pursnew file+8

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

1+-- @shouldFailWith InvalidNewtypeInstance

2+module Main where

4+import Prelude

6+newtype X a = X a

8+derive newtype instance functorX :: Functor X

examples/failing/NewtypeInstance6.pursnew file+8

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

1+-- @shouldFailWith InvalidNewtypeInstance

2+module Main where

4+import Prelude

6+newtype X a b = X (Array b)

8+derive newtype instance functorX :: Functor X

examples/failing/NonWildcardNewtypeInstance.pursnew file+8

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

1+-- @shouldFailWith NonWildcardNewtypeInstance

2+module NonWildcardNewtypeInstance where

4+import Data.Newtype

6+data Test = Test String

8+derive instance newtypeTest :: Newtype Test String

examples/failing/OperatorSections.purs+1−2

@@ -1,8 +1,7 @@

1−-- @shouldFailWith CannotApplyFunction

1+-- @shouldFailWith TypesDoNotUnify

22module Main where

44import Prelude

66main = do

77 (true `not` _)

8−

examples/failing/OverlappingVars.purs−1

@@ -12,4 +12,3 @@ instance overlappingVarsFoo :: OverlappingVars (Foo a a) where

1212 f a = a

1313

1414test = f (Foo "" 0)

15−

examples/failing/ProgrammableTypeErrorsTypeString.pursnew file+18

@@ -0,0 +1,18 @@

1+-- @shouldFailWith NoInstanceFound

3+module Main where

5+import Prelude

6+import Control.Monad.Eff (Eff)

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

9+newtype MyType a = MyType a

10+

11+instance cannotShowFunctions :: Fail ("Don't want to show " <> TypeString (MyType a) <> " because.") => Show (MyType a) where

12+ show _ = "unreachable"

13+

14+infixl 6 type TypeConcat as <>

15+

16+main :: Eff _ _

17+main = do

18+ log $ show (MyType 2)

examples/failing/TypeWildcards3.purs+1−2

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

1−-- @shouldFailWith ErrorParsingModule

1+-- @shouldFailWith InvalidInstanceHead

22module TypeWildcards where

44import Prelude

@@ -7,4 +7,3 @@ data Foo a = Foo

88instance showFoo :: Show (Foo _) where

99 show Foo = "Foo"

10−

examples/failing/UnifyInTypeInstanceLookup.pursdeleted−22

@@ -1,22 +0,0 @@

1−-- @shouldFailWith NoInstanceFound

2−-- See issue #390.

3−-- TODO: Improve this error.

4−module Main where

5−

6−import Prelude

7−

8−data Z = Z

9−data S n = S n

10−

11−data T

12−data F

13−

14−class EQ x y b

15−instance eqT :: EQ x x T

16−instance eqF :: EQ x y F

17−

18−foreign import test :: forall a b. (EQ a b T) => a -> b -> a

19−

20−foreign import anyNat :: forall a. a

21−

22−test1 = test anyNat (S Z)

examples/passing/1807.pursnew file+14

@@ -0,0 +1,14 @@

1+module Main where

3+import Prelude

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

6+fn = _.b.c.d

7+a = {b:{c:{d:2}}}

9+d :: Int

10+d = fn a + a.b.c.d

11+

12+main = if fn a + a.b.c.d == 4

13+ then log "Done"

14+ else log "Fail"

examples/passing/ConstraintParsingIssue.pursnew file+9

@@ -0,0 +1,9 @@

1+module Main where

3+import Control.Monad.Eff.Console

5+class X a

7+instance x :: X (Array (Array a)) => X (Array a)

9+main = log "Done"

examples/passing/DeriveNewtype.pursnew file+27

@@ -0,0 +1,27 @@

1+module Main where

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

5+import Data.Newtype

7+newtype Test = Test String

9+derive instance newtypeTest :: Newtype Test _

10+

11+t :: Test

12+t = wrap "hello"

13+

14+a :: String

15+a = unwrap t

16+

17+newtype First a = First a

18+

19+derive instance newtypeFirst :: Newtype (First b) _

20+

21+f :: First Int

22+f = wrap 1

23+

24+i :: Int

25+i = unwrap f

26+

27+main = log "Done"

examples/passing/FunWithFunDeps.jsnew file+32

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

2+//: forall e. FVect Z e

3+exports.fnil = [];

5+//: forall n e. e -> FVect n e -> FVect (S n) e

6+exports.fcons = function (hd) {

7+ return function (tl) {

8+ return [hd].concat(tl);

9+ };

10+};

11+

12+exports.fappend = function (dict) {

13+ return function (left) {

14+ return function (right) {

15+ return left.concat(right);

16+ };

17+ };

18+};

19+

20+exports.fflatten = function (dict) {

21+ return function (v) {

22+ var accRef = [];

23+ for (var indexRef = 0; indexRef < v.length; indexRef += 1) {

24+ accRef = accRef.concat(v[indexRef]);

25+ }

26+ return accRef;

27+ };

28+};

29+

30+exports.ftoArray = function (vect) {

31+ return vect;

32+};

examples/passing/FunWithFunDeps.pursnew file+41

@@ -0,0 +1,41 @@

1+-- Taken from https://github.com/LiamGoodacre/purescript-fun-with-fundeps

3+module Main where

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

7+-- Nat : Type

8+data Z

9+data S n

10+

11+type S2 n = S (S n)

12+type S3 n = S (S2 n)

13+type S4 n = S (S3 n)

14+type S5 n = S (S4 n)

15+type S15 n = S5 (S5 (S5 n))

16+

17+class NatPlus l r o | l r -> o

18+instance natPlusZ :: NatPlus Z r r

19+instance natPlusS :: (NatPlus l r o) => NatPlus (S l) r (S o)

20+

21+class NatMult l r o | l r -> o

22+instance natMultZ :: NatMult Z n Z

23+instance natMultS :: (NatMult m n r, NatPlus n r s) => NatMult (S m) n s

24+

25+-- Foreign Vect

26+foreign import data FVect :: * -> * -> *

27+foreign import fnil :: forall e. FVect Z e

28+foreign import fcons :: forall n e. e -> FVect n e -> FVect (S n) e

29+foreign import fappend :: forall l r o e. (NatPlus l r o) => FVect l e -> FVect r e -> FVect o e

30+foreign import fflatten :: forall f s t o. (NatMult f s o) => FVect f (FVect s t) -> FVect o t

31+foreign import ftoArray :: forall n e. FVect n e -> Array e

32+

33+-- should be able to figure these out

34+fsingleton x = fcons x fnil

35+fexample = fcons 1 (fsingleton 2) `fappend` fsingleton 3 `fappend` fcons 4 (fsingleton 5)

36+fexample2 = fexample `fappend` fexample `fappend` fexample

37+fexample3 = fsingleton fexample `fappend` fsingleton fexample `fappend` fsingleton fexample

38+

39+fexample4 = fflatten fexample3

40+

41+main = log "Done"

examples/passing/FunctionalDependencies.pursnew file+21

@@ -0,0 +1,21 @@

1+module Main where

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

5+data Nil

6+data Cons x xs

8+class Append a b c | a b -> c

10+instance appendNil :: Append Nil b b

11+

12+instance appendCons :: Append xs b c => Append (Cons x xs) b (Cons x c)

13+

14+data Proxy a = Proxy

15+

16+appendProxy :: forall a b c. Append a b c => Proxy a -> Proxy b -> Proxy c

17+appendProxy Proxy Proxy = Proxy

18+

19+test = appendProxy (Proxy :: Proxy (Cons Int Nil)) (Proxy :: Proxy (Cons String Nil))

20+

21+main = log "Done"

examples/passing/GHCGenerics.pursnew file+140

@@ -0,0 +1,140 @@

1+-- An example to show how we could implement GHC-style Generics using

2+-- functional dependencies.

3+--

4+-- See https://hackage.haskell.org/package/base-4.9.0.0/docs/GHC-Generics.html

6+module Main where

8+import Prelude

9+import Control.Monad.Eff (Eff)

10+import Control.Monad.Eff.Console (CONSOLE, log, logShow)

11+

12+-- Representation for types with no constructors

13+data V1

14+

15+-- Representation for constructors with no arguments

16+data U1 = U1

17+

18+-- Representation for sum types

19+data Sum a b = Inl a | Inr b

20+

21+infixr 5 type Sum as +

22+

23+-- Representation for product types

24+data Product a b = Product a b

25+

26+infixr 6 type Product as *

27+

28+-- Representation for data constructors, with the data constructor name indicated

29+-- at the type level.

30+data Ctor (name :: Symbol) a = Ctor a

31+

32+-- Representation for occurrences of other types in a data type definition.

33+data K a = K a

34+

35+-- The Generic class asserts the existence of a type function from "real" types

36+-- to representation types, and an isomorphism between them.

37+class Generic a repr | a -> repr where

38+ to :: a -> repr

39+ from :: repr -> a

40+

41+-- We can write an instance for the (recursive) type of lists. Note that these

42+-- instances would be generated by the compiler ideally.

43+data List a = Nil | Cons a (List a)

44+

45+instance genericList :: Generic (List a) (Ctor "Nil" U1 + Ctor "Cons" (K a * K (List a))) where

46+ to Nil = Inl (Ctor U1)

47+ to (Cons x xs) = Inr (Ctor (Product (K x) (K xs)))

48+ from (Inl (Ctor U1)) = Nil

49+ from (Inr (Ctor (Product (K x) (K xs)))) = Cons x xs

50+

51+-- We'd like to refect type level strings (for data constructor names) at the value

52+-- level, so that we can "show" them. Again, these instances would ideally be derived

53+-- for us.

54+class KnownSymbol (sym :: Symbol) where

55+ symbol :: forall proxy. proxy sym -> String

56+

57+instance knownSymbolNil :: KnownSymbol "Nil" where

58+ symbol _ = "Nil"

59+

60+instance knownSymbolCons :: KnownSymbol "Cons" where

61+ symbol _ = "Cons"

62+

63+-- A proxy for a type-level string.

64+data SProxy (sym :: Symbol) = SProxy

65+

66+-- To write generic functions, we create a corresponding type class, and use the

67+-- type class machinery to infer the correct function based on the representation

68+-- type.

69+class GShow a where

70+ gShow :: a -> String

71+

72+-- Now provide instances for GShow for the appropriate representation types.

73+-- Note: we don't have to implement all instances here.

74+

75+instance gShowU1 :: GShow U1 where

76+ gShow _ = ""

77+

78+instance gShowSum :: (GShow a, GShow b) => GShow (a + b) where

79+ gShow (Inl a) = gShow a

80+ gShow (Inr b) = gShow b

81+

82+instance gShowProduct :: (GShow a, GShow b) => GShow (a * b) where

83+ gShow (Product a b) = gShow a <> gShow b

84+

85+instance gShowCtor :: (KnownSymbol ctor, GShow a) => GShow (Ctor ctor a) where

86+ gShow (Ctor a) = "(" <> symbol (SProxy :: SProxy ctor) <> gShow a <> ")"

87+

88+instance gShowK :: Show a => GShow (K a) where

89+ gShow (K a) = " " <> show a

90+

91+-- Now we can implement a generic show function which uses the GShow instance

92+-- on the representation type.

93+genericShow :: forall a repr. (Generic a repr, GShow repr) => a -> String

94+genericShow x = gShow (to x)

95+

96+-- Note how the required instance here is Show a, and not Generic a.

97+-- This allows us to use generic programming on a wider variety of types

98+-- (including types which contain foreign types) than we can use now.

99+instance showList :: Show a => Show (List a) where

100+ show xs = genericShow xs -- (we need to eta expand here to avoid stack overflow

101+ -- due to recursion implicit in the instance lookup)

102+

103+-- Another example: Eq

104+

105+class GEq a where

106+ gEq :: a -> a -> Boolean

107+

108+instance gEqU1 :: GEq U1 where

109+ gEq _ _ = true

110+

111+instance gEqSum :: (GEq a, GEq b) => GEq (a + b) where

112+ gEq (Inl a1) (Inl a2) = gEq a1 a2

113+ gEq (Inr b1) (Inr b2) = gEq b1 b2

114+ gEq _ _ = false

115+

116+instance gEqProduct :: (GEq a, GEq b) => GEq (a * b) where

117+ gEq (Product a1 b1) (Product a2 b2) = gEq a1 a2 && gEq b1 b2

118+

119+instance gEqCtor :: (KnownSymbol ctor, GEq a) => GEq (Ctor ctor a) where

120+ gEq (Ctor a1) (Ctor a2) = gEq a1 a2

121+

122+instance gEqK :: Eq a => GEq (K a) where

123+ gEq (K a1) (K a2) = a1 == a2

124+

125+genericEq :: forall a repr. (Generic a repr, GEq repr) => a -> a -> Boolean

126+genericEq x y = gEq (to x) (to y)

127+

128+instance eqList :: Eq a => Eq (List a) where

129+ eq xs ys = genericEq xs ys

130+

131+main :: Eff (console :: CONSOLE) Unit

132+main = do

133+ logShow (Cons 1 Nil)

134+ logShow (Cons 1 (Cons 2 Nil))

135+ logShow (Cons 'x' (Cons 'y' (Cons 'z' Nil)))

136+

137+ logShow (Cons 1 (Cons 2 Nil) == Cons 1 (Cons 2 Nil))

138+ logShow (Cons 1 (Cons 2 Nil) == Cons 1 Nil)

139+

140+ log "Done"

examples/passing/NewtypeClass.pursnew file+39

@@ -0,0 +1,39 @@

1+module Main where

3+import Prelude

4+import Control.Monad.Eff

5+import Control.Monad.Eff.Console

7+class Newtype t a | t -> a where

8+ wrap :: a -> t

9+ unwrap :: t -> a

10+

11+instance newtypeMultiplicative :: Newtype (Multiplicative a) a where

12+ wrap = Multiplicative

13+ unwrap (Multiplicative a) = a

14+

15+data Multiplicative a = Multiplicative a

16+

17+instance semiringMultiplicative :: Semiring a => Semigroup (Multiplicative a) where

18+ append (Multiplicative a) (Multiplicative b) = Multiplicative (a * b)

19+

20+data Pair a = Pair a a

21+

22+foldPair :: forall a s. Semigroup s => (a -> s) -> Pair a -> s

23+foldPair f (Pair a b) = f a <> f b

24+

25+ala

26+ :: forall f t a

27+ . (Functor f, Newtype t a)

28+ => (a -> t)

29+ -> ((a -> t) -> f t)

30+ -> f a

31+ala _ f = map unwrap (f wrap)

32+

33+test = ala Multiplicative foldPair

34+

35+test1 = ala Multiplicative foldPair (Pair 2 3)

36+

37+main = do

38+ logShow (test (Pair 2 3))

39+ log "Done"

examples/passing/NewtypeInstance.pursnew file+41

@@ -0,0 +1,41 @@

1+module Main where

3+import Prelude

4+import Control.Monad.Eff

5+import Control.Monad.Eff.Console

7+newtype X = X String

9+derive newtype instance showX :: Show X

10+

11+derive newtype instance eqX :: Eq X

12+

13+derive newtype instance ordX :: Ord X

14+

15+newtype Y a = Y (Array a)

16+

17+derive newtype instance showY :: Show (Y String)

18+

19+class Singleton a b where

20+ singleton :: a -> b

21+

22+instance singletonArray :: Singleton a (Array a) where

23+ singleton x = [x]

24+

25+derive newtype instance singletonY :: Singleton a (Y a)

26+

27+newtype MyArray a = MyArray (Array a)

28+

29+derive newtype instance showMyArray :: Show a => Show (MyArray a)

30+

31+derive newtype instance functorMyArray :: Functor MyArray

32+

33+newtype ProxyArray x a = ProxyArray (Array a)

34+

35+derive newtype instance functorProxyArray :: Functor (ProxyArray x)

36+

37+main = do

38+ logShow (X "test")

39+ logShow (singleton "test" :: Y String)

40+ logShow (map show (MyArray [1, 2, 3]))

41+ log "Done"

examples/passing/NumberLiterals.purs+2−2

@@ -19,8 +19,8 @@ main = do

1919 test "32.96176575630599" 32.96176575630599

2020 test "38.47735512322269" 38.47735512322269

2121

22− test "10000000000" 1e10

23− test "10000000000" 1.0e10

22+ test "10000000000.0" 1e10

23+ test "10000000000.0" 1.0e10

2424 test "0.00001" 1e-5

2525 test "0.00001" 1.0e-5

2626 test "1.5339794352098402e-118" 1.5339794352098402e-118

examples/passing/RowPolyInstanceContext.purs+1−1

@@ -3,7 +3,7 @@ module Main where

33import Prelude

44import Control.Monad.Eff.Console (log)

6−class T s m where

6+class T s m | m -> s where

77 state :: (s -> s) -> m Unit

99data S s a = S (s -> { new :: s, ret :: a })

examples/passing/Stream.pursnew file+26

@@ -0,0 +1,26 @@

1+module Main where

3+import Prelude

5+import Control.Monad.Eff (Eff)

6+import Control.Monad.Eff.Console (CONSOLE, log)

8+class IsStream el s | s -> el where

9+ cons :: el -> (Unit -> s) -> s

10+ uncons :: s -> { head :: el, tail :: s }

11+

12+data Stream a = Stream a (Unit -> Stream a)

13+

14+instance streamIsStream :: IsStream a (Stream a) where

15+ cons x xs = Stream x xs

16+ uncons (Stream x f) = { head: x, tail: f unit }

17+

18+test :: forall el s. IsStream el s => s -> s

19+test s = case uncons s of

20+ { head, tail } -> cons head \_ -> tail

21+

22+main :: Eff (console :: CONSOLE) Unit

23+main = do

24+ let dones :: Stream String

25+ dones = cons "Done" \_ -> dones

26+ log (uncons (test dones)).head

examples/passing/UnifyInTypeInstanceLookup.pursnew file+25

@@ -0,0 +1,25 @@

1+module Main where

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

5+data Z = Z

6+data S n = S n

8+data T

9+data F

10+

11+class EQ x y b

12+instance eqT :: EQ x x T

13+instance eqF :: EQ x y F

14+

15+test :: forall a b. (EQ a b T) => a -> b -> a

16+test a _ = a

17+

18+spin :: forall a b. a -> b

19+spin a = spin a

20+

21+-- Expected type:

22+-- forall t. (EQ t (S Z) T) => t

23+test1 = test (spin 1) (S Z)

24+

25+main = log "Done"

examples/passing/WildcardInInstance.pursnew file+23

@@ -0,0 +1,23 @@

1+module Main where

3+import Prelude

4+import Control.Monad.Eff

5+import Control.Monad.Eff.Console

7+-- Until the functional dependency gets added to purescript-eff,

8+-- we need this here.

9+class Monad m <= MonadEff eff m | m -> eff where

10+ liftEff :: forall a. Eff eff a -> m a

11+

12+instance monadEffEff :: MonadEff eff (Eff eff) where

13+ liftEff = id

14+

15+-- This should generate a warning with the correct inferred type.

16+test :: forall m. MonadEff _ m => m Unit

17+test = liftEff $ log "Done"

18+

19+test1 :: Eff _ Unit

20+test1 = liftEff $ log "Done"

21+

22+main :: forall eff. Eff (console :: CONSOLE | eff) Unit

23+main = test

examples/warning/UnusedExplicitImportTypeOp.pursnew file+9

@@ -0,0 +1,9 @@

1+-- @shouldWarnWith UnusedExplicitImport

2+module Main where

4+import Prelude (Unit, unit, pure)

5+import Control.Monad.Eff (Eff)

6+import Lib (type (~>), natId)

8+main :: Eff () Unit

9+main = natId (pure unit)

examples/warning/UnusedExplicitImportTypeOp/Lib.pursnew file+8

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

1+module Lib where

3+type Nat f g = ∀ x. f x → g x

5+infixr 4 type Nat as ~>

7+natId ∷ ∀ f. f ~> f

8+natId x = x

examples/warning/UnusedExplicitImportValOp.pursnew file+8

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

1+-- @shouldWarnWith UnusedExplicitImport

2+module Main where

4+import Prelude (Unit, unit, pure, (+))

5+import Control.Monad.Eff (Eff)

7+main :: Eff () Unit

8+main = pure unit

hierarchy/Main.hs+21−18

@@ -18,13 +18,16 @@

1818

1919module Main where

2020

21+import Control.Applicative (optional)

2122import Control.Monad (unless)

2223

2324import Data.List (intercalate,nub,sort)

2425import Data.Foldable (for_)

2526import Data.Version (showVersion)

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

2628

27−import Options.Applicative

29+import Options.Applicative (Parser)

30+import qualified Options.Applicative as Opts

2831import System.Directory (createDirectoryIfMissing)

2932import System.FilePath ((</>))

3033import System.FilePath.Glob (glob)

@@ -40,7 +43,7 @@ data HierarchyOptions = HierarchyOptions

4043 , hierarchyOutput :: Maybe FilePath

4144 }

4245

43−newtype SuperMap = SuperMap { unSuperMap :: Either (P.ProperName 'P.ClassName) ((P.ProperName 'P.ClassName), (P.ProperName 'P.ClassName)) }

46+newtype SuperMap = SuperMap { unSuperMap :: Either (P.ProperName 'P.ClassName) (P.ProperName 'P.ClassName, P.ProperName 'P.ClassName) }

4447 deriving Eq

4548

4649instance Show SuperMap where

@@ -83,33 +86,33 @@ compile (HierarchyOptions inputGlob mOutput) = do

8386 exitSuccess

8487

8588superClasses :: P.Declaration -> [SuperMap]

86−superClasses (P.TypeClassDeclaration sub _ supers@(_:_) _) =

89+superClasses (P.TypeClassDeclaration sub _ supers@(_:_) _ _) =

8790 fmap (\(P.Constraint (P.Qualified _ super) _ _) -> SuperMap (Right (super, sub))) supers

88−superClasses (P.TypeClassDeclaration sub _ _ _) = [SuperMap (Left sub)]

91+superClasses (P.TypeClassDeclaration sub _ _ _ _) = [SuperMap (Left sub)]

8992superClasses (P.PositionedDeclaration _ _ decl) = superClasses decl

9093superClasses _ = []

9194

9295inputFile :: Parser FilePath

93−inputFile = strArgument $

94− metavar "FILE"

95− <> value "main.purs"

96− <> showDefault

97− <> help "The input file to generate a hierarchy from"

96+inputFile = Opts.strArgument $

97+ Opts.metavar "FILE"

98+ <> Opts.value "main.purs"

99+ <> Opts.showDefault

100+ <> Opts.help "The input file to generate a hierarchy from"

98101

99102outputFile :: Parser (Maybe FilePath)

100−outputFile = optional . strOption $

101− short 'o'

102− <> long "output"

103− <> help "The output directory"

103+outputFile = optional . Opts.strOption $

104+ Opts.short 'o'

105+ <> Opts.long "output"

106+ <> Opts.help "The output directory"

104107

105108pscOptions :: Parser HierarchyOptions

106109pscOptions = HierarchyOptions <$> inputFile

107110 <*> outputFile

108111

109112main :: IO ()

110−main = execParser opts >>= compile

113+main = Opts.execParser opts >>= compile

111114 where

112− opts = info (helper <*> pscOptions) infoModList

113− infoModList = fullDesc <> headerInfo <> footerInfo

114− headerInfo = header "hierarchy - Creates a GraphViz directed graph of PureScript TypeClasses"

115− footerInfo = footer $ "hierarchy " ++ showVersion Paths.version

115+ opts = Opts.info (Opts.helper <*> pscOptions) infoModList

116+ infoModList = Opts.fullDesc <> headerInfo <> footerInfo

117+ headerInfo = Opts.header "hierarchy - Creates a GraphViz directed graph of PureScript TypeClasses"

118+ footerInfo = Opts.footer $ "hierarchy " ++ showVersion Paths.version

license-generator/header.txt+9−17

@@ -1,23 +1,15 @@

1−The MIT License (MIT)

2−

42contributors

5+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

7+1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.

6−Permission is hereby granted, free of charge, to any person obtaining a copy of

7−this software and associated documentation files (the "Software"), to deal in

8−the Software without restriction, including without limitation the rights to

9−use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of

10−the Software, and to permit persons to whom the Software is furnished to do so,

11−subject to the following conditions:

1210

13−The above copyright notice and this permission notice shall be included in all

14−copies or substantial portions of the Software.

11+3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.

1512

16−THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR

17−IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS

18−FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR

19−COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER

20−IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN

21−CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

2214

2315PureScript uses the following Haskell library packages. Their license files follow.

pcc/Main.hs+5

@@ -158,6 +158,10 @@ sourceMaps = switch $

158158 long "source-maps"

159159 <> help "Generate source maps"

160160

161+dumpCoreFn :: Parser Bool

162+dumpCoreFn = switch $

163+ long "dump-corefn"

164+ <> help "Dump the (functional) core representation of the compiled code at output/*/corefn.json"

161165

162166options :: Parser P.Options

163167options = P.Options <$> noTco

@@ -167,6 +171,7 @@ options = P.Options <$> noTco

167171 <*> verboseErrors

168172 <*> (not <$> comments)

169173 <*> sourceMaps

174+ <*> dumpCoreFn

170175

171176pccMakeOptions :: Parser PCCMakeOptions

172177pccMakeOptions = PCCMakeOptions <$> many inputFile

pcc/TestMain.hs+2

@@ -105,6 +105,7 @@ packages =

105105 , ("purescript-console", "")

106106 , ("purescript-functions", "")

107107 , ("purescript-partial", "")

108+ , ("purescript-newtype", "")

108109 ]

109110

110111-------------------------------------------------------------------------------

@@ -124,4 +125,5 @@ skipped :: [String]

124125-------------------------------------------------------------------------------

125126skipped =

126127 [ "NumberLiterals.purs" -- unreliable float comparison, test manually

128+ , "FunWithFunDeps.purs" -- requires FFI

127129 ]

psc-bundle/Main.hs+28−25

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

99import Data.Traversable (for)

1010import Data.Version (showVersion)

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

1112

1213import Control.Applicative

1314import Control.Monad

@@ -24,7 +25,8 @@ import System.Directory (createDirectoryIfMissing)

2425

2526import Language.PureScript.Bundle

2627

27−import Options.Applicative as Opts

28+import Options.Applicative (Parser, ParseError (..))

29+import qualified Options.Applicative as Opts

2830

2931import qualified Paths_purescript as Paths

3032

@@ -64,41 +66,41 @@ options = Options <$> some inputFile

6466 <*> namespace

6567 where

6668 inputFile :: Parser FilePath

67− inputFile = strArgument $

68− metavar "FILE"

69− <> help "The input .js file(s)"

69+ inputFile = Opts.strArgument $

70+ Opts.metavar "FILE"

71+ <> Opts.help "The input .js file(s)"

7072

7173 outputFile :: Parser FilePath

72− outputFile = strOption $

73− short 'o'

74− <> long "output"

75− <> help "The output .js file"

74+ outputFile = Opts.strOption $

75+ Opts.short 'o'

76+ <> Opts.long "output"

77+ <> Opts.help "The output .js file"

7678

7779 entryPoint :: Parser String

78− entryPoint = strOption $

79− short 'm'

80− <> long "module"

81− <> help "Entry point module name(s). All code which is not a transitive dependency of an entry point module will be removed."

80+ entryPoint = Opts.strOption $

81+ Opts.short 'm'

82+ <> Opts.long "module"

83+ <> Opts.help "Entry point module name(s). All code which is not a transitive dependency of an entry point module will be removed."

8284

8385 mainModule :: Parser String

84− mainModule = strOption $

85− long "main"

86− <> help "Generate code to run the main method in the specified module."

86+ mainModule = Opts.strOption $

87+ Opts.long "main"

88+ <> Opts.help "Generate code to run the main method in the specified module."

8789

8890 namespace :: Parser String

89− namespace = strOption $

90− short 'n'

91− <> long "namespace"

91+ namespace = Opts.strOption $

92+ Opts.short 'n'

93+ <> Opts.long "namespace"

9294 <> Opts.value "PS"

93− <> showDefault

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

95+ <> Opts.showDefault

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

9597

9698-- | Make it go.

9799main :: IO ()

98100main = do

99101 hSetEncoding stdout utf8

100102 hSetEncoding stderr utf8

101− opts <- execParser (info (version <*> helper <*> options) infoModList)

103+ opts <- Opts.execParser (Opts.info (version <*> Opts.helper <*> options) infoModList)

102104 output <- runExceptT (app opts)

103105 case output of

104106 Left err -> do

@@ -111,9 +113,10 @@ main = do

111113 writeFile outputFile js

112114 Nothing -> putStrLn js

113115 where

114− infoModList = fullDesc <> headerInfo <> footerInfo

115− headerInfo = header "psc-bundle - Bundles compiled PureScript modules for the browser"

116− footerInfo = footer $ "psc-bundle " ++ showVersion Paths.version

116+ infoModList = Opts.fullDesc <> headerInfo <> footerInfo

117+ headerInfo = Opts.header "psc-bundle - Bundles compiled PureScript modules for the browser"

118+ footerInfo = Opts.footer $ "psc-bundle " ++ showVersion Paths.version

117119

118120 version :: Parser (a -> a)

119− version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden

121+ version = Opts.abortOption (InfoMsg (showVersion Paths.version)) $

122+ Opts.long "version" <> Opts.help "Show the version number" <> Opts.hidden

psc-docs/Tags.hs+1−1

@@ -13,6 +13,6 @@ tags = concatMap dtags . P.exportedDeclarations

1313 names (P.TypeDeclaration ident _) = [P.showIdent ident]

1414 names (P.ExternDeclaration ident _) = [P.showIdent ident]

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

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

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

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

1818 names _ = []

psc-ide-client/Main.hs+8−5

@@ -8,8 +8,10 @@ import Control.Exception

88import qualified Data.ByteString.Char8 as BS8

99import qualified Data.Text.IO as T

1010import Data.Version (showVersion)

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

1112import Network

12−import Options.Applicative

13+import Options.Applicative (ParseError (..))

14+import qualified Options.Applicative as Opts

1315import System.Exit

1416import System.IO

1517

@@ -21,15 +23,16 @@ data Options = Options

2123

2224main :: IO ()

2325main = do

24− Options port <- execParser opts

26+ Options port <- Opts.execParser opts

2527 client port

2628 where

2729 parser =

2830 Options <$>

2931 (PortNumber . fromIntegral <$>

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

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

32− version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden

32+ Opts.option Opts.auto (Opts.long "port" <> Opts.short 'p' <> Opts.value (4242 :: Integer)))

33+ opts = Opts.info (version <*> Opts.helper <*> parser) mempty

34+ version = Opts.abortOption (InfoMsg (showVersion Paths.version)) $

35+ Opts.long "version" <> Opts.help "Show the version number" <> Opts.hidden

3336

3437client :: PortID -> IO ()

3538client port = do

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

@@ -38,7 +38,8 @@ import Network hiding (socketPort, accept)

3838import Network.BSD (getProtocolNumber)

3939import Network.Socket hiding (PortNumber, Type,

4040 sClose)

41−import Options.Applicative hiding ((<>))

41+import Options.Applicative (ParseError (..))

42+import qualified Options.Applicative as Opts

4243import System.Directory

4344import System.FilePath

4445import System.IO hiding (putStrLn, print)

@@ -55,7 +56,7 @@ listenOnLocalhost port = do

5556 sClose

5657 (\sock -> do

5758 setSocketOption sock ReuseAddr 1

58− bindSocket sock (SockAddrInet port localhost)

59+ bind sock (SockAddrInet port localhost)

5960 listen sock maxListenQueue

6061 pure sock)

6162

@@ -70,7 +71,7 @@ data Options = Options

7071

7172main :: IO ()

7273main = do

73− Options dir globs outputPath port noWatch debug <- execParser opts

74+ Options dir globs outputPath port noWatch debug <- Opts.execParser opts

7475 maybe (pure ()) setCurrentDirectory dir

7576 ideState <- newTVarIO emptyIdeState

7677 cwd <- getCurrentDirectory

@@ -91,17 +92,17 @@ main = do

9192 where

9293 parser =

9394 Options

94− <$> optional (strOption (long "directory" `mappend` short 'd'))

95− <*> many (argument str (metavar "Source GLOBS..."))

96− <*> strOption (long "output-directory" `mappend` value "output/")

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

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

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

9798 <*> (fromIntegral <$>

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

99− <*> switch (long "no-watch")

100− <*> switch (long "debug")

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

102− version = abortOption

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

100+ <*> Opts.switch (Opts.long "no-watch")

101+ <*> Opts.switch (Opts.long "debug")

102+ opts = Opts.info (version <*> Opts.helper <*> parser) mempty

103+ version = Opts.abortOption

103104 (InfoMsg (showVersion Paths.version))

104− (long "version" `mappend` help "Show the version number")

105+ (Opts.long "version" `mappend` Opts.help "Show the version number")

105106

106107startServer :: PortNumber -> IdeEnvironment -> IO ()

107108startServer port env = withSocketsDo $ do

psc-ide-server/PROTOCOL.md+46−30

@@ -51,27 +51,7 @@ definition position, if it can be found in the passed source files.

5151```

5252

5353**Result:**

54−The possible types are returned in the same format as completions + eventual position information

55−```json

56−[

57− {

58− "module": "Data.Array",

59− "identifier": "filter",

60− "type": "forall a. (a -> Boolean) -> Array a -> Array a"

61− },

62− {

63− "module": "Data.Array",

64− "identifier": "filter",

65− "type": "forall a. (a -> Boolean) -> Array a -> Array a",

66− "definedAt":

67− {

68− "name": "/path/to/file",

69− "start": [1, 3],

70− "end": [3, 1]

71− }

72− }

73−]

74−```

54+The possible types are returned in the same format as completions

7555

7656### Complete

7757The `complete` command looks up possible completions/corrections.

@@ -88,7 +68,7 @@ The `complete` command looks up possible completions/corrections.

8868

8969 If no matcher is given every candidate, that passes the filters, is returned

9070 in no particular order.

91−

71+

9272```json

9373{

9474 "command": "complete",

@@ -104,18 +84,29 @@ The `complete` command looks up possible completions/corrections.

10484

10585The following format is returned as the Result:

10686

87+Both the `definedAt` aswell as the `documentation` field might be `null` if they

88+couldn't be extracted from a source file.

89+

10790```json

10891[

10992 {

11093 "module": "Data.Array",

11194 "identifier": "filter",

112− "type": "forall a. (a -> Boolean) -> Array a -> Array a"

95+ "type": "forall a. (a -> Boolean) -> Array a -> Array a",

96+ "expandedType": "forall a. (a -> Boolean) -> Array a -> Array a",

97+ "definedAt":

98+ {

99+ "name": "/path/to/file",

100+ "start": [1, 3],

101+ "end": [3, 1]

102+ },

103+ "documentation": "A filtering function"

113104 }

114105]

115106```

116107

117108

118−### CaseSplit

109+### CaseSplit

119110

120111The CaseSplit command takes a line of source code, an area in that line of code

121112and replaces it with all patterns for a given type. The parameter `annotations`

@@ -259,9 +250,9 @@ Example:

259250 "importCommand": {

260251 "importCommand": "addImport",

261252 "identifier": "bind"

262− }

253+ }

263254 }

264−}

255+}

265256```

266257

267258### Rebuild

@@ -390,7 +381,7 @@ The list commmand can also list the imports for a given file.

390381

391382The list import command returns a list of imports where imports are of the following form:

392383

393−Implicit Import(`import Data.Array`):

384+Implicit Import (`import Data.Array`):

394385```json

395386[

396387 {

@@ -400,7 +391,7 @@ Implicit Import(`import Data.Array`):

400391]

401392```

402393

403−Implicit qualified Import(`import qualified Data.Array as A`):

394+Implicit qualified Import (`import Data.Array as A`):

404395```json

405396[

406397 {

@@ -411,7 +402,7 @@ Implicit qualified Import(`import qualified Data.Array as A`):

411402]

412403```

413404

414−Explicit Import(`import Data.Array (filter, filterM, join)`):

405+Explicit Import (`import Data.Array (filter, filterM, join)`):

415406```json

416407[

417408 {

@@ -422,7 +413,19 @@ Explicit Import(`import Data.Array (filter, filterM, join)`):

422413]

423414```

424415

425−Hiding Import(`import Data.Array hiding (filter, filterM, join)`):

416+Explicit qualified Import (`import Data.Array (filter, filterM, join) as A`):

417+```json

418+[

419+ {

420+ "module": "Data.Array",

421+ "importType": "explicit",

422+ "identifiers": ["filter", "filterM", "join"],

423+ "qualifier": "A"

424+ }

425+]

426+```

427+

428+Hiding Import (`import Data.Array hiding (filter, filterM, join)`):

426429```json

427430[

428431 {

@@ -432,6 +435,19 @@ Hiding Import(`import Data.Array hiding (filter, filterM, join)`):

432435 }

433436]

434437```

438+

439+Qualified Hiding Import (`import Data.Array hiding (filter, filterM, join) as A`):

440+```json

441+[

442+ {

443+ "module": "Data.Array",

444+ "importType": "hiding",

445+ "identifiers": ["filter", "filterM", "join"],

446+ "qualifier": "A"

447+ }

448+]

449+```

450+

435451### Cwd/Quit/Reset

436452`cwd` returns the working directory of the server(should be your project root).

437453

psc-publish/Main.hs+13−10

@@ -4,8 +4,10 @@ module Main where

44import Data.Version (Version(..), showVersion)

55import qualified Data.Aeson as A

66import qualified Data.ByteString.Lazy.Char8 as BL

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

8−import Options.Applicative hiding (str)

9+import Options.Applicative (Parser, ParseError (..))

10+import qualified Options.Applicative as Opts

911

1012import System.IO (hSetEncoding, stderr, stdout, utf8)

1113

@@ -14,9 +16,9 @@ import Language.PureScript.Publish

1416import Language.PureScript.Publish.ErrorsWarnings

1517

1618dryRun :: Parser Bool

17−dryRun = switch $

18− long "dry-run"

19− <> help "Produce no output, and don't require a tagged version to be checked out."

19+dryRun = Opts.switch $

20+ Opts.long "dry-run"

21+ <> Opts.help "Produce no output, and don't require a tagged version to be checked out."

2022

2123dryRunOptions :: PublishOptions

2224dryRunOptions = defaultPublishOptions

@@ -29,15 +31,16 @@ main :: IO ()

2931main = do

3032 hSetEncoding stdout utf8

3133 hSetEncoding stderr utf8

32− execParser opts >>= publish

34+ Opts.execParser opts >>= publish

3335 where

34− opts = info (version <*> helper <*> dryRun) infoModList

35− infoModList = fullDesc <> headerInfo <> footerInfo

36− headerInfo = header "psc-publish - Generates documentation packages for upload to http://pursuit.purescript.org"

37− footerInfo = footer $ "psc-publish " ++ showVersion Paths.version

36+ opts = Opts.info (version <*> Opts.helper <*> dryRun) infoModList

37+ infoModList = Opts.fullDesc <> headerInfo <> footerInfo

38+ headerInfo = Opts.header "psc-publish - Generates documentation packages for upload to http://pursuit.purescript.org"

39+ footerInfo = Opts.footer $ "psc-publish " ++ showVersion Paths.version

3840

3941 version :: Parser (a -> a)

40− version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden

42+ version = Opts.abortOption (InfoMsg (showVersion Paths.version)) $

43+ Opts.long "version" <> Opts.help "Show the version number" <> Opts.hidden

4144

4245publish :: Bool -> IO ()

4346publish isDryRun =

psc/Main.hs+10−4

@@ -79,11 +79,11 @@ warnFileTypeNotFound = hPutStrLn stderr . ("psc: No files found using pattern: "

7979globWarningOnMisses :: (String -> IO ()) -> [FilePath] -> IO [FilePath]

8080globWarningOnMisses warn = concatMapM globWithWarning

8181 where

82− globWithWarning pattern = do

83− paths <- glob pattern

84− when (null paths) $ warn pattern

82+ globWithWarning pattern' = do

83+ paths <- glob pattern'

84+ when (null paths) $ warn pattern'

8585 return paths

86− concatMapM f = liftM concat . mapM f

86+ concatMapM f = fmap concat . mapM f

8787

8888readInput :: [FilePath] -> IO [(FilePath, String)]

8989readInput inputFiles = forM inputFiles $ \inFile -> (inFile, ) <$> readUTF8File inFile

@@ -143,6 +143,11 @@ sourceMaps = switch $

143143 long "source-maps"

144144 <> help "Generate source maps"

145145

146+dumpCoreFn :: Parser Bool

147+dumpCoreFn = switch $

148+ long "dump-corefn"

149+ <> help "Dump the (functional) core representation of the compiled code at output/*/corefn.json"

150+

146151

147152options :: Parser P.Options

148153options = P.Options <$> noTco

@@ -152,6 +157,7 @@ options = P.Options <$> noTco

152157 <*> verboseErrors

153158 <*> (not <$> comments)

154159 <*> sourceMaps

160+ <*> dumpCoreFn

155161

156162pscMakeOptions :: Parser PSCMakeOptions

157163pscMakeOptions = PSCMakeOptions <$> many inputFile

psci/Main.hs+3−3

@@ -207,7 +207,7 @@ browserBackend serverPort = Backend setup evaluate reload shutdown

207207 -- With many connected clients, all but one of

208208 -- these attempts will fail.

209209 tryPutMVar resultVar (unpack result)

210− Reload -> do

210+ Reload ->

211211 WS.sendTextData conn ("reload" :: Text)

212212

213213 shutdownHandler :: IO () -> IO ()

@@ -278,7 +278,7 @@ browserBackend serverPort = Backend setup evaluate reload shutdown

278278 Left err -> do

279279 putStrLn (unlines (Bundle.printErrorMessage err))

280280 exitFailure

281− Right js -> do

281+ Right js ->

282282 atomically $ writeTVar (browserBundleJS state) (Just js)

283283

284284 reload :: BrowserState -> IO ()

@@ -335,7 +335,7 @@ main = getOpt >>= loop

335335 (externs, env) <- ExceptT . runMake . make $ modules

336336 return (modules, externs, env)

337337 case psciBackend of

338− Backend setup eval reload (shutdown :: state -> IO ()) -> do

338+ Backend setup eval reload (shutdown :: state -> IO ()) ->

339339 case e of

340340 Left errs -> putStrLn (P.prettyPrintMultipleErrors P.defaultPPEOptions errs) >> exitFailure

341341 Right (modules, externs, env) -> do

purescript.cabal+13−8

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

11name: purescript

2−version: 0.9.3

2+version: 0.10.1

33cabal-version: >=1.8

44build-type: Simple

5−license: MIT

5+license: BSD3

66license-file: LICENSE

88maintainer: Phil Freeman <paf31@cantab.net>

99stability: experimental

1010synopsis: PureScript Programming Language Compiler

@@ -60,6 +60,7 @@ extra-source-files: examples/passing/*.purs

6060 , examples/failing/ConflictingImports2/*.purs

6161 , examples/failing/ConflictingQualifiedImports/*.purs

6262 , examples/failing/ConflictingQualifiedImports2/*.purs

63+ , examples/failing/DuplicateModule/*.purs

6364 , examples/failing/ExportConflictClass/*.purs

6465 , examples/failing/ExportConflictCtor/*.purs

6566 , examples/failing/ExportConflictType/*.purs

@@ -76,6 +77,7 @@ extra-source-files: examples/passing/*.purs

7677 , examples/failing/OrphanInstance/*.purs

7778 , examples/warning/*.purs

7879 , examples/warning/*.js

80+ , examples/warning/UnusedExplicitImportTypeOp/*.purs

7981 , examples/docs/bower_components/purescript-prelude/src/*.purs

8082 , examples/docs/bower.json

8183 , examples/docs/src/*.purs

@@ -101,7 +103,7 @@ source-repository head

101103

102104library

103105 build-depends: base >=4.8 && <5,

104− aeson >= 0.8 && < 1.1,

106+ aeson >= 0.8 && < 1.0,

105107 aeson-better-errors >= 0.8,

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

107109 base-compat >=0.6.0,

@@ -110,6 +112,7 @@ library

110112 bytestring -any,

111113 containers -any,

112114 clock -any,

115+ data-ordlist >= 0.4.7.0,

113116 directory >= 1.2,

114117 dlist -any,

115118 edit-distance -any,

@@ -117,7 +120,7 @@ library

117120 fsnotify >= 0.2.1,

118121 Glob >= 0.7 && < 0.8,

119122 haskeline >= 0.7.0.0,

120− http-client >= 0.4.30 && <0.5,

123+ http-client >= 0.4.30 && <0.6,

121124 http-types -any,

122125 language-javascript == 0.6.*,

123126 lifted-base >= 0.2.3 && < 0.2.4,

@@ -196,6 +199,7 @@ library

196199 Language.PureScript.CoreFn.Meta

197200 Language.PureScript.CoreFn.Module

198201 Language.PureScript.CoreFn.Traversals

202+ Language.PureScript.CoreFn.ToJSON

199203 Language.PureScript.Comments

200204 Language.PureScript.Environment

201205 Language.PureScript.Errors

@@ -332,7 +336,7 @@ library

332336executable psc

333337 build-depends: base >=4 && <5,

334338 purescript -any,

335− aeson >= 0.8 && < 1.1,

339+ aeson >= 0.8 && < 1.0,

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

337341 base-compat >=0.6.0,

338342 bytestring -any,

@@ -410,7 +414,7 @@ executable psc-docs

410414executable psc-publish

411415 build-depends: base >=4 && <5,

412416 purescript -any,

413− aeson -any,

417+ aeson >= 0.8 && < 1.0,

414418 bytestring -any,

415419 optparse-applicative -any

416420 main-is: Main.hs

@@ -457,7 +461,7 @@ executable psc-ide-server

457461 other-modules: Paths_purescript

458462 other-extensions:

459463 build-depends: base >=4 && <5,

460− aeson >= 0.8 && < 1.1,

464+ aeson >= 0.8 && < 1.0,

461465 bytestring -any,

462466 purescript -any,

463467 base-compat >=0.6.0,

@@ -563,6 +567,7 @@ test-suite tests

563567 Language.PureScript.Ide.ReexportsSpec

564568 Language.PureScript.Ide.SourceFile.IntegrationSpec

565569 Language.PureScript.Ide.SourceFileSpec

570+ Language.PureScript.Ide.StateSpec

566571 buildable: True

567572 hs-source-dirs: tests

568573

src/Control/Monad/Supply/Class.hs+4

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

88import Control.Monad.Supply

99import Control.Monad.State

10+import Control.Monad.Writer

1011

1112class Monad m => MonadSupply m where

1213 fresh :: m Integer

@@ -20,5 +21,8 @@ instance Monad m => MonadSupply (SupplyT m) where

2021instance MonadSupply m => MonadSupply (StateT s m) where

2122 fresh = lift fresh

2223

24+instance (Monoid w, MonadSupply m) => MonadSupply (WriterT w m) where

25+ fresh = lift fresh

26+

2327freshName :: MonadSupply m => m String

2428freshName = fmap (('$' :) . show) fresh

src/Language/PureScript/AST/Declarations.hs+21−11

@@ -47,7 +47,6 @@ data SimpleErrorMessage

4747 | MultipleValueOpFixities (OpName 'ValueOpName)

4848 | MultipleTypeOpFixities (OpName 'TypeOpName)

4949 | OrphanTypeDeclaration Ident

50− | RedefinedModule ModuleName [SourceSpan]

5150 | RedefinedIdent Ident

5251 | OverlappingNamesInLet

5352 | UnknownName (Qualified Name)

@@ -59,7 +58,7 @@ data SimpleErrorMessage

5958 | ScopeShadowing Name (Maybe ModuleName) [ModuleName]

6059 | DeclConflict Name Name

6160 | ExportConflict (Qualified Name) (Qualified Name)

62− | DuplicateModuleName ModuleName

61+ | DuplicateModule ModuleName [SourceSpan]

6362 | DuplicateTypeArgument String

6463 | InvalidDoBind

6564 | InvalidDoLet

@@ -77,6 +76,7 @@ data SimpleErrorMessage

7776 | NoInstanceFound Constraint

7877 | PossiblyInfiniteInstance (Qualified (ProperName 'ClassName)) [Type]

7978 | CannotDerive (Qualified (ProperName 'ClassName)) [Type]

79+ | InvalidNewtypeInstance (Qualified (ProperName 'ClassName)) [Type]

8080 | CannotFindDerivingType (ProperName 'TypeName)

8181 | DuplicateLabel String (Maybe Expr)

8282 | DuplicateValueDeclaration Ident

@@ -89,7 +89,6 @@ data SimpleErrorMessage

8989 | ExprDoesNotHaveType Expr Type

9090 | PropertyIsMissing String

9191 | AdditionalProperty String

92− | CannotApplyFunction Type Expr

9392 | TypeSynonymInstance

9493 | OrphanInstance Ident (Qualified (ProperName 'ClassName)) [Type]

9594 | InvalidNewtype (ProperName 'TypeName)

@@ -107,9 +106,9 @@ data SimpleErrorMessage

107106 | MisleadingEmptyTypeImport ModuleName (ProperName 'TypeName)

108107 | ImportHidingModule ModuleName

109108 | UnusedImport ModuleName

110− | UnusedExplicitImport ModuleName [String] (Maybe ModuleName) [DeclarationRef]

111− | UnusedDctorImport (ProperName 'TypeName)

112− | UnusedDctorExplicitImport (ProperName 'TypeName) [ProperName 'ConstructorName]

109+ | UnusedExplicitImport ModuleName [Name] (Maybe ModuleName) [DeclarationRef]

110+ | UnusedDctorImport ModuleName (ProperName 'TypeName) (Maybe ModuleName) [DeclarationRef]

111+ | UnusedDctorExplicitImport ModuleName (ProperName 'TypeName) [ProperName 'ConstructorName] (Maybe ModuleName) [DeclarationRef]

113112 | DuplicateSelectiveImport ModuleName

114113 | DuplicateImport ModuleName ImportDeclarationType (Maybe ModuleName)

115114 | DuplicateImportRef Name

@@ -123,6 +122,8 @@ data SimpleErrorMessage

123122 | InvalidOperatorInBinder (Qualified (OpName 'ValueOpName)) (Qualified Ident)

124123 | DeprecatedRequirePath

125124 | CannotGeneralizeRecursiveFunction Ident Type

125+ | CannotDeriveNewtypeForData (ProperName 'TypeName)

126+ | NonWildcardNewtypeInstance (ProperName 'TypeName)

126127 deriving (Show)

127128

128129-- | Error message hints, providing more detailed information about failure.

@@ -177,6 +178,10 @@ data Module = Module SourceSpan [Comment] ModuleName [Declaration] (Maybe [Decla

177178getModuleName :: Module -> ModuleName

178179getModuleName (Module _ _ name _ _) = name

179180

181+-- | Return a module's source span.

182+getModuleSourceSpan :: Module -> SourceSpan

183+getModuleSourceSpan (Module ss _ _ _ _) = ss

184+

180185-- |

181186-- Add an import declaration for a module if it does not already explicitly import it.

182187--

@@ -348,7 +353,7 @@ data Declaration

348353 -- |

349354 -- A type class declaration (name, argument, implies, member declarations)

350355 --

351− | TypeClassDeclaration (ProperName 'ClassName) [(String, Maybe Kind)] [Constraint] [Declaration]

356+ | TypeClassDeclaration (ProperName 'ClassName) [(String, Maybe Kind)] [Constraint] [FunctionalDependency] [Declaration]

352357 -- |

353358 -- A type instance declaration (name, dependencies, class name, instance types, member

354359 -- declarations)

@@ -374,10 +379,15 @@ pattern TypeFixityDeclaration fixity name op = FixityDeclaration (Right (TypeFix

374379

375380-- | The members of a type class instance declaration

376381data TypeInstanceBody

377− -- | This is a derived instance

378382 = DerivedInstance

379− -- | This is a regular (explicit) instance

383+ -- ^ This is a derived instance

384+ | NewtypeInstance

385+ -- ^ This is an instance derived from a newtype

386+ | NewtypeInstanceWithDictionary Expr

387+ -- ^ This is an instance derived from a newtype, desugared to include a

388+ -- dictionary for the type under the newtype.

380389 | ExplicitInstance [Declaration]

390+ -- ^ This is a regular (explicit) instance

381391 deriving (Show)

382392

383393mapTypeInstanceBody :: ([Declaration] -> [Declaration]) -> TypeInstanceBody -> TypeInstanceBody

@@ -385,8 +395,8 @@ mapTypeInstanceBody f = runIdentity . traverseTypeInstanceBody (Identity . f)

385395

386396-- | A traversal for TypeInstanceBody

387397traverseTypeInstanceBody :: (Applicative f) => ([Declaration] -> f [Declaration]) -> TypeInstanceBody -> f TypeInstanceBody

388−traverseTypeInstanceBody _ DerivedInstance = pure DerivedInstance

389398traverseTypeInstanceBody f (ExplicitInstance ds) = ExplicitInstance <$> f ds

399+traverseTypeInstanceBody _ other = pure other

390400

391401-- |

392402-- Test if a declaration is a value declaration

@@ -570,7 +580,7 @@ data Expr

570580 -- |

571581 -- A placeholder for a superclass dictionary to be turned into a TypeClassDictionary during typechecking

572582 --

573− | SuperClassDictionary (Qualified (ProperName 'ClassName)) [Type]

583+ | DeferredDictionary (Qualified (ProperName 'ClassName)) [Type]

574584 -- |

575585 -- A placeholder for an anonymous function argument

576586 --

src/Language/PureScript/AST/Exported.hs+1−1

@@ -133,7 +133,7 @@ isExported (Just exps) decl = any (matches decl) exps

133133 matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'

134134 matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'

135135 matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'

136− matches (TypeClassDeclaration ident _ _ _) (TypeClassRef ident') = ident == ident'

136+ matches (TypeClassDeclaration ident _ _ _ _) (TypeClassRef ident') = ident == ident'

137137 matches (ValueFixityDeclaration _ _ op) (ValueOpRef op') = op == op'

138138 matches (TypeFixityDeclaration _ _ op) (TypeOpRef op') = op == op'

139139 matches (PositionedDeclaration _ _ d) r = d `matches` r

src/Language/PureScript/AST/Traversals.hs+9−9

@@ -34,7 +34,7 @@ everywhereOnValues f g h = (f', g', h')

3434 f' (DataBindingGroupDeclaration ds) = f (DataBindingGroupDeclaration (map f' ds))

3535 f' (ValueDeclaration name nameKind bs val) = f (ValueDeclaration name nameKind (map h' bs) ((map (g' *** g') +++ g') val))

3636 f' (BindingGroupDeclaration ds) = f (BindingGroupDeclaration (map (\(name, nameKind, val) -> (name, nameKind, g' val)) ds))

37− f' (TypeClassDeclaration name args implies ds) = f (TypeClassDeclaration name args implies (map f' ds))

37+ f' (TypeClassDeclaration name args implies deps ds) = f (TypeClassDeclaration name args implies deps (map f' ds))

3838 f' (TypeInstanceDeclaration name cs className args ds) = f (TypeInstanceDeclaration name cs className args (mapTypeInstanceBody (map f') ds))

3939 f' (PositionedDeclaration pos com d) = f (PositionedDeclaration pos com (f' d))

4040 f' other = f other

@@ -101,7 +101,7 @@ everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)

101101 f' (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> traverse (f' <=< f) ds

102102 f' (ValueDeclaration name nameKind bs val) = ValueDeclaration name nameKind <$> traverse (h' <=< h) bs <*> eitherM (traverse (pairM (g' <=< g) (g' <=< g))) (g' <=< g) val

103103 f' (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> traverse (\(name, nameKind, val) -> (,,) name nameKind <$> (g val >>= g')) ds

104− f' (TypeClassDeclaration name args implies ds) = TypeClassDeclaration name args implies <$> traverse (f' <=< f) ds

104+ f' (TypeClassDeclaration name args implies deps ds) = TypeClassDeclaration name args implies deps <$> traverse (f' <=< f) ds

105105 f' (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (traverse (f' <=< f)) ds

106106 f' (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> (f d >>= f')

107107 f' other = f other

@@ -168,7 +168,7 @@ everywhereOnValuesM f g h = (f', g', h')

168168 f' (DataBindingGroupDeclaration ds) = (DataBindingGroupDeclaration <$> traverse f' ds) >>= f

169169 f' (ValueDeclaration name nameKind bs val) = (ValueDeclaration name nameKind <$> traverse h' bs <*> eitherM (traverse (pairM g' g')) g' val) >>= f

170170 f' (BindingGroupDeclaration ds) = (BindingGroupDeclaration <$> traverse (\(name, nameKind, val) -> (,,) name nameKind <$> g' val) ds) >>= f

171− f' (TypeClassDeclaration name args implies ds) = (TypeClassDeclaration name args implies <$> traverse f' ds) >>= f

171+ f' (TypeClassDeclaration name args implies deps ds) = (TypeClassDeclaration name args implies deps <$> traverse f' ds) >>= f

172172 f' (TypeInstanceDeclaration name cs className args ds) = (TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (traverse f') ds) >>= f

173173 f' (PositionedDeclaration pos com d) = (PositionedDeclaration pos com <$> f' d) >>= f

174174 f' other = f other

@@ -240,7 +240,7 @@ everythingOnValues (<>) f g h i j = (f', g', h', i', j')

240240 f' d@(ValueDeclaration _ _ bs (Right val)) = foldl (<>) (f d) (map h' bs) <> g' val

241241 f' d@(ValueDeclaration _ _ bs (Left gs)) = foldl (<>) (f d) (map h' bs ++ concatMap (\(grd, val) -> [g' grd, g' val]) gs)

242242 f' d@(BindingGroupDeclaration ds) = foldl (<>) (f d) (map (\(_, _, val) -> g' val) ds)

243− f' d@(TypeClassDeclaration _ _ _ ds) = foldl (<>) (f d) (map f' ds)

243+ f' d@(TypeClassDeclaration _ _ _ _ ds) = foldl (<>) (f d) (map f' ds)

244244 f' d@(TypeInstanceDeclaration _ _ _ _ (ExplicitInstance ds)) = foldl (<>) (f d) (map f' ds)

245245 f' d@(PositionedDeclaration _ _ d1) = f d <> f' d1

246246 f' d = f d

@@ -314,7 +314,7 @@ everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'

314314 f' s (ValueDeclaration _ _ bs (Right val)) = foldl (<>) r0 (map (h'' s) bs) <> g'' s val

315315 f' s (ValueDeclaration _ _ bs (Left gs)) = foldl (<>) r0 (map (h'' s) bs ++ concatMap (\(grd, val) -> [g'' s grd, g'' s val]) gs)

316316 f' s (BindingGroupDeclaration ds) = foldl (<>) r0 (map (\(_, _, val) -> g'' s val) ds)

317− f' s (TypeClassDeclaration _ _ _ ds) = foldl (<>) r0 (map (f'' s) ds)

317+ f' s (TypeClassDeclaration _ _ _ _ ds) = foldl (<>) r0 (map (f'' s) ds)

318318 f' s (TypeInstanceDeclaration _ _ _ _ (ExplicitInstance ds)) = foldl (<>) r0 (map (f'' s) ds)

319319 f' s (PositionedDeclaration _ _ d1) = f'' s d1

320320 f' _ _ = r0

@@ -395,7 +395,7 @@ everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j

395395 f' s (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> traverse (f'' s) ds

396396 f' s (ValueDeclaration name nameKind bs val) = ValueDeclaration name nameKind <$> traverse (h'' s) bs <*> eitherM (traverse (pairM (g'' s) (g'' s))) (g'' s) val

397397 f' s (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> traverse (thirdM (g'' s)) ds

398− f' s (TypeClassDeclaration name args implies ds) = TypeClassDeclaration name args implies <$> traverse (f'' s) ds

398+ f' s (TypeClassDeclaration name args implies deps ds) = TypeClassDeclaration name args implies deps <$> traverse (f'' s) ds

399399 f' s (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (traverse (f'' s)) ds

400400 f' s (PositionedDeclaration pos com d1) = PositionedDeclaration pos com <$> f'' s d1

401401 f' _ other = return other

@@ -482,7 +482,7 @@ everythingWithScope f g h i j = (f'', g'', h'', i'', \s -> snd . j'' s)

482482 f' s (BindingGroupDeclaration ds) =

483483 let s' = S.union s (S.fromList (map (\(name, _, _) -> name) ds))

484484 in foldMap (\(_, _, val) -> g'' s' val) ds

485− f' s (TypeClassDeclaration _ _ _ ds) = foldMap (f'' s) ds

485+ f' s (TypeClassDeclaration _ _ _ _ ds) = foldMap (f'' s) ds

486486 f' s (TypeInstanceDeclaration _ _ _ _ (ExplicitInstance ds)) = foldMap (f'' s) ds

487487 f' s (PositionedDeclaration _ _ d) = f'' s d

488488 f' _ _ = mempty

@@ -576,13 +576,13 @@ accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (con

576576 where

577577 forDecls (DataDeclaration _ _ _ dctors) = mconcat (concatMap (map f . snd) dctors)

578578 forDecls (ExternDeclaration _ ty) = f ty

579− forDecls (TypeClassDeclaration _ _ implies _) = mconcat (concatMap (map f . constraintArgs) implies)

579+ forDecls (TypeClassDeclaration _ _ implies _ _) = mconcat (concatMap (map f . constraintArgs) implies)

580580 forDecls (TypeInstanceDeclaration _ cs _ tys _) = mconcat (concatMap (map f . constraintArgs) cs) `mappend` mconcat (map f tys)

581581 forDecls (TypeSynonymDeclaration _ _ ty) = f ty

582582 forDecls (TypeDeclaration _ ty) = f ty

583583 forDecls _ = mempty

584584

585585 forValues (TypeClassDictionary c _ _) = mconcat (map f (constraintArgs c))

586− forValues (SuperClassDictionary _ tys) = mconcat (map f tys)

586+ forValues (DeferredDictionary _ tys) = mconcat (map f tys)

587587 forValues (TypedValue _ _ ty) = f ty

588588 forValues _ = mempty

src/Language/PureScript/Bundle.hs+19−7

@@ -43,6 +43,8 @@ data ErrorMessage

4343 | UnableToParseModule String

4444 | UnsupportedExport

4545 | ErrorInModule ModuleIdentifier ErrorMessage

46+ | MissingEntryPoint String

47+ | MissingMainModule String

4648 deriving (Show)

4749

4850-- | Modules are either "regular modules" (i.e. those generated by psc) or foreign modules.

@@ -125,8 +127,14 @@ printErrorMessage (ErrorInModule mid e) =

125127 : ""

126128 : map (" " ++) (printErrorMessage e)

127129 where

128− displayIdentifier (ModuleIdentifier name ty) =

129− name ++ " (" ++ showModuleType ty ++ ")"

130+ displayIdentifier (ModuleIdentifier name ty) =

131+ name ++ " (" ++ showModuleType ty ++ ")"

132+printErrorMessage (MissingEntryPoint mName) =

133+ [ "Couldn't find a CommonJS module for the specified entry point: " ++ mName

134+ ]

135+printErrorMessage (MissingMainModule mName) =

136+ [ "Couldn't find a CommonJS module for the specified main module: " ++ mName

137+ ]

130138

131139-- | Calculate the ModuleIdentifier which a require(...) statement imports.

132140checkImportPath :: String -> ModuleIdentifier -> S.Set String -> Either String ModuleIdentifier

@@ -256,7 +264,7 @@ toModule mids mid top

256264 = pure (Member stmt exported name decl [])

257265 toModuleElement stmt

258266 | Just props <- matchExportsAssignment stmt

259− = (ExportsList <$> traverse toExport (trailingCommaList props))

267+ = ExportsList <$> traverse toExport (trailingCommaList props)

260268 where

261269 toExport :: JSObjectProperty -> m (ExportType, String, JSExpression, [Key])

262270 toExport (JSPropertyNameandValue name _ [val]) =

@@ -524,7 +532,7 @@ codeGen optionsMainModule optionsNamespace ms = renderToString (JSAstProgram (p

524532 indent :: [JSStatement] -> [JSStatement]

525533 indent = everywhere (mkT squash)

526534 where

527− squash JSNoAnnot = (JSAnnot (TokenPn 0 0 2) [])

535+ squash JSNoAnnot = JSAnnot (TokenPn 0 0 2) []

528536 squash (JSAnnot pos ann) = JSAnnot (keepCol pos) (map splat ann)

529537

530538 splat (CommentA pos s) = CommentA (keepCol pos) s

@@ -571,15 +579,15 @@ codeGen optionsMainModule optionsNamespace ms = renderToString (JSAstProgram (p

571579 (JSSemi JSNoAnnot)

572580 ]

573581 where

574− lfHead (h:t) = (addAnn (WhiteSpace tokenPosnEmpty "\n ") h) : t

582+ lfHead (h:t) = addAnn (WhiteSpace tokenPosnEmpty "\n ") h : t

575583 lfHead x = x

576584

577585 addAnn :: CommentAnnotation -> JSStatement -> JSStatement

578586 addAnn a (JSExpressionStatement (JSStringLiteral ann s) _) =

579− (JSExpressionStatement (JSStringLiteral (appendAnn a ann) s) (JSSemi JSNoAnnot))

587+ JSExpressionStatement (JSStringLiteral (appendAnn a ann) s) (JSSemi JSNoAnnot)

580588 addAnn _ x = x

581589

582− appendAnn a JSNoAnnot = (JSAnnot tokenPosnEmpty [a])

590+ appendAnn a JSNoAnnot = JSAnnot tokenPosnEmpty [a]

583591 appendAnn a (JSAnnot _ anns) = JSAnnot tokenPosnEmpty (a:anns ++ [WhiteSpace tokenPosnEmpty " "])

584592

585593 runMain :: String -> [JSStatement]

@@ -609,6 +617,10 @@ bundle :: (MonadError ErrorMessage m)

609617 -> String -- ^ The namespace (e.g. PS).

610618 -> m String

611619bundle inputStrs entryPoints mainModule namespace = do

620+ forM_ mainModule $ \mname ->

621+ when (mname `notElem` map (moduleName . fst) inputStrs) (throwError (MissingMainModule mname))

622+ forM_ entryPoints $ \mIdent ->

623+ when (mIdent `notElem` map fst inputStrs) (throwError (MissingEntryPoint (moduleName mIdent)))

612624 input <- forM inputStrs $ \(ident, js) -> do

613625 ast <- either (throwError . ErrorInModule ident . UnableToParseModule) pure $ parse js (moduleName ident)

614626 return (ident, ast)

src/Language/PureScript/CodeGen/Cpp.hs+45−24

@@ -278,12 +278,12 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

278278 aty = Just $ CppAny [CppConst, CppRef]

279279 rty = Just $ CppAny []

280280

281− declToCpp _ (_, ident) val = do

281+ declToCpp qs (_, ident) val = do

282282 val' <- valueToCpp val

283283 return $

284284 CppVariableIntroduction

285285 (identToCpp ident, Just $ CppAny [CppConst])

286− []

286+ qs

287287 (Just val')

288288

289289 -------------------------------------------------------------------------------------------------

@@ -336,35 +336,46 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

336336

337337 recursive :: Cpp -> [Cpp]

338338 recursive cpp'@(CppFunction _ _ _ qs _) | CppRecursive `elem` qs = [cpp']

339+ recursive cpp'@(CppVariableIntroduction _ qs _) | CppRecursive `elem` qs = [cpp']

339340 recursive _ = []

340341

341342 removeRec :: Cpp -> Cpp

342− removeRec(CppFunction _ _ _ qs _) | CppRecursive `elem` qs = CppNoOp

343+ removeRec (CppFunction _ _ _ qs _) | CppRecursive `elem` qs = CppNoOp

344+ removeRec (CppVariableIntroduction _ qs _) | CppRecursive `elem` qs = CppNoOp

343345 removeRec cpp' = cpp'

344346

347+ replaceVar :: [(String, Cpp)] -> Cpp -> Cpp

348+ replaceVar rs = go

349+ where

350+ go (CppVar var) | Just var' <- lookup var rs = var'

351+ go cpp' = cpp'

352+

345353 dict :: Cpp

346354 dict = CppVariableIntroduction

347355 (topdict, Just $ CppAny [CppConst])

348356 []

349357 (Just $ CppDataLiteral ((\(f,cpp) -> CppComment [LineComment f] cpp) <$> fns))

350358

359+ accessed :: String -> String -> (String, Cpp)

360+ accessed dictname name =

361+ (name, CppApp

362+ (CppIndexer

363+ (CppNumericLiteral .

364+ Left .

365+ fromIntegral .

366+ fromJust $ findIndex ((== name) . fst) fns)

367+ dict'')

368+ [dict'])

369+ where

370+ dict' = CppVar dictname

371+ dict'' = CppCast dataType dict'

372+

351373 accessor :: String -> (String, Cpp) -> Cpp

352374 accessor dictname (name, _) =

353375 CppVariableIntroduction

354376 (name, Just $ CppAny [CppConst])

355377 []

356− (Just accessed)

357− where

358− dict' = CppVar dictname

359− dict'' = CppCast dataType dict'

360− accessed = CppApp

361− (CppIndexer

362− (CppNumericLiteral .

363− Left .

364− fromIntegral .

365− fromJust $ findIndex ((== name) . fst) fns)

366− dict'')

367− [dict']

378+ (Just . snd $ accessed dictname name)

368379

369380 toelem :: Cpp -> (String, Cpp)

370381 toelem (CppFunction name args rtyp _ body'@(CppBlock body)) =

@@ -373,6 +384,12 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

373384 args

374385 rtyp

375386 (CppBlock $ (accessor localdict <$> filteredFns body') ++ body))

387+

388+ toelem (CppVariableIntroduction (name, _) _ (Just body')) =

389+ let replacements = accessed localdict . fst <$> filteredFns body'

390+ replaced = everywhereOnCpp (replaceVar replacements) body'

391+ in (name, withdict . maybeRemCaps $ CppBlock [CppReturn replaced])

392+

376393 toelem _ = error "not a function"

377394

378395 withdict :: Cpp -> Cpp

@@ -495,19 +512,21 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

495512 hasRecursion :: [Cpp] -> Bool

496513 hasRecursion cpps' = any (everythingOnCpp (||) hasRecursiveRef) cpps'

497514 where

498− fnames :: [String]

499− fnames = concatMap (everythingOnCpp (++) fname) cpps'

515+ valnames :: [String]

516+ valnames = concatMap (everythingOnCpp (++) valname) cpps'

500517

501− fname :: Cpp -> [String]

502− fname (CppFunction name _ _ _ _) = [name]

503− fname _ = []

518+ valname :: Cpp -> [String]

519+ valname (CppFunction name _ _ _ _) = [name]

520+ valname (CppVariableIntroduction (name, _) _ _) = [name]

521+ valname _ = []

504522

505523 hasRecursiveRef :: Cpp -> Bool

506524 hasRecursiveRef (CppFunction _ _ _ _ body) = everythingOnCpp (||) ref body

525+ hasRecursiveRef (CppVariableIntroduction _ _ (Just value)) = everythingOnCpp (||) ref value

507526 hasRecursiveRef _ = False

508527

509528 ref :: Cpp -> Bool

510− ref (CppVar name) | name `elem` fnames = True

529+ ref (CppVar name) | name `elem` valnames = True

511530 ref _ = False

512531

513532 valueToCpp Constructor{} = return CppNoOp

@@ -755,9 +774,11 @@ moduleToCpp env (Module _ mn imps _ foreigns decls) = do

755774 findClass :: Qualified (ProperName 'ClassName) -> Maybe ([String], [T.Constraint], [(String, T.Type)])

756775 -------------------------------------------------------------------------------------------------

757776 findClass name

758− | Just (params, fns, constraints) <- M.lookup name (E.typeClasses env),

759− fns' <- (\(i,t) -> (runIdent i, t)) <$> fns

760− = Just (fst <$> params, constraints, (sortBy (compare `on` normalizedName . fst) fns'))

777+ | Just tcd <- M.lookup name (E.typeClasses env),

778+ fns' <- (\(i,t) -> (runIdent i, t)) <$> E.typeClassMembers tcd

779+ = Just (fst <$> E.typeClassArguments tcd,

780+ E.typeClassSuperclasses tcd,

781+ (sortBy (compare `on` normalizedName . fst) fns'))

761782 findClass _ = Nothing

762783

763784 -------------------------------------------------------------------------------------------------

src/Language/PureScript/CodeGen/JS.hs+4−4

@@ -15,7 +15,7 @@ import Control.Monad.Error.Class (MonadError(..))

1515import Control.Monad.Reader (MonadReader, asks)

1616import Control.Monad.Supply.Class

1717

18−import Data.List ((\\), delete, intersect)

18+import Data.List ((\\), delete, intersect, nub)

1919import Data.Maybe (isNothing, fromMaybe)

2020import qualified Data.Foldable as F

2121import qualified Data.Map as M

@@ -51,7 +51,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =

5151 rethrow (addHint (ErrorInModule mn)) $ do

5252 let usedNames = concatMap getNames decls

5353 let mnLookup = renameImports usedNames imps

54− jsImports <- T.traverse (importToJs mnLookup) . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ map snd imps

54+ jsImports <- T.traverse (importToJs mnLookup) . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ nub $ map snd imps

5555 let decls' = renameModules mnLookup decls

5656 jsDecls <- mapM bindToJs decls'

5757 optimized <- T.traverse (T.traverse optimize) jsDecls

@@ -89,7 +89,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =

8989 in if mn' /= mn && mni `elem` used

9090 then let newName = freshModuleName 1 mn' used

9191 in go (M.insert mn' (ann, newName) acc) (Ident (runModuleName newName) : used) mns'

92− else go (M.insert mn' (ann, mn') acc) (mni : used) mns'

92+ else go (M.insert mn' (ann, mn') acc) used mns'

9393 go acc _ [] = acc

9494

9595 freshModuleName :: Integer -> ModuleName -> [Ident] -> ModuleName

@@ -367,7 +367,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =

367367 -- binder.

368368 --

369369 binderToJs' :: String -> [JS] -> Binder Ann -> m [JS]

370− binderToJs' _ done (NullBinder{}) = return done

370+ binderToJs' _ done NullBinder{} = return done

371371 binderToJs' varName done (LiteralBinder _ l) =

372372 literalToBinderJS varName done l

373373 binderToJs' varName done (VarBinder _ ident) =

src/Language/PureScript/CodeGen/JS/Optimizer.hs−6

@@ -34,7 +34,6 @@ import Language.PureScript.CodeGen.JS.Optimizer.MagicDo

3434import Language.PureScript.CodeGen.JS.Optimizer.TCO

3535import Language.PureScript.CodeGen.JS.Optimizer.Unused

3636import Language.PureScript.Options

37−import qualified Language.PureScript.Constants as C

3837

3938-- |

4039-- Apply a series of optimizer passes to simplified Javascript code

@@ -49,11 +48,6 @@ optimize' js = do

4948 opts <- ask

5049 js' <- untilFixedPoint (inlineFnComposition . tidyUp . applyAll

5150 [ inlineCommonValues

52− , inlineOperator (C.prelude, (C.$)) $ \f x -> JSApp Nothing f [x]

53− , inlineOperator (C.dataFunction, C.apply) $ \f x -> JSApp Nothing f [x]

54− , inlineOperator (C.prelude, (C.#)) $ \x f -> JSApp Nothing f [x]

55− , inlineOperator (C.dataFunction, C.applyFlipped) $ \x f -> JSApp Nothing f [x]

56− , inlineOperator (C.dataArrayUnsafe, C.unsafeIndex) $ flip (JSIndexer Nothing)

5751 , inlineCommonOperators

5852 ]) js

5953 untilFixedPoint (return . tidyUp) . tco opts . magicDo opts $ js'

src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs+7−4

@@ -4,7 +4,6 @@

44module Language.PureScript.CodeGen.JS.Optimizer.Inliner

55 ( inlineVariables

66 , inlineCommonValues

7− , inlineOperator

87 , inlineCommonOperators

98 , inlineFnComposition

109 , etaConvert

@@ -100,13 +99,13 @@ inlineCommonValues = everywhereOnJS convert

10099 fnSubtract = (C.dataRing, C.sub)

101100 intOp ss op x y = JSBinary ss BitwiseOr (JSBinary ss op x y) (JSNumericLiteral ss (Left 0))

102101

103−inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS

104−inlineOperator (m, op) f = everywhereOnJS convert

102+inlineNonClassFunction :: (String, String) -> (JS -> JS -> JS) -> JS -> JS

103+inlineNonClassFunction (m, op) f = everywhereOnJS convert

105104 where

106105 convert :: JS -> JS

107106 convert (JSApp _ (JSApp _ op' [x]) [y]) | isOp op' = f x y

108107 convert other = other

109− isOp (JSIndexer _ (JSStringLiteral _ op') (JSVar _ m')) = m == m' && op == op'

108+ isOp (JSAccessor _ op' (JSVar _ m')) = m == m' && op == op'

110109 isOp _ = False

111110

112111inlineCommonOperators :: JS -> JS

@@ -167,6 +166,10 @@ inlineCommonOperators = applyAll $

167166 , binary' C.dataIntBits C.shr ShiftRight

168167 , binary' C.dataIntBits C.zshr ZeroFillShiftRight

169168 , unary' C.dataIntBits C.complement BitwiseNot

169+

170+ , inlineNonClassFunction (C.dataFunction, C.apply) $ \f x -> JSApp Nothing f [x]

171+ , inlineNonClassFunction (C.dataFunction, C.applyFlipped) $ \x f -> JSApp Nothing f [x]

172+ , inlineNonClassFunction (C.dataArrayUnsafe, C.unsafeIndex) $ flip (JSIndexer Nothing)

170173 ] ++

171174 [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]

172175 where

src/Language/PureScript/CoreFn/Desugar.hs+1−1

@@ -72,7 +72,7 @@ moduleToCoreFn env (A.Module _ coms mn decls (Just exps)) =

7272 [NonRec (ssA ss) name (exprToCoreFn ss com Nothing e)]

7373 declToCoreFn ss _ (A.BindingGroupDeclaration ds) =

7474 [Rec $ map (\(name, _, e) -> ((ssA ss, name), exprToCoreFn ss [] Nothing e)) ds]

75− declToCoreFn ss com (A.TypeClassDeclaration name _ supers members) =

75+ declToCoreFn ss com (A.TypeClassDeclaration name _ supers _ members) =

7676 [NonRec (ssA ss) (properToIdent name) $ mkTypeClassConstructor ss com supers members]

7777 declToCoreFn _ com (A.PositionedDeclaration ss com1 d) =

7878 declToCoreFn (Just ss) (com ++ com1) d

src/Language/PureScript/CoreFn/ToJSON.hsnew file+116

@@ -0,0 +1,116 @@

1+-- |

2+-- Dump the core functional representation in JSON format for consumption

3+-- by third-party code generators

4+--

5+module Language.PureScript.CoreFn.ToJSON

6+ ( moduleToJSON

7+ ) where

9+import Prelude.Compat

10+

11+import Data.Aeson

12+import Data.Version (Version, showVersion)

13+import Data.Text (pack)

14+

15+import Language.PureScript.AST.Literals

16+import Language.PureScript.CoreFn

17+import Language.PureScript.Names

18+

19+literalToJSON :: (a -> Value) -> Literal a -> Value

20+literalToJSON _ (NumericLiteral (Left n)) = toJSON ("IntLiteral", n)

21+literalToJSON _ (NumericLiteral (Right n)) = toJSON ("NumberLiteral", n)

22+literalToJSON _ (StringLiteral s) = toJSON ("StringLiteral", s)

23+literalToJSON _ (CharLiteral c) = toJSON ("CharLiteral", c)

24+literalToJSON _ (BooleanLiteral b) = toJSON ("BooleanLiteral", b)

25+literalToJSON t (ArrayLiteral xs) = toJSON ("ArrayLiteral", map t xs)

26+literalToJSON t (ObjectLiteral xs) = toJSON ("ObjectLiteral", recordToJSON t xs)

27+

28+identToJSON :: Ident -> Value

29+identToJSON = toJSON . runIdent

30+

31+properNameToJSON :: ProperName a -> Value

32+properNameToJSON = toJSON . runProperName

33+

34+qualifiedToJSON :: (a -> String) -> Qualified a -> Value

35+qualifiedToJSON f = toJSON . showQualified f

36+

37+moduleNameToJSON :: ModuleName -> Value

38+moduleNameToJSON = toJSON . runModuleName

39+

40+moduleToJSON :: Version -> Module a -> Value

41+moduleToJSON v m = object [ pack "imports" .= map (moduleNameToJSON . snd) (moduleImports m)

42+ , pack "exports" .= map identToJSON (moduleExports m)

43+ , pack "foreign" .= map (identToJSON . fst) (moduleForeign m)

44+ , pack "decls" .= map bindToJSON (moduleDecls m)

45+ , pack "builtWith" .= toJSON (showVersion v)

46+ ]

47+

48+bindToJSON :: Bind a -> Value

49+bindToJSON (NonRec _ n e) = object [ pack (runIdent n) .= exprToJSON e ]

50+bindToJSON (Rec bs) = object $ map (\((_, n), e) -> pack (runIdent n) .= exprToJSON e) bs

51+

52+recordToJSON :: (a -> Value) -> [(String, a)] -> Value

53+recordToJSON f = object . map (\(label, a) -> pack label .= f a)

54+

55+exprToJSON :: Expr a -> Value

56+exprToJSON (Var _ i) = toJSON ( "Var"

57+ , qualifiedToJSON runIdent i

58+ )

59+exprToJSON (Literal _ l) = toJSON ( "Literal"

60+ , literalToJSON (exprToJSON) l

61+ )

62+exprToJSON (Constructor _ d c is) = toJSON ( "Constructor"

63+ , properNameToJSON d

64+ , properNameToJSON c

65+ , map identToJSON is

66+ )

67+exprToJSON (Accessor _ f r) = toJSON ( "Accessor"

68+ , f

69+ , exprToJSON r

70+ )

71+exprToJSON (ObjectUpdate _ r fs) = toJSON ( "ObjectUpdate"

72+ , exprToJSON r

73+ , recordToJSON exprToJSON fs

74+ )

75+exprToJSON (Abs _ p b) = toJSON ( "Abs"

76+ , identToJSON p

77+ , exprToJSON b

78+ )

79+exprToJSON (App _ f x) = toJSON ( "App"

80+ , exprToJSON f

81+ , exprToJSON x

82+ )

83+exprToJSON (Case _ ss cs) = toJSON ( "Case"

84+ , map exprToJSON ss

85+ , map caseAlternativeToJSON cs

86+ )

87+exprToJSON (Let _ bs e) = toJSON ( "Let"

88+ , map bindToJSON bs

89+ , exprToJSON e

90+ )

91+

92+caseAlternativeToJSON :: CaseAlternative a -> Value

93+caseAlternativeToJSON (CaseAlternative bs r') =

94+ toJSON [ toJSON (map binderToJSON bs)

95+ , case r' of

96+ Left rs -> toJSON $ map (\(g, e) -> (exprToJSON g, exprToJSON e)) rs

97+ Right r -> exprToJSON r

98+ ]

99+

100+binderToJSON :: Binder a -> Value

101+binderToJSON (VarBinder _ v) = toJSON ( "VarBinder"

102+ , identToJSON v

103+ )

104+binderToJSON (NullBinder _) = toJSON "NullBinder"

105+binderToJSON (LiteralBinder _ l) = toJSON ( "LiteralBinder"

106+ , literalToJSON binderToJSON l

107+ )

108+binderToJSON (ConstructorBinder _ d c bs) = toJSON ( "ConstructorBinder"

109+ , qualifiedToJSON runProperName d

110+ , qualifiedToJSON runProperName c

111+ , map binderToJSON bs

112+ )

113+binderToJSON (NamedBinder _ n b) = toJSON ( "NamedBinder"

114+ , identToJSON n

115+ , binderToJSON b

116+ )

src/Language/PureScript/Docs/Convert/Single.hs+2−2

@@ -81,7 +81,7 @@ getDeclarationTitle (P.ExternDeclaration name _) = Just (P.showIdent name)

8181getDeclarationTitle (P.DataDeclaration _ name _ _) = Just (P.runProperName name)

8282getDeclarationTitle (P.ExternDataDeclaration name _) = Just (P.runProperName name)

8383getDeclarationTitle (P.TypeSynonymDeclaration name _ _) = Just (P.runProperName name)

84−getDeclarationTitle (P.TypeClassDeclaration name _ _ _) = Just (P.runProperName name)

84+getDeclarationTitle (P.TypeClassDeclaration name _ _ _ _) = Just (P.runProperName name)

8585getDeclarationTitle (P.TypeInstanceDeclaration name _ _ _ _) = Just (P.showIdent name)

8686getDeclarationTitle (P.TypeFixityDeclaration _ _ op) = Just ("type " ++ P.showOp op)

8787getDeclarationTitle (P.ValueFixityDeclaration _ _ op) = Just (P.showOp op)

@@ -121,7 +121,7 @@ convertDeclaration (P.ExternDataDeclaration _ kind') title =

121121 basicDeclaration title (ExternDataDeclaration kind')

122122convertDeclaration (P.TypeSynonymDeclaration _ args ty) title =

123123 basicDeclaration title (TypeSynonymDeclaration args ty)

124−convertDeclaration (P.TypeClassDeclaration _ args implies ds) title =

124+convertDeclaration (P.TypeClassDeclaration _ args implies _ ds) title = -- TODO: include fundep info

125125 Just (Right (mkDeclaration title info) { declChildren = children })

126126 where

127127 info = TypeClassDeclaration args implies

src/Language/PureScript/Environment.hs+42−28

@@ -18,35 +18,46 @@ import Language.PureScript.TypeClassDictionaries

1818import Language.PureScript.Types

1919import qualified Language.PureScript.Constants as C

2020

21−-- |

22−-- The @Environment@ defines all values and types which are currently in scope:

23−--

24−data Environment = Environment {

25− -- |

26− -- Value names currently in scope

27− --

28− names :: M.Map (Qualified Ident) (Type, NameKind, NameVisibility)

29− -- |

30− -- Type names currently in scope

31− --

21+-- | The @Environment@ defines all values and types which are currently in scope:

22+data Environment = Environment

23+ { names :: M.Map (Qualified Ident) (Type, NameKind, NameVisibility)

24+ -- ^ Values currently in scope

3225 , types :: M.Map (Qualified (ProperName 'TypeName)) (Kind, TypeKind)

33− -- |

34− -- Data constructors currently in scope, along with their associated type

35− -- constructor name, argument types and return type.

26+ -- ^ Type names currently in scope

3627 , dataConstructors :: M.Map (Qualified (ProperName 'ConstructorName)) (DataDeclType, ProperName 'TypeName, Type, [Ident])

37− -- |

38− -- Type synonyms currently in scope

39− --

28+ -- ^ Data constructors currently in scope, along with their associated type

29+ -- constructor name, argument types and return type.

4030 , typeSynonyms :: M.Map (Qualified (ProperName 'TypeName)) ([(String, Maybe Kind)], Type)

41− -- |

42− -- Available type class dictionaries

43− --

31+ -- ^ Type synonyms currently in scope

4432 , typeClassDictionaries :: M.Map (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) TypeClassDictionaryInScope))

45− -- |

46− -- Type classes

47− --

48− , typeClasses :: M.Map (Qualified (ProperName 'ClassName)) ([(String, Maybe Kind)], [(Ident, Type)], [Constraint])

49− } deriving (Show)

33+ -- ^ Available type class dictionaries

34+ , typeClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData

35+ -- ^ Type classes

36+ } deriving Show

37+

38+-- | Information about a type class

39+data TypeClassData = TypeClassData

40+ { typeClassArguments :: [(String, Maybe Kind)]

41+ -- ^ A list of type argument names, and their kinds, where kind annotations

42+ -- were provided.

43+ , typeClassMembers :: [(Ident, Type)]

44+ -- ^ A list of type class members and their types. Type arguments listed above

45+ -- are considered bound in these types.

46+ , typeClassSuperclasses :: [Constraint]

47+ -- ^ A list of superclasses of this type class. Type arguments listed above

48+ -- are considered bound in the types appearing in these constraints.

49+ , typeClassDependencies :: [FunctionalDependency]

50+ -- ^ A list of functional dependencies for the type arguments of this class.

51+ } deriving Show

52+

53+-- | A functional dependency indicates a relationship between two sets of

54+-- type arguments in a class declaration.

55+data FunctionalDependency = FunctionalDependency

56+ { fdDeterminers :: [Int]

57+ -- ^ the type arguments which determine the determined type arguments

58+ , fdDetermined :: [Int]

59+ -- ^ the determined type arguments

60+ } deriving Show

5061

5162-- |

5263-- The initial environment with no values and only the default javascript types defined

@@ -241,17 +252,19 @@ primTypes =

241252 , (primName "Boolean", (Star, ExternData))

242253 , (primName "Partial", (Star, ExternData))

243254 , (primName "Fail", (FunKind Symbol Star, ExternData))

255+ , (primName "TypeString", (FunKind Star Symbol, ExternData))

256+ , (primName "TypeConcat", (FunKind Symbol (FunKind Symbol Symbol), ExternData))

244257 ]

245258

246259-- |

247260-- The primitive class map. This just contains to `Partial` class, used as a

248261-- kind of magic constraint for partial functions.

249262--

250−primClasses :: M.Map (Qualified (ProperName 'ClassName)) ([(String, Maybe Kind)], [(Ident, Type)], [Constraint])

263+primClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData

251264primClasses =

252265 M.fromList

253− [ (primName "Partial", ([], [], []))

254− , (primName "Fail", ([("message", Just Symbol)], [], []))

266+ [ (primName "Partial", (TypeClassData [] [] [] []))

267+ , (primName "Fail", (TypeClassData [("message", Just Symbol)] [] [] []))

255268 ]

256269

257270-- |

@@ -276,3 +289,4 @@ lookupValue :: Environment -> Qualified Ident -> Maybe (Type, NameKind, NameVisi

276289lookupValue env ident = ident `M.lookup` names env

277290

278291$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''TypeKind)

292+$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''FunctionalDependency)

src/Language/PureScript/Errors.hs+62−39

@@ -25,6 +25,7 @@ import qualified Data.Map as M

2525

2626import Language.PureScript.AST

2727import Language.PureScript.Crash

28+import Language.PureScript.Environment

2829import Language.PureScript.Names

2930import Language.PureScript.Pretty

3031import Language.PureScript.Traversals

@@ -32,6 +33,7 @@ import Language.PureScript.Types

3233import Language.PureScript.Pretty.Common (endWith)

3334import qualified Language.PureScript.Bundle as Bundle

3435import qualified Language.PureScript.Constants as C

36+import Language.PureScript.Pretty.Common (before)

3537

3638import qualified System.Console.ANSI as ANSI

3739

@@ -88,7 +90,6 @@ errorCode em = case unwrapErrorMessage em of

8890 MultipleValueOpFixities{} -> "MultipleValueOpFixities"

8991 MultipleTypeOpFixities{} -> "MultipleTypeOpFixities"

9092 OrphanTypeDeclaration{} -> "OrphanTypeDeclaration"

91− RedefinedModule{} -> "RedefinedModule"

9293 RedefinedIdent{} -> "RedefinedIdent"

9394 OverlappingNamesInLet -> "OverlappingNamesInLet"

9495 UnknownName{} -> "UnknownName"

@@ -100,7 +101,7 @@ errorCode em = case unwrapErrorMessage em of

100101 ScopeShadowing{} -> "ScopeShadowing"

101102 DeclConflict{} -> "DeclConflict"

102103 ExportConflict{} -> "ExportConflict"

103− DuplicateModuleName{} -> "DuplicateModuleName"

104+ DuplicateModule{} -> "DuplicateModule"

104105 DuplicateTypeArgument{} -> "DuplicateTypeArgument"

105106 InvalidDoBind -> "InvalidDoBind"

106107 InvalidDoLet -> "InvalidDoLet"

@@ -118,6 +119,7 @@ errorCode em = case unwrapErrorMessage em of

118119 NoInstanceFound{} -> "NoInstanceFound"

119120 PossiblyInfiniteInstance{} -> "PossiblyInfiniteInstance"

120121 CannotDerive{} -> "CannotDerive"

122+ InvalidNewtypeInstance{} -> "InvalidNewtypeInstance"

121123 CannotFindDerivingType{} -> "CannotFindDerivingType"

122124 DuplicateLabel{} -> "DuplicateLabel"

123125 DuplicateValueDeclaration{} -> "DuplicateValueDeclaration"

@@ -130,7 +132,6 @@ errorCode em = case unwrapErrorMessage em of

130132 ExprDoesNotHaveType{} -> "ExprDoesNotHaveType"

131133 PropertyIsMissing{} -> "PropertyIsMissing"

132134 AdditionalProperty{} -> "AdditionalProperty"

133− CannotApplyFunction{} -> "CannotApplyFunction"

134135 TypeSynonymInstance -> "TypeSynonymInstance"

135136 OrphanInstance{} -> "OrphanInstance"

136137 InvalidNewtype{} -> "InvalidNewtype"

@@ -164,6 +165,8 @@ errorCode em = case unwrapErrorMessage em of

164165 InvalidOperatorInBinder{} -> "InvalidOperatorInBinder"

165166 DeprecatedRequirePath{} -> "DeprecatedRequirePath"

166167 CannotGeneralizeRecursiveFunction{} -> "CannotGeneralizeRecursiveFunction"

168+ CannotDeriveNewtypeForData{} -> "CannotDeriveNewtypeForData"

169+ NonWildcardNewtypeInstance{} -> "NonWildcardNewtypeInstance"

167170

168171-- |

169172-- A stack trace for an error

@@ -254,12 +257,12 @@ onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse

254257 gSimple (TypesDoNotUnify t1 t2) = TypesDoNotUnify <$> f t1 <*> f t2

255258 gSimple (ConstrainedTypeUnified t1 t2) = ConstrainedTypeUnified <$> f t1 <*> f t2

256259 gSimple (ExprDoesNotHaveType e t) = ExprDoesNotHaveType e <$> f t

257− gSimple (CannotApplyFunction t e) = CannotApplyFunction <$> f t <*> pure e

258260 gSimple (InvalidInstanceHead t) = InvalidInstanceHead <$> f t

259261 gSimple (NoInstanceFound con) = NoInstanceFound <$> overConstraintArgs (traverse f) con

260262 gSimple (OverlappingInstances cl ts insts) = OverlappingInstances cl <$> traverse f ts <*> pure insts

261263 gSimple (PossiblyInfiniteInstance cl ts) = PossiblyInfiniteInstance cl <$> traverse f ts

262264 gSimple (CannotDerive cl ts) = CannotDerive cl <$> traverse f ts

265+ gSimple (InvalidNewtypeInstance cl ts) = InvalidNewtypeInstance cl <$> traverse f ts

263266 gSimple (ExpectedType ty k) = ExpectedType <$> f ty <*> pure k

264267 gSimple (OrphanInstance nm cl ts) = OrphanInstance nm cl <$> traverse f ts

265268 gSimple (WildcardInferredType ty ctx) = WildcardInferredType <$> f ty <*> traverse (sndM f) ctx

@@ -288,6 +291,8 @@ errorSuggestion err = case err of

288291 UnusedImport{} -> emptySuggestion

289292 DuplicateImport{} -> emptySuggestion

290293 UnusedExplicitImport mn _ qual refs -> suggest $ importSuggestion mn refs qual

294+ UnusedDctorImport mn _ qual refs -> suggest $ importSuggestion mn refs qual

295+ UnusedDctorExplicitImport mn _ _ qual refs -> suggest $ importSuggestion mn refs qual

291296 ImplicitImport mn refs -> suggest $ importSuggestion mn refs Nothing

292297 ImplicitQualifiedImport mn asModule refs -> suggest $ importSuggestion mn refs (Just asModule)

293298 HidingImport mn refs -> suggest $ importSuggestion mn refs Nothing

@@ -482,10 +487,6 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

482487 line $ "There are multiple fixity/precedence declarations for type operator " ++ markCode (showOp op)

483488 renderSimpleErrorMessage (OrphanTypeDeclaration nm) =

484489 line $ "The type declaration for " ++ markCode (showIdent nm) ++ " should be followed by its definition."

485− renderSimpleErrorMessage (RedefinedModule name filenames) =

486− paras [ line ("The module " ++ markCode (runModuleName name) ++ " has been defined multiple times:")

487− , indent . paras $ map (line . displaySourceSpan) filenames

488− ]

489490 renderSimpleErrorMessage (RedefinedIdent name) =

490491 line $ "The value " ++ markCode (showIdent name) ++ " has been defined multiple times"

491492 renderSimpleErrorMessage (UnknownName name) =

@@ -515,8 +516,10 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

515516 line $ "Declaration for " ++ printName (Qualified Nothing new) ++ " conflicts with an existing " ++ nameType existing ++ " of the same name."

516517 renderSimpleErrorMessage (ExportConflict new existing) =

517518 line $ "Export for " ++ printName new ++ " conflicts with " ++ runName existing

518− renderSimpleErrorMessage (DuplicateModuleName mn) =

519− line $ "Module " ++ markCode (runModuleName mn) ++ " has been defined multiple times."

519+ renderSimpleErrorMessage (DuplicateModule mn ss) =

520+ paras [ line ("Module " ++ markCode (runModuleName mn) ++ " has been defined multiple times:")

521+ , indent . paras $ map (line . displaySourceSpan) ss

522+ ]

520523 renderSimpleErrorMessage (CycleInDeclaration nm) =

521524 line $ "The value of " ++ markCode (showIdent nm) ++ " is undefined here, so this reference is not allowed."

522525 renderSimpleErrorMessage (CycleInModules mns) =

@@ -592,9 +595,9 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

592595 , line "They may be disallowed completely in a future version of the compiler."

593596 ]

594597 renderSimpleErrorMessage OverlappingInstances{} = internalError "OverlappingInstances: empty instance list"

595− renderSimpleErrorMessage (NoInstanceFound (Constraint C.Fail [ TypeLevelString message ] _)) =

598+ renderSimpleErrorMessage (NoInstanceFound (Constraint C.Fail [ ty ] _)) | Just box <- toTypelevelString ty =

596599 paras [ line "A custom type error occurred while solving type class constraints:"

597− , indent . paras . map line . lines $ message

600+ , indent box

598601 ]

599602 renderSimpleErrorMessage (NoInstanceFound (Constraint C.Partial

600603 _

@@ -638,6 +641,14 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

638641 , Box.vcat Box.left (map typeAtomAsBox ts)

639642 ]

640643 ]

644+ renderSimpleErrorMessage (InvalidNewtypeInstance nm ts) =

645+ paras [ line "Cannot derive newtype instance for"

646+ , markCodeBox $ indent $ Box.hsep 1 Box.left

647+ [ line (showQualified runProperName nm)

648+ , Box.vcat Box.left (map typeAtomAsBox ts)

649+ ]

650+ , line "Make sure this is a newtype."

651+ ]

641652 renderSimpleErrorMessage (CannotFindDerivingType nm) =

642653 line $ "Cannot derive a type class instance, because the type declaration for " ++ markCode (runProperName nm) ++ " could not be found."

643654 renderSimpleErrorMessage (DuplicateLabel l expr) =

@@ -677,12 +688,6 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

677688 line $ "Type of expression lacks required label " ++ markCode prop ++ "."

678689 renderSimpleErrorMessage (AdditionalProperty prop) =

679690 line $ "Type of expression contains additional label " ++ markCode prop ++ "."

680− renderSimpleErrorMessage (CannotApplyFunction fn arg) =

681− paras [ line "A function of type"

682− , markCodeBox $ indent $ typeAsBox fn

683− , line "can not be applied to the argument"

684− , markCodeBox $ indent $ prettyPrintValue valueDepth arg

685− ]

686691 renderSimpleErrorMessage TypeSynonymInstance =

687692 line "Type class instances for type synonyms are disallowed."

688693 renderSimpleErrorMessage (OrphanInstance nm cnm ts) =

@@ -752,16 +757,22 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

752757

753758 renderSimpleErrorMessage msg@(UnusedExplicitImport mn names _ _) =

754759 paras [ line $ "The import of module " ++ markCode (runModuleName mn) ++ " contains the following unused references:"

755− , indent $ paras $ map line names

760+ , indent $ paras $ map (line . markCode . runName . Qualified Nothing) names

756761 , line "It could be replaced with:"

757762 , indent $ line $ markCode $ showSuggestion msg ]

758763

759− renderSimpleErrorMessage (UnusedDctorImport name) =

760− line $ "The import of type " ++ markCode (runProperName name) ++ " includes data constructors but only the type is used"

764+ renderSimpleErrorMessage msg@(UnusedDctorImport mn name _ _) =

765+ paras [line $ "The import of type " ++ markCode (runProperName name)

766+ ++ " from module " ++ markCode (runModuleName mn) ++ " includes data constructors but only the type is used"

767+ , line "It could be replaced with:"

768+ , indent $ line $ markCode $ showSuggestion msg ]

761769

762− renderSimpleErrorMessage (UnusedDctorExplicitImport name names) =

763− paras [ line $ "The import of type " ++ markCode (runProperName name) ++ " includes the following unused data constructors:"

764− , indent $ paras $ map (line . markCode . runProperName) names ]

770+ renderSimpleErrorMessage msg@(UnusedDctorExplicitImport mn name names _ _) =

771+ paras [ line $ "The import of type " ++ markCode (runProperName name)

772+ ++ " from module " ++ markCode (runModuleName mn) ++ " includes the following unused data constructors:"

773+ , indent $ paras $ map (line . markCode . runProperName) names

774+ , line "It could be replaced with:"

775+ , indent $ line $ markCode $ showSuggestion msg ]

765776

766777 renderSimpleErrorMessage (DuplicateSelectiveImport name) =

767778 line $ "There is an existing import of " ++ markCode (runModuleName name) ++ ", consider merging the import lists"

@@ -819,6 +830,14 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

819830 , line "Try adding a type signature."

820831 ]

821832

833+ renderSimpleErrorMessage (CannotDeriveNewtypeForData tyName) =

834+ paras [ line $ "Cannot derive an instance of the " ++ markCode "Newtype" ++ " class for non-newtype " ++ markCode (runProperName tyName) ++ "."

835+ ]

836+

837+ renderSimpleErrorMessage (NonWildcardNewtypeInstance tyName) =

838+ paras [ line $ "A type wildcard (_) should be used for the inner type when deriving the " ++ markCode "Newtype" ++ " instance for " ++ markCode (runProperName tyName) ++ "."

839+ ]

840+

822841 renderHint :: ErrorMessageHint -> Box.Box -> Box.Box

823842 renderHint (ErrorUnifyingTypes t1 t2) detail =

824843 paras [ detail

@@ -933,7 +952,7 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

933952 ]

934953 renderHint (ErrorSolvingConstraint (Constraint nm ts _)) detail =

935954 paras [ detail

936− , line "while solving type class constriant"

955+ , line "while solving type class constraint"

937956 , markCodeBox $ indent $ Box.hsep 1 Box.left

938957 [ line (showQualified runProperName nm)

939958 , Box.vcat Box.left (map typeAtomAsBox ts)

@@ -1016,10 +1035,6 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

10161035

10171036 -- | See https://github.com/purescript/purescript/issues/1802

10181037 stripRedudantHints :: SimpleErrorMessage -> [ErrorMessageHint] -> [ErrorMessageHint]

1019− stripRedudantHints CannotApplyFunction{} = stripFirst isApplicationHint

1020− where

1021− isApplicationHint ErrorInApplication{} = True

1022− isApplicationHint _ = False

10231038 stripRedudantHints ExprDoesNotHaveType{} = stripFirst isCheckHint

10241039 where

10251040 isCheckHint ErrorCheckingType{} = True

@@ -1043,16 +1058,16 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

10431058 stripFirst _ [] = []

10441059

10451060 hintCategory :: ErrorMessageHint -> HintCategory

1046− hintCategory ErrorCheckingType{} = ExprHint

1047− hintCategory ErrorInferringType{} = ExprHint

1048− hintCategory ErrorInExpression{} = ExprHint

1049− hintCategory ErrorUnifyingTypes{} = CheckHint

1050− hintCategory ErrorInSubsumption{} = CheckHint

1051− hintCategory ErrorInApplication{} = CheckHint

1052− hintCategory ErrorCheckingKind{} = CheckHint

1053− hintCategory ErrorSolvingConstraint{} = SolverHint

1054− hintCategory PositionedError{} = PositionHint

1055− hintCategory _ = OtherHint

1061+ hintCategory ErrorCheckingType{} = ExprHint

1062+ hintCategory ErrorInferringType{} = ExprHint

1063+ hintCategory ErrorInExpression{} = ExprHint

1064+ hintCategory ErrorUnifyingTypes{} = CheckHint

1065+ hintCategory ErrorInSubsumption{} = CheckHint

1066+ hintCategory ErrorInApplication{} = CheckHint

1067+ hintCategory ErrorCheckingKind{} = CheckHint

1068+ hintCategory ErrorSolvingConstraint{} = SolverHint

1069+ hintCategory PositionedError{} = PositionHint

1070+ hintCategory _ = OtherHint

10561071

10571072-- Pretty print and export declaration

10581073prettyPrintExport :: DeclarationRef -> String

@@ -1195,6 +1210,14 @@ renderBox = unlines

11951210 dropWhileEnd p = reverse . dropWhile p . reverse

11961211 whiteSpace = all isSpace

11971212

1213+toTypelevelString :: Type -> Maybe Box.Box

1214+toTypelevelString (TypeLevelString s) = Just $ Box.text s

1215+toTypelevelString (TypeApp (TypeConstructor f) x)

1216+ | f == primName "TypeString" = Just $ typeAsBox x

1217+toTypelevelString (TypeApp (TypeApp (TypeConstructor f) x) ret)

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

1219+toTypelevelString _ = Nothing

1220+

11981221-- |

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

12001223--

src/Language/PureScript/Externs.hs+27−26

@@ -93,44 +93,45 @@ data ExternsTypeFixity = ExternsTypeFixity

9393data ExternsDeclaration =

9494 -- | A type declaration

9595 EDType

96− { edTypeName :: ProperName 'TypeName

97− , edTypeKind :: Kind

98− , edTypeDeclarationKind :: TypeKind

96+ { edTypeName :: ProperName 'TypeName

97+ , edTypeKind :: Kind

98+ , edTypeDeclarationKind :: TypeKind

9999 }

100100 -- | A type synonym

101101 | EDTypeSynonym

102− { edTypeSynonymName :: ProperName 'TypeName

103− , edTypeSynonymArguments :: [(String, Maybe Kind)]

104− , edTypeSynonymType :: Type

102+ { edTypeSynonymName :: ProperName 'TypeName

103+ , edTypeSynonymArguments :: [(String, Maybe Kind)]

104+ , edTypeSynonymType :: Type

105105 }

106106 -- | A data construtor

107107 | EDDataConstructor

108− { edDataCtorName :: ProperName 'ConstructorName

109− , edDataCtorOrigin :: DataDeclType

110− , edDataCtorTypeCtor :: ProperName 'TypeName

111− , edDataCtorType :: Type

112− , edDataCtorFields :: [Ident]

108+ { edDataCtorName :: ProperName 'ConstructorName

109+ , edDataCtorOrigin :: DataDeclType

110+ , edDataCtorTypeCtor :: ProperName 'TypeName

111+ , edDataCtorType :: Type

112+ , edDataCtorFields :: [Ident]

113113 }

114114 -- | A value declaration

115115 | EDValue

116− { edValueName :: Ident

117− , edValueType :: Type

116+ { edValueName :: Ident

117+ , edValueType :: Type

118118 }

119119 -- | A type class declaration

120120 | EDClass

121− { edClassName :: ProperName 'ClassName

122− , edClassTypeArguments :: [(String, Maybe Kind)]

123− , edClassMembers :: [(Ident, Type)]

124− , edClassConstraints :: [Constraint]

121+ { edClassName :: ProperName 'ClassName

122+ , edClassTypeArguments :: [(String, Maybe Kind)]

123+ , edClassMembers :: [(Ident, Type)]

124+ , edClassConstraints :: [Constraint]

125+ , edFunctionalDependencies :: [FunctionalDependency]

125126 }

126127 -- | An instance declaration

127128 | EDInstance

128− { edInstanceClassName :: Qualified (ProperName 'ClassName)

129− , edInstanceName :: Ident

130− , edInstanceTypes :: [Type]

131− , edInstanceConstraints :: Maybe [Constraint]

129+ { edInstanceClassName :: Qualified (ProperName 'ClassName)

130+ , edInstanceName :: Ident

131+ , edInstanceTypes :: [Type]

132+ , edInstanceConstraints :: Maybe [Constraint]

132133 }

133− deriving (Show)

134+ deriving Show

134135

135136-- | Convert an externs file back into a module

136137applyExternsFileToEnvironment :: ExternsFile -> Environment -> Environment

@@ -141,7 +142,7 @@ applyExternsFileToEnvironment ExternsFile{..} = flip (foldl' applyDecl) efDeclar

141142 applyDecl env (EDTypeSynonym pn args ty) = env { typeSynonyms = M.insert (qual pn) (args, ty) (typeSynonyms env) }

142143 applyDecl env (EDDataConstructor pn dTy tNm ty nms) = env { dataConstructors = M.insert (qual pn) (dTy, tNm, ty, nms) (dataConstructors env) }

143144 applyDecl env (EDValue ident ty) = env { names = M.insert (Qualified (Just efModuleName) ident) (ty, External, Defined) (names env) }

144− applyDecl env (EDClass pn args members cs) = env { typeClasses = M.insert (qual pn) (args, members, cs) (typeClasses env) }

145+ applyDecl env (EDClass pn args members cs deps) = env { typeClasses = M.insert (qual pn) (TypeClassData args members cs deps) (typeClasses env) }

145146 applyDecl env (EDInstance className ident tys cs) = env { typeClassDictionaries = updateMap (updateMap (M.insert (qual ident) dict) className) (Just efModuleName) (typeClassDictionaries env) }

146147 where

147148 dict :: TypeClassDictionaryInScope

@@ -204,12 +205,12 @@ moduleToExternsFile (Module _ _ mn ds (Just exps)) env = ExternsFile{..}

204205 | Just (ty, _, _) <- Qualified (Just mn) ident `M.lookup` names env

205206 = [ EDValue ident ty ]

206207 toExternsDeclaration (TypeClassRef className)

207− | Just (args, members, implies) <- Qualified (Just mn) className `M.lookup` typeClasses env

208+ | Just TypeClassData{..} <- Qualified (Just mn) className `M.lookup` typeClasses env

208209 , Just (kind, TypeSynonym) <- Qualified (Just mn) (coerceProperName className) `M.lookup` types env

209210 , Just (_, synTy) <- Qualified (Just mn) (coerceProperName className) `M.lookup` typeSynonyms env

210211 = [ EDType (coerceProperName className) kind TypeSynonym

211− , EDTypeSynonym (coerceProperName className) args synTy

212− , EDClass className args members implies

212+ , EDTypeSynonym (coerceProperName className) typeClassArguments synTy

213+ , EDClass className typeClassArguments typeClassMembers typeClassSuperclasses typeClassDependencies

213214 ]

214215 toExternsDeclaration (TypeInstanceRef ident)

215216 = [ EDInstance tcdClassName ident tcdInstanceTypes tcdDependencies

src/Language/PureScript/Ide.hs+6−6

@@ -38,9 +38,9 @@ import Language.PureScript.Ide.SourceFile

3838import Language.PureScript.Ide.State

3939import Language.PureScript.Ide.Types

4040import Language.PureScript.Ide.Util

41−import System.Directory

42−import System.FilePath

43−import System.FilePath.Glob

41+import System.Directory (getCurrentDirectory, getDirectoryContents, doesDirectoryExist, doesFileExist)

42+import System.FilePath ((</>))

43+import System.FilePath.Glob (glob)

4444

4545-- | Accepts a Commmand and runs it against psc-ide's State. This is the main

4646-- entry point for the server.

@@ -77,7 +77,7 @@ handleCommand c = case c of

7777 case rs of

7878 Right rs' -> answerRequest outfp rs'

7979 Left question ->

80− pure (CompletionResult (map completionFromMatch question))

80+ pure (CompletionResult (map (completionFromMatch . map withEmptyAnn) question))

8181 Rebuild file ->

8282 rebuildFile file

8383 Cwd ->

@@ -88,7 +88,7 @@ handleCommand c = case c of

8888 liftIO exitSuccess

8989

9090findCompletions :: Ide m =>

91− [Filter] -> Matcher IdeDeclaration -> Maybe P.ModuleName -> m Success

91+ [Filter] -> Matcher IdeDeclarationAnn -> Maybe P.ModuleName -> m Success

9292findCompletions filters matcher currentModule = do

9393 modules <- getAllModules currentModule

9494 pure . CompletionResult . map completionFromMatch . getCompletions filters matcher $ modules

@@ -97,7 +97,7 @@ findType :: Ide m =>

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

9898findType search filters currentModule = do

9999 modules <- getAllModules currentModule

100− pure . InfoResult . map infoFromMatch . getExactMatches search filters $ modules

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

101101

102102findPursuitCompletions :: MonadIO m =>

103103 PursuitQuery -> m Success

src/Language/PureScript/Ide/Command.hs+1−1

@@ -34,7 +34,7 @@ data Command

3434 }

3535 | Complete

3636 { completeFilters :: [Filter]

37− , completeMatcher :: Matcher IdeDeclaration

37+ , completeMatcher :: Matcher IdeDeclarationAnn

3838 , completeCurrentModule :: Maybe P.ModuleName

3939 }

4040 | Pursuit

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

@@ -9,24 +9,23 @@ import Protolude

99import Language.PureScript.Ide.Filter

1010import Language.PureScript.Ide.Matcher

1111import Language.PureScript.Ide.Types

12−import Language.PureScript.Ide.Util

1312

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

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

1615getCompletions

1716 :: [Filter]

18− -> Matcher IdeDeclaration

17+ -> Matcher IdeDeclarationAnn

1918 -> [Module]

20− -> [Match IdeDeclaration]

19+ -> [Match IdeDeclarationAnn]

2120getCompletions filters matcher modules =

22− runMatcher matcher (completionsFromModules discardAnn (applyFilters filters modules))

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

2322

2423getExactMatches :: Text -> [Filter] -> [Module] -> [Match IdeDeclarationAnn]

2524getExactMatches search filters modules =

26− completionsFromModules identity (applyFilters (equalityFilter search : filters) modules)

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

2726

28−completionsFromModules :: (IdeDeclarationAnn -> a) -> [Module] -> [Match a]

29−completionsFromModules f = foldMap completionFromModule

27+completionsFromModules :: [Module] -> [Match IdeDeclarationAnn]

28+completionsFromModules = foldMap completionFromModule

3029 where

3130 completionFromModule (moduleName, decls) =

32− map (\x -> Match (moduleName, f x)) decls

31+ map (\x -> Match (moduleName, x)) decls

src/Language/PureScript/Ide/Externs.hs+22−14

@@ -17,9 +17,9 @@

1717{-# LANGUAGE FlexibleContexts #-}

1818

1919module Language.PureScript.Ide.Externs

20− ( readExternFile,

21− convertExterns,

22− annotateLocations

20+ ( readExternFile

21+ , convertExterns

22+ , annotateModule

2323 ) where

2424

2525import Protolude

@@ -87,26 +87,31 @@ convertOperator :: P.ExternsFixity -> IdeDeclaration

8787convertOperator P.ExternsFixity{..} =

8888 IdeValueOperator

8989 efOperator

90− (toS (P.showQualified (either P.runIdent P.runProperName) efAlias))

90+ efAlias

9191 efPrecedence

9292 efAssociativity

93+ Nothing

9394

9495convertTypeOperator :: P.ExternsTypeFixity -> IdeDeclaration

9596convertTypeOperator P.ExternsTypeFixity{..} =

9697 IdeTypeOperator

9798 efTypeOperator

98− (toS (P.showQualified P.runProperName efTypeAlias))

99+ efTypeAlias

99100 efTypePrecedence

100101 efTypeAssociativity

102+ Nothing

101103

102−annotateLocations :: Map (Either Text Text) P.SourceSpan -> Module -> Module

103−annotateLocations ast (moduleName, decls) =

104+annotateModule

105+ :: (DefinitionSites P.SourceSpan, TypeAnnotations)

106+ -> Module

107+ -> Module

108+annotateModule (defs, types) (moduleName, decls) =

104109 (moduleName, map convertDeclaration decls)

105110 where

106111 convertDeclaration :: IdeDeclarationAnn -> IdeDeclarationAnn

107112 convertDeclaration (IdeDeclarationAnn ann d) = case d of

108113 IdeValue i t ->

109− annotateValue (runIdentT i) (IdeValue i t)

114+ annotateFunction i (IdeValue i t)

110115 IdeType i k ->

111116 annotateType (runProperNameT i) (IdeType i k)

112117 IdeTypeSynonym i t ->

@@ -115,10 +120,13 @@ annotateLocations ast (moduleName, decls) =

115120 annotateValue (runProperNameT i) (IdeDataConstructor i tn t)

116121 IdeTypeClass i ->

117122 annotateType (runProperNameT i) (IdeTypeClass i)

118− IdeValueOperator n i p a ->

119− annotateValue i (IdeValueOperator n i p a)

120− IdeTypeOperator n i p a ->

121− annotateType i (IdeTypeOperator n i p a)

123+ IdeValueOperator n i p a t ->

124+ annotateValue (valueOperatorAliasT i) (IdeValueOperator n i p a t)

125+ IdeTypeOperator n i p a k ->

126+ annotateType (typeOperatorAliasT i) (IdeTypeOperator n i p a k)

122127 where

123− annotateValue x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Left x) ast})

124− annotateType x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Right x) ast})

128+ annotateFunction x = IdeDeclarationAnn (ann { annLocation = Map.lookup (Left (runIdentT x)) defs

129+ , annTypeAnnotation = Map.lookup x types

130+ })

131+ annotateValue x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Left x) defs})

132+ annotateType x = IdeDeclarationAnn (ann {annLocation = Map.lookup (Right x) defs})

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

@@ -203,9 +203,9 @@ addExplicitImport' decl moduleName imports =

203203 P.TypeRef tn (Just [n])

204204 refFromDeclaration (IdeType n _) =

205205 P.TypeRef n (Just [])

206− refFromDeclaration (IdeValueOperator op _ _ _) =

206+ refFromDeclaration (IdeValueOperator op _ _ _ _) =

207207 P.ValueOpRef op

208− refFromDeclaration (IdeTypeOperator op _ _ _) =

208+ refFromDeclaration (IdeTypeOperator op _ _ _ _) =

209209 P.TypeOpRef op

210210 refFromDeclaration d =

211211 P.ValueRef $ P.Ident $ T.unpack (identifierFromIdeDeclaration d)

src/Language/PureScript/Ide/Matcher.hs+8−8

@@ -38,7 +38,7 @@ type ScoredMatch a = (Match a, Double)

3838

3939newtype Matcher a = Matcher (Endo [Match a]) deriving (Monoid)

4040

41−instance FromJSON (Matcher IdeDeclaration) where

41+instance FromJSON (Matcher IdeDeclarationAnn) where

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

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

4444 case matcher of

@@ -60,17 +60,17 @@ instance FromJSON (Matcher IdeDeclaration) where

6060-- Examples:

6161-- flMa matches flexMatcher. Score: 14.28

6262-- sons matches sortCompletions. Score: 6.25

63−flexMatcher :: Text -> Matcher IdeDeclaration

63+flexMatcher :: Text -> Matcher IdeDeclarationAnn

6464flexMatcher p = mkMatcher (flexMatch p)

6565

66−distanceMatcher :: Text -> Int -> Matcher IdeDeclaration

66+distanceMatcher :: Text -> Int -> Matcher IdeDeclarationAnn

6767distanceMatcher q maxDist = mkMatcher (distanceMatcher' q maxDist)

6868

69−distanceMatcher' :: Text -> Int -> [Match IdeDeclaration] -> [ScoredMatch IdeDeclaration]

69+distanceMatcher' :: Text -> Int -> [Match IdeDeclarationAnn] -> [ScoredMatch IdeDeclarationAnn]

7070distanceMatcher' q maxDist = mapMaybe go

7171 where

7272 go m = let d = dist (T.unpack y)

73− y = identifierFromIdeDeclaration (unwrapMatch m)

73+ y = identifierFromIdeDeclaration (discardAnn (unwrapMatch m))

7474 in if d <= maxDist

7575 then Just (m, 1 / fromIntegral d)

7676 else Nothing

@@ -85,12 +85,12 @@ runMatcher (Matcher m)= appEndo m

8585sortCompletions :: [ScoredMatch a] -> [ScoredMatch a]

8686sortCompletions = sortBy (flip compare `on` snd)

8787

88−flexMatch :: Text -> [Match IdeDeclaration] -> [ScoredMatch IdeDeclaration]

88+flexMatch :: Text -> [Match IdeDeclarationAnn] -> [ScoredMatch IdeDeclarationAnn]

8989flexMatch = mapMaybe . flexRate

9090

91−flexRate :: Text -> Match IdeDeclaration -> Maybe (ScoredMatch IdeDeclaration)

91+flexRate :: Text -> Match IdeDeclarationAnn -> Maybe (ScoredMatch IdeDeclarationAnn)

9292flexRate p c = do

93− score <- flexScore p (identifierFromIdeDeclaration (unwrapMatch c))

93+ score <- flexScore p (identifierFromIdeDeclaration (discardAnn (unwrapMatch c)))

9494 return (c, score)

9595

9696-- FlexMatching ala Sublime.

src/Language/PureScript/Ide/Pursuit.hs+20−24

@@ -35,41 +35,37 @@ import qualified Pipes.Prelude as P

3535-- TODO: remove this when the issue is fixed at Pursuit

3636queryPursuit :: Text -> IO ByteString

3737queryPursuit q = do

38− let qClean = T.dropWhileEnd (== '.') q

39− req' <- parseRequest "http://pursuit.purescript.org/search"

40− let req = req'

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

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

43− }

44− m <- newManager tlsManagerSettings

45− withHTTP req m $ \resp ->

46− P.fold (<>) "" identity (responseBody resp)

47−

38+ let qClean = T.dropWhileEnd (== '.') q

39+ req' <- parseRequest "http://pursuit.purescript.org/search"

40+ let req = req'

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

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

43+ }

44+ m <- newManager tlsManagerSettings

45+ withHTTP req m $ \resp ->

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

4847

4948handler :: HttpException -> IO [a]

50−handler StatusCodeException{} = pure []

5149handler _ = pure []

5250

5351searchPursuitForDeclarations :: Text -> IO [PursuitResponse]

54−searchPursuitForDeclarations query =

55− (do r <- queryPursuit query

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

57− case results' of

58− Nothing -> pure []

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

60− handler

52+searchPursuitForDeclarations query = E.handle handler $ do

53+ r <- queryPursuit query

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

55+ case results' of

56+ Nothing -> pure []

57+ Just results -> pure (mapMaybe (isDeclarationResponse . fromJSON) (toList results))

6158 where

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

6360 isDeclarationResponse _ = Nothing

6461

6562findPackagesForModuleIdent :: Text -> IO [PursuitResponse]

66−findPackagesForModuleIdent query =

67− (do r <- queryPursuit query

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

69− case results' of

63+findPackagesForModuleIdent query = E.handle handler $ do

64+ r <- queryPursuit query

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

66+ case results' of

7067 Nothing -> pure []

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

72− handler

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

7369 where

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

7571 isModuleResponse _ = Nothing

src/Language/PureScript/Ide/Reexports.hs+2−4

@@ -14,8 +14,6 @@

1414-----------------------------------------------------------------------------

1515

1616{-# LANGUAGE OverloadedStrings #-}

17−{-# LANGUAGE PackageImports #-}

18−{-# LANGUAGE TemplateHaskell #-}

1917{-# LANGUAGE RecordWildCards #-}

2018

2119module Language.PureScript.Ide.Reexports

@@ -93,9 +91,9 @@ resolveRef decls ref = case ref of

9391 P.ValueRef i ->

9492 findWrapped (\case IdeValue i' _ -> i' == i; _ -> False)

9593 P.TypeOpRef name ->

96− findWrapped (\case IdeTypeOperator n _ _ _ -> n == name; _ -> False)

94+ findWrapped (\case IdeTypeOperator n _ _ _ _ -> n == name; _ -> False)

9795 P.ValueOpRef name ->

98− findWrapped (\case IdeValueOperator n _ _ _ -> n == name; _ -> False)

96+ findWrapped (\case IdeValueOperator n _ _ _ _ -> n == name; _ -> False)

9997 P.TypeClassRef name ->

10098 findWrapped (\case IdeTypeClass n -> n == name; _ -> False)

10199 _ ->

src/Language/PureScript/Ide/SourceFile.hs+24−1

@@ -17,11 +17,15 @@

1717module Language.PureScript.Ide.SourceFile

1818 ( parseModule

1919 , getImportsForFile

20+ , extractAstInformation

21+ -- for tests

2022 , extractSpans

23+ , extractTypeAnnotations

2124 ) where

2225

2326import Protolude

2427

28+import qualified Data.Map as Map

2529import qualified Language.PureScript as P

2630import Language.PureScript.Ide.Error

2731import Language.PureScript.Ide.Util

@@ -64,6 +68,25 @@ getImportsForFile fp = do

6468 unwrapImportType (P.Hiding decls) = P.Hiding (map unwrapPositionedRef decls)

6569 unwrapImportType P.Implicit = P.Implicit

6670

71+-- | Extracts AST information from a parsed module

72+extractAstInformation

73+ :: P.Module

74+ -> (DefinitionSites P.SourceSpan, TypeAnnotations)

75+extractAstInformation (P.Module ss _ _ decls _) =

76+ let definitions = Map.fromList (concatMap (extractSpans ss) decls)

77+ typeAnnotations = Map.fromList (extractTypeAnnotations decls)

78+ in (definitions, typeAnnotations)

79+

80+-- | Extracts type annotations for functions from a given Module

81+extractTypeAnnotations

82+ :: [P.Declaration]

83+ -> [(P.Ident, P.Type)]

84+extractTypeAnnotations = mapMaybe extract

85+ where

86+ extract d = case unwrapPositioned d of

87+ P.TypeDeclaration ident ty -> Just (ident, ty)

88+ _ -> Nothing

89+

6790-- | Given a surrounding Sourcespan and a Declaration from the PS AST, extracts

6891-- definition sites inside that Declaration.

6992extractSpans

@@ -81,7 +104,7 @@ extractSpans ss d = case d of

81104 [(Left (runIdentT i), ss)]

82105 P.TypeSynonymDeclaration name _ _ ->

83106 [(Right (runProperNameT name), ss)]

84− P.TypeClassDeclaration name _ _ members ->

107+ P.TypeClassDeclaration name _ _ _ members ->

85108 (Right (runProperNameT name), ss) : concatMap (extractSpans' ss) members

86109 P.DataDeclaration _ name _ ctors ->

87110 (Right (runProperNameT name), ss)

src/Language/PureScript/Ide/State.hs+86−18

@@ -28,6 +28,8 @@ module Language.PureScript.Ide.State

2828 , populateStage2

2929 , populateStage3

3030 , populateStage3STM

31+ -- for tests

32+ , resolveOperatorsForModule

3133 ) where

3234

3335import Protolude

@@ -35,7 +37,8 @@ import qualified Prelude

3537

3638import Control.Concurrent.STM

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

38−import qualified Data.Map.Lazy as M

40+import qualified Data.Map.Lazy as Map

41+import qualified Data.List as List

3942import Language.PureScript.Externs

4043import Language.PureScript.Ide.Externs

4144import Language.PureScript.Ide.Reexports

@@ -55,10 +58,10 @@ resetIdeState = do

5558

5659-- | Gets the loaded Modulenames

5760getLoadedModulenames :: Ide m => m [P.ModuleName]

58−getLoadedModulenames = M.keys <$> getExternFiles

61+getLoadedModulenames = Map.keys <$> getExternFiles

5962

6063-- | Gets all loaded ExternFiles

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

64+getExternFiles :: Ide m => m (Map P.ModuleName ExternsFile)

6265getExternFiles = s1Externs <$> getStage1

6366

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

@@ -72,7 +75,7 @@ insertModuleSTM :: TVar IdeState -> (FilePath, P.Module) -> STM ()

7275insertModuleSTM ref (fp, module') =

7376 modifyTVar ref $ \x ->

7477 x { ideStage1 = (ideStage1 x) {

75− s1Modules = M.insert

78+ s1Modules = Map.insert

7679 (P.getModuleName module')

7780 (module', fp)

7881 (s1Modules (ideStage1 x))}}

@@ -126,17 +129,24 @@ getAllModules mmoduleName = do

126129 declarations <- s3Declarations <$> getStage3

127130 rebuild <- cachedRebuild

128131 case mmoduleName of

129− Nothing -> pure (M.toList declarations)

132+ Nothing -> pure (Map.toList declarations)

130133 Just moduleName ->

131134 case rebuild of

132135 Just (cachedModulename, ef)

133136 | cachedModulename == moduleName -> do

134137 (AstData asts) <- s2AstData <$> getStage2

135− let ast = fromMaybe M.empty (M.lookup moduleName asts)

136− pure . M.toList $

137− M.insert moduleName

138− (snd . annotateLocations ast . fst . convertExterns $ ef) declarations

139− _ -> pure (M.toList declarations)

138+ let

139+ ast =

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

141+ cachedModule =

142+ snd . annotateModule ast . fst . convertExterns $ ef

143+ tmp =

144+ Map.insert moduleName cachedModule declarations

145+ resolved =

146+ Map.adjust (resolveOperatorsForModule tmp) moduleName tmp

147+

148+ pure (Map.toList resolved)

149+ _ -> pure (Map.toList declarations)

140150

141151-- | Adds an ExternsFile into psc-ide's State Stage1. This does not populate the

142152-- following Stages, which needs to be done after all the necessary Exterms have

@@ -151,7 +161,7 @@ insertExternsSTM :: TVar IdeState -> ExternsFile -> STM ()

151161insertExternsSTM ref ef =

152162 modifyTVar ref $ \x ->

153163 x { ideStage1 = (ideStage1 x) {

154− s1Externs = M.insert (efModuleName ef) ef (s1Externs (ideStage1 x))}}

164+ s1Externs = Map.insert (efModuleName ef) ef (s1Externs (ideStage1 x))}}

155165

156166-- | Sets rebuild cache to the given ExternsFile

157167cacheRebuild :: Ide m => ExternsFile -> m ()

@@ -180,8 +190,8 @@ populateStage2 = do

180190populateStage2STM :: TVar IdeState -> STM ()

181191populateStage2STM ref = do

182192 modules <- s1Modules <$> getStage1STM ref

183− let spans = map (\((P.Module ss _ _ decls _), _) -> M.fromList (concatMap (extractSpans ss) decls)) modules

184− setStage2STM ref (Stage2 (AstData spans))

193+ let astData = map (extractAstInformation . fst) modules

194+ setStage2STM ref (Stage2 (AstData astData))

185195

186196-- | Resolves reexports and populates Stage3 with data to be used in queries.

187197populateStage3 :: (Ide m, MonadLogger m) => m ()

@@ -202,12 +212,70 @@ populateStage3STM :: TVar IdeState -> STM [ReexportResult Module]

202212populateStage3STM ref = do

203213 externs <- s1Externs <$> getStage1STM ref

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

205− let modules = M.map convertExterns externs

215+ let modules = Map.map convertExterns externs

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

207− nModules = M.mapWithKey

217+ nModules = Map.mapWithKey

208218 (\moduleName (m, refs) ->

209− (fromMaybe m $ annotateLocations <$> M.lookup moduleName asts <*> pure m, refs)) modules

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

210220 -- resolves reexports and discards load failures for now

211− result = resolveReexports (M.map (snd . fst) nModules) <$> M.elems nModules

212− setStage3STM ref (Stage3 (M.fromList (map reResolved result)) Nothing)

221+ result = resolveReexports (map (snd . fst) nModules) <$> Map.elems nModules

222+ resultP = resolveOperators (Map.fromList (reResolved <$> result))

223+ setStage3STM ref (Stage3 resultP Nothing)

213224 pure result

225+

226+resolveOperators

227+ :: Map P.ModuleName [IdeDeclarationAnn]

228+ -> Map P.ModuleName [IdeDeclarationAnn]

229+resolveOperators modules =

230+ map (resolveOperatorsForModule modules) modules

231+

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

233+-- declarations

234+resolveOperatorsForModule

235+ :: Map P.ModuleName [IdeDeclarationAnn]

236+ -> [IdeDeclarationAnn]

237+ -> [IdeDeclarationAnn]

238+resolveOperatorsForModule modules = map (mapIdeDeclaration resolveOperator)

239+ where

240+ resolveOperator (IdeValueOperator

241+ opName

242+ i@(P.Qualified (Just moduleName)

243+ (Left ident)) precedence assoc _) =

244+ let t = do

245+ sourceModule <- Map.lookup moduleName modules

246+ IdeValue _ tP <-

247+ List.find (\case

248+ IdeValue iP _ -> iP == ident

249+ _ -> False) (discardAnn <$> sourceModule)

250+ pure tP

251+

252+ in IdeValueOperator opName i precedence assoc t

253+ resolveOperator (IdeValueOperator

254+ opName

255+ i@(P.Qualified (Just moduleName)

256+ (Right ctor)) precedence assoc _) =

257+ let t = do

258+ sourceModule <- Map.lookup moduleName modules

259+ IdeDataConstructor _ _ tP <-

260+ List.find (\case

261+ IdeDataConstructor cname _ _ -> ctor == cname

262+ _ -> False) (discardAnn <$> sourceModule)

263+ pure tP

264+

265+ in IdeValueOperator opName i precedence assoc t

266+ resolveOperator (IdeTypeOperator

267+ opName

268+ i@(P.Qualified (Just moduleName) properName) precedence assoc _) =

269+ let k = do

270+ sourceModule <- Map.lookup moduleName modules

271+ IdeType _ kP <-

272+ List.find (\case

273+ IdeType name _ -> name == properName

274+ _ -> False) (discardAnn <$> sourceModule)

275+ pure kP

276+

277+ in IdeTypeOperator opName i precedence assoc k

278+ resolveOperator x = x

279+

280+mapIdeDeclaration :: (IdeDeclaration -> IdeDeclaration) -> IdeDeclarationAnn -> IdeDeclarationAnn

281+mapIdeDeclaration f (IdeDeclarationAnn ann decl) = IdeDeclarationAnn ann (f decl)

src/Language/PureScript/Ide/Types.hs+48−65

@@ -21,12 +21,10 @@ import Protolude

2121

2222import Control.Concurrent.STM

2323import Data.Aeson

24−import Data.Map.Lazy as M

24+import qualified Data.Map.Lazy as M

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

2626import qualified Language.PureScript as P

2727import Language.PureScript.Ide.Conversions

28−import Text.Parsec as Parsec

29−import Text.Parsec.Text

3028

3129type ModuleIdent = Text

3230

@@ -36,8 +34,8 @@ data IdeDeclaration

3634 | IdeTypeSynonym (P.ProperName 'P.TypeName) P.Type

3735 | IdeDataConstructor (P.ProperName 'P.ConstructorName) (P.ProperName 'P.TypeName) P.Type

3836 | IdeTypeClass (P.ProperName 'P.ClassName)

39− | IdeValueOperator (P.OpName 'P.ValueOpName) Text P.Precedence P.Associativity

40− | IdeTypeOperator (P.OpName 'P.TypeOpName) Text P.Precedence P.Associativity

37+ | IdeValueOperator (P.OpName 'P.ValueOpName) (P.Qualified (Either P.Ident (P.ProperName 'P.ConstructorName))) P.Precedence P.Associativity (Maybe P.Type)

38+ | IdeTypeOperator (P.OpName 'P.TypeOpName) (P.Qualified (P.ProperName 'P.TypeName)) P.Precedence P.Associativity (Maybe P.Kind)

4139 deriving (Show, Eq, Ord)

4240

4341data IdeDeclarationAnn = IdeDeclarationAnn Annotation IdeDeclaration

@@ -47,15 +45,19 @@ data Annotation

4745 = Annotation

4846 { annLocation :: Maybe P.SourceSpan

4947 , annExportedFrom :: Maybe P.ModuleName

48+ , annTypeAnnotation :: Maybe P.Type

5049 } deriving (Show, Eq, Ord)

5150

5251emptyAnn :: Annotation

53−emptyAnn = Annotation Nothing Nothing

52+emptyAnn = Annotation Nothing Nothing Nothing

5453

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

5655

57−newtype AstData a =

58− AstData (Map P.ModuleName (Map (Either Text Text) a))

56+type DefinitionSites a = Map (Either Text Text) a

57+type TypeAnnotations = Map P.Ident P.Type

58+newtype AstData a = AstData (Map P.ModuleName (DefinitionSites a, TypeAnnotations))

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

60+ -- annotations found in a module

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

6062

6163data Configuration =

@@ -108,21 +110,25 @@ data Stage3 = Stage3

108110newtype Match a = Match (P.ModuleName, a)

109111 deriving (Show, Eq, Functor)

110112

111−newtype Completion =

112− Completion (Text, Text, Text)

113− deriving (Show,Eq)

114−

115−newtype Info =

116− Info (Text, Text, Text, Maybe P.SourceSpan)

117− deriving (Show,Eq)

118−

119−instance ToJSON Info where

120− toJSON (Info (m, d, t, sourceSpan)) =

121− object ["module" .= m, "identifier" .= d, "type" .= t, "definedAt" .= sourceSpan]

113+-- | A completion as it gets sent to the editors

114+data Completion = Completion

115+ { complModule :: Text

116+ , complIdentifier :: Text

117+ , complType :: Text

118+ , complExpandedType :: Text

119+ , complLocation :: Maybe P.SourceSpan

120+ , complDocumentation :: Maybe Text

121+ } deriving (Show, Eq)

122122

123123instance ToJSON Completion where

124− toJSON (Completion (m, d, t)) =

125− object ["module" .= m, "identifier" .= d, "type" .= t]

124+ toJSON (Completion {..}) =

125+ object [ "module" .= complModule

126+ , "identifier" .= complIdentifier

127+ , "type" .= complType

128+ , "expandedType" .= complExpandedType

129+ , "definedAt" .= complLocation

130+ , "documentation" .= complDocumentation

131+ ]

126132

127133data ModuleImport =

128134 ModuleImport

@@ -140,17 +146,17 @@ instance ToJSON ModuleImport where

140146 toJSON (ModuleImport mn P.Implicit qualifier) =

141147 object $ [ "module" .= mn

142148 , "importType" .= ("implicit" :: Text)

143− ] ++ fmap (\x -> "qualifier" .= x) (maybeToList qualifier)

144− toJSON (ModuleImport mn (P.Explicit refs) _) =

145− object [ "module" .= mn

146− , "importType" .= ("explicit" :: Text)

147− , "identifiers" .= (identifierFromDeclarationRef <$> refs)

148− ]

149− toJSON (ModuleImport mn (P.Hiding refs) _) =

150− object [ "module" .= mn

151− , "importType" .= ("hiding" :: Text)

152− , "identifiers" .= (identifierFromDeclarationRef <$> refs)

153− ]

149+ ] ++ map (\x -> "qualifier" .= x) (maybeToList qualifier)

150+ toJSON (ModuleImport mn (P.Explicit refs) qualifier) =

151+ object $ [ "module" .= mn

152+ , "importType" .= ("explicit" :: Text)

153+ , "identifiers" .= (identifierFromDeclarationRef <$> refs)

154+ ] ++ map (\x -> "qualifier" .= x) (maybeToList qualifier)

155+ toJSON (ModuleImport mn (P.Hiding refs) qualifier) =

156+ object $ [ "module" .= mn

157+ , "importType" .= ("hiding" :: Text)

158+ , "identifiers" .= (identifierFromDeclarationRef <$> refs)

159+ ] ++ map (\x -> "qualifier" .= x) (maybeToList qualifier)

154160

155161identifierFromDeclarationRef :: P.DeclarationRef -> Text

156162identifierFromDeclarationRef (P.TypeRef name _) = runProperNameT name

@@ -160,14 +166,13 @@ identifierFromDeclarationRef _ = ""

160166

161167data Success =

162168 CompletionResult [Completion]

163− | InfoResult [Info]

164169 | TextResult Text

165170 | MultilineTextResult [Text]

166171 | PursuitResult [PursuitResponse]

167172 | ImportList [ModuleImport]

168173 | ModuleList [ModuleIdent]

169174 | RebuildSuccess [P.JSONError]

170− deriving(Show, Eq)

175+ deriving (Show, Eq)

171176

172177encodeSuccess :: (ToJSON a) => a -> Value

173178encodeSuccess res =

@@ -175,7 +180,6 @@ encodeSuccess res =

175180

176181instance ToJSON Success where

177182 toJSON (CompletionResult cs) = encodeSuccess cs

178− toJSON (InfoResult i) = encodeSuccess i

179183 toJSON (TextResult t) = encodeSuccess t

180184 toJSON (MultilineTextResult ts) = encodeSuccess ts

181185 toJSON (PursuitResult resp) = encodeSuccess resp

@@ -203,9 +207,9 @@ data PursuitResponse =

203207 -- | A Pursuit Response for a module. Consists of the modules name and the

204208 -- package it belongs to

205209 ModuleResponse ModuleIdent Text

206− -- | A Pursuit Response for a declaration. Consist of the declarations type,

207− -- module, name and package

208− | DeclarationResponse Text ModuleIdent Text Text

210+ -- | A Pursuit Response for a declaration. Consist of the declaration's

211+ -- module, name, package, type summary text

212+ | DeclarationResponse Text ModuleIdent Text (Maybe Text) Text

209213 deriving (Show,Eq)

210214

211215instance FromJSON PursuitResponse where

@@ -219,42 +223,21 @@ instance FromJSON PursuitResponse where

219223 pure (ModuleResponse name package)

220224 "declaration" -> do

221225 moduleName <- info .: "module"

222− Right (ident, declType) <- typeParse <$> o .: "text"

223− pure (DeclarationResponse declType moduleName ident package)

226+ ident <- info .: "title"

227+ (text :: Text) <- o .: "text"

228+ typ <- info .:? "typeText"

229+ pure (DeclarationResponse moduleName ident package typ text)

224230 _ -> mzero

225231 parseJSON _ = mzero

226232

227−

228−typeParse :: Text -> Either Text (Text, Text)

229−typeParse t = case parse parseType "" t of

230− Right (x,y) -> Right (x, y)

231− Left err -> Left (show err)

232− where

233− parseType :: Parser (Text, Text)

234− parseType = do

235− name <- identifier

236− _ <- string "::"

237− spaces

238− type' <- many1 anyChar

239− pure (name, toS type')

240−

241− identifier :: Parser Text

242− identifier = do

243− spaces

244− ident <-

245− -- necessary for being able to parse the following ((++), concat)

246− between (char '(') (char ')') (many1 (noneOf ", )")) Parsec.<|>

247− many1 (noneOf ", )")

248− spaces

249− pure (toS ident)

250−

251233instance ToJSON PursuitResponse where

252234 toJSON (ModuleResponse name package) =

253235 object ["module" .= name, "package" .= package]

254− toJSON (DeclarationResponse module' ident type' package) =

236+ toJSON (DeclarationResponse module' ident package type' text) =

255237 object

256238 [ "module" .= module'

257239 , "ident" .= ident

258240 , "type" .= type'

259241 , "package" .= package

242+ , "text" .= text

260243 ]

src/Language/PureScript/Ide/Util.hs+41−25

@@ -20,10 +20,12 @@ module Language.PureScript.Ide.Util

2020 , unwrapPositioned

2121 , unwrapPositionedRef

2222 , completionFromMatch

23− , infoFromMatch

2423 , encodeT

2524 , decodeT

2625 , discardAnn

26+ , withEmptyAnn

27+ , valueOperatorAliasT

28+ , typeOperatorAliasT

2729 , module Language.PureScript.Ide.Conversions

2830 ) where

2931

@@ -42,31 +44,41 @@ identifierFromIdeDeclaration d = case d of

4244 IdeTypeSynonym name _ -> runProperNameT name

4345 IdeDataConstructor name _ _ -> runProperNameT name

4446 IdeTypeClass name -> runProperNameT name

45− IdeValueOperator op _ _ _ -> runOpNameT op

46− IdeTypeOperator op _ _ _ -> runOpNameT op

47+ IdeValueOperator op _ _ _ _ -> runOpNameT op

48+ IdeTypeOperator op _ _ _ _ -> runOpNameT op

4749

4850discardAnn :: IdeDeclarationAnn -> IdeDeclaration

4951discardAnn (IdeDeclarationAnn _ d) = d

5052

53+withEmptyAnn :: IdeDeclaration -> IdeDeclarationAnn

54+withEmptyAnn = IdeDeclarationAnn emptyAnn

55+

5156unwrapMatch :: Match a -> a

5257unwrapMatch (Match (_, ed)) = ed

5358

54−completionFromMatch :: Match IdeDeclaration -> Completion

55−completionFromMatch = Completion . completionFromMatch'

56−

57−completionFromMatch' :: Match IdeDeclaration -> (Text, Text, Text)

58−completionFromMatch' (Match (m', d)) = case d of

59− IdeValue name type' -> (m, runIdentT name, prettyTypeT type')

60− IdeType name kind -> (m, runProperNameT name, toS (P.prettyPrintKind kind))

61− IdeTypeSynonym name kind -> (m, runProperNameT name, prettyTypeT kind)

62− IdeDataConstructor name _ type' -> (m, runProperNameT name, prettyTypeT type')

63− IdeTypeClass name -> (m, runProperNameT name, "class")

64− IdeValueOperator op ref precedence associativity ->

65− (m, runOpNameT op, showFixity precedence associativity ref op)

66− IdeTypeOperator op ref precedence associativity ->

67− (m, runOpNameT op, showFixity precedence associativity ref op)

59+completionFromMatch :: Match IdeDeclarationAnn -> Completion

60+completionFromMatch (Match (m, IdeDeclarationAnn ann decl)) =

61+ Completion {..}

6862 where

69− m = runModuleNameT m'

63+ (complIdentifier, complExpandedType) = case decl of

64+ IdeValue name type' -> (runIdentT name, prettyTypeT type')

65+ IdeType name kind -> (runProperNameT name, toS (P.prettyPrintKind kind))

66+ IdeTypeSynonym name kind -> (runProperNameT name, prettyTypeT kind)

67+ IdeDataConstructor name _ type' -> (runProperNameT name, prettyTypeT type')

68+ IdeTypeClass name -> (runProperNameT name, "class")

69+ IdeValueOperator op ref precedence associativity typeP ->

70+ (runOpNameT op, maybe (showFixity precedence associativity (valueOperatorAliasT ref) op) prettyTypeT typeP)

71+ IdeTypeOperator op ref precedence associativity kind ->

72+ (runOpNameT op, maybe (showFixity precedence associativity (typeOperatorAliasT ref) op) (toS . P.prettyPrintKind) kind)

73+

74+ complModule = runModuleNameT m

75+

76+ complType = maybe complExpandedType prettyTypeT (annTypeAnnotation ann)

77+

78+ complLocation = annLocation ann

79+

80+ complDocumentation = Nothing

81+

7082 showFixity p a r o =

7183 let asso = case a of

7284 P.Infix -> "infix"

@@ -74,12 +86,16 @@ completionFromMatch' (Match (m', d)) = case d of

7486 P.Infixr -> "infixr"

7587 in T.unwords [asso, show p, r, "as", runOpNameT o]

7688

77−infoFromMatch :: Match IdeDeclarationAnn -> Info

78−infoFromMatch (Match (m, (IdeDeclarationAnn ann d))) =

79− Info (a, b, c, annLocation ann)

80− where

81− (a, b, c) = completionFromMatch' (Match (m, d))

89+valueOperatorAliasT

90+ :: P.Qualified (Either P.Ident (P.ProperName 'P.ConstructorName)) -> Text

91+valueOperatorAliasT i =

92+ toS (P.showQualified (either P.runIdent P.runProperName) i)

8293

94+typeOperatorAliasT

95+ :: P.Qualified (P.ProperName 'P.TypeName) -> Text

96+typeOperatorAliasT i =

97+ toS (P.showQualified P.runProperName i)

98+

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

84100encodeT = toS . decodeUtf8 . encode

85101

@@ -87,9 +103,9 @@ decodeT :: (FromJSON a) => Text -> Maybe a

87103decodeT = decode . encodeUtf8 . toS

88104

89105unwrapPositioned :: P.Declaration -> P.Declaration

90−unwrapPositioned (P.PositionedDeclaration _ _ x) = x

106+unwrapPositioned (P.PositionedDeclaration _ _ x) = unwrapPositioned x

91107unwrapPositioned x = x

92108

93109unwrapPositionedRef :: P.DeclarationRef -> P.DeclarationRef

94−unwrapPositionedRef (P.PositionedDeclarationRef _ _ x) = x

110+unwrapPositionedRef (P.PositionedDeclarationRef _ _ x) = unwrapPositionedRef x

95111unwrapPositionedRef x = x

src/Language/PureScript/Interactive/Completion.hs+2−2

@@ -206,7 +206,7 @@ identNames = nubOnFst . concatMap getDeclNames . P.exportedDeclarations

206206 getDeclNames d@(P.ValueDeclaration ident _ _ _) = [(ident, d)]

207207 getDeclNames d@(P.TypeDeclaration ident _ ) = [(ident, d)]

208208 getDeclNames d@(P.ExternDeclaration ident _) = [(ident, d)]

209− getDeclNames d@(P.TypeClassDeclaration _ _ _ ds) = map (second (const d)) $ concatMap getDeclNames ds

209+ getDeclNames d@(P.TypeClassDeclaration _ _ _ _ ds) = map (second (const d)) $ concatMap getDeclNames ds

210210 getDeclNames (P.PositionedDeclaration _ _ d) = getDeclNames d

211211 getDeclNames _ = []

212212

@@ -214,7 +214,7 @@ dctorNames :: P.Module -> [(N.ProperName 'N.ConstructorName, P.Declaration)]

214214dctorNames = nubOnFst . concatMap go . P.exportedDeclarations

215215 where

216216 go :: P.Declaration -> [(N.ProperName 'N.ConstructorName, P.Declaration)]

217− go decl@(P.DataDeclaration _ _ _ ctors) = map (\n -> (n, decl)) (map fst ctors)

217+ go decl@(P.DataDeclaration _ _ _ ctors) = map ((\n -> (n, decl)) . fst) ctors

218218 go (P.PositionedDeclaration _ _ d) = go d

219219 go _ = []

220220

src/Language/PureScript/Interactive/Printer.hs+11−11

@@ -17,7 +17,7 @@ import qualified Text.PrettyPrint.Boxes as Box

1717-- Pretty print a module's signatures

1818--

1919printModuleSignatures :: P.ModuleName -> P.Environment -> String

20−printModuleSignatures moduleName (P.Environment {..}) =

20+printModuleSignatures moduleName P.Environment{..} =

2121 -- get relevant components of a module from environment

2222 let moduleNamesIdent = byModuleName names

2323 moduleTypeClasses = byModuleName typeClasses

@@ -44,34 +44,34 @@ printModuleSignatures moduleName (P.Environment {..}) =

4444 showNameType _ = P.internalError "The impossible happened in printModuleSignatures."

4545

4646 findTypeClass

47− :: M.Map (P.Qualified (P.ProperName 'P.ClassName)) ([(String, Maybe P.Kind)], [(P.Ident, P.Type)], [P.Constraint])

47+ :: M.Map (P.Qualified (P.ProperName 'P.ClassName)) P.TypeClassData

4848 -> P.Qualified (P.ProperName 'P.ClassName)

49− -> (P.Qualified (P.ProperName 'P.ClassName), Maybe ([(String, Maybe P.Kind)], [(P.Ident, P.Type)], [P.Constraint]))

49+ -> (P.Qualified (P.ProperName 'P.ClassName), Maybe P.TypeClassData)

5050 findTypeClass envTypeClasses name = (name, M.lookup name envTypeClasses)

5151

5252 showTypeClass

53− :: (P.Qualified (P.ProperName 'P.ClassName), Maybe ([(String, Maybe P.Kind)], [(P.Ident, P.Type)], [P.Constraint]))

53+ :: (P.Qualified (P.ProperName 'P.ClassName), Maybe P.TypeClassData)

5454 -> Maybe Box.Box

5555 showTypeClass (_, Nothing) = Nothing

56− showTypeClass (P.Qualified _ name, Just (vars, body, constrs)) =

56+ showTypeClass (P.Qualified _ name, Just P.TypeClassData{..}) =

5757 let constraints =

58− if null constrs

58+ if null typeClassSuperclasses

5959 then Box.text ""

6060 else Box.text "("

61− Box.<> Box.hcat Box.left (intersperse (Box.text ", ") $ map (\(P.Constraint (P.Qualified _ pn) lt _) -> Box.text (P.runProperName pn) Box.<+> Box.hcat Box.left (map P.typeAtomAsBox lt)) constrs)

61+ Box.<> Box.hcat Box.left (intersperse (Box.text ", ") $ map (\(P.Constraint (P.Qualified _ pn) lt _) -> Box.text (P.runProperName pn) Box.<+> Box.hcat Box.left (map P.typeAtomAsBox lt)) typeClassSuperclasses)

6262 Box.<> Box.text ") <= "

6363 className =

6464 Box.text (P.runProperName name)

65− Box.<> Box.text (concatMap ((' ':) . fst) vars)

65+ Box.<> Box.text (concatMap ((' ':) . fst) typeClassArguments)

6666 classBody =

67− Box.vcat Box.top (map (\(i, t) -> Box.text (P.showIdent i ++ " ::") Box.<+> P.typeAsBox t) body)

67+ Box.vcat Box.top (map (\(i, t) -> Box.text (P.showIdent i ++ " ::") Box.<+> P.typeAsBox t) typeClassMembers)

6868

6969 in

7070 Just $

7171 (Box.text "class "

7272 Box.<> constraints

7373 Box.<> className

74− Box.<+> if null body then Box.text "" else Box.text "where")

74+ Box.<+> if null typeClassMembers then Box.text "" else Box.text "where")

7575 Box.// Box.moveRight 2 classBody

7676

7777

@@ -82,7 +82,7 @@ printModuleSignatures moduleName (P.Environment {..}) =

8282 findType envTypes name = (name, M.lookup name envTypes)

8383

8484 showType

85− :: M.Map (P.Qualified (P.ProperName 'P.ClassName)) ([(String, Maybe P.Kind)], [(P.Ident, P.Type)], [P.Constraint])

85+ :: M.Map (P.Qualified (P.ProperName 'P.ClassName)) P.TypeClassData

8686 -> M.Map (P.Qualified (P.ProperName 'P.ConstructorName)) (P.DataDeclType, P.ProperName 'P.TypeName, P.Type, [P.Ident])

8787 -> M.Map (P.Qualified (P.ProperName 'P.TypeName)) ([(String, Maybe P.Kind)], P.Type)

8888 -> (P.Qualified (P.ProperName 'P.TypeName), Maybe (P.Kind, P.TypeKind))

src/Language/PureScript/Interactive/Types.hs+2−2

@@ -42,11 +42,11 @@ initialPSCiState = PSCiState [] [] []

4242type ImportedModule = (P.ModuleName, P.ImportDeclarationType, Maybe P.ModuleName)

4343

4444psciImportedModuleNames :: PSCiState -> [P.ModuleName]

45−psciImportedModuleNames (PSCiState{psciImportedModules = is}) =

45+psciImportedModuleNames PSCiState{psciImportedModules = is} =

4646 map (\(mn, _, _) -> mn) is

4747

4848allImportsOf :: P.Module -> PSCiState -> [ImportedModule]

49−allImportsOf m (PSCiState{psciImportedModules = is}) =

49+allImportsOf m PSCiState{psciImportedModules = is} =

5050 filter isImportOfThis is

5151 where

5252 name = P.getModuleName m

src/Language/PureScript/Linter/Imports.hs+14−14

@@ -243,12 +243,12 @@ lintImportDecl env mni qualifierName names declType allowImplicit =

243243 didWarn' <- forM (mapMaybe getTypeRef declrefs) $ \(tn, c) -> do

244244 let allCtors = dctorsForType mni tn

245245 -- If we've not already warned a type is unused, check its data constructors

246− unless' (runProperName tn `notElem` usedNames) $

246+ unless' (TyName tn `notElem` usedNames) $

247247 case (c, dctors `intersect` allCtors) of

248− (_, []) | c /= Just [] -> warn (UnusedDctorImport tn)

248+ (_, []) | c /= Just [] -> warn (UnusedDctorImport mni tn qualifierName allRefs)

249249 (Just ctors, dctors') ->

250250 let ddiff = ctors \\ dctors'

251− in unless' (null ddiff) $ warn $ UnusedDctorExplicitImport tn ddiff

251+ in unless' (null ddiff) $ warn $ UnusedDctorExplicitImport mni tn ddiff qualifierName allRefs

252252 _ -> return False

253253

254254 return (didWarn || or didWarn')

@@ -335,18 +335,18 @@ findUsedRefs env mni qn names =

335335matchName

336336 :: (ProperName 'ConstructorName -> Maybe (ProperName 'TypeName))

337337 -> Name

338− -> Maybe String

339−matchName _ (IdentName x) = Just $ showIdent x

340−matchName _ (TyName x) = Just $ runProperName x

341−matchName _ (TyClassName x) = Just $ runProperName x

342−matchName lookupDc (DctorName x) = runProperName <$> lookupDc x

343−matchName _ _ = Nothing

344−

345−runDeclRef :: DeclarationRef -> Maybe String

338+ -> Maybe Name

339+matchName lookupDc (DctorName x) = TyName <$> lookupDc x

340+matchName _ ModName{} = Nothing

341+matchName _ name = Just name

342+

343+runDeclRef :: DeclarationRef -> Maybe Name

346344runDeclRef (PositionedDeclarationRef _ _ ref) = runDeclRef ref

347−runDeclRef (ValueRef ident) = Just $ showIdent ident

348−runDeclRef (TypeRef pn _) = Just $ runProperName pn

349−runDeclRef (TypeClassRef pn) = Just $ runProperName pn

345+runDeclRef (ValueRef ident) = Just $ IdentName ident

346+runDeclRef (ValueOpRef op) = Just $ ValOpName op

347+runDeclRef (TypeRef pn _) = Just $ TyName pn

348+runDeclRef (TypeOpRef op) = Just $ TyOpName op

349+runDeclRef (TypeClassRef pn) = Just $ TyClassName pn

350350runDeclRef _ = Nothing

351351

352352checkDuplicateImports

src/Language/PureScript/Make.hs+22−13

@@ -1,5 +1,6 @@

11{-# LANGUAGE GeneralizedNewtypeDeriving #-}

22{-# LANGUAGE TypeFamilies #-}

3+{-# LANGUAGE OverloadedStrings #-}

45module Language.PureScript.Make

56 (

@@ -36,10 +37,12 @@ import Control.Monad.Trans.Except

3637import Control.Monad.Writer.Class (MonadWriter(..))

3738

3839import Data.Aeson (encode, decode)

40+import qualified Data.Aeson as Aeson

3941import Data.ByteString.Builder (toLazyByteString, stringUtf8)

4042import Data.Either (partitionEithers)

43+import Data.Function (on)

4144import Data.Foldable (for_)

42−import Data.List (foldl', sort)

45+import Data.List (foldl', sortBy, groupBy)

4346import Data.Maybe (fromMaybe, catMaybes)

4447import Data.String (fromString)

4548import Data.Time.Clock

@@ -69,6 +72,7 @@ import qualified Language.PureScript.Bundle as Bundle

6972import qualified Language.PureScript.CodeGen.JS as J

7073import qualified Language.PureScript.Constants as C

7174import qualified Language.PureScript.CoreFn as CF

75+import qualified Language.PureScript.CoreFn.ToJSON as CFJ

7276import qualified Language.PureScript.Parser as PSParser

7377

7478import qualified Paths_purescript as Paths

@@ -188,18 +192,17 @@ make ma@MakeActions{..} ms = do

188192 where

189193 checkModuleNamesAreUnique :: m ()

190194 checkModuleNamesAreUnique =

191− case findDuplicate (map getModuleName ms) of

192− Nothing -> return ()

193− Just mn -> throwError . errorMessage $ DuplicateModuleName mn

194−

195− -- Verify that a list of values has unique keys

196− findDuplicate :: (Ord a) => [a] -> Maybe a

197− findDuplicate = go . sort

198− where

199− go (x : y : xs)

200− | x == y = Just x

201− | otherwise = go (y : xs)

202− go _ = Nothing

195+ for_ (findDuplicates getModuleName ms) $ \mss ->

196+ throwError . flip foldMap mss $ \ms' ->

197+ let mn = getModuleName (head ms')

198+ in errorMessage $ DuplicateModule mn (map getModuleSourceSpan ms')

199+

200+ -- Find all groups of duplicate values in a list based on a projection.

201+ findDuplicates :: Ord b => (a -> b) -> [a] -> Maybe [[a]]

202+ findDuplicates f xs =

203+ case filter ((> 1) . length) . groupBy ((==) `on` f) . sortBy (compare `on` f) $ xs of

204+ [] -> Nothing

205+ xss -> Just xss

203206

204207 -- Sort a list so its elements appear in the same order as in another list.

205208 inOrderOf :: (Ord a) => [a] -> [a] -> [a]

@@ -369,6 +372,12 @@ buildMakeActions outputDir filePathMap foreigns usePrefix =

369372 for_ (mn `M.lookup` foreigns) (readTextFile >=> writeTextFile foreignFile)

370373 writeTextFile externsFile exts

371374 lift $ when sourceMaps $ genSourceMap dir mapFile (length prefix) mappings

375+ dumpCoreFn <- lift $ asks optionsDumpCoreFn

376+ when dumpCoreFn $ do

377+ let coreFnFile = outputDir </> filePath </> "corefn.json"

378+ let jsonPayload = CFJ.moduleToJSON Paths.version m

379+ let json = Aeson.object [ (fromString (runModuleName mn), jsonPayload) ]

380+ lift $ writeTextFile coreFnFile (BU8.toString . B.toStrict . encode $ json)

372381

373382 genSourceMap :: String -> String -> Int -> [SMap] -> Make ()

374383 genSourceMap dir mapFile extraLines mappings = do

src/Language/PureScript/Options.hs+4−1

@@ -31,9 +31,12 @@ data Options = Options {

3131 -- |

3232 -- Generate soure maps

3333 , optionsSourceMaps :: Bool

34+ -- |

35+ -- Dump CoreFn

36+ , optionsDumpCoreFn :: Bool

3437 } deriving Show

3538

3639-- |

3740-- Default make options

3841defaultOptions :: Options

39−defaultOptions = Options False False Nothing False False False False

42+defaultOptions = Options False False Nothing False False False False False

src/Language/PureScript/Parser/Declarations.hs+10−3

@@ -17,6 +17,7 @@ module Language.PureScript.Parser.Declarations

1717

1818import Prelude hiding (lex)

1919

20+import Data.Functor (($>))

2021import Data.Maybe (fromMaybe)

2122

2223import Control.Applicative

@@ -183,10 +184,15 @@ parseTypeClassDeclaration = do

183184 return implies

184185 className <- indented *> properName

185186 idents <- P.many (indented *> kindedIdent)

187+ let parseNamedIdent = foldl (<|>) empty (zipWith (\(name, _) index -> lname' name $> index) idents [0..])

188+ parseFunctionalDependency =

189+ FunctionalDependency <$> P.many parseNamedIdent <* rarrow

190+ <*> P.many parseNamedIdent

191+ dependencies <- P.option [] (indented *> pipe *> commaSep1 parseFunctionalDependency)

186192 members <- P.option [] $ do

187193 indented *> reserved "where"

188194 indented *> mark (P.many (same *> positioned parseTypeDeclaration))

189− return $ TypeClassDeclaration className idents implies members

195+ return $ TypeClassDeclaration className idents implies dependencies members

190196

191197parseConstraint :: TokenParser Constraint

192198parseConstraint = Constraint <$> parseQualified properName

@@ -203,7 +209,7 @@ parseInstanceDeclaration = do

203209 rfatArrow

204210 return deps

205211 className <- indented *> parseQualified properName

206− ty <- P.many (indented *> noWildcards parseTypeAtom)

212+ ty <- P.many (indented *> parseTypeAtom)

207213 return $ TypeInstanceDeclaration name (fromMaybe [] deps) className ty

208214

209215parseTypeInstanceDeclaration :: TokenParser Declaration

@@ -217,8 +223,9 @@ parseTypeInstanceDeclaration = do

217223parseDerivingInstanceDeclaration :: TokenParser Declaration

218224parseDerivingInstanceDeclaration = do

219225 reserved "derive"

226+ ty <- P.option DerivedInstance (reserved "newtype" $> NewtypeInstance)

220227 instanceDecl <- parseInstanceDeclaration

221− return $ instanceDecl DerivedInstance

228+ return $ instanceDecl ty

222229

223230positioned :: TokenParser Declaration -> TokenParser Declaration

224231positioned = withSourceSpan PositionedDeclaration

src/Language/PureScript/Parser/Lexer.hs+7

@@ -40,6 +40,7 @@ module Language.PureScript.Parser.Lexer

4040 , commaSep

4141 , commaSep1

4242 , lname

43+ , lname'

4344 , qualifier

4445 , tyname

4546 , uname

@@ -414,6 +415,12 @@ lname = token go P.<?> "identifier"

414415 go (LName s) = Just s

415416 go _ = Nothing

416417

418+lname' :: String -> TokenParser ()

419+lname' s = token go P.<?> show s

420+ where

421+ go (LName s') | s == s' = Just ()

422+ go _ = Nothing

423+

417424qualifier :: TokenParser String

418425qualifier = token go P.<?> "qualifier"

419426 where

src/Language/PureScript/Parser/Types.hs+2−4

@@ -54,8 +54,7 @@ parseForAll = mkForAll <$> ((reserved "forall" <|> reserved "∀") *> P.many1 (i

5454--

5555parseTypeAtom :: TokenParser Type

5656parseTypeAtom = indented *> P.choice

57− [ P.try parseConstrainedType

58− , P.try parseFunction

57+ [ P.try parseFunction

5958 , parseTypeLevelString

6059 , parseObject

6160 , parseTypeWildcard

@@ -81,9 +80,8 @@ parseConstrainedType = do

8180 ty <- P.many parseTypeAtom

8281 return (Constraint className ty Nothing)

8382

84−

8583parseAnyType :: TokenParser Type

86−parseAnyType = P.buildExpressionParser operators (buildPostfixParser postfixTable parseTypeAtom) P.<?> "type"

84+parseAnyType = P.buildExpressionParser operators (buildPostfixParser postfixTable (P.try parseConstrainedType <|> parseTypeAtom)) P.<?> "type"

8785 where

8886 operators = [ [ P.Infix (return TypeApp) P.AssocLeft ]

8987 , [ P.Infix (P.try (parseQualified parseOperator) >>= \ident ->

src/Language/PureScript/Pretty/Common.hs+1−1

@@ -74,7 +74,7 @@ instance Emit StrPos where

7474 -- |

7575 -- Add a new mapping entry for given source position with initially zero generated position

7676 --

77− addMapping (SourceSpan { spanName = file, spanStart = startPos }) = StrPos (zeroPos, mempty, [mapping])

77+ addMapping SourceSpan { spanName = file, spanStart = startPos } = StrPos (zeroPos, mempty, [mapping])

7878 where

7979 mapping = SMap file startPos zeroPos

8080 zeroPos = SourcePos 0 0

src/Language/PureScript/Pretty/Types.hs+4−4

@@ -45,11 +45,11 @@ typeLiterals = mkPattern match

4545 match _ = Nothing

4646

4747constraintsAsBox :: [Constraint] -> Box -> Box

48−constraintsAsBox [(Constraint pn tys _)] ty = text "(" <> constraintAsBox pn tys <> text ") => " <> ty

49−constraintsAsBox xs ty = vcat left (zipWith (\i (Constraint pn tys _) -> text (if i == 0 then "( " else ", ") <> constraintAsBox pn tys) [0 :: Int ..] xs) `before` (text ") => " <> ty)

48+constraintsAsBox [con] ty = text "(" <> constraintAsBox con `before` (text ") => " <> ty)

49+constraintsAsBox xs ty = vcat left (zipWith (\i con -> text (if i == 0 then "( " else ", ") <> constraintAsBox con) [0 :: Int ..] xs) `before` (text ") => " <> ty)

5050

51−constraintAsBox :: Qualified (ProperName a) -> [Type] -> Box

52−constraintAsBox pn tys = hsep 1 left (text (runProperName (disqualify pn)) : map typeAtomAsBox tys)

51+constraintAsBox :: Constraint -> Box

52+constraintAsBox (Constraint pn tys _) = typeAsBox (foldl TypeApp (TypeConstructor (fmap coerceProperName pn)) tys)

5353

5454-- |

5555-- Generate a pretty-printed string representing a Row

src/Language/PureScript/Pretty/Values.hs+1−1

@@ -61,7 +61,7 @@ prettyPrintValue d (Let ds val) =

6161prettyPrintValue d (Do els) =

6262 text "do " <> vcat left (map (prettyPrintDoNotationElement (d - 1)) els)

6363prettyPrintValue _ (TypeClassDictionary (Constraint name tys _) _ _) = foldl1 beforeWithSpace $ text ("#dict " ++ runProperName (disqualify name)) : map typeAtomAsBox tys

64−prettyPrintValue _ (SuperClassDictionary name _) = text $ "#dict " ++ runProperName (disqualify name)

64+prettyPrintValue _ (DeferredDictionary name _) = text $ "#dict " ++ runProperName (disqualify name)

6565prettyPrintValue _ (TypeClassDictionaryAccessor className ident) =

6666 text "#dict-accessor " <> text (runProperName (disqualify className)) <> text "." <> text (showIdent ident) <> text ">"

6767prettyPrintValue d (TypedValue _ val _) = prettyPrintValue d val

src/Language/PureScript/Publish/ErrorsWarnings.hs+8−8

@@ -182,10 +182,10 @@ displayUserError e = case e of

182182 , spacer

183183 ] ++ spdxExamples ++

184184 [ spacer

185− , para (concat

186− [ "Note that distributing code without a license means that nobody "

187− , "will (legally) be able to use it."

188− ])

185+ , para (

186+ "Note that distributing code without a license means that nobody "

187+ ++ "will (legally) be able to use it."

188+ )

189189 , spacer

190190 , para (concat

191191 [ "It is also recommended to add a LICENSE file to the repository, "

@@ -420,10 +420,10 @@ warnUnacceptableVersions pkgs =

420420

421421warnDirtyWorkingTree :: Box

422422warnDirtyWorkingTree =

423− para (concat

424− [ "Your working tree is dirty. (Note: this would be an error if it "

425− , "were not a dry run)"

426− ])

423+ para (

424+ "Your working tree is dirty. (Note: this would be an error if it "

425+ ++ "were not a dry run)"

426+ )

427427

428428printWarnings :: [PackageWarning] -> IO ()

429429printWarnings = printToStderr . renderWarnings

src/Language/PureScript/Renamer.hs+3−3

@@ -142,7 +142,7 @@ renameInDecl isTopLevel (Rec ds) = do

142142renameInValue :: Expr Ann -> Rename (Expr Ann)

143143renameInValue (Literal ann l) =

144144 Literal ann <$> renameInLiteral renameInValue l

145−renameInValue c@(Constructor{}) = return c

145+renameInValue c@Constructor{} = return c

146146renameInValue (Accessor ann prop v) =

147147 Accessor ann prop <$> renameInValue v

148148renameInValue (ObjectUpdate ann obj vs) =

@@ -154,7 +154,7 @@ renameInValue (App ann v1 v2) =

154154 App ann <$> renameInValue v1 <*> renameInValue v2

155155renameInValue (Var ann (Qualified Nothing name)) =

156156 Var ann . Qualified Nothing <$> lookupIdent name

157−renameInValue v@(Var{}) = return v

157+renameInValue v@Var{} = return v

158158renameInValue (Case ann vs alts) =

159159 newScope $ Case ann <$> traverse renameInValue vs <*> traverse renameInCaseAlternative alts

160160renameInValue (Let ann ds v) =

@@ -180,7 +180,7 @@ renameInCaseAlternative (CaseAlternative bs v) = newScope $

180180-- Renames within binders.

181181--

182182renameInBinder :: Binder a -> Rename (Binder a)

183−renameInBinder n@(NullBinder{}) = return n

183+renameInBinder n@NullBinder{} = return n

184184renameInBinder (LiteralBinder ann b) =

185185 LiteralBinder ann <$> renameInLiteral renameInBinder b

186186renameInBinder (VarBinder ann name) =

src/Language/PureScript/Sugar/Names.hs+8−11

@@ -99,15 +99,12 @@ desugarImportsWithEnv externs modules = do

9999 exportedRefs f = M.fromList $ (, efModuleName) <$> mapMaybe f efExports

100100

101101 updateEnv :: ([Module], Env) -> Module -> m ([Module], Env)

102− updateEnv (ms, env) m@(Module ss _ mn _ refs) =

103− case mn `M.lookup` env of

104− Just m' -> throwError . errorMessage $ RedefinedModule mn [envModuleSourceSpan m', ss]

105− Nothing -> do

106− members <- findExportable m

107− let env' = M.insert mn (ss, primImports, members) env

108− (m', imps) <- resolveImports env' m

109− exps <- maybe (return members) (resolveExports env' ss mn imps members) refs

110− return (m' : ms, M.insert mn (ss, imps, exps) env)

102+ updateEnv (ms, env) m@(Module ss _ mn _ refs) = do

103+ members <- findExportable m

104+ let env' = M.insert mn (ss, primImports, members) env

105+ (m', imps) <- resolveImports env' m

106+ exps <- maybe (return members) (resolveExports env' ss mn imps members) refs

107+ return (m' : ms, M.insert mn (ss, imps, exps) env)

111108

112109 renameInModule' :: Env -> Module -> m Module

113110 renameInModule' env m@(Module _ _ mn _ _) =

@@ -171,8 +168,8 @@ renameInModule imports (Module ss coms mn decls exps) =

171168 (,) (pos, bound) <$> (DataDeclaration dtype name args <$> traverse (sndM (traverse (updateTypesEverywhere pos))) dctors)

172169 updateDecl (pos, bound) (TypeSynonymDeclaration name ps ty) =

173170 (,) (pos, bound) <$> (TypeSynonymDeclaration name ps <$> updateTypesEverywhere pos ty)

174− updateDecl (pos, bound) (TypeClassDeclaration className args implies ds) =

175− (,) (pos, bound) <$> (TypeClassDeclaration className args <$> updateConstraints pos implies <*> pure ds)

171+ updateDecl (pos, bound) (TypeClassDeclaration className args implies deps ds) =

172+ (,) (pos, bound) <$> (TypeClassDeclaration className args <$> updateConstraints pos implies <*> pure deps <*> pure ds)

176173 updateDecl (pos, bound) (TypeInstanceDeclaration name cs cn ts ds) =

177174 (,) (pos, bound) <$> (TypeInstanceDeclaration name <$> updateConstraints pos cs <*> updateClassName cn pos <*> traverse (updateTypesEverywhere pos) ts <*> pure ds)

178175 updateDecl (pos, bound) (TypeDeclaration name ty) =

src/Language/PureScript/Sugar/Names/Exports.hs+1−1

@@ -30,7 +30,7 @@ findExportable (Module _ _ mn ds _) =

3030 rethrow (addHint (ErrorInModule mn)) $ foldM updateExports nullExports ds

3131 where

3232 updateExports :: Exports -> Declaration -> m Exports

33− updateExports exps (TypeClassDeclaration tcn _ _ ds') = do

33+ updateExports exps (TypeClassDeclaration tcn _ _ _ ds') = do

3434 exps' <- exportTypeClass Internal exps tcn mn

3535 foldM go exps' ds'

3636 where

src/Language/PureScript/Sugar/ObjectWildcards.hs+17−10

@@ -1,5 +1,6 @@

11module Language.PureScript.Sugar.ObjectWildcards

22 ( desugarObjectConstructors

3+ , desugarDecl

34 ) where

56import Prelude.Compat

@@ -21,13 +22,12 @@ desugarObjectConstructors

2122 => Module

2223 -> m Module

2324desugarObjectConstructors (Module ss coms mn ds exts) = Module ss coms mn <$> mapM desugarDecl ds <*> pure exts

24− where

2525

26− desugarDecl :: Declaration -> m Declaration

27− desugarDecl (PositionedDeclaration pos com d) = rethrowWithPosition pos $ PositionedDeclaration pos com <$> desugarDecl d

28− desugarDecl other = f other

29− where

30− (f, _, _) = everywhereOnValuesTopDownM return desugarExpr return

26+desugarDecl :: forall m. (MonadSupply m, MonadError MultipleErrors m) => Declaration -> m Declaration

27+desugarDecl (PositionedDeclaration pos com d) = rethrowWithPosition pos $ PositionedDeclaration pos com <$> desugarDecl d

28+desugarDecl other = fn other

29+ where

30+ (fn, _, _) = everywhereOnValuesTopDownM return desugarExpr return

3131

3232 desugarExpr :: Expr -> m Expr

3333 desugarExpr AnonymousArgument = throwError . errorMessage $ IncorrectAnonymousArgument

@@ -45,12 +45,13 @@ desugarObjectConstructors (Module ss coms mn ds exts) = Module ss coms mn <$> ma

4545 obj <- freshIdent'

4646 Abs (Left obj) <$> wrapLambda (ObjectUpdate (argToExpr obj)) ps

4747 desugarExpr (ObjectUpdate obj ps) = wrapLambda (ObjectUpdate obj) ps

48− desugarExpr (Accessor prop u) | isAnonymousArgument u = do

49− arg <- freshIdent'

50− return $ Abs (Left arg) (Accessor prop (argToExpr arg))

48+ desugarExpr (Accessor prop u)

49+ | Just props <- peelAnonAccessorChain u = do

50+ arg <- freshIdent'

51+ return $ Abs (Left arg) $ foldr Accessor (argToExpr arg) (prop:props)

5152 desugarExpr (Case args cas) | any isAnonymousArgument args = do

5253 argIdents <- forM args freshIfAnon

53− let args' = zipWith (\p -> maybe p argToExpr) args argIdents

54+ let args' = zipWith (`maybe` argToExpr) args argIdents

5455 return $ foldr (Abs . Left) (Case args' cas) (catMaybes argIdents)

5556 desugarExpr (IfThenElse u t f) | any isAnonymousArgument [u, t, f] = do

5657 u' <- freshIfAnon u

@@ -73,6 +74,12 @@ desugarObjectConstructors (Module ss coms mn ds exts) = Module ss coms mn <$> ma

7374 stripPositionInfo (PositionedValue _ _ e) = stripPositionInfo e

7475 stripPositionInfo e = e

7576

77+ peelAnonAccessorChain :: Expr -> Maybe [String]

78+ peelAnonAccessorChain (Accessor p e) = (p :) <$> peelAnonAccessorChain e

79+ peelAnonAccessorChain (PositionedValue _ _ e) = peelAnonAccessorChain e

80+ peelAnonAccessorChain AnonymousArgument = Just []

81+ peelAnonAccessorChain _ = Nothing

82+

7683 isAnonymousArgument :: Expr -> Bool

7784 isAnonymousArgument AnonymousArgument = True

7885 isAnonymousArgument (PositionedValue _ _ e) = isAnonymousArgument e

src/Language/PureScript/Sugar/Operators.hs+4−4

@@ -312,9 +312,9 @@ updateTypes goType = (goDecl, goExpr, goBinder)

312312 goDecl pos (ExternDeclaration name ty) = do

313313 ty' <- goType' pos ty

314314 return (pos, ExternDeclaration name ty')

315− goDecl pos (TypeClassDeclaration name args implies decls) = do

315+ goDecl pos (TypeClassDeclaration name args implies deps decls) = do

316316 implies' <- traverse (overConstraintArgs (traverse (goType' pos))) implies

317− return (pos, TypeClassDeclaration name args implies' decls)

317+ return (pos, TypeClassDeclaration name args implies' deps decls)

318318 goDecl pos (TypeInstanceDeclaration name cs className tys impls) = do

319319 cs' <- traverse (overConstraintArgs (traverse (goType' pos))) cs

320320 tys' <- traverse (goType' pos) tys

@@ -332,9 +332,9 @@ updateTypes goType = (goDecl, goExpr, goBinder)

332332 goExpr pos (TypeClassDictionary (Constraint name tys info) dicts hints) = do

333333 tys' <- traverse (goType' pos) tys

334334 return (pos, TypeClassDictionary (Constraint name tys' info) dicts hints)

335− goExpr pos (SuperClassDictionary cls tys) = do

335+ goExpr pos (DeferredDictionary cls tys) = do

336336 tys' <- traverse (goType' pos) tys

337− return (pos, SuperClassDictionary cls tys')

337+ return (pos, DeferredDictionary cls tys')

338338 goExpr pos (TypedValue check v ty) = do

339339 ty' <- goType' pos ty

340340 return (pos, TypedValue check v ty')

src/Language/PureScript/Sugar/Operators/Common.hs+2−2

@@ -28,12 +28,12 @@ parseValue :: P.Parsec (Chain a) () a

2828parseValue = token (either Just (const Nothing)) P.<?> "expression"

2929

3030parseOp

31− :: (a -> (Maybe (Qualified (OpName nameType))))

31+ :: (a -> Maybe (Qualified (OpName nameType)))

3232 -> P.Parsec (Chain a) () (Qualified (OpName nameType))

3333parseOp fromOp = token (either (const Nothing) fromOp) P.<?> "operator"

3434

3535matchOp

36− :: (a -> (Maybe (Qualified (OpName nameType))))

36+ :: (a -> Maybe (Qualified (OpName nameType)))

3737 -> Qualified (OpName nameType)

3838 -> P.Parsec (Chain a) () ()

3939matchOp fromOp op = do

src/Language/PureScript/Sugar/Operators/Expr.hs+1−1

@@ -28,7 +28,7 @@ matchExprOperators = matchOperators isBinOp extractOp fromOp reapply modOpTable

2828 fromOp _ = Nothing

2929

3030 reapply :: Qualified (OpName 'ValueOpName) -> Expr -> Expr -> Expr

31− reapply op t1 t2 = App (App (Op op) t1) t2

31+ reapply op t1 = App (App (Op op) t1)

3232

3333 modOpTable

3434 :: [[P.Operator (Chain Expr) () Identity Expr]]

src/Language/PureScript/Sugar/TypeClasses.hs+25−18

@@ -30,7 +30,7 @@ import Data.Maybe (catMaybes, mapMaybe, isJust)

3030

3131import qualified Data.Map as M

3232

33−type MemberMap = M.Map (ModuleName, ProperName 'ClassName) ([(String, Maybe Kind)], [Constraint], [Declaration])

33+type MemberMap = M.Map (ModuleName, ProperName 'ClassName) TypeClassData

3434

3535type Desugar = StateT MemberMap

3636

@@ -46,14 +46,20 @@ desugarTypeClasses

4646desugarTypeClasses externs = flip evalStateT initialState . traverse desugarModule

4747 where

4848 initialState :: MemberMap

49− initialState = M.singleton (ModuleName [ProperName C.prim], ProperName C.partial) ([], [], [])

50− `M.union` M.fromList (externs >>= \ExternsFile{..} -> mapMaybe (fromExternsDecl efModuleName) efDeclarations)

49+ initialState =

50+ M.mapKeys (qualify (ModuleName [ProperName C.prim])) primClasses

51+ `M.union` M.fromList (externs >>= \ExternsFile{..} -> mapMaybe (fromExternsDecl efModuleName) efDeclarations)

5152

5253 fromExternsDecl

5354 :: ModuleName

5455 -> ExternsDeclaration

55− -> Maybe ((ModuleName, ProperName 'ClassName), ([(String, Maybe Kind)], [Constraint], [Declaration]))

56− fromExternsDecl mn (EDClass name args members implies) = Just ((mn, name), (args, implies, map (uncurry TypeDeclaration) members))

56+ -> Maybe ((ModuleName, ProperName 'ClassName), TypeClassData)

57+ fromExternsDecl mn (EDClass name args members implies deps) = Just ((mn, name), typeClass) where

58+ typeClass = TypeClassData { typeClassArguments = args

59+ , typeClassMembers = members

60+ , typeClassSuperclasses = implies

61+ , typeClassDependencies = deps

62+ }

5763 fromExternsDecl _ _ = Nothing

5864

5965desugarModule

@@ -129,7 +135,7 @@ desugarModule _ = internalError "Exports should have been elaborated in name des

129135--

130136-- subString :: {} -> Sub String

131137-- subString _ = { sub: "",

132−-- , "__superclass_Foo_0": \_ -> <SuperClassDictionary Foo String>

138+-- , "__superclass_Foo_0": \_ -> <DeferredDictionary Foo String>

133139-- }

134140--

135141-- and finally as the generated javascript:

@@ -173,14 +179,18 @@ desugarDecl

173179 -> Desugar m (Maybe DeclarationRef, [Declaration])

174180desugarDecl mn exps = go

175181 where

176− go d@(TypeClassDeclaration name args implies members) = do

177− modify (M.insert (mn, name) (args, implies, members))

182+ go d@(TypeClassDeclaration name args implies deps members) = do

183+ modify (M.insert (mn, name) (TypeClassData args (map memberToNameAndType members) implies deps))

178184 return (Nothing, d : typeClassDictionaryDeclaration name args implies members : map (typeClassMemberToDictionaryAccessor mn name args) members)

179185 go (TypeInstanceDeclaration _ _ _ _ DerivedInstance) = internalError "Derived instanced should have been desugared"

180186 go d@(TypeInstanceDeclaration name deps className tys (ExplicitInstance members)) = do

181187 desugared <- desugarCases members

182188 dictDecl <- typeInstanceDictionaryDeclaration name mn deps className tys desugared

183189 return (expRef name className tys, [d, dictDecl])

190+ go d@(TypeInstanceDeclaration name deps className tys (NewtypeInstanceWithDictionary dict)) = do

191+ let dictTy = foldl TypeApp (TypeConstructor (fmap coerceProperName className)) tys

192+ constrainedTy = quantify (if null deps then dictTy else ConstrainedType deps dictTy)

193+ return (expRef name className tys, [d, ValueDeclaration name Private [] (Right (TypedValue True dict constrainedTy))])

184194 go (PositionedDeclaration pos com d) = do

185195 (dr, ds) <- rethrowWithPosition pos $ desugarDecl mn exps d

186196 return (dr, map (PositionedDeclaration pos com) ds)

@@ -267,18 +277,15 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls =

267277 m <- get

268278

269279 -- Lookup the type arguments and member types for the type class

270− (args, implies, tyDecls) <-

280+ TypeClassData{..} <-

271281 maybe (throwError . errorMessage . UnknownName $ fmap TyClassName className) return $

272282 M.lookup (qualify mn className) m

273283

274− case mapMaybe declName tyDecls \\ mapMaybe declName decls of

284+ case map fst typeClassMembers \\ mapMaybe declName decls of

275285 member : _ -> throwError . errorMessage $ MissingClassMember member

276286 [] -> do

277−

278− let instanceTys = map memberToNameAndType tyDecls

279−

280287 -- Replace the type arguments with the appropriate types in the member types

281− let memberTypes = map (second (replaceAllTypeVars (zip (map fst args) tys))) instanceTys

288+ let memberTypes = map (second (replaceAllTypeVars (zip (map fst typeClassArguments) tys))) typeClassMembers

282289

283290 -- Create values for the type instance members

284291 members <- zip (map typeClassMemberName decls) <$> traverse (memberToValue memberTypes) decls

@@ -286,10 +293,10 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls =

286293 -- Create the type of the dictionary

287294 -- The type is a record type, but depending on type instance dependencies, may be constrained.

288295 -- The dictionary itself is a record literal.

289− let superclasses = superClassDictionaryNames implies `zip`

290− [ Abs (Left (Ident C.__unused)) (SuperClassDictionary superclass tyArgs)

291− | (Constraint superclass suTyArgs _) <- implies

292− , let tyArgs = map (replaceAllTypeVars (zip (map fst args) tys)) suTyArgs

296+ let superclasses = superClassDictionaryNames typeClassSuperclasses `zip`

297+ [ Abs (Left (Ident C.__unused)) (DeferredDictionary superclass tyArgs)

298+ | (Constraint superclass suTyArgs _) <- typeClassSuperclasses

299+ , let tyArgs = map (replaceAllTypeVars (zip (map fst typeClassArguments) tys)) suTyArgs

293300 ]

294301

295302 let props = Literal $ ObjectLiteral (members ++ superclasses)

src/Language/PureScript/Sugar/TypeClasses/Deriving.hs+109−5

@@ -1,4 +1,5 @@

11{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE PatternGuards #-}

34-- |

45-- This module implements the generic deriving elaboration that takes place during desugaring.

@@ -22,6 +23,7 @@ import Language.PureScript.Environment

2223import Language.PureScript.Errors

2324import Language.PureScript.Names

2425import Language.PureScript.Types

26+import Language.PureScript.TypeChecker (checkNewtype)

2527import qualified Language.PureScript.Constants as C

2628

2729-- | Elaborates deriving instance declarations by code generation.

@@ -44,16 +46,29 @@ deriveInstance mn ds (TypeInstanceDeclaration nm deps className tys@[ty] Derived

4446 , Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor ty

4547 , mn == fromMaybe mn mn'

4648 = TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveGeneric mn ds tyCon args

47− | className == Qualified (Just (ModuleName [ ProperName "Data", ProperName "Eq" ])) (ProperName "Eq")

49+ | className == Qualified (Just dataEq) (ProperName "Eq")

4850 , Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor ty

4951 , mn == fromMaybe mn mn'

5052 = TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveEq mn ds tyCon

51− | className == Qualified (Just (ModuleName [ ProperName "Data", ProperName "Ord" ])) (ProperName "Ord")

53+ | className == Qualified (Just dataOrd) (ProperName "Ord")

5254 , Just (Qualified mn' tyCon, _) <- unwrapTypeConstructor ty

5355 , mn == fromMaybe mn mn'

5456 = TypeInstanceDeclaration nm deps className tys . ExplicitInstance <$> deriveOrd mn ds tyCon

57+deriveInstance mn ds (TypeInstanceDeclaration nm deps className [wrappedTy, unwrappedTy] DerivedInstance)

58+ | className == Qualified (Just dataNewtype) (ProperName "Newtype")

59+ , Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor wrappedTy

60+ , mn == fromMaybe mn mn'

61+ = do

62+ (inst, actualUnwrappedTy) <- deriveNewtype mn ds tyCon args unwrappedTy

63+ return $ TypeInstanceDeclaration nm deps className [wrappedTy, actualUnwrappedTy] (ExplicitInstance inst)

5564deriveInstance _ _ (TypeInstanceDeclaration _ _ className tys DerivedInstance)

5665 = throwError . errorMessage $ CannotDerive className tys

66+deriveInstance mn ds (TypeInstanceDeclaration nm deps className tys@(_ : _) NewtypeInstance)

67+ | Just (Qualified mn' tyCon, args) <- unwrapTypeConstructor (last tys)

68+ , mn == fromMaybe mn mn'

69+ = TypeInstanceDeclaration nm deps className tys . NewtypeInstanceWithDictionary <$> deriveNewtypeInstance className ds tys tyCon args

70+deriveInstance _ _ (TypeInstanceDeclaration _ _ className tys NewtypeInstance)

71+ = throwError . errorMessage $ InvalidNewtypeInstance className tys

5772deriveInstance mn ds (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> deriveInstance mn ds d

5873deriveInstance _ _ e = return e

5974

@@ -66,6 +81,44 @@ unwrapTypeConstructor = fmap (second reverse) . go

6681 return (tyCon, arg : args)

6782 go _ = Nothing

6883

84+deriveNewtypeInstance

85+ :: forall m

86+ . MonadError MultipleErrors m

87+ => Qualified (ProperName 'ClassName)

88+ -> [Declaration]

89+ -> [Type]

90+ -> ProperName 'TypeName

91+ -> [Type]

92+ -> m Expr

93+deriveNewtypeInstance className ds tys tyConNm dargs = do

94+ tyCon <- findTypeDecl tyConNm ds

95+ go tyCon

96+ where

97+ go (DataDeclaration Newtype _ tyArgNames [(_, [wrapped])])

98+ -- The newtype might not be applied to all type arguments.

99+ -- This is okay as long as the newtype wraps something which ends with

100+ -- sufficiently many type applications to variables.

101+ -- For example, we can derive Functor for

102+ --

103+ -- newtype MyArray a = MyArray (Array a)

104+ --

105+ -- since Array a is a type application which uses the last

106+ -- type argument

107+ | Just wrapped' <- stripRight (takeReverse (length tyArgNames - length dargs) tyArgNames) wrapped =

108+ do let subst = zipWith (\(name, _) t -> (name, t)) tyArgNames dargs

109+ return (DeferredDictionary className (init tys ++ [replaceAllTypeVars subst wrapped']))

110+ go (PositionedDeclaration _ _ d) = go d

111+ go _ = throwError . errorMessage $ InvalidNewtypeInstance className tys

112+

113+ takeReverse :: Int -> [a] -> [a]

114+ takeReverse n = take n . reverse

115+

116+ stripRight :: [(String, Maybe kind)] -> Type -> Maybe Type

117+ stripRight [] ty = Just ty

118+ stripRight ((arg, _) : args) (TypeApp t (TypeVar arg'))

119+ | arg == arg' = stripRight args t

120+ stripRight _ _ = Nothing

121+

69122dataGeneric :: ModuleName

70123dataGeneric = ModuleName [ ProperName "Data", ProperName "Generic" ]

71124

@@ -75,6 +128,15 @@ dataMaybe = ModuleName [ ProperName "Data", ProperName "Maybe" ]

75128typesProxy :: ModuleName

76129typesProxy = ModuleName [ ProperName "Type", ProperName "Proxy" ]

77130

131+dataEq :: ModuleName

132+dataEq = ModuleName [ ProperName "Data", ProperName "Eq" ]

133+

134+dataOrd :: ModuleName

135+dataOrd = ModuleName [ ProperName "Data", ProperName "Ord" ]

136+

137+dataNewtype :: ModuleName

138+dataNewtype = ModuleName [ ProperName "Data", ProperName "Newtype" ]

139+

78140deriveGeneric

79141 :: forall m. (MonadError MultipleErrors m, MonadSupply m)

80142 => ModuleName

@@ -223,7 +285,7 @@ deriveGeneric mn ds tyConNm dargs = do

223285 $ liftApplicative (mkRecFun rs) (map (\(x, y) -> fromSpineFun (Accessor "recValue" (mkVar (Ident x))) y) rs)

224286

225287 mkRecFun :: [(String, Type)] -> Expr

226− mkRecFun xs = mkJust $ foldr lam recLiteral (map (Ident . fst) xs)

288+ mkRecFun xs = mkJust $ foldr (lam . Ident . fst) recLiteral xs

227289 where recLiteral = Literal . ObjectLiteral $ map (\(s,_) -> (s, mkVar (Ident s))) xs

228290 mkFromSpineFunction (PositionedDeclaration _ _ d) = mkFromSpineFunction d

229291 mkFromSpineFunction _ = internalError "mkFromSpineFunction: expected DataDeclaration"

@@ -265,7 +327,7 @@ deriveEq mn ds tyConNm = do

265327 preludeConj = App . App (Var (Qualified (Just (ModuleName [ProperName "Data", ProperName "HeytingAlgebra"])) (Ident C.conj)))

266328

267329 preludeEq :: Expr -> Expr -> Expr

268− preludeEq = App . App (Var (Qualified (Just (ModuleName [ProperName "Data", ProperName "Eq"])) (Ident C.eq)))

330+ preludeEq = App . App (Var (Qualified (Just dataEq) (Ident C.eq)))

269331

270332 addCatch :: [CaseAlternative] -> [CaseAlternative]

271333 addCatch xs

@@ -335,7 +397,7 @@ deriveOrd mn ds tyConNm = do

335397 orderingBinder name = ConstructorBinder (orderingName name) []

336398

337399 ordCompare :: Expr -> Expr -> Expr

338− ordCompare = App . App (Var (Qualified (Just (ModuleName [ProperName "Data", ProperName "Ord"])) (Ident C.compare)))

400+ ordCompare = App . App (Var (Qualified (Just dataOrd) (Ident C.compare)))

339401

340402 mkCtorClauses :: ((ProperName 'ConstructorName, [Type]), Bool) -> m [CaseAlternative]

341403 mkCtorClauses ((ctorName, tys), isLast) = do

@@ -379,6 +441,48 @@ deriveOrd mn ds tyConNm = do

379441 $ decomposeRec rec

380442 toOrdering l r _ = ordCompare l r

381443

444+deriveNewtype

445+ :: forall m

446+ . (MonadError MultipleErrors m, MonadSupply m)

447+ => ModuleName

448+ -> [Declaration]

449+ -> ProperName 'TypeName

450+ -> [Type]

451+ -> Type

452+ -> m ([Declaration], Type)

453+deriveNewtype mn ds tyConNm tyConArgs unwrappedTy = do

454+ checkIsWildcard unwrappedTy

455+ go =<< findTypeDecl tyConNm ds

456+ where

457+ go :: Declaration -> m ([Declaration], Type)

458+ go (DataDeclaration Data name _ _) =

459+ throwError . errorMessage $ CannotDeriveNewtypeForData name

460+ go (DataDeclaration Newtype name args dctors) = do

461+ checkNewtype name dctors

462+ wrappedIdent <- freshIdent "n"

463+ unwrappedIdent <- freshIdent "a"

464+ let (ctorName, [ty]) = head dctors

465+ inst =

466+ [ ValueDeclaration (Ident "wrap") Public [] $ Right $

467+ Constructor (Qualified (Just mn) ctorName)

468+ , ValueDeclaration (Ident "unwrap") Public [] $ Right $

469+ lamCase wrappedIdent

470+ [ CaseAlternative

471+ [ConstructorBinder (Qualified (Just mn) ctorName) [VarBinder unwrappedIdent]]

472+ (Right (Var (Qualified Nothing unwrappedIdent)))

473+ ]

474+ ]

475+ subst = zipWith ((,) . fst) args tyConArgs

476+ return (inst, replaceAllTypeVars subst ty)

477+ go (PositionedDeclaration _ _ d) = go d

478+ go _ = internalError "deriveNewtype go: expected DataDeclaration"

479+

480+ checkIsWildcard :: Type -> m ()

481+ checkIsWildcard (TypeWildcard _) =

482+ return ()

483+ checkIsWildcard _ =

484+ throwError . errorMessage $ NonWildcardNewtypeInstance tyConNm

485+

382486findTypeDecl

383487 :: (MonadError MultipleErrors m)

384488 => ProperName 'TypeName

src/Language/PureScript/TypeChecker.hs+27−13

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

66module Language.PureScript.TypeChecker

77 ( module T

88 , typeCheckModule

9+ , checkNewtype

910 ) where

1011

1112import Prelude.Compat

@@ -112,15 +113,23 @@ addTypeClass

112113 -> ProperName 'ClassName

113114 -> [(String, Maybe Kind)]

114115 -> [Constraint]

116+ -> [FunctionalDependency]

115117 -> [Declaration]

116118 -> m ()

117−addTypeClass moduleName pn args implies ds =

118− let members = map toPair ds in

119− modify $ \st -> st { checkEnv = (checkEnv st) { typeClasses = M.insert (Qualified (Just moduleName) pn) (args, members, implies) (typeClasses . checkEnv $ st) } }

119+addTypeClass moduleName pn args implies dependencies ds =

120+ modify $ \st -> st { checkEnv = (checkEnv st) { typeClasses = M.insert (Qualified (Just moduleName) pn) newClass (typeClasses . checkEnv $ st) } }

120121 where

121− toPair (TypeDeclaration ident ty) = (ident, ty)

122− toPair (PositionedDeclaration _ _ d) = toPair d

123− toPair _ = internalError "Invalid declaration in TypeClassDeclaration"

122+ newClass :: TypeClassData

123+ newClass =

124+ TypeClassData { typeClassArguments = args

125+ , typeClassMembers = map toPair ds

126+ , typeClassSuperclasses = implies

127+ , typeClassDependencies = dependencies

128+ }

129+

130+ toPair (TypeDeclaration ident ty) = (ident, ty)

131+ toPair (PositionedDeclaration _ _ d) = toPair d

132+ toPair _ = internalError "Invalid declaration in TypeClassDeclaration"

124133

125134addTypeClassDictionaries

126135 :: (MonadState CheckState m)

@@ -265,8 +274,8 @@ typeCheckAll moduleName _ = traverse go

265274 return d

266275 go d@FixityDeclaration{} = return d

267276 go d@ImportDeclaration{} = return d

268− go d@(TypeClassDeclaration pn args implies tys) = do

269− addTypeClass moduleName pn args implies tys

277+ go d@(TypeClassDeclaration pn args implies deps tys) = do

278+ addTypeClass moduleName pn args implies deps tys

270279 return d

271280 go (d@(TypeInstanceDeclaration dictName deps className tys body)) = rethrow (addHint (ErrorInInstance className tys)) $ do

272281 traverse_ (checkTypeClassInstance moduleName) tys

@@ -310,10 +319,6 @@ typeCheckAll moduleName _ = traverse go

310319 checkType _ = internalError "Invalid type in instance in checkOrphanInstance"

311320 checkOrphanInstance _ _ _ = internalError "Unqualified class name in checkOrphanInstance"

312321

313− checkNewtype :: ProperName 'TypeName -> [(ProperName 'ConstructorName, [Type])] -> m ()

314− checkNewtype _ [(_, [_])] = return ()

315− checkNewtype name _ = throwError . errorMessage $ InvalidNewtype name

316−

317322 -- |

318323 -- This function adds the argument kinds for a type constructor so that they may appear in the externs file,

319324 -- extracted from the kind of the type constructor itself.

@@ -324,6 +329,15 @@ typeCheckAll moduleName _ = traverse go

324329 withKinds ( (s, Nothing):ss) (FunKind k1 k2) = (s, Just k1) : withKinds ss k2

325330 withKinds _ _ = internalError "Invalid arguments to peelKinds"

326331

332+checkNewtype

333+ :: forall m

334+ . MonadError MultipleErrors m

335+ => ProperName 'TypeName

336+ -> [(ProperName 'ConstructorName, [Type])]

337+ -> m ()

338+checkNewtype _ [(_, [_])] = return ()

339+checkNewtype name _ = throwError . errorMessage $ InvalidNewtype name

340+

327341-- |

328342-- Type check an entire module and ensure all types and classes defined within the module that are

329343-- required by exported members are also exported.

@@ -414,7 +428,7 @@ typeCheckModule (Module ss coms mn decls (Just exps)) =

414428 unless (null missingMembers) $ throwError . errorMessage $ TransitiveExportError dr members

415429 where

416430 findClassMembers :: Declaration -> Maybe [Ident]

417− findClassMembers (TypeClassDeclaration name' _ _ ds) | name == name' = Just $ map extractMemberName ds

431+ findClassMembers (TypeClassDeclaration name' _ _ _ ds) | name == name' = Just $ map extractMemberName ds

418432 findClassMembers (PositionedDeclaration _ _ d) = findClassMembers d

419433 findClassMembers _ = Nothing

420434 extractMemberName :: Declaration -> Ident

src/Language/PureScript/TypeChecker/Entailment.hs+355−148

@@ -1,28 +1,35 @@

1+{-# LANGUAGE NamedFieldPuns #-}

13-- |

24-- Type class entailment

35--

46module Language.PureScript.TypeChecker.Entailment

57 ( InstanceContext

68 , replaceTypeClassDictionaries

9+ , newDictionaries

710 ) where

811

912import Prelude.Compat

1013

14+import Control.Arrow (second)

1115import Control.Monad.Error.Class (MonadError(..))

1216import Control.Monad.State

1317import Control.Monad.Supply.Class (MonadSupply(..))

1418import Control.Monad.Writer

1519

20+import Data.Foldable (for_)

1621import Data.Function (on)

17−import Data.List (minimumBy, sortBy, groupBy)

18−import Data.Maybe (maybeToList, mapMaybe)

22+import Data.List (minimumBy, nub)

23+import Data.Maybe (fromMaybe, maybeToList, mapMaybe)

1924import qualified Data.Map as M

25+import qualified Data.Set as S

2026

2127import Language.PureScript.AST

2228import Language.PureScript.Crash

29+import Language.PureScript.Environment

2330import Language.PureScript.Errors

2431import Language.PureScript.Names

25−import Language.PureScript.TypeChecker.Monad (CheckState, withErrorMessageHint)

32+import Language.PureScript.TypeChecker.Monad

2633import Language.PureScript.TypeChecker.Unify

2734import Language.PureScript.TypeClassDictionaries

2835import Language.PureScript.Types

@@ -34,24 +41,57 @@ type InstanceContext = M.Map (Maybe ModuleName)

3441 (M.Map (Qualified Ident)

3542 TypeClassDictionaryInScope))

3643

37−-- | Merge two type class contexts

44+-- | A type substitution which makes an instance head match a list of types.

45+--

46+-- Note: we store many types per type variable name. For any name, all types

47+-- should unify if we are going to commit to an instance.

48+type Matching a = M.Map String a

49+

3850combineContexts :: InstanceContext -> InstanceContext -> InstanceContext

3951combineContexts = M.unionWith (M.unionWith M.union)

4052

4153-- | Replace type class dictionary placeholders with inferred type class dictionaries

4254replaceTypeClassDictionaries

43− :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)

55+ :: forall m

56+ . (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)

4457 => Bool

45− -> ModuleName

4658 -> Expr

4759 -> m (Expr, [(Ident, Constraint)])

48−replaceTypeClassDictionaries shouldGeneralize mn =

49− let (_, f, _) = everywhereOnValuesTopDownM return (WriterT . go) return

50− in flip evalStateT M.empty . runWriterT . f

60+replaceTypeClassDictionaries shouldGeneralize expr = flip evalStateT M.empty $ do

61+ -- Loop, deferring any unsolved constraints, until there are no more

62+ -- constraints which can be solved, then make a generalization pass.

63+ let loop e = do

64+ (e', solved) <- deferPass e

65+ if getAny solved

66+ then loop e'

67+ else return e'

68+ loop expr >>= generalizePass

5169 where

52− go (TypeClassDictionary constraint dicts hints) =

53− rethrow (addHints hints) $ entails shouldGeneralize mn dicts constraint

54− go other = return (other, [])

70+ -- This pass solves constraints where possible, deferring constraints if not.

71+ deferPass :: Expr -> StateT InstanceContext m (Expr, Any)

72+ deferPass = fmap (second fst) . runWriterT . f where

73+ f :: Expr -> WriterT (Any, [(Ident, Constraint)]) (StateT InstanceContext m) Expr

74+ (_, f, _) = everywhereOnValuesTopDownM return (go True) return

75+

76+ -- This pass generalizes any remaining constraints

77+ generalizePass :: Expr -> StateT InstanceContext m (Expr, [(Ident, Constraint)])

78+ generalizePass = fmap (second snd) . runWriterT . f where

79+ f :: Expr -> WriterT (Any, [(Ident, Constraint)]) (StateT InstanceContext m) Expr

80+ (_, f, _) = everywhereOnValuesTopDownM return (go False) return

81+

82+ go :: Bool -> Expr -> WriterT (Any, [(Ident, Constraint)]) (StateT InstanceContext m) Expr

83+ go deferErrors dict@(TypeClassDictionary _ _ hints) =

84+ rethrow (addHints hints) $ entails shouldGeneralize deferErrors dict

85+ go _ other = return other

86+

87+-- | Three options for how we can handle a constraint, depending on the mode we're in.

88+data EntailsResult a

89+ = Solved a TypeClassDictionaryInScope

90+ -- ^ We solved this constraint

91+ | Unsolved Constraint

92+ -- ^ We couldn't solve this constraint right now, it will be generalized

93+ | Deferred

94+ -- ^ We couldn't solve this constraint right now, so it has been deferred

5595

5696-- |

5797-- Check that the current set of type class dictionaries entail the specified type class goal, and, if so,

@@ -61,14 +101,14 @@ entails

61101 :: forall m

62102 . (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m, MonadSupply m)

63103 => Bool

64− -> ModuleName

65− -> InstanceContext

66− -> Constraint

67− -> StateT InstanceContext m (Expr, [(Ident, Constraint)])

68−entails shouldGeneralize moduleName context = solve

104+ -> Bool

105+ -> Expr

106+ -> WriterT (Any, [(Ident, Constraint)]) (StateT InstanceContext m) Expr

107+entails shouldGeneralize deferErrors (TypeClassDictionary constraint context hints) =

108+ solve constraint

69109 where

70110 forClassName :: InstanceContext -> Qualified (ProperName 'ClassName) -> [Type] -> [TypeClassDictionaryInScope]

71− forClassName ctx cn@(Qualified (Just mn) _) tys = concatMap (findDicts ctx cn) (Nothing : Just mn : map Just (mapMaybe ctorModules tys))

111+ forClassName ctx cn@(Qualified (Just mn) _) tys = concatMap (findDicts ctx cn) (nub (Nothing : Just mn : map Just (mapMaybe ctorModules tys)))

72112 forClassName _ _ _ = internalError "forClassName: expected qualified class name"

73113

74114 ctorModules :: Type -> Maybe ModuleName

@@ -80,139 +120,306 @@ entails shouldGeneralize moduleName context = solve

80120 findDicts :: InstanceContext -> Qualified (ProperName 'ClassName) -> Maybe ModuleName -> [TypeClassDictionaryInScope]

81121 findDicts ctx cn = maybe [] M.elems . (>>= M.lookup cn) . flip M.lookup ctx

82122

83− solve :: Constraint -> StateT InstanceContext m (Expr, [(Ident, Constraint)])

84− solve con = StateT . (withErrorMessageHint (ErrorSolvingConstraint con) .) . runStateT $ do

85− (dict, unsolved) <- go 0 con

86− return (dictionaryValueToValue dict, unsolved)

123+ valUndefined :: Expr

124+ valUndefined = Var (Qualified (Just (ModuleName [ProperName C.prim])) (Ident C.undefined))

125+

126+ solve :: Constraint -> WriterT (Any, [(Ident, Constraint)]) (StateT InstanceContext m) Expr

127+ solve con = go 0 con

87128 where

88− go :: Int -> Constraint -> StateT InstanceContext m (DictionaryValue, [(Ident, Constraint)])

89− go work (Constraint className' tys' _) | work > 1000 = throwError . errorMessage $ PossiblyInfiniteInstance className' tys'

90− go work con'@(Constraint className' tys' _) = do

91− -- Get the inferred constraint context so far, and merge it with the global context

92− inferred <- get

93− let instances = do

94− tcd <- forClassName (combineContexts context inferred) className' tys'

95− -- Make sure the type unifies with the type in the type instance definition

96− subst <- maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName) tys' (tcdInstanceTypes tcd)

97− return (subst, tcd)

98− solution <- lift $ unique instances

99− case solution of

100− Left (subst, tcd) -> do

101− -- Solve any necessary subgoals

102− (args, unsolved) <- solveSubgoals subst (tcdDependencies tcd)

103− let match = foldr (\(superclassName, index) dict -> SubclassDictionaryValue dict superclassName index)

104− (mkDictionary (tcdName tcd) args)

105− (tcdPath tcd)

106− return (match, unsolved)

107− Right unsolved@(Constraint unsolvedClassName@(Qualified _ pn) unsolvedTys _) -> do

108− -- Generate a fresh name for the unsolved constraint's new dictionary

109− ident <- freshIdent ("dict" ++ runProperName pn)

110− let qident = Qualified Nothing ident

111− -- Store the new dictionary in the InstanceContext so that we can solve this goal in

112− -- future.

113− let newDict = TypeClassDictionaryInScope qident [] unsolvedClassName unsolvedTys Nothing

114− newContext = M.singleton Nothing (M.singleton unsolvedClassName (M.singleton qident newDict))

115− modify (combineContexts newContext)

116− return (LocalDictionaryValue qident, [(ident, unsolved)])

117− where

129+ go :: Int -> Constraint -> WriterT (Any, [(Ident, Constraint)]) (StateT InstanceContext m) Expr

130+ go work (Constraint className' tys' _) | work > 1000 = throwError . errorMessage $ PossiblyInfiniteInstance className' tys'

131+ go work con'@(Constraint className' tys' conInfo) = WriterT . StateT . (withErrorMessageHint (ErrorSolvingConstraint con') .) . runStateT . runWriterT $ do

132+ -- We might have unified types by solving other constraints, so we need to

133+ -- apply the latest substitution.

134+ latestSubst <- lift . lift $ gets checkSubstitution

135+ let tys'' = map (substituteType latestSubst) tys'

136+ -- Get the inferred constraint context so far, and merge it with the global context

137+ inferred <- lift get

138+ -- We need information about functional dependencies, so we have to look up the class

139+ -- name in the environment:

140+ let findClass = fromMaybe (internalError "entails: type class not found in environment") . M.lookup className'

141+ TypeClassData{ typeClassDependencies } <- lift . lift $ gets (findClass . typeClasses . checkEnv)

142+ let instances =

143+ [ (substs, tcd)

144+ | tcd <- forClassName (combineContexts context inferred) className' tys''

145+ -- Make sure the type unifies with the type in the type instance definition

146+ , substs <- maybeToList (matches typeClassDependencies tcd tys'')

147+ ]

148+ solution <- lift . lift $ unique tys'' instances

149+ case solution of

150+ Solved substs tcd -> do

151+ -- Note that we solved something.

152+ tell (Any True, mempty)

153+ -- Make sure the substitution is valid:

154+ lift . lift . for_ substs $ pairwiseM unifyTypes

155+ -- Now enforce any functional dependencies, using unification

156+ -- Note: we need to generate fresh types for any unconstrained

157+ -- type variables before unifying.

158+ let subst = fmap head substs

159+ currentSubst <- lift . lift $ gets checkSubstitution

160+ subst' <- lift . lift $ withFreshTypes tcd (fmap (substituteType currentSubst) subst)

161+ lift . lift $ zipWithM_ (\t1 t2 -> do

162+ let inferredType = replaceAllTypeVars (M.toList subst') t1

163+ unifyTypes inferredType t2) (tcdInstanceTypes tcd) tys''

164+ currentSubst' <- lift . lift $ gets checkSubstitution

165+ let subst'' = fmap (substituteType currentSubst') subst'

166+ -- Solve any necessary subgoals

167+ args <- solveSubgoals subst'' (tcdDependencies tcd)

168+ let match = foldr (\(superclassName, index) dict -> subclassDictionaryValue dict superclassName index)

169+ (mkDictionary (tcdName tcd) args)

170+ (tcdPath tcd)

171+ return match

172+ Unsolved unsolved -> do

173+ -- Generate a fresh name for the unsolved constraint's new dictionary

174+ ident <- freshIdent ("dict" ++ runProperName (disqualify (constraintClass unsolved)))

175+ let qident = Qualified Nothing ident

176+ -- Store the new dictionary in the InstanceContext so that we can solve this goal in

177+ -- future.

178+ newDicts <- lift . lift $ newDictionaries [] qident unsolved

179+ let newContext = mkContext newDicts

180+ modify (combineContexts newContext)

181+ -- Mark this constraint for generalization

182+ tell (mempty, [(ident, unsolved)])

183+ return (Var qident)

184+ Deferred ->

185+ -- Constraint was deferred, just return the dictionary unchanged,

186+ -- with no unsolved constraints. Hopefully, we can solve this later.

187+ return (TypeClassDictionary (Constraint className' tys'' conInfo) context hints)

188+ where

189+ -- | When checking functional dependencies, we need to use unification to make

190+ -- sure it is safe to use the selected instance. We will unify the solved type with

191+ -- the type in the instance head under the substition inferred from its instantiation.

192+ -- As an example, when solving MonadState t0 (State Int), we choose the

193+ -- MonadState s (State s) instance, and we unify t0 with Int, since the functional

194+ -- dependency from MonadState dictates that t0 should unify with s\[s -> Int], which is

195+ -- Int. This is fine, but in some cases, the substitution does not remove all TypeVars

196+ -- from the type, so we end up with a unification error. So, any type arguments which

197+ -- appear in the instance head, but not in the substitution need to be replaced with

198+ -- fresh type variables. This function extends a substitution with fresh type variables

199+ -- as necessary, based on the types in the instance head.

200+ withFreshTypes

201+ :: TypeClassDictionaryInScope

202+ -> Matching Type

203+ -> m (Matching Type)

204+ withFreshTypes TypeClassDictionaryInScope{..} subst = do

205+ let onType = everythingOnTypes S.union fromTypeVar

206+ typeVarsInHead = foldMap onType tcdInstanceTypes

207+ <> foldMap (foldMap (foldMap onType . constraintArgs)) tcdDependencies

208+ typeVarsInSubst = S.fromList (M.keys subst)

209+ uninstantiatedTypeVars = typeVarsInHead S.\\ typeVarsInSubst

210+ newSubst <- traverse withFreshType (S.toList uninstantiatedTypeVars)

211+ return (subst <> M.fromList newSubst)

212+ where

213+ fromTypeVar (TypeVar v) = S.singleton v

214+ fromTypeVar _ = S.empty

118215

119− unique :: [(a, TypeClassDictionaryInScope)] -> m (Either (a, TypeClassDictionaryInScope) Constraint)

120− unique [] | shouldGeneralize && all canBeGeneralized tys' = return (Right con')

121− | otherwise = throwError . errorMessage $ NoInstanceFound con'

122− unique [a] = return $ Left a

123− unique tcds | pairwise overlapping (map snd tcds) = do

124− tell . errorMessage $ OverlappingInstances className' tys' (map (tcdName . snd) tcds)

125− return $ Left (head tcds)

126− | otherwise = return $ Left (minimumBy (compare `on` length . tcdPath . snd) tcds)

127−

128− canBeGeneralized :: Type -> Bool

129− canBeGeneralized TUnknown{} = True

130− canBeGeneralized Skolem{} = True

131− canBeGeneralized _ = False

132−

133− -- |

134− -- Check if two dictionaries are overlapping

135− --

136− -- Dictionaries which are subclass dictionaries cannot overlap, since otherwise the overlap would have

137− -- been caught when constructing superclass dictionaries.

138− overlapping :: TypeClassDictionaryInScope -> TypeClassDictionaryInScope -> Bool

139− overlapping TypeClassDictionaryInScope{ tcdPath = _ : _ } _ = False

140− overlapping _ TypeClassDictionaryInScope{ tcdPath = _ : _ } = False

141− overlapping TypeClassDictionaryInScope{ tcdDependencies = Nothing } _ = False

142− overlapping _ TypeClassDictionaryInScope{ tcdDependencies = Nothing } = False

143− overlapping tcd1 tcd2 = tcdName tcd1 /= tcdName tcd2

144−

145− -- Create dictionaries for subgoals which still need to be solved by calling go recursively

146− -- E.g. the goal (Show a, Show b) => Show (Either a b) can be satisfied if the current type

147− -- unifies with Either a b, and we can satisfy the subgoals Show a and Show b recursively.

148− solveSubgoals :: [(String, Type)] -> Maybe [Constraint] -> StateT InstanceContext m (Maybe [DictionaryValue], [(Ident, Constraint)])

149− solveSubgoals _ Nothing = return (Nothing, [])

150− solveSubgoals subst (Just subgoals) = do

151− zipped <- traverse (go (work + 1) . mapConstraintArgs (map (replaceAllTypeVars subst))) subgoals

152− let (dicts, unsolved) = unzip zipped

153− return (Just dicts, concat unsolved)

154−

155− -- Make a dictionary from subgoal dictionaries by applying the correct function

156− mkDictionary :: Qualified Ident -> Maybe [DictionaryValue] -> DictionaryValue

157− mkDictionary fnName Nothing = LocalDictionaryValue fnName

158− mkDictionary fnName (Just []) = GlobalDictionaryValue fnName

159− mkDictionary fnName (Just dicts) = DependentDictionaryValue fnName dicts

160−

161− -- Turn a DictionaryValue into a Expr

162− dictionaryValueToValue :: DictionaryValue -> Expr

163− dictionaryValueToValue (LocalDictionaryValue fnName) = Var fnName

164− dictionaryValueToValue (GlobalDictionaryValue fnName) = Var fnName

165− dictionaryValueToValue (DependentDictionaryValue fnName dicts) = foldl App (Var fnName) (map dictionaryValueToValue dicts)

166− dictionaryValueToValue (SubclassDictionaryValue dict superclassName index) =

167− App (Accessor (C.__superclass_ ++ showQualified runProperName superclassName ++ "_" ++ show index)

168− (dictionaryValueToValue dict))

169− valUndefined

170− -- Ensure that a substitution is valid

171− verifySubstitution :: [(String, Type)] -> Maybe [(String, Type)]

172− verifySubstitution subst = do

173− let grps = groupBy ((==) `on` fst) . sortBy (compare `on` fst) $ subst

174− guard (all (pairwise unifiesWith . map snd) grps)

175− return $ map head grps

216+ withFreshType s = do

217+ t <- freshType

218+ return (s, t)

176219

177− valUndefined :: Expr

178− valUndefined = Var (Qualified (Just (ModuleName [ProperName C.prim])) (Ident C.undefined))

220+ unique :: [Type] -> [(a, TypeClassDictionaryInScope)] -> m (EntailsResult a)

221+ unique tyArgs []

222+ | deferErrors = return Deferred

223+ -- We need a special case for nullary type classes, since we want

224+ -- to generalize over Partial constraints.

225+ | shouldGeneralize && (null tyArgs || any canBeGeneralized tyArgs) = return (Unsolved (Constraint className' tyArgs conInfo))

226+ | otherwise = throwError . errorMessage $ NoInstanceFound (Constraint className' tyArgs conInfo)

227+ unique _ [(a, dict)] = return $ Solved a dict

228+ unique tyArgs tcds

229+ | pairwiseAny overlapping (map snd tcds) = do

230+ tell . errorMessage $ OverlappingInstances className' tyArgs (map (tcdName . snd) tcds)

231+ return $ uncurry Solved (head tcds)

232+ | otherwise = return $ uncurry Solved (minimumBy (compare `on` length . tcdPath . snd) tcds)

179233

180−-- |

181−-- Check whether the type heads of two types are equal (for the purposes of type class dictionary lookup),

182−-- and return a substitution from type variables to types which makes the type heads unify.

183−--

184−typeHeadsAreEqual :: ModuleName -> Type -> Type -> Maybe [(String, Type)]

185−typeHeadsAreEqual _ (TUnknown u1) (TUnknown u2) | u1 == u2 = Just []

186−typeHeadsAreEqual _ (Skolem _ s1 _ _) (Skolem _ s2 _ _) | s1 == s2 = Just []

187−typeHeadsAreEqual _ t (TypeVar v) = Just [(v, t)]

188−typeHeadsAreEqual _ (TypeConstructor c1) (TypeConstructor c2) | c1 == c2 = Just []

189−typeHeadsAreEqual _ (TypeLevelString s1) (TypeLevelString s2) | s1 == s2 = Just []

190−typeHeadsAreEqual m (TypeApp h1 t1) (TypeApp h2 t2) = (++) <$> typeHeadsAreEqual m h1 h2

191− <*> typeHeadsAreEqual m t1 t2

192−typeHeadsAreEqual _ REmpty REmpty = Just []

193−typeHeadsAreEqual m r1@RCons{} r2@RCons{} =

194− let (s1, r1') = rowToList r1

195− (s2, r2') = rowToList r2

196−

197− int = [ (t1, t2) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]

198− sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]

199− sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]

200− in (++) <$> foldMap (uncurry (typeHeadsAreEqual m)) int

201− <*> go sd1 r1' sd2 r2'

234+ canBeGeneralized :: Type -> Bool

235+ canBeGeneralized TUnknown{} = True

236+ canBeGeneralized Skolem{} = True

237+ canBeGeneralized _ = False

238+

239+ -- |

240+ -- Check if two dictionaries are overlapping

241+ --

242+ -- Dictionaries which are subclass dictionaries cannot overlap, since otherwise the overlap would have

243+ -- been caught when constructing superclass dictionaries.

244+ overlapping :: TypeClassDictionaryInScope -> TypeClassDictionaryInScope -> Bool

245+ overlapping TypeClassDictionaryInScope{ tcdPath = _ : _ } _ = False

246+ overlapping _ TypeClassDictionaryInScope{ tcdPath = _ : _ } = False

247+ overlapping TypeClassDictionaryInScope{ tcdDependencies = Nothing } _ = False

248+ overlapping _ TypeClassDictionaryInScope{ tcdDependencies = Nothing } = False

249+ overlapping tcd1 tcd2 = tcdName tcd1 /= tcdName tcd2

250+

251+ -- Create dictionaries for subgoals which still need to be solved by calling go recursively

252+ -- E.g. the goal (Show a, Show b) => Show (Either a b) can be satisfied if the current type

253+ -- unifies with Either a b, and we can satisfy the subgoals Show a and Show b recursively.

254+ solveSubgoals :: Matching Type -> Maybe [Constraint] -> WriterT (Any, [(Ident, Constraint)]) (StateT InstanceContext m) (Maybe [Expr])

255+ solveSubgoals _ Nothing = return Nothing

256+ solveSubgoals subst (Just subgoals) =

257+ Just <$> traverse (go (work + 1) . mapConstraintArgs (map (replaceAllTypeVars (M.toList subst)))) subgoals

258+

259+ -- Make a dictionary from subgoal dictionaries by applying the correct function

260+ mkDictionary :: Qualified Ident -> Maybe [Expr] -> Expr

261+ mkDictionary fnName Nothing = Var fnName

262+ mkDictionary fnName (Just []) = Var fnName

263+ mkDictionary fnName (Just dicts) = foldl App (Var fnName) dicts

264+

265+ -- Turn a DictionaryValue into a Expr

266+ subclassDictionaryValue :: Expr -> Qualified (ProperName a) -> Integer -> Expr

267+ subclassDictionaryValue dict superclassName index =

268+ App (Accessor (C.__superclass_ ++ showQualified runProperName superclassName ++ "_" ++ show index)

269+ dict)

270+ valUndefined

271+entails _ _ _ = internalError "entails: expected TypeClassDictionary"

272+

273+-- Check if an instance matches our list of types, allowing for types

274+-- to be solved via functional dependencies. If the types match, we return a

275+-- substitution which makes them match. If not, we return 'Nothing'.

276+matches :: [FunctionalDependency] -> TypeClassDictionaryInScope -> [Type] -> Maybe (Matching [Type])

277+matches deps TypeClassDictionaryInScope{..} tys = do

278+ -- First, find those types which match exactly

279+ let matched = zipWith typeHeadsAreEqual tys tcdInstanceTypes

280+ -- Now, use any functional dependencies to infer any remaining types

281+ guard $ covers matched

282+ -- Verify that any repeated type variables are unifiable

283+ let determinedSet = foldMap (S.fromList . fdDetermined) deps

284+ solved = map snd . filter ((`S.notMember` determinedSet) . fst) $ zipWith (\(_, ts) i -> (i, ts)) matched [0..]

285+ verifySubstitution (M.unionsWith (++) solved)

202286 where

203− go :: [(String, Type)] -> Type -> [(String, Type)] -> Type -> Maybe [(String, Type)]

204− go [] REmpty [] REmpty = Just []

205− go [] (TUnknown _) _ _ = Just []

206− go [] (TypeVar v1) [] (TypeVar v2) | v1 == v2 = Just []

207− go [] (Skolem _ s1 _ _) [] (Skolem _ s2 _ _) | s1 == s2 = Just []

208− go sd r [] (TypeVar v) = Just [(v, rowFromList (sd, r))]

209− go _ _ _ _ = Nothing

210−typeHeadsAreEqual _ _ _ = Nothing

287+ -- | Find the closure of a set of functional dependencies.

288+ covers :: [(Bool, subst)] -> Bool

289+ covers ms = finalSet == S.fromList [0..length ms - 1]

290+ where

291+ initialSet :: S.Set Int

292+ initialSet = S.fromList . map snd . filter (fst . fst) $ zip ms [0..]

211293

212−-- |

213−-- Check all values in a list pairwise match a predicate

214−--

215−pairwise :: (a -> a -> Bool) -> [a] -> Bool

216−pairwise _ [] = True

217−pairwise _ [_] = True

218−pairwise p (x : xs) = all (p x) xs && pairwise p xs

294+ finalSet :: S.Set Int

295+ finalSet = untilFixedPoint applyAll initialSet

296+

297+ untilFixedPoint :: Eq a => (a -> a) -> a -> a

298+ untilFixedPoint f = go

299+ where

300+ go a | a' == a = a'

301+ | otherwise = go a'

302+ where a' = f a

303+

304+ applyAll :: S.Set Int -> S.Set Int

305+ applyAll s = foldr applyDependency s deps

306+

307+ applyDependency :: FunctionalDependency -> S.Set Int -> S.Set Int

308+ applyDependency FunctionalDependency{..} xs

309+ | S.fromList fdDeterminers `S.isSubsetOf` xs = xs <> S.fromList fdDetermined

310+ | otherwise = xs

311+

312+ --

313+ -- Check whether the type heads of two types are equal (for the purposes of type class dictionary lookup),

314+ -- and return a substitution from type variables to types which makes the type heads unify.

315+ --

316+ typeHeadsAreEqual :: Type -> Type -> (Bool, Matching [Type])

317+ typeHeadsAreEqual (TUnknown u1) (TUnknown u2) | u1 == u2 = (True, M.empty)

318+ typeHeadsAreEqual (Skolem _ s1 _ _) (Skolem _ s2 _ _) | s1 == s2 = (True, M.empty)

319+ typeHeadsAreEqual t (TypeVar v) = (True, M.singleton v [t])

320+ typeHeadsAreEqual (TypeConstructor c1) (TypeConstructor c2) | c1 == c2 = (True, M.empty)

321+ typeHeadsAreEqual (TypeLevelString s1) (TypeLevelString s2) | s1 == s2 = (True, M.empty)

322+ typeHeadsAreEqual (TypeApp h1 t1) (TypeApp h2 t2) =

323+ both (typeHeadsAreEqual h1 h2) (typeHeadsAreEqual t1 t2)

324+ typeHeadsAreEqual REmpty REmpty = (True, M.empty)

325+ typeHeadsAreEqual r1@RCons{} r2@RCons{} =

326+ foldr both (go sd1 r1' sd2 r2') (map (uncurry typeHeadsAreEqual) int)

327+ where

328+ (s1, r1') = rowToList r1

329+ (s2, r2') = rowToList r2

330+

331+ int = [ (t1, t2) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]

332+ sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]

333+ sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]

334+

335+ go :: [(String, Type)] -> Type -> [(String, Type)] -> Type -> (Bool, Matching [Type])

336+ go [] REmpty [] REmpty = (True, M.empty)

337+ go [] (TUnknown u1) [] (TUnknown u2) | u1 == u2 = (True, M.empty)

338+ go [] (TypeVar v1) [] (TypeVar v2) | v1 == v2 = (True, M.empty)

339+ go [] (Skolem _ sk1 _ _) [] (Skolem _ sk2 _ _) | sk1 == sk2 = (True, M.empty)

340+ go sd r [] (TypeVar v) = (True, M.singleton v [rowFromList (sd, r)])

341+ go _ _ _ _ = (False, M.empty)

342+ typeHeadsAreEqual _ _ = (False, M.empty)

343+

344+ both :: (Bool, Matching [Type]) -> (Bool, Matching [Type]) -> (Bool, Matching [Type])

345+ both (b1, m1) (b2, m2) = (b1 && b2, M.unionWith (++) m1 m2)

346+

347+ -- Ensure that a substitution is valid

348+ verifySubstitution :: Matching [Type] -> Maybe (Matching [Type])

349+ verifySubstitution = traverse meet where

350+ meet ts | pairwiseAll typesAreEqual ts = Just ts

351+ | otherwise = Nothing

352+

353+ -- Note that unknowns are only allowed to unify if they came from a type

354+ -- which was _not_ solved, i.e. one which was inferred by a functional

355+ -- dependency.

356+ typesAreEqual :: Type -> Type -> Bool

357+ typesAreEqual (TUnknown u1) (TUnknown u2) | u1 == u2 = True

358+ typesAreEqual (Skolem _ s1 _ _) (Skolem _ s2 _ _) = s1 == s2

359+ typesAreEqual (TypeVar v1) (TypeVar v2) = v1 == v2

360+ typesAreEqual (TypeLevelString s1) (TypeLevelString s2) = s1 == s2

361+ typesAreEqual (TypeConstructor c1) (TypeConstructor c2) = c1 == c2

362+ typesAreEqual (TypeApp h1 t1) (TypeApp h2 t2) = typesAreEqual h1 h2 && typesAreEqual t1 t2

363+ typesAreEqual REmpty REmpty = True

364+ typesAreEqual r1 r2 | isRCons r1 || isRCons r2 =

365+ let (s1, r1') = rowToList r1

366+ (s2, r2') = rowToList r2

367+

368+ int = [ (t1, t2) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]

369+ sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]

370+ sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]

371+ in all (uncurry typesAreEqual) int && go sd1 r1' sd2 r2'

372+ where

373+ go :: [(String, Type)] -> Type -> [(String, Type)] -> Type -> Bool

374+ go [] (TUnknown u1) [] (TUnknown u2) | u1 == u2 = True

375+ go [] (Skolem _ s1 _ _) [] (Skolem _ s2 _ _) = s1 == s2

376+ go [] REmpty [] REmpty = True

377+ go [] (TypeVar v1) [] (TypeVar v2) = v1 == v2

378+ go _ _ _ _ = False

379+ typesAreEqual _ _ = False

380+

381+ isRCons :: Type -> Bool

382+ isRCons RCons{} = True

383+ isRCons _ = False

384+

385+-- | Add a dictionary for the constraint to the scope, and dictionaries

386+-- for all implied superclass instances.

387+newDictionaries

388+ :: MonadState CheckState m

389+ => [(Qualified (ProperName 'ClassName), Integer)]

390+ -> Qualified Ident

391+ -> Constraint

392+ -> m [TypeClassDictionaryInScope]

393+newDictionaries path name (Constraint className instanceTy _) = do

394+ tcs <- gets (typeClasses . checkEnv)

395+ let TypeClassData{..} = fromMaybe (internalError "newDictionaries: type class lookup failed") $ M.lookup className tcs

396+ supDicts <- join <$> zipWithM (\(Constraint supName supArgs _) index ->

397+ newDictionaries ((supName, index) : path)

398+ name

399+ (Constraint supName (instantiateSuperclass (map fst typeClassArguments) supArgs instanceTy) Nothing)

400+ ) typeClassSuperclasses [0..]

401+ return (TypeClassDictionaryInScope name path className instanceTy Nothing : supDicts)

402+ where

403+ instantiateSuperclass :: [String] -> [Type] -> [Type] -> [Type]

404+ instantiateSuperclass args supArgs tys = map (replaceAllTypeVars (zip args tys)) supArgs

405+

406+mkContext :: [TypeClassDictionaryInScope] -> InstanceContext

407+mkContext = foldr combineContexts M.empty . map fromDict where

408+ fromDict d = M.singleton Nothing (M.singleton (tcdClassName d) (M.singleton (tcdName d) d))

409+

410+-- | Check all pairs of values in a list match a predicate

411+pairwiseAll :: (a -> a -> Bool) -> [a] -> Bool

412+pairwiseAll _ [] = True

413+pairwiseAll _ [_] = True

414+pairwiseAll p (x : xs) = all (p x) xs && pairwiseAll p xs

415+

416+-- | Check any pair of values in a list match a predicate

417+pairwiseAny :: (a -> a -> Bool) -> [a] -> Bool

418+pairwiseAny _ [] = False

419+pairwiseAny _ [_] = False

420+pairwiseAny p (x : xs) = any (p x) xs || pairwiseAny p xs

421+

422+pairwiseM :: Applicative m => (a -> a -> m ()) -> [a] -> m ()

423+pairwiseM _ [] = pure ()

424+pairwiseM _ [_] = pure ()

425+pairwiseM p (x : xs) = traverse (p x) xs *> pairwiseM p xs

src/Language/PureScript/TypeChecker/Kinds.hs+7−8

@@ -16,7 +16,6 @@ import Control.Arrow (second)

1616import Control.Monad

1717import Control.Monad.Error.Class (MonadError(..))

1818import Control.Monad.State

19−import Control.Monad.Writer.Class (MonadWriter(..))

2019

2120import qualified Data.Map as M

2221

@@ -96,19 +95,19 @@ unifyKinds k1 k2 = do

9695

9796-- | Infer the kind of a single type

9897kindOf

99− :: (MonadError MultipleErrors m, MonadState CheckState m, MonadWriter MultipleErrors m)

98+ :: (MonadError MultipleErrors m, MonadState CheckState m)

10099 => Type

101100 -> m Kind

102101kindOf ty = fst <$> kindOfWithScopedVars ty

103102

104103-- | Infer the kind of a single type, returning the kinds of any scoped type variables

105104kindOfWithScopedVars ::

106− (MonadError MultipleErrors m, MonadState CheckState m, MonadWriter MultipleErrors m) =>

105+ (MonadError MultipleErrors m, MonadState CheckState m) =>

107106 Type ->

108107 m (Kind, [(String, Kind)])

109108kindOfWithScopedVars ty =

110109 withErrorMessageHint (ErrorCheckingKind ty) $

111− fmap tidyUp . liftUnify $ infer ty

110+ fmap tidyUp . withFreshSubstitution . captureSubstitution $ infer ty

112111 where

113112 tidyUp ((k, args), sub) = ( starIfUnknown (substituteKind sub k)

114113 , map (second (starIfUnknown . substituteKind sub)) args

@@ -116,14 +115,14 @@ kindOfWithScopedVars ty =

116115

117116-- | Infer the kind of a type constructor with a collection of arguments and a collection of associated data constructors

118117kindsOf

119− :: (MonadError MultipleErrors m, MonadState CheckState m, MonadWriter MultipleErrors m)

118+ :: (MonadError MultipleErrors m, MonadState CheckState m)

120119 => Bool

121120 -> ModuleName

122121 -> ProperName 'TypeName

123122 -> [(String, Maybe Kind)]

124123 -> [Type]

125124 -> m Kind

126−kindsOf isData moduleName name args ts = fmap tidyUp . liftUnify $ do

125+kindsOf isData moduleName name args ts = fmap tidyUp . withFreshSubstitution . captureSubstitution $ do

127126 tyCon <- freshKind

128127 kargs <- replicateM (length args) freshKind

129128 rest <- zipWithM freshKindVar args kargs

@@ -145,12 +144,12 @@ freshKindVar (arg, Just kind') kind = do

145144

146145-- | Simultaneously infer the kinds of several mutually recursive type constructors

147146kindsOfAll

148− :: (MonadError MultipleErrors m, MonadState CheckState m, MonadWriter MultipleErrors m)

147+ :: (MonadError MultipleErrors m, MonadState CheckState m)

149148 => ModuleName

150149 -> [(ProperName 'TypeName, [(String, Maybe Kind)], Type)]

151150 -> [(ProperName 'TypeName, [(String, Maybe Kind)], [Type])]

152151 -> m ([Kind], [Kind])

153−kindsOfAll moduleName syns tys = fmap tidyUp . liftUnify $ do

152+kindsOfAll moduleName syns tys = fmap tidyUp . withFreshSubstitution . captureSubstitution $ do

154153 synVars <- replicateM (length syns) freshKind

155154 let dict = zipWith (\(name, _, _) var -> (name, var)) syns synVars

156155 bindLocalTypeVariables moduleName dict $ do

src/Language/PureScript/TypeChecker/Monad.hs+31−19

@@ -11,7 +11,7 @@ import Prelude.Compat

1111import Control.Arrow (second)

1212import Control.Monad.Error.Class (MonadError(..))

1313import Control.Monad.State

14−import Control.Monad.Writer.Class (MonadWriter(..), listen, censor)

14+import Control.Monad.Writer.Class (MonadWriter(..), censor)

1515

1616import Data.Maybe

1717import qualified Data.Map as M

@@ -245,7 +245,7 @@ getEnv = checkEnv <$> get

245245getLocalContext :: MonadState CheckState m => m Context

246246getLocalContext = do

247247 env <- getEnv

248− return [ (ident, ty') | ((Qualified Nothing ident@Ident{}), (ty', _, Defined)) <- M.toList (names env) ]

248+ return [ (ident, ty') | (Qualified Nothing ident@Ident{}, (ty', _, Defined)) <- M.toList (names env) ]

249249

250250-- | Update the @Environment@

251251putEnv :: (MonadState CheckState m) => Environment -> m ()

@@ -269,23 +269,35 @@ guardWith _ True = return ()

269269guardWith e False = throwError e

270270

271271-- | Run a computation in the substitution monad, generating a return value and the final substitution.

272−liftUnify ::

273− (MonadState CheckState m, MonadWriter MultipleErrors m, MonadError MultipleErrors m) =>

274− m a ->

275− m (a, Substitution)

276−liftUnify = liftUnifyWarnings (const id)

277−

278−-- | Run a computation in the substitution monad, generating a return value, the final substitution and updating warnings values.

279−liftUnifyWarnings ::

280− (MonadState CheckState m, MonadWriter MultipleErrors m, MonadError MultipleErrors m) =>

281− (Substitution -> ErrorMessage -> ErrorMessage) ->

282− m a ->

283− m (a, Substitution)

284−liftUnifyWarnings replace ma = do

272+captureSubstitution

273+ :: MonadState CheckState m

274+ => m a

275+ -> m (a, Substitution)

276+captureSubstitution = capturingSubstitution (,)

277+

278+capturingSubstitution

279+ :: MonadState CheckState m

280+ => (a -> Substitution -> b)

281+ -> m a

282+ -> m b

283+capturingSubstitution f ma = do

284+ a <- ma

285+ subst <- gets checkSubstitution

286+ return (f a subst)

287+

288+withFreshSubstitution

289+ :: MonadState CheckState m

290+ => m a

291+ -> m a

292+withFreshSubstitution ma = do

285293 orig <- get

286294 modify $ \st -> st { checkSubstitution = emptySubstitution }

287− (a, w) <- reflectErrors . censor (const mempty) . reifyErrors . listen $ ma

288− subst <- gets checkSubstitution

289− tell . onErrorMessages (replace subst) $ w

295+ a <- ma

290296 modify $ \st -> st { checkSubstitution = checkSubstitution orig }

291− return (a, subst)

297+ return a

298+

299+withoutWarnings

300+ :: MonadWriter w m

301+ => m a

302+ -> m (a, w)

303+withoutWarnings = censor (const mempty) . listen

src/Language/PureScript/TypeChecker/Skolems.hs+3−3

@@ -61,7 +61,7 @@ skolemize ident sko scope ss = replaceTypeVars ident (Skolem ident sko scope ss)

6161

6262-- |

6363-- This function has one purpose - to skolemize type variables appearing in a

64−-- SuperClassDictionary placeholder. These type variables are somewhat unique since they are the

64+-- DeferredDictionary placeholder. These type variables are somewhat unique since they are the

6565-- only example of scoped type variables.

6666--

6767skolemizeTypesInValue :: String -> Int -> SkolemScope -> Maybe SourceSpan -> Expr -> Expr

@@ -71,8 +71,8 @@ skolemizeTypesInValue ident sko scope ss =

7171 in runIdentity . f

7272 where

7373 onExpr :: [String] -> Expr -> Identity ([String], Expr)

74− onExpr sco (SuperClassDictionary c ts)

75− | ident `notElem` sco = return (sco, SuperClassDictionary c (map (skolemize ident sko scope ss) ts))

74+ onExpr sco (DeferredDictionary c ts)

75+ | ident `notElem` sco = return (sco, DeferredDictionary c (map (skolemize ident sko scope ss) ts))

7676 onExpr sco (TypedValue check val ty)

7777 | ident `notElem` sco = return (sco ++ peelTypeVars ty, TypedValue check val (skolemize ident sko scope ss ty))

7878 onExpr sco other = return (sco, other)

src/Language/PureScript/TypeChecker/Subsumption.hs+17−8

@@ -7,10 +7,13 @@ module Language.PureScript.TypeChecker.Subsumption

88import Prelude.Compat

10+import Control.Monad (when)

1011import Control.Monad.Error.Class (MonadError(..))

1112import Control.Monad.State.Class (MonadState(..), gets)

1213

13−import Data.List (sortBy)

14+import Data.Foldable (for_)

15+import Data.List (sortBy, uncons)

16+import Data.List.Ordered (minusBy')

1417import Data.Ord (comparing)

1518

1619import Language.PureScript.AST

@@ -26,7 +29,7 @@ import Language.PureScript.Types

2629subsumes :: (MonadError MultipleErrors m, MonadState CheckState m) => Maybe Expr -> Type -> Type -> m (Maybe Expr)

2730subsumes val ty1 ty2 = withErrorMessageHint (ErrorInSubsumption ty1 ty2) $ subsumes' val ty1 ty2

2831

29−-- | Check tahat one type subsumes another

32+-- | Check that one type subsumes another

3033subsumes' :: (MonadError MultipleErrors m, MonadState CheckState m) =>

3134 Maybe Expr ->

3235 Type ->

@@ -60,6 +63,14 @@ subsumes' val (TypeApp f1 r1) (TypeApp f2 r2) | f1 == tyRecord && f2 == tyRecord

6063 (ts2, r2') = rowToList r2

6164 ts1' = sortBy (comparing fst) ts1

6265 ts2' = sortBy (comparing fst) ts2

66+ -- For { ts1 | r1 } to subsume { ts2 | r2 } when r1 is empty (= we're working with a closed row),

67+ -- every property in ts2 must appear in ts1. If not, then the candidate expression is missing a required property.

68+ -- Conversely, when r2 is empty, every property in ts1 must appear in ts2, or else the expression has

69+ -- an additional property which is not allowed.

70+ when (r1' == REmpty)

71+ (for_ (firstMissingProp ts2' ts1') (throwError . errorMessage . PropertyIsMissing . fst))

72+ when (r2' == REmpty)

73+ (for_ (firstMissingProp ts1' ts2') (throwError . errorMessage . AdditionalProperty . fst))

6374 go ts1' ts2' r1' r2'

6475 return val

6576 where

@@ -72,15 +83,13 @@ subsumes' val (TypeApp f1 r1) (TypeApp f2 r2) | f1 == tyRecord && f2 == tyRecord

7283 -- What happens next is a bit of a hack.

7384 -- TODO: in the new type checker, object properties will probably be restricted to being monotypes

7485 -- in which case, this branch of the subsumes function should not even be necessary.

75− case r2' of

76− REmpty -> throwError . errorMessage $ AdditionalProperty p1

77− _ -> unifyTypes r2' (RCons p1 ty1 rest)

86+ unifyTypes r2' (RCons p1 ty1 rest)

7887 go ts1 ((p2, ty2) : ts2) r1' rest

7988 | otherwise = do rest <- freshType

80− case r1' of

81− REmpty -> throwError . errorMessage $ PropertyIsMissing p2

82− _ -> unifyTypes r1' (RCons p2 ty2 rest)

89+ unifyTypes r1' (RCons p2 ty2 rest)

8390 go ((p1, ty1) : ts1) ts2 rest r2'

91+ -- Find the first property that's in the first list (of tuples) but not in the second

92+ firstMissingProp t1 t2 = fst <$> uncons (minusBy' (comparing fst) t1 t2)

8493subsumes' val ty1 ty2@(TypeApp obj _) | obj == tyRecord = subsumes val ty2 ty1

8594subsumes' val ty1 ty2 = do

8695 unifyTypes ty1 ty2

src/Language/PureScript/TypeChecker/Types.hs+125−119

@@ -1,4 +1,5 @@

11{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE NamedFieldPuns #-}

34-- |

45-- This module implements the type checker

@@ -36,6 +37,7 @@ import Data.Either (lefts, rights)

3637import Data.List (transpose, nub, (\\), partition, delete)

3738import Data.Maybe (fromMaybe)

3839import qualified Data.Map as M

40+import qualified Data.Set as S

3941

4042import Language.PureScript.AST

4143import Language.PureScript.Crash

@@ -52,7 +54,6 @@ import Language.PureScript.TypeChecker.Skolems

5254import Language.PureScript.TypeChecker.Subsumption

5355import Language.PureScript.TypeChecker.Synonyms

5456import Language.PureScript.TypeChecker.Unify

55−import Language.PureScript.TypeClassDictionaries

5657import Language.PureScript.Types

5758

5859data BindingGroupType

@@ -62,65 +63,78 @@ data BindingGroupType

6263

6364-- | Infer the types of multiple mutually-recursive values, and return elaborated values including

6465-- type class dictionaries and type annotations.

65−typesOf ::

66− (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

67− BindingGroupType ->

68− ModuleName ->

69− [(Ident, Expr)] ->

70− m [(Ident, (Expr, Type))]

71−typesOf bindingGroupType moduleName vals = do

72− tys <- fmap tidyUp . escalateWarningWhen isHoleError . liftUnifyWarnings replace $ do

73− (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup (Just moduleName) vals

74− ds1 <- parU typed $ \e -> checkTypedBindingGroupElement moduleName e dict

75− ds2 <- forM untyped $ \e -> typeForBindingGroupElement e dict untypedDict

76− return (map (\x -> (False, x)) ds1 ++ map (\x -> (True, x)) ds2)

77−

78− forM tys $ \(shouldGeneralize, (ident, (val, ty))) -> do

79− -- Replace type class dictionary placeholders with actual dictionaries

80− (val', unsolved) <- replaceTypeClassDictionaries shouldGeneralize moduleName val

81− let unsolvedTypeVars = nub $ unknownsInType ty

82− -- Generalize and constrain the type

83− let generalized = generalize unsolved ty

84−

85− when shouldGeneralize $ do

86− -- Show the inferred type in a warning

87− tell . errorMessage $ MissingTypeDeclaration ident generalized

88− -- For non-recursive binding groups, can generalize over constraints.

89− -- For recursive binding groups, we throw an error here for now.

90− when (bindingGroupType == RecursiveBindingGroup && not (null unsolved))

91− . throwError

92− . errorMessage

93− $ CannotGeneralizeRecursiveFunction ident generalized

94− -- Make sure any unsolved type constraints only use type variables which appear

95− -- unknown in the inferred type.

96− forM_ unsolved $ \(_, con) -> do

97− let constraintTypeVars = nub $ foldMap unknownsInType (constraintArgs con)

98− when (any (`notElem` unsolvedTypeVars) constraintTypeVars) $

99− throwError . errorMessage $ NoInstanceFound con

100−

101− -- Check skolem variables did not escape their scope

102− skolemEscapeCheck val'

103− -- Check rows do not contain duplicate labels

104− checkDuplicateLabels val'

105− return (ident, (foldr (Abs . Left . fst) val' unsolved, generalized))

66+typesOf

67+ :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

68+ => BindingGroupType

69+ -> ModuleName

70+ -> [(Ident, Expr)]

71+ -> m [(Ident, (Expr, Type))]

72+typesOf bindingGroupType moduleName vals = withFreshSubstitution $ do

73+ (tys, w) <- withoutWarnings . capturingSubstitution tidyUp $ do

74+ (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup (Just moduleName) vals

75+ ds1 <- parU typed $ \e -> checkTypedBindingGroupElement moduleName e dict

76+ ds2 <- forM untyped $ \e -> typeForBindingGroupElement e dict untypedDict

77+ return (map (\x -> (False, x)) ds1 ++ map (\x -> (True, x)) ds2)

78+

79+ inferred <- forM tys $ \(shouldGeneralize, (ident, (val, ty))) -> do

80+ -- Replace type class dictionary placeholders with actual dictionaries

81+ (val', unsolved) <- replaceTypeClassDictionaries shouldGeneralize val

82+ -- Generalize and constrain the type

83+ currentSubst <- gets checkSubstitution

84+ let ty' = substituteType currentSubst ty

85+ unsolvedTypeVars = nub $ unknownsInType ty'

86+ generalized = generalize unsolved ty'

87+

88+ when shouldGeneralize $ do

89+ -- Show the inferred type in a warning

90+ tell . errorMessage $ MissingTypeDeclaration ident generalized

91+ -- For non-recursive binding groups, can generalize over constraints.

92+ -- For recursive binding groups, we throw an error here for now.

93+ when (bindingGroupType == RecursiveBindingGroup && not (null unsolved))

94+ . throwError

95+ . errorMessage

96+ $ CannotGeneralizeRecursiveFunction ident generalized

97+ -- Make sure any unsolved type constraints only use type variables which appear

98+ -- unknown in the inferred type.

99+ forM_ unsolved $ \(_, con) -> do

100+ -- We need information about functional dependencies, since we allow

101+ -- ambiguous types to be inferred if they can be solved by some functional

102+ -- dependency.

103+ let findClass = fromMaybe (internalError "entails: type class not found in environment") . M.lookup (constraintClass con)

104+ TypeClassData{ typeClassDependencies } <- gets (findClass . typeClasses . checkEnv)

105+ let solved = foldMap (S.fromList . fdDetermined) typeClassDependencies

106+ let constraintTypeVars = nub . foldMap (unknownsInType . fst) . filter ((`notElem` solved) . snd) $ zip (constraintArgs con) [0..]

107+ when (any (`notElem` unsolvedTypeVars) constraintTypeVars) $

108+ throwError . onErrorMessages (replaceTypes currentSubst) . errorMessage $ NoInstanceFound con

109+

110+ -- Check skolem variables did not escape their scope

111+ skolemEscapeCheck val'

112+ -- Check rows do not contain duplicate labels

113+ checkDuplicateLabels val'

114+ return (ident, (foldr (Abs . Left . fst) val' unsolved, generalized))

115+

116+ -- Show warnings here, since types in wildcards might have been solved during

117+ -- instance resolution (by functional dependencies).

118+ finalSubst <- gets checkSubstitution

119+ escalateWarningWhen isHoleError . tell . onErrorMessages (replaceTypes finalSubst) $ w

120+

121+ return inferred

106122 where

123+ replaceTypes subst = onTypesInErrorMessage (substituteType subst)

107124

108− -- | Generalize type vars using forall and add inferred constraints

109− generalize unsolved = varIfUnknown . constrain unsolved

125+ -- | Generalize type vars using forall and add inferred constraints

126+ generalize unsolved = varIfUnknown . constrain unsolved

110127

111− -- | Add any unsolved constraints

112− constrain [] = id

113− constrain cs = ConstrainedType (map snd cs)

128+ -- | Add any unsolved constraints

129+ constrain [] = id

130+ constrain cs = ConstrainedType (map snd cs)

114131

115− -- Apply the substitution that was returned from runUnify to both types and (type-annotated) values

116− tidyUp (ts, sub) = map (\(b, (i, (val, ty))) -> (b, (i, (overTypes (substituteType sub) val, substituteType sub ty)))) ts

132+ -- Apply the substitution that was returned from runUnify to both types and (type-annotated) values

133+ tidyUp ts sub = map (\(b, (i, (val, ty))) -> (b, (i, (overTypes (substituteType sub) val, substituteType sub ty)))) ts

117134

118− -- Replace all the wildcards types with their inferred types

119− replace sub = onTypesInErrorMessage (substituteType sub)

120−

121− isHoleError :: ErrorMessage -> Bool

122− isHoleError (ErrorMessage _ HoleInferredType{}) = True

123− isHoleError _ = False

135+ isHoleError :: ErrorMessage -> Bool

136+ isHoleError (ErrorMessage _ HoleInferredType{}) = True

137+ isHoleError _ = False

124138

125139type TypeData = M.Map (Qualified Ident) (Type, NameKind, NameVisibility)

126140

@@ -148,7 +162,7 @@ typeDictionaryForBindingGroup moduleName vals = do

148162 -- Make a map of names to the unification variables of untyped declarations

149163 untypedDict = zip (map fst untyped) untypedNames

150164 -- Create the dictionary of all name/type pairs, which will be added to the environment during type checking

151− dict = M.fromList (map (\(ident, ty) -> ((Qualified moduleName ident), (ty, Private, Undefined))) $ typedDict ++ untypedDict)

165+ dict = M.fromList (map (\(ident, ty) -> (Qualified moduleName ident, (ty, Private, Undefined))) $ typedDict ++ untypedDict)

152166 return (untyped, typed, dict, untypedDict)

153167

154168checkTypedBindingGroupElement

@@ -278,7 +292,7 @@ infer' (Abs (Left arg) ret) = do

278292infer' (Abs (Right _) _) = internalError "Binder was not desugared"

279293infer' (App f arg) = do

280294 f'@(TypedValue _ _ ft) <- infer f

281− (ret, app) <- checkFunctionApplication f' ft arg Nothing

295+ (ret, app) <- checkFunctionApplication f' ft arg

282296 return $ TypedValue True app ret

283297infer' (Var var) = do

284298 checkVisibility var

@@ -311,7 +325,7 @@ infer' (IfThenElse cond th el) = do

311325infer' (Let ds val) = do

312326 (ds', val'@(TypedValue _ _ valTy)) <- inferLetBinding [] ds val infer

313327 return $ TypedValue True (Let ds' val') valTy

314−infer' (SuperClassDictionary className tys) = do

328+infer' (DeferredDictionary className tys) = do

315329 dicts <- getTypeClassDictionaries

316330 hints <- gets checkHints

317331 return $ TypeClassDictionary (Constraint className tys Nothing) dicts hints

@@ -526,26 +540,6 @@ check' val t@(ConstrainedType constraints ty) = do

526540 dicts <- join <$> zipWithM (newDictionaries []) (map (Qualified Nothing) dictNames) constraints

527541 val' <- withBindingGroupVisible $ withTypeClassDictionaries dicts $ check val ty

528542 return $ TypedValue True (foldr (Abs . Left) val' dictNames) t

529− where

530− -- | Add a dictionary for the constraint to the scope, and dictionaries

531− -- for all implied superclass instances.

532− newDictionaries

533− :: [(Qualified (ProperName 'ClassName), Integer)]

534− -> Qualified Ident

535− -> Constraint

536− -> m [TypeClassDictionaryInScope]

537− newDictionaries path name (Constraint className instanceTy _) = do

538− tcs <- gets (typeClasses . checkEnv)

539− let (args, _, superclasses) = fromMaybe (internalError "newDictionaries: type class lookup failed") $ M.lookup className tcs

540− supDicts <- join <$> zipWithM (\(Constraint supName supArgs _) index ->

541− newDictionaries ((supName, index) : path)

542− name

543− (Constraint supName (instantiateSuperclass (map fst args) supArgs instanceTy) Nothing)

544− ) superclasses [0..]

545− return (TypeClassDictionaryInScope name path className instanceTy Nothing : supDicts)

546−

547− instantiateSuperclass :: [String] -> [Type] -> [Type] -> [Type]

548− instantiateSuperclass args supArgs tys = map (replaceAllTypeVars (zip args tys)) supArgs

549543check' val u@(TUnknown _) = do

550544 val'@(TypedValue _ _ ty) <- infer val

551545 -- Don't unify an unknown with an inferred polytype

@@ -573,8 +567,11 @@ check' (Abs (Left arg) ret) ty@(TypeApp (TypeApp t argTy) retTy) = do

573567check' (Abs (Right _) _) _ = internalError "Binder was not desugared"

574568check' (App f arg) ret = do

575569 f'@(TypedValue _ _ ft) <- infer f

576− (_, app) <- checkFunctionApplication f' ft arg (Just ret)

577− return $ TypedValue True app ret

570+ (retTy, app) <- checkFunctionApplication f' ft arg

571+ v' <- subsumes (Just app) retTy ret

572+ case v' of

573+ Nothing -> internalError "check: unable to check the subsumes relation."

574+ Just app' -> return $ TypedValue True app' ret

578575check' v@(Var var) ty = do

579576 checkVisibility var

580577 repl <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< lookupVariable $ var

@@ -583,7 +580,7 @@ check' v@(Var var) ty = do

583580 case v' of

584581 Nothing -> internalError "check: unable to check the subsumes relation."

585582 Just v'' -> return $ TypedValue True v'' ty'

586−check' (SuperClassDictionary className tys) _ = do

583+check' (DeferredDictionary className tys) _ = do

587584 {-

588585 -- Here, we replace a placeholder for a superclass dictionary with a regular

589586 -- TypeClassDictionary placeholder. The reason we do this is that it is necessary to have the

@@ -698,55 +695,64 @@ checkProperties expr ps row lax = let (ts, r') = rowToList row in go ps ts r' wh

698695 return $ (p, v') : ps''

699696 go _ _ _ = throwError . errorMessage $ ExprDoesNotHaveType expr (TypeApp tyRecord row)

700697

701−-- | Check the type of a function application, rethrowing errors to provide a better error message

702−checkFunctionApplication ::

703− (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

704− Expr ->

705− Type ->

706− Expr ->

707− Maybe Type ->

708− m (Type, Expr)

709−checkFunctionApplication fn fnTy arg ret = withErrorMessageHint (ErrorInApplication fn fnTy arg) $ do

698+-- | Check the type of a function application, rethrowing errors to provide a better error message.

699+--

700+-- This judgment takes three inputs:

701+--

702+-- * The expression of the function we are applying

703+-- * The type of that function

704+-- * The expression we are applying it to

705+--

706+-- and synthesizes two outputs:

707+--

708+-- * The return type

709+-- * The elaborated expression for the function application (since we might need to

710+-- insert type class dictionaries, etc.)

711+checkFunctionApplication

712+ :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

713+ => Expr

714+ -- ^ The function expression

715+ -> Type

716+ -- ^ The type of the function

717+ -> Expr

718+ -- ^ The argument expression

719+ -> m (Type, Expr)

720+ -- ^ The result type, and the elaborated term

721+checkFunctionApplication fn fnTy arg = withErrorMessageHint (ErrorInApplication fn fnTy arg) $ do

710722 subst <- gets checkSubstitution

711− checkFunctionApplication' fn (substituteType subst fnTy) arg (substituteType subst <$> ret)

723+ checkFunctionApplication' fn (substituteType subst fnTy) arg

712724

713725-- | Check the type of a function application

714−checkFunctionApplication' ::

715− (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>

716− Expr ->

717− Type ->

718− Expr ->

719− Maybe Type ->

720− m (Type, Expr)

721−checkFunctionApplication' fn (TypeApp (TypeApp tyFunction' argTy) retTy) arg ret = do

726+checkFunctionApplication'

727+ :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)

728+ => Expr

729+ -> Type

730+ -> Expr

731+ -> m (Type, Expr)

732+checkFunctionApplication' fn (TypeApp (TypeApp tyFunction' argTy) retTy) arg = do

722733 unifyTypes tyFunction' tyFunction

723734 arg' <- check arg argTy

724− case ret of

725− Nothing -> return (retTy, App fn arg')

726− Just ret' -> do

727− Just app' <- subsumes (Just (App fn arg')) retTy ret'

728− return (retTy, app')

729−checkFunctionApplication' fn (ForAll ident ty _) arg ret = do

735+ return (retTy, App fn arg')

736+checkFunctionApplication' fn (ForAll ident ty _) arg = do

730737 replaced <- replaceVarWithUnknown ident ty

731− checkFunctionApplication fn replaced arg ret

732−checkFunctionApplication' fn u@(TUnknown _) arg ret = do

738+ checkFunctionApplication fn replaced arg

739+checkFunctionApplication' fn (KindedType ty _) arg =

740+ checkFunctionApplication fn ty arg

741+checkFunctionApplication' fn (ConstrainedType constraints fnTy) arg = do

742+ dicts <- getTypeClassDictionaries

743+ hints <- gets checkHints

744+ checkFunctionApplication' (foldl App fn (map (\cs -> TypeClassDictionary cs dicts hints) constraints)) fnTy arg

745+checkFunctionApplication' fn fnTy dict@TypeClassDictionary{} =

746+ return (fnTy, App fn dict)

747+checkFunctionApplication' fn u arg = do

733748 arg' <- do

734749 TypedValue _ arg' t <- infer arg

735750 (arg'', t') <- instantiatePolyTypeWithUnknowns arg' t

736751 return $ TypedValue True arg'' t'

737752 let ty = (\(TypedValue _ _ t) -> t) arg'

738− ret' <- maybe freshType return ret

739− unifyTypes u (function ty ret')

740− return (ret', App fn arg')

741−checkFunctionApplication' fn (KindedType ty _) arg ret =

742− checkFunctionApplication fn ty arg ret

743−checkFunctionApplication' fn (ConstrainedType constraints fnTy) arg ret = do

744− dicts <- getTypeClassDictionaries

745− hints <- gets checkHints

746− checkFunctionApplication' (foldl App fn (map (\cs -> TypeClassDictionary cs dicts hints) constraints)) fnTy arg ret

747−checkFunctionApplication' fn fnTy dict@TypeClassDictionary{} _ =

748− return (fnTy, App fn dict)

749−checkFunctionApplication' _ fnTy arg _ = throwError . errorMessage $ CannotApplyFunction fnTy arg

753+ ret <- freshType

754+ unifyTypes u (function ty ret)

755+ return (ret, App fn arg')

750756

751757-- |

752758-- Ensure a set of property names and value does not contain duplicate labels

src/Language/PureScript/TypeChecker/Unify.hs+1−31

@@ -10,7 +10,6 @@ module Language.PureScript.TypeChecker.Unify

1010 , unknownsInType

1111 , unifyTypes

1212 , unifyRows

13− , unifiesWith

1413 , replaceVarWithUnknown

1514 , replaceTypeWildcards

1615 , varIfUnknown

@@ -102,6 +101,7 @@ unifyTypes t1 t2 = do

102101 unifyTypes' (TypeVar v1) (TypeVar v2) | v1 == v2 = return ()

103102 unifyTypes' ty1@(TypeConstructor c1) ty2@(TypeConstructor c2) =

104103 guardWith (errorMessage (TypesDoNotUnify ty1 ty2)) (c1 == c2)

104+ unifyTypes' (TypeLevelString s1) (TypeLevelString s2) | s1 == s2 = return ()

105105 unifyTypes' (TypeApp t3 t4) (TypeApp t5 t6) = do

106106 t3 `unifyTypes` t5

107107 t4 `unifyTypes` t6

@@ -152,36 +152,6 @@ unifyRows r1 r2 =

152152 unifyRows' _ _ _ _ =

153153 throwError . errorMessage $ TypesDoNotUnify r1 r2

154154

155−-- |

156−-- Check that two types unify

157−--

158−unifiesWith :: Type -> Type -> Bool

159−unifiesWith (TUnknown u1) (TUnknown u2) = u1 == u2

160−unifiesWith (Skolem _ s1 _ _) (Skolem _ s2 _ _) = s1 == s2

161−unifiesWith (TypeVar v1) (TypeVar v2) = v1 == v2

162−unifiesWith (TypeLevelString s1) (TypeLevelString s2) = s1 == s2

163−unifiesWith (TypeConstructor c1) (TypeConstructor c2) = c1 == c2

164−unifiesWith (TypeApp h1 t1) (TypeApp h2 t2) = h1 `unifiesWith` h2 && t1 `unifiesWith` t2

165−unifiesWith REmpty REmpty = True

166−unifiesWith r1@RCons{} r2@RCons{} =

167− let (s1, r1') = rowToList r1

168− (s2, r2') = rowToList r2

169−

170− int = [ (t1, t2) | (name, t1) <- s1, (name', t2) <- s2, name == name' ]

171− sd1 = [ (name, t1) | (name, t1) <- s1, name `notElem` map fst s2 ]

172− sd2 = [ (name, t2) | (name, t2) <- s2, name `notElem` map fst s1 ]

173− in all (uncurry unifiesWith) int && go sd1 r1' sd2 r2'

174− where

175− go :: [(String, Type)] -> Type -> [(String, Type)] -> Type -> Bool

176− go [] REmpty [] REmpty = True

177− go [] (TypeVar v1) [] (TypeVar v2) = v1 == v2

178− go [] (Skolem _ s1 _ _) [] (Skolem _ s2 _ _) = s1 == s2

179− go [] (TUnknown _) _ _ = True

180− go _ _ [] (TUnknown _) = True

181− go _ (TUnknown _) _ (TUnknown _) = True

182− go _ _ _ _ = False

183−unifiesWith _ _ = False

184−

185155-- |

186156-- Replace a single type variable with a new unification variable

187157--

src/Language/PureScript/TypeClassDictionaries.hs−23

@@ -22,26 +22,3 @@ data TypeClassDictionaryInScope

2222 , tcdDependencies :: Maybe [Constraint]

2323 }

2424 deriving (Show)

25−

26−-- |

27−-- A simplified representation of expressions which are used to represent type

28−-- class dictionaries at runtime, which can be compared for equality

29−--

30−data DictionaryValue

31− -- |

32− -- A dictionary which is brought into scope by a local constraint

33− --

34− = LocalDictionaryValue (Qualified Ident)

35− -- |

36− -- A dictionary which is brought into scope by an instance declaration

37− --

38− | GlobalDictionaryValue (Qualified Ident)

39− -- |

40− -- A dictionary which depends on other dictionaries

41− --

42− | DependentDictionaryValue (Qualified Ident) [DictionaryValue]

43− -- |

44− -- A subclass dictionary

45− --

46− | SubclassDictionaryValue DictionaryValue (Qualified (ProperName 'ClassName)) Integer

47− deriving (Show, Ord, Eq)

src/Language/PureScript/Types.hs+2−2

@@ -257,8 +257,8 @@ everywhereOnTypesTopDown f = go . f

257257 go (PrettyPrintFunction t1 t2) = PrettyPrintFunction (go (f t1)) (go (f t2))

258258 go (PrettyPrintObject t) = PrettyPrintObject (go (f t))

259259 go (PrettyPrintForAll args t) = PrettyPrintForAll args (go (f t))

260− go (BinaryNoParensType t1 t2 t3) = BinaryNoParensType (f (go t1)) (f (go t2)) (f (go t3))

261− go (ParensInType t) = ParensInType (f (go t))

260+ go (BinaryNoParensType t1 t2 t3) = BinaryNoParensType (go (f t1)) (go (f t2)) (go (f t3))

261+ go (ParensInType t) = ParensInType (go (f t))

262262 go other = f other

263263

264264everywhereOnTypesM :: Monad m => (Type -> m Type) -> Type -> m Type

src/System/IO/UTF8.hs+4−15

@@ -2,24 +2,13 @@ module System.IO.UTF8 where

33import Prelude.Compat

5−import System.IO ( IOMode(..)

6− , hGetContents

7− , hSetEncoding

8− , hClose

9− , hPutStr

10− , openFile

11− , utf8

12− )

5+import qualified Data.ByteString as BS

6+import qualified Data.ByteString.UTF8 as UTF8

137

148readUTF8File :: FilePath -> IO String

159readUTF8File inFile = do

16− h <- openFile inFile ReadMode

17− hSetEncoding h utf8

18− hGetContents h

10+ fmap UTF8.toString (BS.readFile inFile)

1911

2012writeUTF8File :: FilePath -> String -> IO ()

2113writeUTF8File inFile text = do

22− h <- openFile inFile WriteMode

23− hSetEncoding h utf8

24− hPutStr h text

25− hClose h

14+ BS.writeFile inFile (UTF8.fromString text)

stack.yaml+9−6

@@ -1,9 +1,12 @@

1−resolver: lts-6.10

1+resolver: lts-6.13

22packages:

33- '.'

44extra-deps:

5−- aeson-1.0.0.0

6−- semigroups-0.18.2

7−flags:

8− semigroups:

9− bytestring-builder: false

5+# - aeson-1.0.0.0

6+- http-client-0.5.1

7+- http-client-tls-0.3.0

8+- pipes-http-1.0.4

9+# - semigroups-0.18.2

10+# flags:

11+# semigroups:

12+# bytestring-builder: false

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

@@ -70,7 +70,7 @@ spec = do

7070 addValueImport i mn is =

7171 prettyPrintImportSection (addExplicitImport' (IdeValue (P.Ident i) wildcard) mn is)

7272 addOpImport op mn is =

73− prettyPrintImportSection (addExplicitImport' (IdeValueOperator op "" 2 P.Infix) mn is)

73+ prettyPrintImportSection (addExplicitImport' (IdeValueOperator op (P.Qualified Nothing (Left (P.Ident ""))) 2 P.Infix Nothing) mn is)

7474 addDtorImport i t mn is =

7575 prettyPrintImportSection (addExplicitImport' (IdeDataConstructor (P.ProperName i) t wildcard) mn is)

7676 it "adds an implicit unqualified import" $

tests/Language/PureScript/Ide/Integration.hs+8−20

@@ -37,13 +37,11 @@ module Language.PureScript.Ide.Integration

3737 , getFlexCompletions

3838 , getFlexCompletionsInModule

3939 , getType

40− , getInfo

4140 , rebuildModule

4241 , reset

4342 -- checking results

4443 , resultIsSuccess

4544 , parseCompletions

46− , parseInfo

4745 , parseTextResult

4846 ) where

4947

@@ -95,7 +93,7 @@ compileTestProject = do

9593 pdir <- projectDirectory

9694 (_, _, _, procHandle) <- createProcess $

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

98− r <- tryNTimes 5 (getProcessExitCode procHandle)

96+ r <- tryNTimes 10 (getProcessExitCode procHandle)

9997 pure (fromMaybe False (isSuccess <$> r))

10098

10199tryNTimes :: Int -> IO (Maybe a) -> IO (Maybe a)

@@ -158,18 +156,15 @@ loadModules = sendCommand . load

158156loadAll :: IO Text

159157loadAll = sendCommand (load [])

160158

161−getFlexCompletions :: Text -> IO [(Text, Text, Text)]

159+getFlexCompletions :: Text -> IO [(Text, Text, Text, Maybe P.SourceSpan)]

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

163161

164−getFlexCompletionsInModule :: Text -> Text -> IO [(Text, Text, Text)]

162+getFlexCompletionsInModule :: Text -> Text -> IO [(Text, Text, Text, Maybe P.SourceSpan)]

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

166164

167−getType :: Text -> IO [(Text, Text, Text)]

165+getType :: Text -> IO [(Text, Text, Text, Maybe P.SourceSpan)]

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

169167

170−getInfo :: Text -> IO [P.SourceSpan]

171−getInfo q = parseInfo <$> sendCommand (typeC q [])

172−

173168addImport :: Text -> FilePath -> FilePath -> IO Text

174169addImport identifier fp outfp = sendCommand (addImportC identifier fp outfp)

175170

@@ -254,17 +249,14 @@ withResult p v = do

254249 Left err -> pure (Left err)

255250 Right res -> Right <$> p res

256251

257−completionParser :: Value -> Parser [(Text, Text, Text)]

252+completionParser :: Value -> Parser [(Text, Text, Text, Maybe P.SourceSpan)]

258253completionParser = withArray "res" $ \cs ->

259254 mapM (withObject "completion" $ \o -> do

260255 ident <- o .: "identifier"

261256 module' <- o .: "module"

262257 ty <- o .: "type"

263− pure (module', ident, ty)) (V.toList cs)

264−

265−infoParser :: Value -> Parser [P.SourceSpan]

266−infoParser = withArray "res" $ \cs ->

267− mapM (withObject "info" $ \o -> o .: "definedAt") (V.toList cs)

258+ ss <- o .: "definedAt"

259+ pure (module', ident, ty, ss)) (V.toList cs)

268260

269261valueFromText :: Text -> Value

270262valueFromText = fromJust . decode . toS

@@ -272,14 +264,10 @@ valueFromText = fromJust . decode . toS

272264resultIsSuccess :: Text -> Bool

273265resultIsSuccess = isRight . join . first toS . parseEither unwrapResult . valueFromText

274266

275−parseCompletions :: Text -> [(Text, Text, Text)]

267+parseCompletions :: Text -> [(Text, Text, Text, Maybe P.SourceSpan)]

276268parseCompletions s =

277269 fromJust $ join (rightToMaybe <$> parseMaybe (withResult completionParser) (valueFromText s))

278270

279−parseInfo :: Text -> [P.SourceSpan]

280−parseInfo s =

281− fromJust $ join (rightToMaybe <$> parseMaybe (withResult infoParser) (valueFromText s))

282−

283271parseTextResult :: Text -> Text

284272parseTextResult s =

285273 fromJust $ join (rightToMaybe <$> parseMaybe (withResult (withText "tr" pure)) (valueFromText s))

tests/Language/PureScript/Ide/MatcherSpec.hs+9−7

@@ -9,20 +9,21 @@ import qualified Language.PureScript as P

99import Language.PureScript.Ide.Integration

1010import Language.PureScript.Ide.Matcher

1111import Language.PureScript.Ide.Types

12+import Language.PureScript.Ide.Util

1213import Test.Hspec

1314

14−value :: Text -> IdeDeclaration

15−value s = IdeValue (P.Ident (toS s)) P.REmpty

15+value :: Text -> IdeDeclarationAnn

16+value s = withEmptyAnn (IdeValue (P.Ident (toS s)) P.REmpty)

1617

17−firstResult, secondResult, fiult :: Match IdeDeclaration

18+firstResult, secondResult, fiult :: Match IdeDeclarationAnn

1819firstResult = Match (P.moduleNameFromString "Match", value "firstResult")

1920secondResult = Match (P.moduleNameFromString "Match", value "secondResult")

2021fiult = Match (P.moduleNameFromString "Match", value "fiult")

2122

22−completions :: [Match IdeDeclaration]

23+completions :: [Match IdeDeclarationAnn]

2324completions = [firstResult, secondResult, fiult]

2425

25−runFlex :: Text -> [Match IdeDeclaration]

26+runFlex :: Text -> [Match IdeDeclarationAnn]

2627runFlex s = runMatcher (flexMatcher s) completions

2728

2829setup :: IO ()

@@ -43,5 +44,6 @@ spec = do

4344 cs <- getFlexCompletions ""

4445 cs `shouldBe` []

4546 it "matches on equality" $ do

46− cs <- getFlexCompletions "const"

47− cs `shouldBe` [("MatcherSpec", "const", "forall a b. a -> b -> a")]

47+ -- ignore any position information

48+ (m, i, t, _) : _ <- getFlexCompletions "const"

49+ (m, i, t) `shouldBe` ("MatcherSpec", "const", "forall a b. a -> b -> a")

tests/Language/PureScript/Ide/ReexportsSpec.hs+1−1

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

22{-# LANGUAGE NoImplicitPrelude #-}

33module Language.PureScript.Ide.ReexportsSpec where

5−import qualified Prelude as Prelude

5+import qualified Prelude

66import Protolude

88import qualified Data.Map as Map

tests/Language/PureScript/Ide/SourceFile/IntegrationSpec.hs+13−8

@@ -14,23 +14,28 @@ setup :: IO ()

1414setup = void (Integration.reset *> Integration.loadAll)

1515

1616spec :: Spec

17−spec = beforeAll_ setup $ do

17+spec = beforeAll_ setup $

1818 describe "Sourcefile Integration" $ do

19− it "finds a value declaration" $ do

19+ it "finds a value declaration" $

2020 testCase "sfValue" (3, 1)

21− it "finds a type declaration" $ do

21+ it "finds a type declaration" $

2222 testCase "SFType" (5, 1)

23− it "finds a data declaration" $ do

23+ it "finds a data declaration" $

2424 testCase "SFData" (7, 1)

25− it "finds a data constructor" $ do

25+ it "finds a data constructor" $

2626 testCase "SFOne" (7, 1)

27− it "finds a typeclass" $ do

27+ it "finds a typeclass" $

2828 testCase "SFClass" (9, 1)

29− it "finds a typeclass member" $ do

29+ it "finds a typeclass member" $

3030 testCase "sfShow" (10, 3)

3131

3232testCase :: Text -> (Int, Int) -> IO ()

3333testCase s (x, y) = do

34− (P.SourceSpan f (P.SourcePos l c) _):_ <- Integration.getInfo s

34+ P.SourceSpan f (P.SourcePos l c) _ <- getLocation s

3535 toS f `shouldSatisfy` T.isSuffixOf "SourceFileSpec.purs"

3636 (l, c) `shouldBe` (x, y)

37+

38+getLocation :: Text -> IO P.SourceSpan

39+getLocation s = do

40+ (_, _, _, Just location) : _ <- Integration.getType s

41+ pure location

tests/Language/PureScript/Ide/SourceFileSpec.hs+7−3

@@ -13,11 +13,12 @@ span0 = P.SourceSpan "ModuleLevel" (P.SourcePos 0 0) (P.SourcePos 1 1)

1313span1 = P.SourceSpan "" (P.SourcePos 1 1) (P.SourcePos 2 2)

1414span2 = P.SourceSpan "" (P.SourcePos 2 2) (P.SourcePos 3 3)

1515

16−value1, synonym1, class1, class2, data1, data2, foreign1, foreign2, member1 :: P.Declaration

16+typeAnnotation1, value1, synonym1, class1, class2, data1, data2, foreign1, foreign2, member1 :: P.Declaration

17+typeAnnotation1 = P.TypeDeclaration (P.Ident "value1") P.REmpty

1718value1 = P.ValueDeclaration (P.Ident "value1") P.Public [] (Left [])

1819synonym1 = P.TypeSynonymDeclaration (P.ProperName "Synonym1") [] P.REmpty

19−class1 = P.TypeClassDeclaration (P.ProperName "Class1") [] [] []

20−class2 = P.TypeClassDeclaration (P.ProperName "Class2") [] []

20+class1 = P.TypeClassDeclaration (P.ProperName "Class1") [] [] [] []

21+class2 = P.TypeClassDeclaration (P.ProperName "Class2") [] [] []

2122 [P.PositionedDeclaration span2 [] member1]

2223data1 = P.DataDeclaration P.Newtype (P.ProperName "Data1") [] []

2324data2 = P.DataDeclaration P.Data (P.ProperName "Data2") [] [(P.ProperName "Cons1", [])]

@@ -44,3 +45,6 @@ spec = do

4445 extractSpans span0 (P.PositionedDeclaration span1 [] foreign1) `shouldBe` [(Left "foreign1", span1)]

4546 it "extracts a span for a data foreign declaration" $

4647 extractSpans span0 (P.PositionedDeclaration span1 [] foreign2) `shouldBe` [(Right "Foreign2", span1)]

48+ describe "Type annotations" $ do

49+ it "extracts a type annotation" $

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

tests/Language/PureScript/Ide/StateSpec.hsnew file+51

@@ -0,0 +1,51 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE NoImplicitPrelude #-}

3+module Language.PureScript.Ide.StateSpec where

5+import Protolude

6+import Language.PureScript.Ide.Types

7+import Language.PureScript.Ide.State

8+import qualified Language.PureScript as P

9+import Test.Hspec

10+import qualified Data.Map as Map

11+

12+valueOperator :: Maybe P.Type -> IdeDeclarationAnn

13+valueOperator =

14+ d . IdeValueOperator (P.OpName "<$>") (P.Qualified (Just (mn "Test")) (Left (P.Ident "function"))) 2 P.Infix

15+

16+ctorOperator :: Maybe P.Type -> IdeDeclarationAnn

17+ctorOperator =

18+ d . IdeValueOperator (P.OpName ":") (P.Qualified (Just (mn "Test")) (Right (P.ProperName "Cons"))) 2 P.Infix

19+

20+typeOperator :: Maybe P.Kind -> IdeDeclarationAnn

21+typeOperator =

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

23+

24+testModule :: Module

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

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

27+ , d (IdeType (P.ProperName "List") P.Star)

28+ , valueOperator Nothing

29+ , ctorOperator Nothing

30+ , typeOperator Nothing

31+ ])

32+

33+d :: IdeDeclaration -> IdeDeclarationAnn

34+d = IdeDeclarationAnn emptyAnn

35+

36+mn :: Text -> P.ModuleName

37+mn = P.moduleNameFromString . toS

38+

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

40+testState = Map.fromList

41+ [ testModule

42+ ]

43+

44+spec :: Spec

45+spec = describe "resolving operators" $ do

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

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

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

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

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

51+ resolveOperatorsForModule testState (snd testModule) `shouldSatisfy` elem (typeOperator (Just P.Star))

tests/TestDocs.hs+1

@@ -278,6 +278,7 @@ testCases =

278278 [ ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "explicit" (ShowFn (hasTypeVar "something"))

279279 , ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "anInt" (ShowFn (P.tyInt ==))

280280 , ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "aNumber" (ShowFn (P.tyNumber ==))

281+ , ValueShouldHaveTypeSignature (n "ExplicitTypeSignatures") "nestedForAll" (renderedType "forall c. (forall a b. c)")

281282 ])

282283

283284 , ("ConstrainedArgument",

tests/TestPscIde.hs+1

@@ -11,4 +11,5 @@ main = do

1111 s <- compileTestProject

1212 unless s $ fail "Failed to compile .purs sources"

1313

14+ quitServer -- shuts down any left over server (primarily happens during development)

1415 withServer (hspec PscIdeSpec.spec)

tests/TestPsci.hs−1

@@ -102,7 +102,6 @@ completionTestData =

102102 , ("ST.new", ["ST.newSTRef"])

103103 , ("Control.Monad.ST.new", ["Control.Monad.ST.newSTRef"])

104104 ]

105− where

106105

107106assertCompletedOk :: (String, [String]) -> Assertion

108107assertCompletedOk (line, expecteds) = do

tests/TestUtils.hs+2

@@ -75,6 +75,8 @@ supportModules =

7575 , "Data.Function"

7676 , "Data.Functor"

7777 , "Data.HeytingAlgebra"

78+ , "Data.NaturalTransformation"

79+ , "Data.Newtype"

7880 , "Data.Ord.Unsafe"

7981 , "Data.Ord"

8082 , "Data.Ordering"

tests/support/bower.json+3−2

@@ -5,8 +5,9 @@

55 "purescript-console": "1.0.0-rc.1",

66 "purescript-eff": "1.0.0-rc.1",

77 "purescript-functions": "1.0.0-rc.1",

8− "purescript-prelude": "1.0.0-rc.3",

8+ "purescript-prelude": "1.1.0",

99 "purescript-st": "1.0.0-rc.1",

10− "purescript-partial": "1.1.2"

10+ "purescript-partial": "1.1.2",

11+ "purescript-newtype": "0.1.0"

1112 }

1213}