git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Fix conflicts
16915beBenjamin Kovach
.gitignore+6
compare with golang
unifiedsplit
@@ -9,3 +9,9 @@ cabal.sandbox.config
9*.lksh*
9*.lksh*
10.virthualenv
10.virthualenv
11.psci_modules/
11.psci_modules/
12+.test_modules/
13+bower_components/
14+node_modules
15+tmp/
16+.stack-work/
17+tests/support/flattened/
.travis.yml+77−1
@@ -1,3 +1,79 @@
1−language: haskell
1+language: c
2+sudo: false
3+matrix:
4+ include:
5+ - env: GHCVER=7.8.4 COVERAGE_SUITE=tests
6+ compiler: ": #GHC 7.8.4 - tests"
7+ # ^ HACK before https://github.com/travis-ci/travis-ci/issues/4393 is resolved
8+ addons: {apt: {packages: [cabal-install-1.22,ghc-7.8.4,happy-1.19.5,alex-3.1.4], sources: [hvr-ghc]}}
9+ - env: GHCVER=7.8.4 COVERAGE_SUITE=psci-tests
10+ compiler: ": #GHC 7.8.4 - psci-tests"
11+ addons: {apt: {packages: [cabal-install-1.22,ghc-7.8.4,happy-1.19.5,alex-3.1.4], sources: [hvr-ghc]}}
12+ - env: GHCVER=7.8.4 STACKAGE=lts-22
13+ compiler: ": #GHC 7.8.4 - lts-2.22"
14+ addons: {apt: {packages: [cabal-install-1.22,ghc-7.8.4,happy-1.19.5,alex-3.1.4], sources: [hvr-ghc]}}
15+ - env: GHCVER=7.6.3
16+ compiler: ": #GHC 7.6.3"
17+ addons: {apt: {packages: [cabal-install-1.22,ghc-7.6.3,happy-1.19.5,alex-3.1.4], sources: [hvr-ghc]}}
18+ - env: GHCVER=7.10.1
19+ compiler: ": #GHC 7.10.1"
20+ addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.1,happy-1.19.5,alex-3.1.4], sources: [hvr-ghc]}}
21+ - env: GHCVER=7.10.2 STACKAGE=lts=3.4 RUNSDISTTESTS=YES
22+ compiler: ": #GHC 7.10.2 lts-3.4"
23+ addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2,happy-1.19.5,alex-3.1.4], sources: [hvr-ghc]}}
24+ - env: GHCVER=7.10.2 STACKAGE=nightly-2015-08-24
25+ compiler: ": #GHC 7.10.2 nightly-2015-09-09"
26+ addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2,happy-1.19.5,alex-3.1.4], sources: [hvr-ghc]}}
27+before_install:
28+ - unset CC
29+ - export PATH="/opt/ghc/$GHCVER/bin:$PATH"
30+ - export PATH="/opt/cabal/1.22/bin:$PATH"
31+ - export PATH="$HOME/.cabal/bin:$PATH"
32+ - export PATH="/opt/happy/1.19.5/bin:/$PATH"
33+ - export PATH="/opt/alex/3.1.4/bin:/$PATH"
34+install:
35+ - cabal --version
36+ - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
37+ - travis_retry cabal update
38+ # Run sequentially
39+ # Travis container infrastructure seems to expose all host CPUs (16?), thus
40+ # cabal and ghc tries to use them all. Which is bad idea on a shared box.
41+ # See also: https://ghc.haskell.org/trac/ghc/ticket/9221
42+ - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
43+ # Cache sandboxes in ~/cabal-sandboxes
44+ # Move right sandbox to .cabal-sandbox if exists
45+ - if [ -d ~/cabal-sandboxes/$GHCVER-${STACKAGE:-none} ]; then
46+ mv ~/cabal-sandboxes/$GHCVER-${STACKAGE:-none} .cabal-sandbox;
47+ fi
48+ - mkdir -p .cabal-sandbox
49+ - cabal sandbox init --sandbox .cabal-sandbox
50+ # Download stackage cabal.config, not sure whether filtering is necessary
51+ - if [ -n "$STACKAGE" ]; then curl http://www.stackage.org/$STACKAGE/cabal.config | grep -v purescript > cabal.config; fi
52+ - cabal install --only-dependencies --enable-tests
53+ - cabal install hpc-coveralls
54+ # Snapshot state of the sandbox now, so we don't need to make new one for test install
55+ - rm -rf ~/cabal-sandboxes/$GHCVER-${STACKAGE:-none}
56+ - cp -r .cabal-sandbox ~/cabal-sandboxes/$GHCVER-${STACKAGE:-none}
57+script:
58+ - ./travis/configure.sh
59+ - cabal build --ghc-options="-Werror"
60+ - cabal test
61+ - ./travis/test-install.sh
62+after_script:
63+ - ./travis/after.sh
2notifications:
64notifications:
3 email: true
65 email: true
66+before_deploy: "./bundle/build.sh linux64"
67+deploy:
68+ provider: releases
69+ api_key: $RELEASE_KEY
70+ file:
71+ - bundle/linux64.tar.gz
72+ - bundle/linux64.sha
73+ skip_cleanup: true
74+ on:
75+ all_branches: true
76+ tags: true
77+cache:
78+ directories:
79+ - ~/cabal-sandboxes
CONTRIBUTING.md+32−6
@@ -2,17 +2,43 @@ An introductory overview of the compiler is available [here](https://www.youtube
2
2
3Pull requests are encouraged.
3Pull requests are encouraged.
4
4
5+## Finding Issues to Work On
6+
7+If you would like to contribute, please consider the issues in the current milestone first. If you are a new contributor, you may want to have a go at the ["easy" issues](https://github.com/purescript/purescript/labels/easy) to get started.
8+
9+## Pull Requests
10+
5Please follow the following guidelines:
11Please follow the following guidelines:
6
12
7- Add at least a test to `examples/passing/` and possibly to `examples/failing`.
13- Add at least a test to `examples/passing/` and possibly to `examples/failing`.
8- Build the binaries and libs with `cabal build`
14- Build the binaries and libs with `cabal build`
9- Install the binaries and libs with `cabal install`.
15- Install the binaries and libs with `cabal install`.
10−- Run `cabal configure --enable-tests && cabal build && cabal test` to build the test suite.
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.
11−- Run `purescript-test-everything` to make sure you haven't broken any core library builds.
17+- Build the core libraries by running the script in `core-tests`.
12−- Run `starter-kit` to make sure the starter kit has not been broken.
13
18
14−If you would like to contribute, please consider the issues in the current milestone first. If you are a new contributor, you may want to have a go at the ["easy" issues](https://github.com/purescript/purescript/labels/easy) to get started.
19+## Code Review
15−
16−Finally, if you have made code changes and would like to be included in the copyright notice in the cabal file, please include that change in your pull request.
17
20
18To prevent core libraries from getting broken, every change must be reviewed. A pull request will be merged as long as one other team member has verified the changes.
21To prevent core libraries from getting broken, every change must be reviewed. A pull request will be merged as long as one other team member has verified the changes.
22+
23+## Adding Dependencies
24+
25+Because the PureScript compiler is distributed in binary form, we include
26+the licenses of all dependencies, including transitive ones, in the LICENSE
27+file. Therefore, whenever the dependencies change, the LICENSE file should be
28+updated.
29+
30+You can automate this (if you have bash):
31+
32+- get a copy of [cabal-dependency-licenses][]
33+- run at the command line: `./license/generate > LICENSE`
34+
35+[cabal-dependency-licenses]: https://github.com/jaspervdj/cabal-dependency-licenses
36+
37+## Writing Issues
38+
39+- If the issue is actually a question, please consider asking on Reddit, Stack Overflow or IRC first.
40+- Please include a minimal, repeatable test case with any bug report.
41+
42+## Copyright and Licensing
43+
44+For any code change, please append a copyright and licensing notice to the [CONTRIBUTORS.md](CONTRIBUTORS.md) file.
CONTRIBUTORS.mdnew file+60
@@ -0,0 +1,60 @@
1+## Contributors
2+
3+This file lists the contributors to the PureScript compiler project, and the terms under which their code is licensed.
4+
5+### Individuals
6+
7+- [@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+- [@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).
9+- [@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
10+- [@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).
11+- [@aspidites](https://github.com/aspidites) (Edwin Marshall) My existing contributions and all future contributions until further notice are Copyright Edwin Marshall, 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).
12+- [@balajirrao](https://github.com/balajirrao) (Balaji Rao) - My existing contributions and all future contributions until further notice are Copyright Balaji Rao, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
13+- [@bergmark](https://github.com/bergmark) (Adam Bergmark) - My existing contributions and all future contributions until further notice are Copyright Adam Bergmark, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
14+- [@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).
15+- [@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).
16+- [@dckc](https://github.com/dckc) (Dan Connolly) My existing contributions and all future contributions until further notice are Copyright Dan Connolly, 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).
17+- [@dylex](https://github.com/dylex) (Dylan Simon) My existing and all future contributions to the PureScript compiler until further notice are Copyright Dylan Simon, 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).
18+- [@eamelink](https://github.com/eamelink) (Erik Bakker) - My existing contributions and all future contributions until further notice are Copyright Erik Bakker, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
19+- [@epost](https://github.com/epost) (Erik Post) - My existing contributions and all future contributions until further notice are Copyright Erik Post, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license
20+- [@erdeszt](https://github.com/erdeszt) (Tibor Erdesz) My existing contributions and all future contributions until further notice are Copyright Tibor Erdesz, 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+- [@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).
22+- [@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).
23+- [@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).
24+- [@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).
25+- [@japesinator](https://github.com/japesinator) (JP Smith) My existing contributions and all future contributions until further notice are Copyright JP Smith, 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).
26+- [@joneshf](https://github.com/joneshf) (Hardy Jones) - My existing contributions and all future contributions until further notice are Copyright Hardy Jones, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
27+- [@kRITZCREEK](https://github.com/kRITZCREEK) (Christoph Hegemann) - My existing contributions and all future contributions until further notice are Copyright Christoph Hegemann, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
28+- [@L8D](https://github.com/L8D) (Tenor Biel) My existing contributions and all future contributions until further notice are Copyright Tenor Biel, 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).
29+- [@lukerandall](https://github.com/lukerandall) (Luke Randall) My existing contributions and all future contributions until further notice are Copyright Luke Randall, 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).
30+- [@michaelficarra](https://github.com/michaelficarra) (Michael Ficarra) My existing contributions and all future contributions until further notice are Copyright Michael Ficarra, 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).
31+- [@MichaelXavier](https://github.com/MichaelXavier) (Michael Xavier) - My existing contributions and all future contributions until further notice are Copyright Michael Xavier, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
32+- [@mjgpy3](https://github.com/mjgpy3) (Michael Gilliland) My existing contributions and all future contributions until further notice are Copyright Michael Gilliland, 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).
33+- [@mpietrzak](https://github.com/mpietrzak) (Maciej Pietrzak) My existing contributions and all future contributions until further notice are Copyright Maciej Pietrzak, 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+- [@mrhania](https://github.com/mrhania) (Łukasz Hanuszczak) - My existing contributions and all future contributions until further notice are Copyright Łukasz Hanuszczak, 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).
35+- [@nagisa](https://github.com/nagisa) I hereby release my [only contribution](https://github.com/purescript/purescript/commit/80287a5d0de619862d3b4cda9c1ee276d18fdcd8) into public domain.
36+- [@natefaubion](https://github.com/natefaubion) (Nathan Faubion) My existing contributions and all future contributions until further notice are Copyright Nathan Faubion, 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+- [@nicodelpiano](https://github.com/nicodelpiano) (Nicolas Del Piano) My existing contributions and all future contributions until further notice are Copyright Nicolas Del Piano, 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).
38+- [@nullobject](https://github.com/nullobject) (Josh Bassett) My existing contributions and all future contributions until further notice are Copyright Josh Bassett, 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).
39+- [@osa1](https://github.com/osa1) (Ömer Sinan Ağacan) - My existing contributions and all future contributions until further notice are Copyright Ömer Sinan Ağacan, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
40+- [@paf31](https://github.com/paf31) (Phil Freeman) My existing contributions and all future contributions until further notice are Copyright Phil Freeman, 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).
41+- [@paulyoung](https://github.com/paulyoung) (Paul Young) My existing contributions and all future contributions until further notice are Copyright Paul Young, 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).
42+- [@pelotom](https://github.com/pelotom) (Thomas Crockett) My existing contributions and all future contributions until further notice are Copyright Thomas Crockett, 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).
43+- [@phadej](https://github.com/phadej) (Oleg Grenrus) My existing contributions and all future contributions until further notice are Copyright Oleg Grenrus, 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).
44+- [@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).
45+- [@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).
46+- [@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.
47+- [@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).
48+- [@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).
49+- [@sebastiaanvisser](https://github.com/sebastiaanvisser) (Sebastiaan Visser) - My existing contributions and all future contributions until further notice are Copyright Sebastiaan Visser, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
50+- [@sztupi](https://github.com/sztupi) (Attila Sztupak) My existing contributions and all future contributions until further notice are Copyright Attila Sztupak, 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).
51+- [@taku0](https://github.com/taku0) - My existing contributions and all future contributions until further notice are Copyright taku0, 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).
52+- [@trofi](https://github.com/trofi) (Sergei Trofimovich) My existing contributions and all future contributions until further notice are Copyright Sergei Trofimovich, 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).
53+- [@utkarshkukreti](https://github.com/utkarshkukreti) (Utkarsh Kukreti) My existing contributions and all future contributions until further notice are Copyright Utkarsh Kukreti, 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).
54+- [@vkorablin](https://github.com/vkorablin) (Vladimir Korablin) - My existing contributions and all future contributions until further notice are Copyright Vladimir Korablin, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
55+- [@zudov](https://github.com/zudov) (Konstantin Zudov) My existing contributions and all future contributions until further notice are Copyright Konstantin Zudov, 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).
56+<http://opensource.org/licenses/MIT>.
57+
58+### Companies
59+
60+- [@slamdata](https://github.com/slamdata) (SlamData, Inc.) Speaking on behalf of SlamData for SlamData employees, our existing contributions and all future contributions to the PureScript compiler are, until further notice, Copyright SlamData Inc., 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). - @jdegoes
INSTALL.mdnew file+47
@@ -0,0 +1,47 @@
1+# Installation information
2+
3+If you are having difficulty installing the PureScript compiler, feel free to
4+ask for help! A good place is the #purescript IRC channel on Freenode, or
5+alternatively Stack Overflow.
6+
7+## Using prebuilt binaries
8+
9+The prebuilt binaries are compiled with GHC 7.8.4, and therefore they should
10+run on any operating system supported by GHC 7.8.4, such as:
11+
12+* Windows 2000 or later,
13+* OS X 10.7 or later,
14+* Linux ??? (we're not sure what the minimum version is).
15+
16+This list is not exhaustive. If your OS is too old or not listed, or if the
17+binaries fail to run, you may be able to install the compiler by building it
18+from source; see below.
19+
20+It's probably safe to assume that other prebuilt distributions (eg, Homebrew,
21+Chocolatey, AUR, npm) use the same binaries, and therefore have the same
22+requirements.
23+
24+## Compiling from source
25+
26+GHC 7.6.1 or newer is required to compile from source. The easiest way is to
27+use `cabal-install`:
28+
29+```
30+$ cabal update && cabal install purescript
31+```
32+
33+The PureScript compiler has been known to run on OS X 10.6 when built with GHC
34+7.6.
35+
36+## The "curses" library
37+
38+`psci` depends on the `curses` library (via the Haskell package `terminfo`). If
39+you are having difficulty running the compiler, it may be because the `curses`
40+library is missing.
41+
42+On Linux, you will probably need to install `ncurses` manually. On Ubuntu, for
43+example, this can be done by running:
44+
45+```
46+$ sudo apt-get install libncurses5-dev
47+```
LICENSE+1850−1
@@ -1,6 +1,7 @@
1The MIT License (MIT)
1The MIT License (MIT)
2
2
3−Copyright (c) 2013 Phil Freeman
3+Copyright (c) 2013-15 Phil Freeman, (c) 2014-2015 Gary Burgess, and other
4+contributors
4
5
5Permission is hereby granted, free of charge, to any person obtaining a copy of
6Permission is hereby granted, free of charge, to any person obtaining a copy of
6this software and associated documentation files (the "Software"), to deal in
7this software and associated documentation files (the "Software"), to deal in
@@ -18,3 +19,1851 @@ FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
18COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
19COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
19IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
20IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
20CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
21CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
22+
23+PureScript uses the following Haskell library packages. Their license files follow.
24+
25+ Glob
26+ HUnit
27+ aeson
28+ aeson-better-errors
29+ ansi-terminal
30+ ansi-wl-pprint
31+ array
32+ attoparsec
33+ base
34+ blaze-builder
35+ bower-json
36+ boxes
37+ bytestring
38+ containers
39+ deepseq
40+ directory
41+ dlist
42+ filepath
43+ ghc-prim
44+ hashable
45+ haskeline
46+ integer-gmp
47+ language-javascript
48+ mtl
49+ nats
50+ old-locale
51+ optparse-applicative
52+ parsec
53+ pattern-arrows
54+ pretty
55+ primitive
56+ process
57+ rts
58+ safe
59+ scientific
60+ semigroups
61+ split
62+ syb
63+ template-haskell
64+ terminfo
65+ text
66+ time
67+ transformers
68+ transformers-compat
69+ unix
70+ unordered-containers
71+ utf8-string
72+ vector
73+ void
74+
75+Glob LICENSE file:
76+
77+ The code in Glob is released under the license below. Copyrights to parts of
78+ the code are held by whoever wrote the code in question: see CREDITS.txt for a
79+ list of authors.
80+
81+ Copyright (c) 2008-2012 <authors>
82+ All rights reserved.
83+
84+ Redistribution and use in source and binary forms, with or without
85+ modification, are permitted provided that the following conditions are met:
86+ * Redistributions of source code must retain the above copyright
87+ notice, this list of conditions and the following disclaimer.
88+ * Redistributions in binary form must reproduce the above copyright
89+ notice, this list of conditions and the following disclaimer in the
90+ documentation and/or other materials provided with the distribution.
91+ * Neither the name of the project nor the names of its contributors may be
92+ used to endorse or promote products derived from this software without
93+ specific prior written permission.
94+
95+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED
96+ WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
97+ MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
98+ EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
99+ INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
100+ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
101+ PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
102+ LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
103+ OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
104+ ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
105+
106+HUnit LICENSE file:
107+
108+ HUnit is Copyright (c) Dean Herington, 2002, all rights reserved,
109+ and is distributed as free software under the following license.
110+
111+ Redistribution and use in source and binary forms, with or without
112+ modification, are permitted provided that the following conditions
113+ are met:
114+
115+ - Redistributions of source code must retain the above copyright
116+ notice, this list of conditions, and the following disclaimer.
117+
118+ - Redistributions in binary form must reproduce the above copyright
119+ notice, this list of conditions, and the following disclaimer in the
120+ documentation and/or other materials provided with the distribution.
121+
122+ - The names of the copyright holders may not be used to endorse or
123+ promote products derived from this software without specific prior
124+ written permission.
125+
126+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY
127+ EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
128+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
129+ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE
130+ LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
131+ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
132+ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
133+ BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
134+ WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
135+ OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
136+ IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
137+
138+aeson LICENSE file:
139+
140+ Copyright (c) 2011, MailRank, Inc.
141+
142+ All rights reserved.
143+
144+ Redistribution and use in source and binary forms, with or without
145+ modification, are permitted provided that the following conditions
146+ are met:
147+
148+ 1. Redistributions of source code must retain the above copyright
149+ notice, this list of conditions and the following disclaimer.
150+
151+ 2. Redistributions in binary form must reproduce the above copyright
152+ notice, this list of conditions and the following disclaimer in the
153+ documentation and/or other materials provided with the distribution.
154+
155+ 3. Neither the name of the author nor the names of his contributors
156+ may be used to endorse or promote products derived from this software
157+ without specific prior written permission.
158+
159+ THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
160+ OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
161+ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
162+ DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
163+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
164+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
165+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
166+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
167+ STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
168+ ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
169+ POSSIBILITY OF SUCH DAMAGE.
170+
171+aeson-better-errors LICENSE file:
172+
173+ Copyright (c) 2015 Harry Garrood
174+
175+ Permission is hereby granted, free of charge, to any person obtaining
176+ a copy of this software and associated documentation files (the
177+ "Software"), to deal in the Software without restriction, including
178+ without limitation the rights to use, copy, modify, merge, publish,
179+ distribute, sublicense, and/or sell copies of the Software, and to
180+ permit persons to whom the Software is furnished to do so, subject to
181+ the following conditions:
182+
183+ The above copyright notice and this permission notice shall be included
184+ in all copies or substantial portions of the Software.
185+
186+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
187+ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
188+ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
189+ IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
190+ CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
191+ TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
192+ SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
193+
194+ansi-terminal LICENSE file:
195+
196+ Copyright (c) 2008, Maximilian Bolingbroke
197+ All rights reserved.
198+
199+ Redistribution and use in source and binary forms, with or without modification, are permitted
200+ provided that the following conditions are met:
201+
202+ * Redistributions of source code must retain the above copyright notice, this list of
203+ conditions and the following disclaimer.
204+ * Redistributions in binary form must reproduce the above copyright notice, this list of
205+ conditions and the following disclaimer in the documentation and/or other materials
206+ provided with the distribution.
207+ * Neither the name of Maximilian Bolingbroke nor the names of other contributors may be used to
208+ endorse or promote products derived from this software without specific prior written permission.
209+
210+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR
211+ IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
212+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
213+ CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
214+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
215+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
216+ IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
217+ OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
218+
219+ansi-wl-pprint LICENSE file:
220+
221+ Copyright 2008, Daan Leijen and Max Bolingbroke. All rights reserved.
222+
223+ Redistribution and use in source and binary forms, with or without
224+ modification, are permitted provided that the following conditions are
225+ met:
226+
227+ * Redistributions of source code must retain the above copyright
228+ notice, this list of conditions and the following disclaimer.
229+
230+ * Redistributions in binary form must reproduce the above copyright
231+ notice, this list of conditions and the following disclaimer in
232+ the documentation and/or other materials provided with the
233+ distribution.
234+
235+ This software is provided by the copyright holders "as is" and any
236+ express or implied warranties, including, but not limited to, the
237+ implied warranties of merchantability and fitness for a particular
238+ purpose are disclaimed. In no event shall the copyright holders be
239+ liable for any direct, indirect, incidental, special, exemplary, or
240+ consequential damages (including, but not limited to, procurement of
241+ substitute goods or services; loss of use, data, or profits; or
242+ business interruption) however caused and on any theory of liability,
243+ whether in contract, strict liability, or tort (including negligence
244+ or otherwise) arising in any way out of the use of this software, even
245+ if advised of the possibility of such damage.
246+
247+array LICENSE file:
248+
249+ This library (libraries/base) is derived from code from several
250+ sources:
251+
252+ * Code from the GHC project which is largely (c) The University of
253+ Glasgow, and distributable under a BSD-style license (see below),
254+
255+ * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
256+ and freely redistributable (but see the full license for
257+ restrictions).
258+
259+ * Code from the Haskell Foreign Function Interface specification,
260+ which is (c) Manuel M. T. Chakravarty and freely redistributable
261+ (but see the full license for restrictions).
262+
263+ The full text of these licenses is reproduced below. All of the
264+ licenses are BSD-style or compatible.
265+
266+ -----------------------------------------------------------------------------
267+
268+ The Glasgow Haskell Compiler License
269+
270+ Copyright 2004, The University Court of the University of Glasgow.
271+ All rights reserved.
272+
273+ Redistribution and use in source and binary forms, with or without
274+ modification, are permitted provided that the following conditions are met:
275+
276+ - Redistributions of source code must retain the above copyright notice,
277+ this list of conditions and the following disclaimer.
278+
279+ - Redistributions in binary form must reproduce the above copyright notice,
280+ this list of conditions and the following disclaimer in the documentation
281+ and/or other materials provided with the distribution.
282+
283+ - Neither name of the University nor the names of its contributors may be
284+ used to endorse or promote products derived from this software without
285+ specific prior written permission.
286+
287+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
288+ GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
289+ INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
290+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
291+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
292+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
293+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
294+ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
295+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
296+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
297+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
298+ DAMAGE.
299+
300+ -----------------------------------------------------------------------------
301+
302+ Code derived from the document "Report on the Programming Language
303+ Haskell 98", is distributed under the following license:
304+
305+ Copyright (c) 2002 Simon Peyton Jones
306+
307+ The authors intend this Report to belong to the entire Haskell
308+ community, and so we grant permission to copy and distribute it for
309+ any purpose, provided that it is reproduced in its entirety,
310+ including this Notice. Modified versions of this Report may also be
311+ copied and distributed for any purpose, provided that the modified
312+ version is clearly presented as such, and that it does not claim to
313+ be a definition of the Haskell 98 Language.
314+
315+ -----------------------------------------------------------------------------
316+
317+ Code derived from the document "The Haskell 98 Foreign Function
318+ Interface, An Addendum to the Haskell 98 Report" is distributed under
319+ the following license:
320+
321+ Copyright (c) 2002 Manuel M. T. Chakravarty
322+
323+ The authors intend this Report to belong to the entire Haskell
324+ community, and so we grant permission to copy and distribute it for
325+ any purpose, provided that it is reproduced in its entirety,
326+ including this Notice. Modified versions of this Report may also be
327+ copied and distributed for any purpose, provided that the modified
328+ version is clearly presented as such, and that it does not claim to
329+ be a definition of the Haskell 98 Foreign Function Interface.
330+
331+ -----------------------------------------------------------------------------
332+
333+attoparsec LICENSE file:
334+
335+ Copyright (c) Lennart Kolmodin
336+
337+ All rights reserved.
338+
339+ Redistribution and use in source and binary forms, with or without
340+ modification, are permitted provided that the following conditions
341+ are met:
342+
343+ 1. Redistributions of source code must retain the above copyright
344+ notice, this list of conditions and the following disclaimer.
345+
346+ 2. Redistributions in binary form must reproduce the above copyright
347+ notice, this list of conditions and the following disclaimer in the
348+ documentation and/or other materials provided with the distribution.
349+
350+ 3. Neither the name of the author nor the names of his contributors
351+ may be used to endorse or promote products derived from this software
352+ without specific prior written permission.
353+
354+ THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
355+ OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
356+ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
357+ DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
358+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
359+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
360+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
361+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
362+ STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
363+ ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
364+ POSSIBILITY OF SUCH DAMAGE.
365+
366+base LICENSE file:
367+
368+ This library (libraries/base) is derived from code from several
369+ sources:
370+
371+ * Code from the GHC project which is largely (c) The University of
372+ Glasgow, and distributable under a BSD-style license (see below),
373+
374+ * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
375+ and freely redistributable (but see the full license for
376+ restrictions).
377+
378+ * Code from the Haskell Foreign Function Interface specification,
379+ which is (c) Manuel M. T. Chakravarty and freely redistributable
380+ (but see the full license for restrictions).
381+
382+ The full text of these licenses is reproduced below. All of the
383+ licenses are BSD-style or compatible.
384+
385+ -----------------------------------------------------------------------------
386+
387+ The Glasgow Haskell Compiler License
388+
389+ Copyright 2004, The University Court of the University of Glasgow.
390+ All rights reserved.
391+
392+ Redistribution and use in source and binary forms, with or without
393+ modification, are permitted provided that the following conditions are met:
394+
395+ - Redistributions of source code must retain the above copyright notice,
396+ this list of conditions and the following disclaimer.
397+
398+ - Redistributions in binary form must reproduce the above copyright notice,
399+ this list of conditions and the following disclaimer in the documentation
400+ and/or other materials provided with the distribution.
401+
402+ - Neither name of the University nor the names of its contributors may be
403+ used to endorse or promote products derived from this software without
404+ specific prior written permission.
405+
406+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
407+ GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
408+ INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
409+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
410+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
411+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
412+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
413+ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
414+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
415+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
416+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
417+ DAMAGE.
418+
419+ -----------------------------------------------------------------------------
420+
421+ Code derived from the document "Report on the Programming Language
422+ Haskell 98", is distributed under the following license:
423+
424+ Copyright (c) 2002 Simon Peyton Jones
425+
426+ The authors intend this Report to belong to the entire Haskell
427+ community, and so we grant permission to copy and distribute it for
428+ any purpose, provided that it is reproduced in its entirety,
429+ including this Notice. Modified versions of this Report may also be
430+ copied and distributed for any purpose, provided that the modified
431+ version is clearly presented as such, and that it does not claim to
432+ be a definition of the Haskell 98 Language.
433+
434+ -----------------------------------------------------------------------------
435+
436+ Code derived from the document "The Haskell 98 Foreign Function
437+ Interface, An Addendum to the Haskell 98 Report" is distributed under
438+ the following license:
439+
440+ Copyright (c) 2002 Manuel M. T. Chakravarty
441+
442+ The authors intend this Report to belong to the entire Haskell
443+ community, and so we grant permission to copy and distribute it for
444+ any purpose, provided that it is reproduced in its entirety,
445+ including this Notice. Modified versions of this Report may also be
446+ copied and distributed for any purpose, provided that the modified
447+ version is clearly presented as such, and that it does not claim to
448+ be a definition of the Haskell 98 Foreign Function Interface.
449+
450+ -----------------------------------------------------------------------------
451+
452+blaze-builder LICENSE file:
453+
454+ Copyright Jasper Van der Jeugt 2010, Simon Meier 2010 & 2011
455+
456+ All rights reserved.
457+
458+ Redistribution and use in source and binary forms, with or without
459+ modification, are permitted provided that the following conditions are met:
460+
461+ * Redistributions of source code must retain the above copyright
462+ notice, this list of conditions and the following disclaimer.
463+
464+ * Redistributions in binary form must reproduce the above
465+ copyright notice, this list of conditions and the following
466+ disclaimer in the documentation and/or other materials provided
467+ with the distribution.
468+
469+ * Neither the name of Jasper Van der Jeugt nor the names of other
470+ contributors may be used to endorse or promote products derived
471+ from this software without specific prior written permission.
472+
473+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
474+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
475+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
476+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
477+ OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
478+ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
479+ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
480+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
481+ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
482+ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
483+ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
484+
485+bower-json LICENSE file:
486+
487+ Copyright (c) 2015 Harry Garrood
488+
489+ Permission is hereby granted, free of charge, to any person obtaining
490+ a copy of this software and associated documentation files (the
491+ "Software"), to deal in the Software without restriction, including
492+ without limitation the rights to use, copy, modify, merge, publish,
493+ distribute, sublicense, and/or sell copies of the Software, and to
494+ permit persons to whom the Software is furnished to do so, subject to
495+ the following conditions:
496+
497+ The above copyright notice and this permission notice shall be included
498+ in all copies or substantial portions of the Software.
499+
500+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
501+ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
502+ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
503+ IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
504+ CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
505+ TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
506+ SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
507+
508+boxes LICENSE file:
509+
510+ Copyright (c) Brent Yorgey 2008
511+
512+ Redistribution and use in source and binary forms, with or without
513+ modification, are permitted provided that the following conditions
514+ are met:
515+ 1. Redistributions of source code must retain the above copyright
516+ notice, this list of conditions and the following disclaimer.
517+ 2. Redistributions in binary form must reproduce the above copyright
518+ notice, this list of conditions and the following disclaimer in the
519+ documentation and/or other materials provided with the distribution.
520+ 3. Neither the name of the author nor the names of other contributors
521+ may be used to endorse or promote products derived from this software
522+ without specific prior written permission.
523+
524+ All other rights are reserved.
525+
526+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND
527+ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
528+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
529+ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
530+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
531+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
532+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
533+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
534+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
535+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
536+ SUCH DAMAGE.
537+
538+bytestring LICENSE file:
539+
540+ Copyright (c) Don Stewart 2005-2009
541+ (c) Duncan Coutts 2006-2015
542+ (c) David Roundy 2003-2005
543+ (c) Simon Meier 2010-2011
544+
545+ All rights reserved.
546+
547+ Redistribution and use in source and binary forms, with or without
548+ modification, are permitted provided that the following conditions
549+ are met:
550+ 1. Redistributions of source code must retain the above copyright
551+ notice, this list of conditions and the following disclaimer.
552+ 2. Redistributions in binary form must reproduce the above copyright
553+ notice, this list of conditions and the following disclaimer in the
554+ documentation and/or other materials provided with the distribution.
555+ 3. Neither the name of the author nor the names of his contributors
556+ may be used to endorse or promote products derived from this software
557+ without specific prior written permission.
558+
559+ THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
560+ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
561+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
562+ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
563+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
564+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
565+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
566+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
567+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
568+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
569+ SUCH DAMAGE.
570+
571+containers LICENSE file:
572+
573+ The Glasgow Haskell Compiler License
574+
575+ Copyright 2004, The University Court of the University of Glasgow.
576+ All rights reserved.
577+
578+ Redistribution and use in source and binary forms, with or without
579+ modification, are permitted provided that the following conditions are met:
580+
581+ - Redistributions of source code must retain the above copyright notice,
582+ this list of conditions and the following disclaimer.
583+
584+ - Redistributions in binary form must reproduce the above copyright notice,
585+ this list of conditions and the following disclaimer in the documentation
586+ and/or other materials provided with the distribution.
587+
588+ - Neither name of the University nor the names of its contributors may be
589+ used to endorse or promote products derived from this software without
590+ specific prior written permission.
591+
592+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
593+ GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
594+ INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
595+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
596+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
597+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
598+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
599+ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
600+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
601+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
602+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
603+ DAMAGE.
604+
605+deepseq LICENSE file:
606+
607+ This library (deepseq) is derived from code from the GHC project which
608+ is largely (c) The University of Glasgow, and distributable under a
609+ BSD-style license (see below).
610+
611+ -----------------------------------------------------------------------------
612+
613+ The Glasgow Haskell Compiler License
614+
615+ Copyright 2001-2009, The University Court of the University of Glasgow.
616+ All rights reserved.
617+
618+ Redistribution and use in source and binary forms, with or without
619+ modification, are permitted provided that the following conditions are met:
620+
621+ - Redistributions of source code must retain the above copyright notice,
622+ this list of conditions and the following disclaimer.
623+
624+ - Redistributions in binary form must reproduce the above copyright notice,
625+ this list of conditions and the following disclaimer in the documentation
626+ and/or other materials provided with the distribution.
627+
628+ - Neither name of the University nor the names of its contributors may be
629+ used to endorse or promote products derived from this software without
630+ specific prior written permission.
631+
632+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
633+ GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
634+ INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
635+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
636+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
637+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
638+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
639+ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
640+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
641+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
642+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
643+ DAMAGE.
644+
645+ -----------------------------------------------------------------------------
646+
647+directory LICENSE file:
648+
649+ This library (libraries/base) is derived from code from two
650+ sources:
651+
652+ * Code from the GHC project which is largely (c) The University of
653+ Glasgow, and distributable under a BSD-style license (see below),
654+
655+ * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
656+ and freely redistributable (but see the full license for
657+ restrictions).
658+
659+ The full text of these licenses is reproduced below. Both of the
660+ licenses are BSD-style or compatible.
661+
662+ -----------------------------------------------------------------------------
663+
664+ The Glasgow Haskell Compiler License
665+
666+ Copyright 2004, The University Court of the University of Glasgow.
667+ All rights reserved.
668+
669+ Redistribution and use in source and binary forms, with or without
670+ modification, are permitted provided that the following conditions are met:
671+
672+ - Redistributions of source code must retain the above copyright notice,
673+ this list of conditions and the following disclaimer.
674+
675+ - Redistributions in binary form must reproduce the above copyright notice,
676+ this list of conditions and the following disclaimer in the documentation
677+ and/or other materials provided with the distribution.
678+
679+ - Neither name of the University nor the names of its contributors may be
680+ used to endorse or promote products derived from this software without
681+ specific prior written permission.
682+
683+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
684+ GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
685+ INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
686+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
687+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
688+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
689+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
690+ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
691+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
692+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
693+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
694+ DAMAGE.
695+
696+ -----------------------------------------------------------------------------
697+
698+ Code derived from the document "Report on the Programming Language
699+ Haskell 98", is distributed under the following license:
700+
701+ Copyright (c) 2002 Simon Peyton Jones
702+
703+ The authors intend this Report to belong to the entire Haskell
704+ community, and so we grant permission to copy and distribute it for
705+ any purpose, provided that it is reproduced in its entirety,
706+ including this Notice. Modified versions of this Report may also be
707+ copied and distributed for any purpose, provided that the modified
708+ version is clearly presented as such, and that it does not claim to
709+ be a definition of the Haskell 98 Language.
710+
711+ -----------------------------------------------------------------------------
712+
713+dlist LICENSE file:
714+
715+ Copyright (c) 2006-2009 Don Stewart, 2013-2014 Sean Leather
716+
717+ All rights reserved.
718+
719+ Redistribution and use in source and binary forms, with or without
720+ modification, are permitted provided that the following conditions are
721+ met:
722+
723+ * Redistributions of source code must retain the above copyright
724+ notice, this list of conditions and the following disclaimer.
725+
726+ * Redistributions in binary form must reproduce the above
727+ copyright notice, this list of conditions and the following
728+ disclaimer in the documentation and/or other materials provided
729+ with the distribution.
730+
731+ * Neither the name of Don Stewart nor the names of other
732+ contributors may be used to endorse or promote products derived
733+ from this software without specific prior written permission.
734+
735+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
736+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
737+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
738+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
739+ OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
740+ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
741+ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
742+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
743+ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
744+ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
745+ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
746+
747+filepath LICENSE file:
748+
749+ Copyright Neil Mitchell 2005-2015.
750+ All rights reserved.
751+
752+ Redistribution and use in source and binary forms, with or without
753+ modification, are permitted provided that the following conditions are
754+ met:
755+
756+ * Redistributions of source code must retain the above copyright
757+ notice, this list of conditions and the following disclaimer.
758+
759+ * Redistributions in binary form must reproduce the above
760+ copyright notice, this list of conditions and the following
761+ disclaimer in the documentation and/or other materials provided
762+ with the distribution.
763+
764+ * Neither the name of Neil Mitchell nor the names of other
765+ contributors may be used to endorse or promote products derived
766+ from this software without specific prior written permission.
767+
768+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
769+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
770+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
771+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
772+ OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
773+ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
774+ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
775+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
776+ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
777+ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
778+ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
779+
780+ghc-prim LICENSE file:
781+
782+ This library (libraries/ghc-prim) is derived from code from several
783+ sources:
784+
785+ * Code from the GHC project which is largely (c) The University of
786+ Glasgow, and distributable under a BSD-style license (see below),
787+
788+ * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
789+ and freely redistributable (but see the full license for
790+ restrictions).
791+
792+ The full text of these licenses is reproduced below. All of the
793+ licenses are BSD-style or compatible.
794+
795+ -----------------------------------------------------------------------------
796+
797+ The Glasgow Haskell Compiler License
798+
799+ Copyright 2004, The University Court of the University of Glasgow.
800+ All rights reserved.
801+
802+ Redistribution and use in source and binary forms, with or without
803+ modification, are permitted provided that the following conditions are met:
804+
805+ - Redistributions of source code must retain the above copyright notice,
806+ this list of conditions and the following disclaimer.
807+
808+ - Redistributions in binary form must reproduce the above copyright notice,
809+ this list of conditions and the following disclaimer in the documentation
810+ and/or other materials provided with the distribution.
811+
812+ - Neither name of the University nor the names of its contributors may be
813+ used to endorse or promote products derived from this software without
814+ specific prior written permission.
815+
816+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
817+ GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
818+ INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
819+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
820+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
821+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
822+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
823+ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
824+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
825+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
826+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
827+ DAMAGE.
828+
829+ -----------------------------------------------------------------------------
830+
831+ Code derived from the document "Report on the Programming Language
832+ Haskell 98", is distributed under the following license:
833+
834+ Copyright (c) 2002 Simon Peyton Jones
835+
836+ The authors intend this Report to belong to the entire Haskell
837+ community, and so we grant permission to copy and distribute it for
838+ any purpose, provided that it is reproduced in its entirety,
839+ including this Notice. Modified versions of this Report may also be
840+ copied and distributed for any purpose, provided that the modified
841+ version is clearly presented as such, and that it does not claim to
842+ be a definition of the Haskell 98 Language.
843+
844+
845+hashable LICENSE file:
846+
847+ Copyright Milan Straka 2010
848+
849+ All rights reserved.
850+
851+ Redistribution and use in source and binary forms, with or without
852+ modification, are permitted provided that the following conditions are met:
853+
854+ * Redistributions of source code must retain the above copyright
855+ notice, this list of conditions and the following disclaimer.
856+
857+ * Redistributions in binary form must reproduce the above
858+ copyright notice, this list of conditions and the following
859+ disclaimer in the documentation and/or other materials provided
860+ with the distribution.
861+
862+ * Neither the name of Milan Straka nor the names of other
863+ contributors may be used to endorse or promote products derived
864+ from this software without specific prior written permission.
865+
866+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
867+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
868+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
869+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
870+ OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
871+ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
872+ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
873+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
874+ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
875+ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
876+ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
877+
878+haskeline LICENSE file:
879+
880+ Copyright 2007-2009, Judah Jacobson.
881+ All Rights Reserved.
882+
883+ Redistribution and use in source and binary forms, with or without
884+ modification, are permitted provided that the following conditions are met:
885+
886+ - Redistribution of source code must retain the above copyright notice,
887+ this list of conditions and the following disclaimer.
888+
889+ - Redistribution in binary form must reproduce the above copyright notice,
890+ this list of conditions and the following disclaimer in the documentation
891+ and/or other materials provided with the distribution.
892+
893+ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS "AS IS" AND ANY
894+ EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
895+ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
896+ DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR THE CONTRIBUTORS BE LIABLE
897+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
898+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
899+ SERVICES; LOSS OF USE, DATA OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
900+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
901+ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
902+ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
903+
904+integer-gmp LICENSE file:
905+
906+ Copyright (c) 2014, Herbert Valerio Riedel
907+
908+ All rights reserved.
909+
910+ Redistribution and use in source and binary forms, with or without
911+ modification, are permitted provided that the following conditions are met:
912+
913+ * Redistributions of source code must retain the above copyright
914+ notice, this list of conditions and the following disclaimer.
915+
916+ * Redistributions in binary form must reproduce the above
917+ copyright notice, this list of conditions and the following
918+ disclaimer in the documentation and/or other materials provided
919+ with the distribution.
920+
921+ * Neither the name of Herbert Valerio Riedel nor the names of other
922+ contributors may be used to endorse or promote products derived
923+ from this software without specific prior written permission.
924+
925+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
926+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
927+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
928+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
929+ OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
930+ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
931+ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
932+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
933+ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
934+ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
935+ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
936+
937+language-javascript LICENSE file:
938+
939+ Copyright (c)2010, Alan Zimmerman
940+
941+ All rights reserved.
942+
943+ Redistribution and use in source and binary forms, with or without
944+ modification, are permitted provided that the following conditions are met:
945+
946+ * Redistributions of source code must retain the above copyright
947+ notice, this list of conditions and the following disclaimer.
948+
949+ * Redistributions in binary form must reproduce the above
950+ copyright notice, this list of conditions and the following
951+ disclaimer in the documentation and/or other materials provided
952+ with the distribution.
953+
954+ * Neither the name of Alan Zimmerman nor the names of other
955+ contributors may be used to endorse or promote products derived
956+ from this software without specific prior written permission.
957+
958+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
959+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
960+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
961+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
962+ OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
963+ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
964+ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
965+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
966+ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
967+ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
968+ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
969+
970+mtl LICENSE file:
971+
972+ The Glasgow Haskell Compiler License
973+
974+ Copyright 2004, The University Court of the University of Glasgow.
975+ All rights reserved.
976+
977+ Redistribution and use in source and binary forms, with or without
978+ modification, are permitted provided that the following conditions are met:
979+
980+ - Redistributions of source code must retain the above copyright notice,
981+ this list of conditions and the following disclaimer.
982+
983+ - Redistributions in binary form must reproduce the above copyright notice,
984+ this list of conditions and the following disclaimer in the documentation
985+ and/or other materials provided with the distribution.
986+
987+ - Neither name of the University nor the names of its contributors may be
988+ used to endorse or promote products derived from this software without
989+ specific prior written permission.
990+
991+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
992+ GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
993+ INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
994+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
995+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
996+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
997+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
998+ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
999+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1000+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1001+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1002+ DAMAGE.
1003+
1004+nats LICENSE file:
1005+
1006+ Copyright 2011-2014 Edward Kmett
1007+
1008+ All rights reserved.
1009+
1010+ Redistribution and use in source and binary forms, with or without
1011+ modification, are permitted provided that the following conditions
1012+ are met:
1013+
1014+ 1. Redistributions of source code must retain the above copyright
1015+ notice, this list of conditions and the following disclaimer.
1016+
1017+ 2. Redistributions in binary form must reproduce the above copyright
1018+ notice, this list of conditions and the following disclaimer in the
1019+ documentation and/or other materials provided with the distribution.
1020+
1021+ 3. Neither the name of the author nor the names of his contributors
1022+ may be used to endorse or promote products derived from this software
1023+ without specific prior written permission.
1024+
1025+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
1026+ IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1027+ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1028+ DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
1029+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1030+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
1031+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
1032+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
1033+ STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
1034+ ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
1035+ POSSIBILITY OF SUCH DAMAGE.
1036+
1037+old-locale LICENSE file:
1038+
1039+ This library (libraries/base) is derived from code from two
1040+ sources:
1041+
1042+ * Code from the GHC project which is largely (c) The University of
1043+ Glasgow, and distributable under a BSD-style license (see below),
1044+
1045+ * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
1046+ and freely redistributable (but see the full license for
1047+ restrictions).
1048+
1049+ The full text of these licenses is reproduced below. Both of the
1050+ licenses are BSD-style or compatible.
1051+
1052+ -----------------------------------------------------------------------------
1053+
1054+ The Glasgow Haskell Compiler License
1055+
1056+ Copyright 2004, The University Court of the University of Glasgow.
1057+ All rights reserved.
1058+
1059+ Redistribution and use in source and binary forms, with or without
1060+ modification, are permitted provided that the following conditions are met:
1061+
1062+ - Redistributions of source code must retain the above copyright notice,
1063+ this list of conditions and the following disclaimer.
1064+
1065+ - Redistributions in binary form must reproduce the above copyright notice,
1066+ this list of conditions and the following disclaimer in the documentation
1067+ and/or other materials provided with the distribution.
1068+
1069+ - Neither name of the University nor the names of its contributors may be
1070+ used to endorse or promote products derived from this software without
1071+ specific prior written permission.
1072+
1073+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1074+ GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1075+ INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1076+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1077+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1078+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1079+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1080+ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1081+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1082+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1083+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1084+ DAMAGE.
1085+
1086+ -----------------------------------------------------------------------------
1087+
1088+ Code derived from the document "Report on the Programming Language
1089+ Haskell 98", is distributed under the following license:
1090+
1091+ Copyright (c) 2002 Simon Peyton Jones
1092+
1093+ The authors intend this Report to belong to the entire Haskell
1094+ community, and so we grant permission to copy and distribute it for
1095+ any purpose, provided that it is reproduced in its entirety,
1096+ including this Notice. Modified versions of this Report may also be
1097+ copied and distributed for any purpose, provided that the modified
1098+ version is clearly presented as such, and that it does not claim to
1099+ be a definition of the Haskell 98 Language.
1100+
1101+ -----------------------------------------------------------------------------
1102+
1103+optparse-applicative LICENSE file:
1104+
1105+ Copyright (c) 2012, Paolo Capriotti
1106+
1107+ All rights reserved.
1108+
1109+ Redistribution and use in source and binary forms, with or without
1110+ modification, are permitted provided that the following conditions are met:
1111+
1112+ * Redistributions of source code must retain the above copyright
1113+ notice, this list of conditions and the following disclaimer.
1114+
1115+ * Redistributions in binary form must reproduce the above
1116+ copyright notice, this list of conditions and the following
1117+ disclaimer in the documentation and/or other materials provided
1118+ with the distribution.
1119+
1120+ * Neither the name of Paolo Capriotti nor the names of other
1121+ contributors may be used to endorse or promote products derived
1122+ from this software without specific prior written permission.
1123+
1124+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1125+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1126+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1127+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1128+ OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1129+ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1130+ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1131+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1132+ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1133+ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1134+ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1135+
1136+parsec LICENSE file:
1137+
1138+ Copyright 1999-2000, Daan Leijen; 2007, Paolo Martini. All rights reserved.
1139+
1140+ Redistribution and use in source and binary forms, with or without
1141+ modification, are permitted provided that the following conditions are met:
1142+
1143+ * Redistributions of source code must retain the above copyright notice,
1144+ this list of conditions and the following disclaimer.
1145+ * Redistributions in binary form must reproduce the above copyright
1146+ notice, this list of conditions and the following disclaimer in the
1147+ documentation and/or other materials provided with the distribution.
1148+
1149+ This software is provided by the copyright holders "as is" and any express or
1150+ implied warranties, including, but not limited to, the implied warranties of
1151+ merchantability and fitness for a particular purpose are disclaimed. In no
1152+ event shall the copyright holders be liable for any direct, indirect,
1153+ incidental, special, exemplary, or consequential damages (including, but not
1154+ limited to, procurement of substitute goods or services; loss of use, data,
1155+ or profits; or business interruption) however caused and on any theory of
1156+ liability, whether in contract, strict liability, or tort (including
1157+ negligence or otherwise) arising in any way out of the use of this software,
1158+ even if advised of the possibility of such damage.
1159+
1160+pattern-arrows LICENSE file:
1161+
1162+ The MIT License (MIT)
1163+
1164+ Copyright (c) 2013 Phil Freeman
1165+
1166+ Permission is hereby granted, free of charge, to any person obtaining a copy of
1167+ this software and associated documentation files (the "Software"), to deal in
1168+ the Software without restriction, including without limitation the rights to
1169+ use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
1170+ the Software, and to permit persons to whom the Software is furnished to do so,
1171+ subject to the following conditions:
1172+
1173+ The above copyright notice and this permission notice shall be included in all
1174+ copies or substantial portions of the Software.
1175+
1176+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
1177+ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
1178+ FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
1179+ COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
1180+ IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
1181+ CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
1182+
1183+pretty LICENSE file:
1184+
1185+ This library (libraries/pretty) is derived from code from
1186+ the GHC project which is largely (c) The University of
1187+ Glasgow, and distributable under a BSD-style license (see below).
1188+
1189+ -----------------------------------------------------------------------------
1190+
1191+ The Glasgow Haskell Compiler License
1192+
1193+ Copyright 2004, The University Court of the University of Glasgow.
1194+ All rights reserved.
1195+
1196+ Redistribution and use in source and binary forms, with or without
1197+ modification, are permitted provided that the following conditions are met:
1198+
1199+ - Redistributions of source code must retain the above copyright notice,
1200+ this list of conditions and the following disclaimer.
1201+
1202+ - Redistributions in binary form must reproduce the above copyright notice,
1203+ this list of conditions and the following disclaimer in the documentation
1204+ and/or other materials provided with the distribution.
1205+
1206+ - Neither name of the University nor the names of its contributors may be
1207+ used to endorse or promote products derived from this software without
1208+ specific prior written permission.
1209+
1210+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1211+ GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1212+ INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1213+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1214+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1215+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1216+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1217+ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1218+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1219+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1220+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1221+ DAMAGE.
1222+
1223+ -----------------------------------------------------------------------------
1224+
1225+primitive LICENSE file:
1226+
1227+ Copyright (c) 2008-2009, Roman Leshchinskiy
1228+ All rights reserved.
1229+
1230+ Redistribution and use in source and binary forms, with or without
1231+ modification, are permitted provided that the following conditions are met:
1232+
1233+ - Redistributions of source code must retain the above copyright notice,
1234+ this list of conditions and the following disclaimer.
1235+
1236+ - Redistributions in binary form must reproduce the above copyright notice,
1237+ this list of conditions and the following disclaimer in the documentation
1238+ and/or other materials provided with the distribution.
1239+
1240+ - Neither name of the University nor the names of its contributors may be
1241+ used to endorse or promote products derived from this software without
1242+ specific prior written permission.
1243+
1244+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1245+ GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1246+ INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1247+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1248+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1249+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1250+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1251+ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1252+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1253+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1254+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1255+ DAMAGE.
1256+
1257+
1258+process LICENSE file:
1259+
1260+ This library (libraries/process) is derived from code from two
1261+ sources:
1262+
1263+ * Code from the GHC project which is largely (c) The University of
1264+ Glasgow, and distributable under a BSD-style license (see below),
1265+
1266+ * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
1267+ and freely redistributable (but see the full license for
1268+ restrictions).
1269+
1270+ The full text of these licenses is reproduced below. Both of the
1271+ licenses are BSD-style or compatible.
1272+
1273+ -----------------------------------------------------------------------------
1274+
1275+ The Glasgow Haskell Compiler License
1276+
1277+ Copyright 2004, The University Court of the University of Glasgow.
1278+ All rights reserved.
1279+
1280+ Redistribution and use in source and binary forms, with or without
1281+ modification, are permitted provided that the following conditions are met:
1282+
1283+ - Redistributions of source code must retain the above copyright notice,
1284+ this list of conditions and the following disclaimer.
1285+
1286+ - Redistributions in binary form must reproduce the above copyright notice,
1287+ this list of conditions and the following disclaimer in the documentation
1288+ and/or other materials provided with the distribution.
1289+
1290+ - Neither name of the University nor the names of its contributors may be
1291+ used to endorse or promote products derived from this software without
1292+ specific prior written permission.
1293+
1294+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1295+ GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1296+ INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1297+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1298+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1299+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1300+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1301+ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1302+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1303+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1304+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1305+ DAMAGE.
1306+
1307+ -----------------------------------------------------------------------------
1308+
1309+ Code derived from the document "Report on the Programming Language
1310+ Haskell 98", is distributed under the following license:
1311+
1312+ Copyright (c) 2002 Simon Peyton Jones
1313+
1314+ The authors intend this Report to belong to the entire Haskell
1315+ community, and so we grant permission to copy and distribute it for
1316+ any purpose, provided that it is reproduced in its entirety,
1317+ including this Notice. Modified versions of this Report may also be
1318+ copied and distributed for any purpose, provided that the modified
1319+ version is clearly presented as such, and that it does not claim to
1320+ be a definition of the Haskell 98 Language.
1321+
1322+ -----------------------------------------------------------------------------
1323+
1324+rts LICENSE file:
1325+
1326+ Package not found: No such package in package index
1327+
1328+safe LICENSE file:
1329+
1330+ Copyright Neil Mitchell 2007-2015.
1331+ All rights reserved.
1332+
1333+ Redistribution and use in source and binary forms, with or without
1334+ modification, are permitted provided that the following conditions are
1335+ met:
1336+
1337+ * Redistributions of source code must retain the above copyright
1338+ notice, this list of conditions and the following disclaimer.
1339+
1340+ * Redistributions in binary form must reproduce the above
1341+ copyright notice, this list of conditions and the following
1342+ disclaimer in the documentation and/or other materials provided
1343+ with the distribution.
1344+
1345+ * Neither the name of Neil Mitchell nor the names of other
1346+ contributors may be used to endorse or promote products derived
1347+ from this software without specific prior written permission.
1348+
1349+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1350+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1351+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1352+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1353+ OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1354+ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1355+ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1356+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1357+ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1358+ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1359+ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1360+
1361+scientific LICENSE file:
1362+
1363+ Copyright (c) 2013, Bas van Dijk
1364+
1365+ All rights reserved.
1366+
1367+ Redistribution and use in source and binary forms, with or without
1368+ modification, are permitted provided that the following conditions are met:
1369+
1370+ * Redistributions of source code must retain the above copyright
1371+ notice, this list of conditions and the following disclaimer.
1372+
1373+ * Redistributions in binary form must reproduce the above
1374+ copyright notice, this list of conditions and the following
1375+ disclaimer in the documentation and/or other materials provided
1376+ with the distribution.
1377+
1378+ * Neither the name of Bas van Dijk nor the names of other
1379+ contributors may be used to endorse or promote products derived
1380+ from this software without specific prior written permission.
1381+
1382+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1383+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1384+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1385+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1386+ OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1387+ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1388+ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1389+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1390+ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1391+ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1392+ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1393+
1394+semigroups LICENSE file:
1395+
1396+ Copyright 2011-2015 Edward Kmett
1397+
1398+ All rights reserved.
1399+
1400+ Redistribution and use in source and binary forms, with or without
1401+ modification, are permitted provided that the following conditions
1402+ are met:
1403+
1404+ 1. Redistributions of source code must retain the above copyright
1405+ notice, this list of conditions and the following disclaimer.
1406+
1407+ 2. Redistributions in binary form must reproduce the above copyright
1408+ notice, this list of conditions and the following disclaimer in the
1409+ documentation and/or other materials provided with the distribution.
1410+
1411+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
1412+ IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1413+ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1414+ DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
1415+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1416+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
1417+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
1418+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
1419+ STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
1420+ ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
1421+ POSSIBILITY OF SUCH DAMAGE.
1422+
1423+split LICENSE file:
1424+
1425+ Copyright (c) 2008 Brent Yorgey, Louis Wasserman
1426+
1427+ All rights reserved.
1428+
1429+ Redistribution and use in source and binary forms, with or without
1430+ modification, are permitted provided that the following conditions
1431+ are met:
1432+ 1. Redistributions of source code must retain the above copyright
1433+ notice, this list of conditions and the following disclaimer.
1434+ 2. Redistributions in binary form must reproduce the above copyright
1435+ notice, this list of conditions and the following disclaimer in the
1436+ documentation and/or other materials provided with the distribution.
1437+ 3. Neither the name of the author nor the names of other contributors
1438+ may be used to endorse or promote products derived from this software
1439+ without specific prior written permission.
1440+
1441+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND
1442+ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
1443+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
1444+ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
1445+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1446+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
1447+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
1448+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1449+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1450+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
1451+ SUCH DAMAGE.
1452+
1453+syb LICENSE file:
1454+
1455+ This library (libraries/syb) is derived from code from several
1456+ sources:
1457+
1458+ * Code from the GHC project which is largely (c) The University of
1459+ Glasgow, and distributable under a BSD-style license (see below),
1460+
1461+ * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
1462+ and freely redistributable (but see the full license for
1463+ restrictions).
1464+
1465+ * Code from the Haskell Foreign Function Interface specification,
1466+ which is (c) Manuel M. T. Chakravarty and freely redistributable
1467+ (but see the full license for restrictions).
1468+
1469+ The full text of these licenses is reproduced below. All of the
1470+ licenses are BSD-style or compatible.
1471+
1472+ -----------------------------------------------------------------------------
1473+
1474+ The Glasgow Haskell Compiler License
1475+
1476+ Copyright 2004, The University Court of the University of Glasgow.
1477+ All rights reserved.
1478+
1479+ Redistribution and use in source and binary forms, with or without
1480+ modification, are permitted provided that the following conditions are met:
1481+
1482+ - Redistributions of source code must retain the above copyright notice,
1483+ this list of conditions and the following disclaimer.
1484+
1485+ - Redistributions in binary form must reproduce the above copyright notice,
1486+ this list of conditions and the following disclaimer in the documentation
1487+ and/or other materials provided with the distribution.
1488+
1489+ - Neither name of the University nor the names of its contributors may be
1490+ used to endorse or promote products derived from this software without
1491+ specific prior written permission.
1492+
1493+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1494+ GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1495+ INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1496+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1497+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1498+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1499+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1500+ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1501+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1502+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1503+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1504+ DAMAGE.
1505+
1506+ -----------------------------------------------------------------------------
1507+
1508+ Code derived from the document "Report on the Programming Language
1509+ Haskell 98", is distributed under the following license:
1510+
1511+ Copyright (c) 2002 Simon Peyton Jones
1512+
1513+ The authors intend this Report to belong to the entire Haskell
1514+ community, and so we grant permission to copy and distribute it for
1515+ any purpose, provided that it is reproduced in its entirety,
1516+ including this Notice. Modified versions of this Report may also be
1517+ copied and distributed for any purpose, provided that the modified
1518+ version is clearly presented as such, and that it does not claim to
1519+ be a definition of the Haskell 98 Language.
1520+
1521+ -----------------------------------------------------------------------------
1522+
1523+ Code derived from the document "The Haskell 98 Foreign Function
1524+ Interface, An Addendum to the Haskell 98 Report" is distributed under
1525+ the following license:
1526+
1527+ Copyright (c) 2002 Manuel M. T. Chakravarty
1528+
1529+ The authors intend this Report to belong to the entire Haskell
1530+ community, and so we grant permission to copy and distribute it for
1531+ any purpose, provided that it is reproduced in its entirety,
1532+ including this Notice. Modified versions of this Report may also be
1533+ copied and distributed for any purpose, provided that the modified
1534+ version is clearly presented as such, and that it does not claim to
1535+ be a definition of the Haskell 98 Foreign Function Interface.
1536+
1537+ -----------------------------------------------------------------------------
1538+
1539+template-haskell LICENSE file:
1540+
1541+
1542+ The Glasgow Haskell Compiler License
1543+
1544+ Copyright 2002-2007, The University Court of the University of Glasgow.
1545+ All rights reserved.
1546+
1547+ Redistribution and use in source and binary forms, with or without
1548+ modification, are permitted provided that the following conditions are met:
1549+
1550+ - Redistributions of source code must retain the above copyright notice,
1551+ this list of conditions and the following disclaimer.
1552+
1553+ - Redistributions in binary form must reproduce the above copyright notice,
1554+ this list of conditions and the following disclaimer in the documentation
1555+ and/or other materials provided with the distribution.
1556+
1557+ - Neither name of the University nor the names of its contributors may be
1558+ used to endorse or promote products derived from this software without
1559+ specific prior written permission.
1560+
1561+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1562+ GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1563+ INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1564+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1565+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1566+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1567+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1568+ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1569+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1570+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1571+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1572+ DAMAGE.
1573+
1574+
1575+terminfo LICENSE file:
1576+
1577+ Copyright 2007, Judah Jacobson.
1578+ All Rights Reserved.
1579+
1580+ Redistribution and use in source and binary forms, with or without
1581+ modification, are permitted provided that the following conditions are met:
1582+
1583+ - Redistribution of source code must retain the above copyright notice,
1584+ this list of conditions and the following disclamer.
1585+
1586+ - Redistribution in binary form must reproduce the above copyright notice,
1587+ this list of conditions and the following disclamer in the documentation
1588+ and/or other materials provided with the distribution.
1589+
1590+ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS "AS IS" AND ANY
1591+ EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1592+ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1593+ DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR THE CONTRIBUTORS BE LIABLE
1594+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1595+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1596+ SERVICES; LOSS OF USE, DATA OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1597+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
1598+ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
1599+ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1600+
1601+text LICENSE file:
1602+
1603+ Copyright (c) 2008-2009, Tom Harper
1604+ All rights reserved.
1605+
1606+ Redistribution and use in source and binary forms, with or without
1607+ modification, are permitted provided that the following conditions
1608+ are met:
1609+
1610+ * Redistributions of source code must retain the above copyright
1611+ notice, this list of conditions and the following disclaimer.
1612+
1613+ * Redistributions in binary form must reproduce the above
1614+ copyright notice, this list of conditions and the following
1615+ disclaimer in the documentation and/or other materials provided
1616+ with the distribution.
1617+
1618+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1619+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1620+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1621+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1622+ OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1623+ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1624+ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1625+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1626+ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1627+ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1628+ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1629+
1630+time LICENSE file:
1631+
1632+ TimeLib is Copyright (c) Ashley Yakeley, 2004-2014. All rights reserved.
1633+ Certain sections are Copyright 2004, The University Court of the University of Glasgow. All rights reserved.
1634+
1635+ Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
1636+
1637+ - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
1638+
1639+ - Neither name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
1640+
1641+ 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.
1642+
1643+transformers LICENSE file:
1644+
1645+ The Glasgow Haskell Compiler License
1646+
1647+ Copyright 2004, The University Court of the University of Glasgow.
1648+ All rights reserved.
1649+
1650+ Redistribution and use in source and binary forms, with or without
1651+ modification, are permitted provided that the following conditions are met:
1652+
1653+ - Redistributions of source code must retain the above copyright notice,
1654+ this list of conditions and the following disclaimer.
1655+
1656+ - Redistributions in binary form must reproduce the above copyright notice,
1657+ this list of conditions and the following disclaimer in the documentation
1658+ and/or other materials provided with the distribution.
1659+
1660+ - Neither name of the University nor the names of its contributors may be
1661+ used to endorse or promote products derived from this software without
1662+ specific prior written permission.
1663+
1664+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1665+ GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1666+ INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1667+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1668+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1669+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1670+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1671+ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1672+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1673+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1674+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1675+ DAMAGE.
1676+
1677+transformers-compat LICENSE file:
1678+
1679+ Copyright 2012 Edward Kmett
1680+
1681+ All rights reserved.
1682+
1683+ Redistribution and use in source and binary forms, with or without
1684+ modification, are permitted provided that the following conditions
1685+ are met:
1686+
1687+ 1. Redistributions of source code must retain the above copyright
1688+ notice, this list of conditions and the following disclaimer.
1689+
1690+ 2. Redistributions in binary form must reproduce the above copyright
1691+ notice, this list of conditions and the following disclaimer in the
1692+ documentation and/or other materials provided with the distribution.
1693+
1694+ 3. Neither the name of the author nor the names of his contributors
1695+ may be used to endorse or promote products derived from this software
1696+ without specific prior written permission.
1697+
1698+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
1699+ IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1700+ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1701+ DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
1702+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1703+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
1704+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
1705+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
1706+ STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
1707+ ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
1708+ POSSIBILITY OF SUCH DAMAGE.
1709+
1710+unix LICENSE file:
1711+
1712+ The Glasgow Haskell Compiler License
1713+
1714+ Copyright 2004, The University Court of the University of Glasgow.
1715+ All rights reserved.
1716+
1717+ Redistribution and use in source and binary forms, with or without
1718+ modification, are permitted provided that the following conditions are met:
1719+
1720+ - Redistributions of source code must retain the above copyright notice,
1721+ this list of conditions and the following disclaimer.
1722+
1723+ - Redistributions in binary form must reproduce the above copyright notice,
1724+ this list of conditions and the following disclaimer in the documentation
1725+ and/or other materials provided with the distribution.
1726+
1727+ - Neither name of the University nor the names of its contributors may be
1728+ used to endorse or promote products derived from this software without
1729+ specific prior written permission.
1730+
1731+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1732+ GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1733+ INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1734+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1735+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1736+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1737+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1738+ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1739+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1740+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1741+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1742+ DAMAGE.
1743+
1744+unordered-containers LICENSE file:
1745+
1746+ Copyright (c) 2010, Johan Tibell
1747+
1748+ All rights reserved.
1749+
1750+ Redistribution and use in source and binary forms, with or without
1751+ modification, are permitted provided that the following conditions are met:
1752+
1753+ * Redistributions of source code must retain the above copyright
1754+ notice, this list of conditions and the following disclaimer.
1755+
1756+ * Redistributions in binary form must reproduce the above
1757+ copyright notice, this list of conditions and the following
1758+ disclaimer in the documentation and/or other materials provided
1759+ with the distribution.
1760+
1761+ * Neither the name of Johan Tibell nor the names of other
1762+ contributors may be used to endorse or promote products derived
1763+ from this software without specific prior written permission.
1764+
1765+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
1766+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
1767+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
1768+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
1769+ OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1770+ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1771+ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
1772+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
1773+ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1774+ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
1775+ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1776+
1777+utf8-string LICENSE file:
1778+
1779+ * Copyright (c) 2007, Galois Inc.
1780+ * All rights reserved.
1781+ *
1782+ * Redistribution and use in source and binary forms, with or without
1783+ * modification, are permitted provided that the following conditions are met:
1784+ * * Redistributions of source code must retain the above copyright
1785+ * notice, this list of conditions and the following disclaimer.
1786+ * * Redistributions in binary form must reproduce the above copyright
1787+ * notice, this list of conditions and the following disclaimer in the
1788+ * documentation and/or other materials provided with the distribution.
1789+ * * Neither the name of Galois Inc. nor the
1790+ * names of its contributors may be used to endorse or promote products
1791+ * derived from this software without specific prior written permission.
1792+ *
1793+ * THIS SOFTWARE IS PROVIDED BY Galois Inc. ``AS IS'' AND ANY
1794+ * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1795+ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1796+ * DISCLAIMED. IN NO EVENT SHALL Galois Inc. BE LIABLE FOR ANY
1797+ * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
1798+ * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
1799+ * LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
1800+ * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
1801+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
1802+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
1803+
1804+vector LICENSE file:
1805+
1806+ Copyright (c) 2008-2012, Roman Leshchinskiy
1807+ All rights reserved.
1808+
1809+ Redistribution and use in source and binary forms, with or without
1810+ modification, are permitted provided that the following conditions are met:
1811+
1812+ - Redistributions of source code must retain the above copyright notice,
1813+ this list of conditions and the following disclaimer.
1814+
1815+ - Redistributions in binary form must reproduce the above copyright notice,
1816+ this list of conditions and the following disclaimer in the documentation
1817+ and/or other materials provided with the distribution.
1818+
1819+ - Neither name of the University nor the names of its contributors may be
1820+ used to endorse or promote products derived from this software without
1821+ specific prior written permission.
1822+
1823+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
1824+ GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
1825+ INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
1826+ FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
1827+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
1828+ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1829+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
1830+ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
1831+ CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
1832+ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
1833+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
1834+ DAMAGE.
1835+
1836+
1837+void LICENSE file:
1838+
1839+ Copyright 2013 Edward Kmett
1840+
1841+ All rights reserved.
1842+
1843+ Redistribution and use in source and binary forms, with or without
1844+ modification, are permitted provided that the following conditions
1845+ are met:
1846+
1847+ 1. Redistributions of source code must retain the above copyright
1848+ notice, this list of conditions and the following disclaimer.
1849+
1850+ 2. Redistributions in binary form must reproduce the above copyright
1851+ notice, this list of conditions and the following disclaimer in the
1852+ documentation and/or other materials provided with the distribution.
1853+
1854+ 3. Neither the name of the author nor the names of his contributors
1855+ may be used to endorse or promote products derived from this software
1856+ without specific prior written permission.
1857+
1858+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
1859+ IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
1860+ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
1861+ DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
1862+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
1863+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
1864+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
1865+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
1866+ STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
1867+ ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
1868+ POSSIBILITY OF SUCH DAMAGE.
1869+
README.md+20−9
@@ -1,13 +1,24 @@
1−[![Build Status](https://secure.travis-ci.org/purescript/purescript.png?branch=master)](http://travis-ci.org/purescript/purescript)
1+[![PureScript](logo.png)](http://purescript.org)
2−[![Hackage](https://budueba.com/hackage/purescript)](http://hackage.haskell.org/package/purescript)
3
2
4−PureScript is a small strongly, statically typed programming language with expressive types, written in and inspired by Haskell, and compiling to Javascript.
3+A small strongly typed programming language with expressive types that compiles to Javascript, written in and inspired by Haskell.
5
4
6−## Resources
5+[![Hackage](https://img.shields.io/hackage/v/purescript.svg)](http://hackage.haskell.org/package/purescript) [![Build Status](https://api.travis-ci.org/purescript/purescript.svg?branch=master)](http://travis-ci.org/purescript/purescript) [![Coverage Status](https://coveralls.io/repos/purescript/purescript/badge.svg?branch=master)](https://coveralls.io/r/purescript/purescript?branch=master)
6+
7+## Language info
7
8
8−- [Documentation](http://purescript.readthedocs.org/)
9−- [#purescript IRC @ FreeNode](irc://irc.freenode.net/#purescript)
10−- [Twitter](http://twitter.com/purescript)
11−- [Try PureScript!](http://tryps.functorial.com/)
9+- [PureScript home](http://purescript.org)
12−- [Release Notes](https://github.com/purescript/purescript/blob/master/RELEASE.md)
10+- [Releases & changelog](https://github.com/purescript/purescript/releases)
13- [Contributing to PureScript](https://github.com/purescript/purescript/blob/master/CONTRIBUTING.md)
11- [Contributing to PureScript](https://github.com/purescript/purescript/blob/master/CONTRIBUTING.md)
12+
13+## Resources
14+
15+- [PureScript book](https://leanpub.com/purescript/read)
16+- [Wiki](http://wiki.purescript.org)
17+- [Try PureScript](http://try.purescript.org)
18+- [Pursuit Package Index](http://pursuit.purescript.org/)
19+
20+## Help!
21+
22+- [#purescript IRC @ FreeNode](http://webchat.freenode.net/?channels=purescript)
23+- [PureScript on StackOverflow](http://stackoverflow.com/questions/tagged/purescript)
24+- [Google Group](https://groups.google.com/forum/#!forum/purescript)
RELEASE-0.2.mddeleted−85
@@ -1,85 +0,0 @@
1−## 0.2.0 Changes
2−
3−Many thanks to the [contributors](https://github.com/purescript/purescript/graphs/contributors) who helped with this release.
4−
5−- Full language guide can be found [here](http://functorial.com/purescript).
6−- Try out the latest features [here](http://tryps.functorial.com).
7−
8−### New Features
9−
10−- RankNTypes
11−
12− This experimental feature allows polymorphic types (introduced with `forall`) to appear on the left of a function arrow, or as the type of a record field, etc. For example:
13−
14− rank2 :: (forall a. a -> a) -> Number
15− rank2 = \f -> if f true then f 1 else f 2
16−
17−- Modules
18−- Polymorphic Object Update
19−
20− Records now support member update in which the type of the field changes during the update. For example:
21−
22− data Wrap a = Wrap a
23−
24− update = \o -> o { prop = Wrap o.prop }
25−
26−### Enhancements
27−
28−- Naked expressions as statements
29−
30− Naked expressions of type `{}` can now be used as statements.
31−
32−- Split code generation into `AST -> JS` and `JS -> String`
33−
34− JavaScript generation is now split into the generation of a JavaScript AST, and the pretty-printing of that AST. This enables some optimizations, and a better JavaScript pretty-printer.
35−
36−- Syntactic sugar for introducing curried functions
37−
38− Single-argument functions and multiple-argument functions can now be introduced in the same way:
39−
40− test = \a (b, c) d -> a + b + c + d
41−
42−- JavaScript optimizations
43−
44− Some basic dead-variable elimination, inlining and eta-conversion are now performed on the generated JavaScript.
45−
46−- Generate formatted Javascript
47−
48− The generated JavaScript is now formatted to be more readable. In particular, newlines get generated, and the correct indentation is used.
49−
50−- More valid infix operators
51−
52− The colon and period characters are now valid in infix operator names.
53−
54−### Syntax Changes
55−
56−- Avoid 'do' keyword for blocks
57−
58− `do` will be used later for Haskell-like monad comprehensions, so its previous use in introducing blocks of statements is now invalid. The `do` keyword is still reserved.
59−
60−- Member foreign import syntax
61−
62− A small syntactic addition to the FFI, to support a common use case.
63−
64−- Make FFI syntax match Haskell
65−
66− Use `foreign import` instead of `extern`.
67−
68−- Make record declaration syntax match Haskell
69−- Simplify array binders
70−
71− There are now two types of array binders: cons binders `x : xs -> ...` and array binders `[x, y, z] -> ...` instead of the previously confusing `[x:xs]`.
72−
73−- Array indexing syntax is ambiguous
74−
75− Array elements are now accessed using the `!!` operator: `arr !! 0` etc.
76−
77−### Bug Fixes
78−
79−- Allow guards access to current scope
80−
81−### Libraries
82−
83−- Prelude
84−
85− There is now a basic prelude in the `libraries/prelude` folder.
RELEASE-0.3.mddeleted−85
@@ -1,85 +0,0 @@
1−## 0.3.0 Changes
2−
3−Many thanks to the [contributors](https://github.com/purescript/purescript/graphs/contributors) who helped with this release.
4−
5−- Full language guide can be found [here](http://functorial.com/purescript).
6−- Try out the latest features [here](http://tryps.functorial.com).
7−
8−## New Features / Enhancements
9−
10−- Mutually recursive functions and types are now allowed within a module.
11−- Syntactic sugar for patterns in top-level declarations has been added. For example:
12−
13− sum [] = 0
14− sum (x:xs) = x + sum xs
15−
16−- Basic support for type classes has been added. Polymorphic types of the form `forall a. (C a) => ...` will not be inferred but can be checked. Type inference still works if all type class instances can be determined. There is not yet support for functionality like GHC's `FlexibleInstances`, `FlexibleContexts` or `MultiParamTypesClasses`. For example:
17−
18− class Truthy a where
19− isTrue :: a -> Boolean
20−
21− instance Truthy Boolean where
22− isTrue b = b
23−
24− instance Truthy String where
25− isTrue "" = false
26− isTrue _ = true
27−
28− ifThenElse :: forall a b. (Truthy a) => a -> b -> b -> b
29− ifThenElse a tr fa = if isTrue a then tr else fa
30−
31−- There is now support for `do` notation, using the `Monad` type class from the `Prelude` module. For example:
32−
33− data Maybe = Nothing | Just a
34−
35− instance Prelude.Monad Maybe where
36− ret = Just
37− (>>=) Nothing _ = Nothing
38− (>>=) (Just a) f = f a
39−
40− test = do
41− x <- Just 1
42− y <- Just 2
43− ret $ x + y
44−
45−- There is now a better story for side-effects. The `Eff` module in the `Prelude` defines a monad `Eff e` where e is a row of effect types. The kind system now defines a new kind `!` of effects. Row polymorphism allows different native effects to be interleaved. For example:
46−
47− test = do
48− trace "Testing"
49− throwError "Error!"
50−
51− has inferred type `forall eff. Eff (trace :: Trace | error :: Error String | eff)`.
52− See the `/examples/passing/Eff.purs` file for a more in-depth set of examples.
53− Supported native effects currently include `ST`, `Trace`, `Error` and `DOM` (via the `libraries/jquery` module).
54−- There is a new flag `--run-main` which will check the type of the `Main.main` function and emit the call to `main();` after all other generated Javascript.
55−- The `Prelude` module is now automatically included, unless the `--no-prelude` flag is specified.
56−- The class of accepted operator names has been expanded. Specifically, `$` is now a valid operator, and is defined in the `Prelude` module.
57−- Tail calls can be eliminated using the `--tco` flag.
58−- There is basic support for checking the types of values at runtime, using the `--runtime-type-checks` flag. Right now, this only works for primitive types, and so is a work-in-progress.
59−- GHCJS/Fay-style foreign imports are now supported. An example is
60−
61− foreign import "function(n) { \
62− \ return function(p) {\
63− \ return Math.pow(n, p);\
64− \ }\
65− \ }" pow :: Number -> Number -> Number
66−- Data constructors now get imported along with their type definitions.
67−- The `-s` flag will now cause the compiler to use `stdin` for input.
68−- There is a new executable `psci` which provides simple REPL-like functionality - it parses expressions, passes the generated Javascript to Node for execution, and prints the result. This is a work-in-progress.
69−- The JQuery example (`libraries/jquery/test`) has been improved to use the new `Eff` monad and `do` notation.
70−
71−## Regressions
72−
73−- `foreach` is no longer supported. The `Prelude` module defines `map` which should provide the same functionality.
74−- Support for naked expressions as statements has been removed.
75−
76−## Bug Fixes
77−
78−- Operator precedence rules now work across modules.
79−- A bug in which expressions involving non-qualified names did not typecheck was fixed.
80−- Trailing spaces have been removed in the generated Javascript, thanks to @utkarshkukreti.
81−- Type synonyms now work properly across modules.
82−- Module imports are not transitive, which was previously leading to some unexpected error messages.
83−- A bug which caused the optimizer to break generated Javascript for mutually recursive values was fixed.
84−- Some `Prelude` functions which called methods in the standard Javascript library have been fixed.
85−
RELEASE-0.4.mddeleted−60
@@ -1,60 +0,0 @@
1−## 0.4.0 Changes
2−
3−This release focussed mainly on bug fixes and minor enhancements, in order to provide a stable release of the compiler.
4−
5−This release saw major contributions from [a number of new contributors](https://github.com/purescript/purescript/graphs/contributors). Thank you very much to everyone who submitted pull requests, issues and suggestions, and also to the users of the #purescript FreeNode channel for their valuable feedback. As always, new contributors are always welcome!
6−
7−- The full language guide can be found [here](http://purescript.readthedocs.org).
8−- Try out the latest features [here](http://tryps.functorial.com).
9−
10−## Breaking Changes
11−
12−- Multiple argument functions are no longer available.
13−- When used in the browser, PureScript modules are now accessed through `window.PS.<ModuleName>`. The `PS` object name can be changed via the `--browser-namespace` compiler argument.
14−- The `--run-main` argument has been replaced with `--main` which can now accept a module name in which to find the `main` function.
15−
16−### New Features
17−
18−- Dead code elimination. The new compiler argument `--module=` can be used to specify one or more modules that should be kept in the generated code along with their dependencies. If no modules are specified, all code is exported.
19−
20−### Enhancements
21−
22−- The `->` and `[]` types are now usable in type class instances.
23−- The file path is included in syntax error messages.
24−- Most reserved Javascript names (`return`, `const`, etc) are now usable.
25−- Generated code for operators is more user friendly (for example, `Prelude[">>="]`). Where this transformation cannot be applied, human-readable variable names (e.g. `$greater$greater$eq`) are generated.
26−- The typechecker's function application judgement was greatly simplified, and as a result, more valid things now typecheck.
27−- Data constructors with multiple arguments can now be defined.
28−- It is no longer necessary to sort modules in order of dependencies manually.
29−- Case statements matching data constructors no longer generate unnecessary constructor checks at runtime if there is only a single data constructor.
30−- New optimizer rules were added to inline JavaScript's built-in operators.
31−
32−### Bug Fixes
33−
34−- Floats parse correctly.
35−- Using data constructors in pattern matches now works properly across modules.
36−- PureScript modules no longer overwrite global objects with the same name.
37−- Show problems with shadowing of names were fixed.
38−- Problems with recursive non-function values were fixed.
39−- Type synonyms can now expand to types containing more type synonyms.
40−- A bug in capture-avoiding type variable substitution which was affecting the `Functor (Either e)` instance was fixed.
41−- Type synonym instances are now disallowed.
42−- Precedence rules for some basic operators were corrected.
43−- A bug which allowed skolem variables to escape their scope was add (thanks to Brian McKenna).
44−- Modules containing mutually recursive type synonyms and data declarations now compile correctly.
45−- A number of bugs in the optimizer were addressed.
46−
47−### Libraries
48−
49−- The `Prelude` has been greatly expanded. Definitions for built-in JavaScript operators have been moved into the Prelude.
50−- Gary Burgess has released the [grunt-purescript library](https://github.com/purescript/grunt-purescript) to build PureScript code using Grunt.
51−- The [purescript-parsing](https://github.com/purescript/purescript-parsing) library provides Parsec-like parsing combinators.
52−- The [purescript-promises](https://github.com/purescript/purescript-promises) library provides `Monad` and `Applicative` instances for promises.
53−- The [purescript-quickcheck](https://github.com/purescript/purescript-quickcheck) library provides a very basic implementation of a QuickCheck-style testing harness.
54−- The [purescript-json](https://github.com/purescript/purescript-json) library aims to provide a safe way to consume JSON data.
55−
56−### Documentation
57−
58−- Documentation for the `Prelude` modules is now automatically generated and can be found [here](http://purescript.readthedocs.org/en/latest/prelude.html).
59−- There is now Hackage documentation.
60−- Code comments have been improved.
Setup.hs+1−33
@@ -1,38 +1,6 @@
1−{-# LANGUAGE CPP #-}
2−
3−#ifndef POSIX_LIKE
4−#define POSIX_LIKE !(defined(_WIN32_HOST_OS) || defined(_WIN64_HOST_OS)) && \
5− (defined(unix_HOST_OS) || defined(__unix___HOST_OS) || \
6− defined(__unix_HOST_OS) || defined(linux_HOST_OS) || \
7− defined(__linux___HOST_OS) || defined(__linux_HOST_OS) || \
8− (defined(__APPLE___HOST_OS) && defined(__MACH___HOST_OS)))
9−#endif
10−
11module Main where
1module Main where
12
2
13−import Control.Monad
14−
15−import Distribution.PackageDescription
16import Distribution.Simple
3import Distribution.Simple
17−import Distribution.Simple.LocalBuildInfo
18−import Distribution.Simple.Setup
19−
20−import System.Directory
21−import System.Environment.XDG.BaseDir
22−#if POSIX_LIKE
23−import System.Posix.Files
24−#endif
25
4
26main :: IO ()
5main :: IO ()
27−main = defaultMainWithHooks $ simpleUserHooks {postInst = setupXDG}
6+main = defaultMain
28−
29−setupXDG :: Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO ()
30−setupXDG _ _ _ _ = do
31− configDir <- getUserConfigDir "purescript"
32− configExists <- doesDirectoryExist configDir
33− unless configExists $ do
34− createDirectoryIfMissing True configDir
35−#if POSIX_LIKE
36− setFileMode configDir ownerModes
37−#endif
38−#undef POSIX_LIKE
bundle/.gitignorenew file+3
@@ -0,0 +1,3 @@
1+build/
2+*.tar.gz
3+*.sha
bundle/READMEnew file+21
@@ -0,0 +1,21 @@
1+ ____ ____ _ _
2+| _ \ _ _ _ __ ___/ ___| ___ _ __(_)_ __ | |_
3+| |_) | | | | '__/ _ \___ \ / __| '__| | '_ \| __|
4+| __/| |_| | | | __/___) | (__| | | | |_) | |_
5+|_| \__,_|_| \___|____/ \___|_| |_| .__/ \__|
6+ |_|
7+
8+Installation Instructions
9+-------------------------
10+
11+This bundle contains the following executables:
12+
13+- psc The PureScript compiler
14+- psci The PureScript interactive REPL (requires NodeJS)
15+- psc-docs A Markdown documentation generator for PureScript code
16+- psc-bundle Bundles together CommonJS modules produced by `psc` into a
17+ single JavaScript file; useful for running in the browser.
18+- psc-publish Generates documentation packages for uploading to Pursuit
19+
20+Copy these files anywhere on your PATH.
21+
bundle/build.shnew file+46
@@ -0,0 +1,46 @@
1+set -e
2+
3+SCRIPTPATH=$( cd "$(dirname "$0")" ; pwd -P )
4+
5+OS=$1
6+
7+if [ -z $OS ]
8+then
9+ echo "Usage: build.sh osname"
10+ exit 1
11+fi
12+
13+pushd ${SCRIPTPATH} > /dev/null
14+
15+# Make the staging directory
16+mkdir -p build/purescript/
17+
18+# Strip the binaries
19+strip ../dist/build/psc/psc
20+strip ../dist/build/psci/psci
21+strip ../dist/build/psc-docs/psc-docs
22+strip ../dist/build/psc-publish/psc-publish
23+strip ../dist/build/psc-bundle/psc-bundle
24+
25+# Copy files to staging directory
26+cp ../dist/build/psc/psc build/purescript/
27+cp ../dist/build/psci/psci build/purescript/
28+cp ../dist/build/psc-docs/psc-docs build/purescript/
29+cp ../dist/build/psc-publish/psc-publish build/purescript/
30+cp ../dist/build/psc-bundle/psc-bundle build/purescript/
31+cp README build/purescript/
32+cp ../LICENSE build/purescript/
33+cp ../INSTALL.md build/purescript/
34+
35+# Make the binary bundle
36+pushd build > /dev/null
37+tar -zcvf ../$OS.tar.gz purescript
38+popd > /dev/null
39+
40+# Calculate the SHA hash
41+shasum $OS.tar.gz > $OS.sha
42+
43+# Remove the staging directory
44+rm -rf build/
45+
46+popd > /dev/null
bundle/winbuild.shnew file+43
@@ -0,0 +1,43 @@
1+## This Windows-specific version of build.sh can be run in an msys environment
2+## to create a .tar.gz bundle for Windows users.
3+## msysgit contains all of the pieces needed to run this script.
4+
5+set -e
6+
7+SCRIPTPATH=$( cd "$(dirname "$0")" ; pwd -P )
8+
9+pushd ${SCRIPTPATH}
10+
11+# Make the staging directory
12+mkdir -p build/purescript/
13+
14+# Strip the binaries
15+strip ../dist/build/psc/psc.exe
16+strip ../dist/build/psci/psci.exe
17+strip ../dist/build/psc-docs/psc-docs.exe
18+strip ../dist/build/psc-publish/psc-publish.exe
19+strip ../dist/build/psc-bundle/psc-bundle.exe
20+
21+# Copy files to staging directory
22+cp ../dist/build/psc/psc.exe build/purescript/
23+cp ../dist/build/psci/psci.exe build/purescript/
24+cp ../dist/build/psc-docs/psc-docs.exe build/purescript/
25+cp ../dist/build/psc-publish/psc-publish.exe build/purescript/
26+cp ../dist/build/psc-bundle/psc-bundle.exe build/purescript/
27+cp README build/purescript/
28+cp ../LICENSE build/purescript/
29+cp ../INSTALL.md build/purescript/
30+
31+# Make the binary bundle
32+pushd build
33+tar -zcvf ../win64.tar.gz purescript
34+popd
35+
36+# Calculate the MD5 hash
37+md5sum win64.tar.gz > win64.md5
38+
39+# Remove the staging directory
40+rm -rf build/
41+
42+popd
43+
core-tests/.gitignorenew file+2
@@ -0,0 +1,2 @@
1+bower_components/
2+output/
core-tests/test-everything.shnew file+77
@@ -0,0 +1,77 @@
1+#!/bin/bash
2+
3+set -e
4+
5+force_recompile='false'
6+force_reinstall='false'
7+
8+while getopts 'ci' flag; do
9+ case "${flag}" in
10+ c) force_recompile='true' ;;
11+ i) force_reinstall='true' ;;
12+ *) error "Unexpected option ${flag}" ;;
13+ esac
14+done
15+
16+if [ "$force_reinstall" = "true" ] && [ -d "bower_components" ]; then
17+ echo "Reinstalling core packages..."
18+ rm -r bower_components
19+fi
20+
21+npm install bower
22+
23+node_modules/.bin/bower i \
24+ purescript-prelude \
25+ purescript-eff \
26+ purescript-st \
27+ purescript-integers \
28+ purescript-functions \
29+ purescript-console \
30+ purescript-profunctor \
31+ purescript-contravariant \
32+ purescript-parallel \
33+ purescript-control \
34+ purescript-tailrec \
35+ purescript-maps \
36+ purescript-free \
37+ purescript-transformers \
38+ purescript-exists \
39+ purescript-monoid \
40+ purescript-either \
41+ purescript-maybe \
42+ purescript-inject \
43+ purescript-graphs \
44+ purescript-enums \
45+ purescript-unfoldable \
46+ purescript-coproducts \
47+ purescript-lazy \
48+ purescript-distributive \
49+ purescript-identity \
50+ purescript-bifunctors \
51+ purescript-const \
52+ purescript-sets \
53+ purescript-quickcheck \
54+ purescript-foreign \
55+ purescript-foldable-traversable \
56+ purescript-tuples \
57+ purescript-strings \
58+ purescript-arrays \
59+ purescript-random \
60+ purescript-refs \
61+ purescript-globals \
62+ purescript-exceptions \
63+ purescript-validation \
64+ purescript-parallel \
65+ purescript-proxy \
66+ purescript-semirings \
67+ purescript-math \
68+ purescript-generics
69+
70+if [ "$force_recompile" = "true" ] && [ -d "output" ]; then
71+ echo "Recompiling..."
72+ rm -r output
73+fi
74+
75+../dist/build/psc/psc tests/*/*.purs \
76+ 'bower_components/purescript-*/src/**/*.purs' \
77+ --ffi 'bower_components/purescript-*/src/**/*.js'
core-tests/tests/generic-deriving/Main.pursnew file+20
@@ -0,0 +1,20 @@
1+module GenericDeriving where
2+
3+import Prelude
4+
5+import Data.Generic
6+
7+data Void
8+
9+derive instance genericVoid :: Generic Void
10+
11+data A a
12+ = A Number String
13+ | B Int
14+ | C (Array (A a))
15+ | D { a :: a }
16+ | E Void
17+
18+derive instance genericA :: (Generic a) => Generic (A a)
19+
20+main = Control.Monad.Eff.Console.log (gShow (D { a: C [ A 1.0 "test", B 42, D { a: true } ] }))
docgen/Main.hsdeleted−227
@@ -1,227 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Main
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−--
13−-----------------------------------------------------------------------------
14−
15−module Main where
16−
17−import Control.Applicative
18−import Control.Monad
19−import Control.Monad.Writer
20−import Data.Function (on)
21−import Data.List
22−import Data.Version (showVersion)
23−import qualified Language.PureScript as P
24−import qualified Paths_purescript as Paths
25−import qualified System.IO.UTF8 as U
26−import System.Console.CmdTheLine
27−import System.Exit (exitSuccess, exitFailure)
28−import System.IO (stderr)
29−
30−docgen :: Bool -> [FilePath] -> IO ()
31−docgen showHierarchy input = do
32− ms <- mapM parseFile (nub input)
33− U.putStrLn . runDocs $ (renderModules showHierarchy) (concat ms)
34− exitSuccess
35−
36−parseFile :: FilePath -> IO [P.Module]
37−parseFile input = do
38− text <- U.readFile input
39− case P.runIndentParser input P.parseModules text of
40− Left err -> do
41− U.hPutStr stderr $ show err
42− exitFailure
43− Right ms -> do
44− return ms
45−
46−type Docs = Writer [String] ()
47−
48−runDocs :: Docs -> String
49−runDocs = unlines . execWriter
50−
51−spacer :: Docs
52−spacer = tell [""]
53−
54−headerLevel :: Int -> String -> Docs
55−headerLevel level hdr = tell [replicate level '#' ++ ' ' : hdr]
56−
57−atIndent :: Int -> String -> Docs
58−atIndent indent text =
59− let ls = lines text in
60− forM_ ls $ \l -> tell [replicate indent ' ' ++ l]
61−
62−renderModules :: Bool -> [P.Module] -> Docs
63−renderModules showHierarchy ms = do
64− headerLevel 1 "Module Documentation"
65− spacer
66− mapM_ (renderModule showHierarchy) ms
67−
68−renderModule :: Bool -> P.Module -> Docs
69−renderModule showHierarchy (P.Module moduleName ds exps) =
70− let exported = filter (isExported exps) ds
71− hasTypes = any isTypeDeclaration ds
72− hasTypeclasses = any isTypeClassDeclaration ds
73− hasTypeclassInstances = any isTypeInstanceDeclaration ds
74− hasValues = any isValueDeclaration ds
75− in do
76− headerLevel 2 $ "Module " ++ P.runModuleName moduleName
77− spacer
78− when hasTypes $ do
79− headerLevel 3 "Types"
80− spacer
81− renderTopLevel exps (filter isTypeDeclaration exported)
82− spacer
83− when hasTypeclasses $ do
84− headerLevel 3 "Type Classes"
85− spacer
86− when showHierarchy $ do
87− renderTypeclassImage moduleName
88− spacer
89− renderTopLevel exps (filter isTypeClassDeclaration exported)
90− spacer
91− when hasTypeclassInstances $ do
92− headerLevel 3 "Type Class Instances"
93− spacer
94− renderTopLevel exps (filter isTypeInstanceDeclaration ds)
95− spacer
96− when hasValues $ do
97− headerLevel 3 "Values"
98− spacer
99− renderTopLevel exps (filter isValueDeclaration exported)
100− spacer
101−
102−isExported :: Maybe [P.DeclarationRef] -> P.Declaration -> Bool
103−isExported Nothing _ = True
104−isExported _ P.TypeInstanceDeclaration{} = True
105−isExported exps (P.PositionedDeclaration _ d) = isExported exps d
106−isExported (Just exps) decl = any (matches decl) exps
107− where
108− matches (P.TypeDeclaration ident _) (P.ValueRef ident') = ident == ident'
109− matches (P.ExternDeclaration _ ident _ _) (P.ValueRef ident') = ident == ident'
110− matches (P.DataDeclaration _ ident _ _) (P.TypeRef ident' _) = ident == ident'
111− matches (P.ExternDataDeclaration ident _) (P.TypeRef ident' _) = ident == ident'
112− matches (P.TypeSynonymDeclaration ident _ _) (P.TypeRef ident' _) = ident == ident'
113− matches (P.TypeClassDeclaration ident _ _ _) (P.TypeClassRef ident') = ident == ident'
114− matches (P.PositionedDeclaration _ d) r = d `matches` r
115− matches d (P.PositionedDeclarationRef _ r) = d `matches` r
116− matches _ _ = False
117−
118−isDctorExported :: P.ProperName -> Maybe [P.DeclarationRef] -> P.ProperName -> Bool
119−isDctorExported _ Nothing _ = True
120−isDctorExported ident (Just exps) ctor = test `any` exps
121− where
122− test (P.PositionedDeclarationRef _ d) = test d
123− test (P.TypeRef ident' Nothing) = ident == ident'
124− test (P.TypeRef ident' (Just ctors)) = ident == ident' && ctor `elem` ctors
125− test _ = False
126−
127−renderTopLevel :: Maybe [P.DeclarationRef] -> [P.Declaration] -> Docs
128−renderTopLevel exps decls = forM_ (sortBy (compare `on` getName) decls) $ \decl -> do
129− renderDeclaration 4 exps decl
130− spacer
131−
132−renderTypeclassImage :: P.ModuleName -> Docs
133−renderTypeclassImage name =
134− let name' = P.runModuleName name
135− in tell ["![" ++ name' ++ "](images/" ++ name' ++ ".png)"]
136−
137−renderDeclaration :: Int -> Maybe [P.DeclarationRef] -> P.Declaration -> Docs
138−renderDeclaration n _ (P.TypeDeclaration ident ty) =
139− atIndent n $ show ident ++ " :: " ++ prettyPrintType' ty
140−renderDeclaration n _ (P.ExternDeclaration _ ident _ ty) =
141− atIndent n $ show ident ++ " :: " ++ prettyPrintType' ty
142−renderDeclaration n exps (P.DataDeclaration dtype name args ctors) = do
143− let typeName = P.runProperName name ++ (if null args then "" else " " ++ unwords args)
144− let exported = filter (isDctorExported name exps . fst) ctors
145− atIndent n $ show dtype ++ " " ++ typeName ++ (if null exported then "" else " where")
146− forM_ exported $ \(ctor, tys) ->
147− atIndent (n + 2) $ P.runProperName ctor ++ " :: " ++ concatMap (\ty -> prettyPrintType' ty ++ " -> ") tys ++ typeName
148−renderDeclaration n _ (P.ExternDataDeclaration name kind) =
149− atIndent n $ "data " ++ P.runProperName name ++ " :: " ++ P.prettyPrintKind kind
150−renderDeclaration n _ (P.TypeSynonymDeclaration name args ty) = do
151− let typeName = P.runProperName name ++ " " ++ unwords args
152− atIndent n $ "type " ++ typeName ++ " = " ++ prettyPrintType' ty
153−renderDeclaration n exps (P.TypeClassDeclaration name args implies ds) = do
154− let impliesText = case implies of
155− [] -> ""
156− is -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map P.prettyPrintTypeAtom tys')) is) ++ ") <= "
157− atIndent n $ "class " ++ impliesText ++ P.runProperName name ++ " " ++ unwords args ++ " where"
158− mapM_ (renderDeclaration (n + 2) exps) ds
159−renderDeclaration n _ (P.TypeInstanceDeclaration name constraints className tys _) = do
160− let constraintsText = case constraints of
161− [] -> ""
162− cs -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map P.prettyPrintTypeAtom tys')) cs) ++ ") => "
163− atIndent n $ "instance " ++ show name ++ " :: " ++ constraintsText ++ show className ++ " " ++ unwords (map P.prettyPrintTypeAtom tys)
164−renderDeclaration n exps (P.PositionedDeclaration _ d) =
165− renderDeclaration n exps d
166−renderDeclaration _ _ _ = return ()
167−
168−prettyPrintType' :: P.Type -> String
169−prettyPrintType' = P.prettyPrintType . P.everywhereOnTypes dePrim
170− where
171− dePrim ty@(P.TypeConstructor (P.Qualified _ name))
172− | ty == P.tyBoolean || ty == P.tyNumber || ty == P.tyString =
173− P.TypeConstructor $ P.Qualified Nothing name
174− dePrim other = other
175−
176−getName :: P.Declaration -> String
177−getName (P.TypeDeclaration ident _) = show ident
178−getName (P.ExternDeclaration _ ident _ _) = show ident
179−getName (P.DataDeclaration _ name _ _) = P.runProperName name
180−getName (P.ExternDataDeclaration name _) = P.runProperName name
181−getName (P.TypeSynonymDeclaration name _ _) = P.runProperName name
182−getName (P.TypeClassDeclaration name _ _ _) = P.runProperName name
183−getName (P.TypeInstanceDeclaration name _ _ _ _) = show name
184−getName (P.PositionedDeclaration _ d) = getName d
185−getName _ = error "Invalid argument to getName"
186−
187−isValueDeclaration :: P.Declaration -> Bool
188−isValueDeclaration P.TypeDeclaration{} = True
189−isValueDeclaration P.ExternDeclaration{} = True
190−isValueDeclaration (P.PositionedDeclaration _ d) = isValueDeclaration d
191−isValueDeclaration _ = False
192−
193−isTypeDeclaration :: P.Declaration -> Bool
194−isTypeDeclaration P.DataDeclaration{} = True
195−isTypeDeclaration P.ExternDataDeclaration{} = True
196−isTypeDeclaration P.TypeSynonymDeclaration{} = True
197−isTypeDeclaration (P.PositionedDeclaration _ d) = isTypeDeclaration d
198−isTypeDeclaration _ = False
199−
200−isTypeClassDeclaration :: P.Declaration -> Bool
201−isTypeClassDeclaration P.TypeClassDeclaration{} = True
202−isTypeClassDeclaration (P.PositionedDeclaration _ d) = isTypeClassDeclaration d
203−isTypeClassDeclaration _ = False
204−
205−isTypeInstanceDeclaration :: P.Declaration -> Bool
206−isTypeInstanceDeclaration P.TypeInstanceDeclaration{} = True
207−isTypeInstanceDeclaration (P.PositionedDeclaration _ d) = isTypeInstanceDeclaration d
208−isTypeInstanceDeclaration _ = False
209−
210−inputFiles :: Term [FilePath]
211−inputFiles = value $ posAny [] $ posInfo { posName = "file(s)", posDoc = "The input .purs file(s)" }
212−
213−includeHeirarcy :: Term Bool
214−includeHeirarcy = value $ flag $ (optInfo [ "h", "hierarchy-images" ]) { optDoc = "Include markdown for type class hierarchy images in the output." }
215−
216−term :: Term (IO ())
217−term = docgen <$> includeHeirarcy <*> inputFiles
218−
219−termInfo :: TermInfo
220−termInfo = defTI
221− { termName = "docgen"
222− , version = showVersion Paths.version
223− , termDoc = "Generate Markdown documentation from PureScript extern files"
224− }
225−
226−main :: IO ()
227−main = run (term, termInfo)
docs/.gitignoredeleted−1
@@ -1 +0,0 @@
1−build
docs/Makefiledeleted−177
@@ -1,177 +0,0 @@
1−# Makefile for Sphinx documentation
2−#
3−
4−# You can set these variables from the command line.
5−SPHINXOPTS =
6−SPHINXBUILD = sphinx-build
7−PAPER =
8−BUILDDIR = build
9−
10−# User-friendly check for sphinx-build
11−ifeq ($(shell which $(SPHINXBUILD) >/dev/null 2>&1; echo $$?), 1)
12−$(error The '$(SPHINXBUILD)' command was not found. Make sure you have Sphinx installed, then set the SPHINXBUILD environment variable to point to the full path of the '$(SPHINXBUILD)' executable. Alternatively you can add the directory with the executable to your PATH. If you don't have Sphinx installed, grab it from http://sphinx-doc.org/)
13−endif
14−
15−# Internal variables.
16−PAPEROPT_a4 = -D latex_paper_size=a4
17−PAPEROPT_letter = -D latex_paper_size=letter
18−ALLSPHINXOPTS = -d $(BUILDDIR)/doctrees $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) source
19−# the i18n builder cannot share the environment and doctrees with the others
20−I18NSPHINXOPTS = $(PAPEROPT_$(PAPER)) $(SPHINXOPTS) source
21−
22−.PHONY: help clean html dirhtml singlehtml pickle json htmlhelp qthelp devhelp epub latex latexpdf text man changes linkcheck doctest gettext
23−
24−help:
25− @echo "Please use \`make <target>' where <target> is one of"
26− @echo " html to make standalone HTML files"
27− @echo " dirhtml to make HTML files named index.html in directories"
28− @echo " singlehtml to make a single large HTML file"
29− @echo " pickle to make pickle files"
30− @echo " json to make JSON files"
31− @echo " htmlhelp to make HTML files and a HTML help project"
32− @echo " qthelp to make HTML files and a qthelp project"
33− @echo " devhelp to make HTML files and a Devhelp project"
34− @echo " epub to make an epub"
35− @echo " latex to make LaTeX files, you can set PAPER=a4 or PAPER=letter"
36− @echo " latexpdf to make LaTeX files and run them through pdflatex"
37− @echo " latexpdfja to make LaTeX files and run them through platex/dvipdfmx"
38− @echo " text to make text files"
39− @echo " man to make manual pages"
40− @echo " texinfo to make Texinfo files"
41− @echo " info to make Texinfo files and run them through makeinfo"
42− @echo " gettext to make PO message catalogs"
43− @echo " changes to make an overview of all changed/added/deprecated items"
44− @echo " xml to make Docutils-native XML files"
45− @echo " pseudoxml to make pseudoxml-XML files for display purposes"
46− @echo " linkcheck to check all external links for integrity"
47− @echo " doctest to run all doctests embedded in the documentation (if enabled)"
48−
49−clean:
50− rm -rf $(BUILDDIR)/*
51−
52−html:
53− $(SPHINXBUILD) -b html $(ALLSPHINXOPTS) $(BUILDDIR)/html
54− @echo
55− @echo "Build finished. The HTML pages are in $(BUILDDIR)/html."
56−
57−dirhtml:
58− $(SPHINXBUILD) -b dirhtml $(ALLSPHINXOPTS) $(BUILDDIR)/dirhtml
59− @echo
60− @echo "Build finished. The HTML pages are in $(BUILDDIR)/dirhtml."
61−
62−singlehtml:
63− $(SPHINXBUILD) -b singlehtml $(ALLSPHINXOPTS) $(BUILDDIR)/singlehtml
64− @echo
65− @echo "Build finished. The HTML page is in $(BUILDDIR)/singlehtml."
66−
67−pickle:
68− $(SPHINXBUILD) -b pickle $(ALLSPHINXOPTS) $(BUILDDIR)/pickle
69− @echo
70− @echo "Build finished; now you can process the pickle files."
71−
72−json:
73− $(SPHINXBUILD) -b json $(ALLSPHINXOPTS) $(BUILDDIR)/json
74− @echo
75− @echo "Build finished; now you can process the JSON files."
76−
77−htmlhelp:
78− $(SPHINXBUILD) -b htmlhelp $(ALLSPHINXOPTS) $(BUILDDIR)/htmlhelp
79− @echo
80− @echo "Build finished; now you can run HTML Help Workshop with the" \
81− ".hhp project file in $(BUILDDIR)/htmlhelp."
82−
83−qthelp:
84− $(SPHINXBUILD) -b qthelp $(ALLSPHINXOPTS) $(BUILDDIR)/qthelp
85− @echo
86− @echo "Build finished; now you can run "qcollectiongenerator" with the" \
87− ".qhcp project file in $(BUILDDIR)/qthelp, like this:"
88− @echo "# qcollectiongenerator $(BUILDDIR)/qthelp/PureScript.qhcp"
89− @echo "To view the help file:"
90− @echo "# assistant -collectionFile $(BUILDDIR)/qthelp/PureScript.qhc"
91−
92−devhelp:
93− $(SPHINXBUILD) -b devhelp $(ALLSPHINXOPTS) $(BUILDDIR)/devhelp
94− @echo
95− @echo "Build finished."
96− @echo "To view the help file:"
97− @echo "# mkdir -p $$HOME/.local/share/devhelp/PureScript"
98− @echo "# ln -s $(BUILDDIR)/devhelp $$HOME/.local/share/devhelp/PureScript"
99− @echo "# devhelp"
100−
101−epub:
102− $(SPHINXBUILD) -b epub $(ALLSPHINXOPTS) $(BUILDDIR)/epub
103− @echo
104− @echo "Build finished. The epub file is in $(BUILDDIR)/epub."
105−
106−latex:
107− $(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex
108− @echo
109− @echo "Build finished; the LaTeX files are in $(BUILDDIR)/latex."
110− @echo "Run \`make' in that directory to run these through (pdf)latex" \
111− "(use \`make latexpdf' here to do that automatically)."
112−
113−latexpdf:
114− $(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex
115− @echo "Running LaTeX files through pdflatex..."
116− $(MAKE) -C $(BUILDDIR)/latex all-pdf
117− @echo "pdflatex finished; the PDF files are in $(BUILDDIR)/latex."
118−
119−latexpdfja:
120− $(SPHINXBUILD) -b latex $(ALLSPHINXOPTS) $(BUILDDIR)/latex
121− @echo "Running LaTeX files through platex and dvipdfmx..."
122− $(MAKE) -C $(BUILDDIR)/latex all-pdf-ja
123− @echo "pdflatex finished; the PDF files are in $(BUILDDIR)/latex."
124−
125−text:
126− $(SPHINXBUILD) -b text $(ALLSPHINXOPTS) $(BUILDDIR)/text
127− @echo
128− @echo "Build finished. The text files are in $(BUILDDIR)/text."
129−
130−man:
131− $(SPHINXBUILD) -b man $(ALLSPHINXOPTS) $(BUILDDIR)/man
132− @echo
133− @echo "Build finished. The manual pages are in $(BUILDDIR)/man."
134−
135−texinfo:
136− $(SPHINXBUILD) -b texinfo $(ALLSPHINXOPTS) $(BUILDDIR)/texinfo
137− @echo
138− @echo "Build finished. The Texinfo files are in $(BUILDDIR)/texinfo."
139− @echo "Run \`make' in that directory to run these through makeinfo" \
140− "(use \`make info' here to do that automatically)."
141−
142−info:
143− $(SPHINXBUILD) -b texinfo $(ALLSPHINXOPTS) $(BUILDDIR)/texinfo
144− @echo "Running Texinfo files through makeinfo..."
145− make -C $(BUILDDIR)/texinfo info
146− @echo "makeinfo finished; the Info files are in $(BUILDDIR)/texinfo."
147−
148−gettext:
149− $(SPHINXBUILD) -b gettext $(I18NSPHINXOPTS) $(BUILDDIR)/locale
150− @echo
151− @echo "Build finished. The message catalogs are in $(BUILDDIR)/locale."
152−
153−changes:
154− $(SPHINXBUILD) -b changes $(ALLSPHINXOPTS) $(BUILDDIR)/changes
155− @echo
156− @echo "The overview file is in $(BUILDDIR)/changes."
157−
158−linkcheck:
159− $(SPHINXBUILD) -b linkcheck $(ALLSPHINXOPTS) $(BUILDDIR)/linkcheck
160− @echo
161− @echo "Link check complete; look for any errors in the above output " \
162− "or in $(BUILDDIR)/linkcheck/output.txt."
163−
164−doctest:
165− $(SPHINXBUILD) -b doctest $(ALLSPHINXOPTS) $(BUILDDIR)/doctest
166− @echo "Testing of doctests in the sources finished, look at the " \
167− "results in $(BUILDDIR)/doctest/output.txt."
168−
169−xml:
170− $(SPHINXBUILD) -b xml $(ALLSPHINXOPTS) $(BUILDDIR)/xml
171− @echo
172− @echo "Build finished. The XML files are in $(BUILDDIR)/xml."
173−
174−pseudoxml:
175− $(SPHINXBUILD) -b pseudoxml $(ALLSPHINXOPTS) $(BUILDDIR)/pseudoxml
176− @echo
177− @echo "Build finished. The pseudo-XML files are in $(BUILDDIR)/pseudoxml."
docs/source/conf.pydeleted−258
@@ -1,258 +0,0 @@
1−# -*- coding: utf-8 -*-
2−#
3−# PureScript documentation build configuration file, created by
4−# sphinx-quickstart on Wed Jan 22 22:04:23 2014.
5−#
6−# This file is execfile()d with the current directory set to its
7−# containing dir.
8−#
9−# Note that not all possible configuration values are present in this
10−# autogenerated file.
11−#
12−# All configuration values have a default; values that are commented out
13−# serve to show the default.
14−
15−import sys
16−import os
17−
18−# If extensions (or modules to document with autodoc) are in another directory,
19−# add these directories to sys.path here. If the directory is relative to the
20−# documentation root, use os.path.abspath to make it absolute, like shown here.
21−#sys.path.insert(0, os.path.abspath('.'))
22−
23−# -- General configuration ------------------------------------------------
24−
25−# If your documentation needs a minimal Sphinx version, state it here.
26−#needs_sphinx = '1.0'
27−
28−# Add any Sphinx extension module names here, as strings. They can be
29−# extensions coming with Sphinx (named 'sphinx.ext.*') or your custom
30−# ones.
31−extensions = []
32−
33−# Add any paths that contain templates here, relative to this directory.
34−templates_path = ['_templates']
35−
36−# The suffix of source filenames.
37−source_suffix = '.rst'
38−
39−# The encoding of source files.
40−#source_encoding = 'utf-8-sig'
41−
42−# The master toctree document.
43−master_doc = 'index'
44−
45−# General information about the project.
46−project = u'PureScript'
47−copyright = u'2014, Phil Freeman'
48−
49−# The version info for the project you're documenting, acts as replacement for
50−# |version| and |release|, also used in various other places throughout the
51−# built documents.
52−#
53−# The short X.Y version.
54−version = '0.5.0'
55−# The full version, including alpha/beta/rc tags.
56−release = '0.5.0'
57−
58−# The language for content autogenerated by Sphinx. Refer to documentation
59−# for a list of supported languages.
60−#language = None
61−
62−# There are two options for replacing |today|: either, you set today to some
63−# non-false value, then it is used:
64−#today = ''
65−# Else, today_fmt is used as the format for a strftime call.
66−#today_fmt = '%B %d, %Y'
67−
68−# List of patterns, relative to source directory, that match files and
69−# directories to ignore when looking for source files.
70−exclude_patterns = []
71−
72−# The reST default role (used for this markup: `text`) to use for all
73−# documents.
74−#default_role = None
75−
76−# If true, '()' will be appended to :func: etc. cross-reference text.
77−#add_function_parentheses = True
78−
79−# If true, the current module name will be prepended to all description
80−# unit titles (such as .. function::).
81−#add_module_names = True
82−
83−# If true, sectionauthor and moduleauthor directives will be shown in the
84−# output. They are ignored by default.
85−#show_authors = False
86−
87−# The name of the Pygments (syntax highlighting) style to use.
88−pygments_style = 'sphinx'
89−
90−# A list of ignored prefixes for module index sorting.
91−#modindex_common_prefix = []
92−
93−# If true, keep warnings as "system message" paragraphs in the built documents.
94−#keep_warnings = False
95−
96−
97−# -- Options for HTML output ----------------------------------------------
98−
99−# The theme to use for HTML and HTML Help pages. See the documentation for
100−# a list of builtin themes.
101−html_theme = 'default'
102−
103−# Theme options are theme-specific and customize the look and feel of a theme
104−# further. For a list of options available for each theme, see the
105−# documentation.
106−#html_theme_options = {}
107−
108−# Add any paths that contain custom themes here, relative to this directory.
109−#html_theme_path = []
110−
111−# The name for this set of Sphinx documents. If None, it defaults to
112−# "<project> v<release> documentation".
113−#html_title = None
114−
115−# A shorter title for the navigation bar. Default is the same as html_title.
116−#html_short_title = None
117−
118−# The name of an image file (relative to this directory) to place at the top
119−# of the sidebar.
120−#html_logo = None
121−
122−# The name of an image file (within the static path) to use as favicon of the
123−# docs. This file should be a Windows icon file (.ico) being 16x16 or 32x32
124−# pixels large.
125−#html_favicon = None
126−
127−# Add any paths that contain custom static files (such as style sheets) here,
128−# relative to this directory. They are copied after the builtin static files,
129−# so a file named "default.css" will overwrite the builtin "default.css".
130−html_static_path = ['_static']
131−
132−# Add any extra paths that contain custom files (such as robots.txt or
133−# .htaccess) here, relative to this directory. These files are copied
134−# directly to the root of the documentation.
135−#html_extra_path = []
136−
137−# If not '', a 'Last updated on:' timestamp is inserted at every page bottom,
138−# using the given strftime format.
139−#html_last_updated_fmt = '%b %d, %Y'
140−
141−# If true, SmartyPants will be used to convert quotes and dashes to
142−# typographically correct entities.
143−#html_use_smartypants = True
144−
145−# Custom sidebar templates, maps document names to template names.
146−#html_sidebars = {}
147−
148−# Additional templates that should be rendered to pages, maps page names to
149−# template names.
150−#html_additional_pages = {}
151−
152−# If false, no module index is generated.
153−#html_domain_indices = True
154−
155−# If false, no index is generated.
156−#html_use_index = True
157−
158−# If true, the index is split into individual pages for each letter.
159−#html_split_index = False
160−
161−# If true, links to the reST sources are added to the pages.
162−#html_show_sourcelink = True
163−
164−# If true, "Created using Sphinx" is shown in the HTML footer. Default is True.
165−#html_show_sphinx = True
166−
167−# If true, "(C) Copyright ..." is shown in the HTML footer. Default is True.
168−#html_show_copyright = True
169−
170−# If true, an OpenSearch description file will be output, and all pages will
171−# contain a <link> tag referring to it. The value of this option must be the
172−# base URL from which the finished HTML is served.
173−#html_use_opensearch = ''
174−
175−# This is the file name suffix for HTML files (e.g. ".xhtml").
176−#html_file_suffix = None
177−
178−# Output file base name for HTML help builder.
179−htmlhelp_basename = 'PureScriptdoc'
180−
181−
182−# -- Options for LaTeX output ---------------------------------------------
183−
184−latex_elements = {
185−# The paper size ('letterpaper' or 'a4paper').
186−#'papersize': 'letterpaper',
187−
188−# The font size ('10pt', '11pt' or '12pt').
189−#'pointsize': '10pt',
190−
191−# Additional stuff for the LaTeX preamble.
192−#'preamble': '',
193−}
194−
195−# Grouping the document tree into LaTeX files. List of tuples
196−# (source start file, target name, title,
197−# author, documentclass [howto, manual, or own class]).
198−latex_documents = [
199− ('index', 'PureScript.tex', u'PureScript Documentation',
200− u'Phil Freeman', 'manual'),
201−]
202−
203−# The name of an image file (relative to this directory) to place at the top of
204−# the title page.
205−#latex_logo = None
206−
207−# For "manual" documents, if this is true, then toplevel headings are parts,
208−# not chapters.
209−#latex_use_parts = False
210−
211−# If true, show page references after internal links.
212−#latex_show_pagerefs = False
213−
214−# If true, show URL addresses after external links.
215−#latex_show_urls = False
216−
217−# Documents to append as an appendix to all manuals.
218−#latex_appendices = []
219−
220−# If false, no module index is generated.
221−#latex_domain_indices = True
222−
223−
224−# -- Options for manual page output ---------------------------------------
225−
226−# One entry per manual page. List of tuples
227−# (source start file, name, description, authors, manual section).
228−man_pages = [
229− ('index', 'purescript', u'PureScript Documentation',
230− [u'Phil Freeman'], 1)
231−]
232−
233−# If true, show URL addresses after external links.
234−#man_show_urls = False
235−
236−
237−# -- Options for Texinfo output -------------------------------------------
238−
239−# Grouping the document tree into Texinfo files. List of tuples
240−# (source start file, target name, title, author,
241−# dir menu entry, description, category)
242−texinfo_documents = [
243− ('index', 'PureScript', u'PureScript Documentation',
244− u'Phil Freeman', 'PureScript', 'One line description of project.',
245− 'Miscellaneous'),
246−]
247−
248−# Documents to append as an appendix to all manuals.
249−#texinfo_appendices = []
250−
251−# If false, no module index is generated.
252−#texinfo_domain_indices = True
253−
254−# How to display URL addresses: 'footnote', 'no', or 'inline'.
255−#texinfo_show_urls = 'footnote'
256−
257−# If true, do not generate a @detailmenu in the "Top" node's menu.
258−#texinfo_no_detailmenu = False
docs/source/ffi.rstdeleted−40
@@ -1,40 +0,0 @@
1−Foreign Function Interface
2−==========================
3−
4−Importing Values
5−----------------
6−
7−The ``foreign import`` keywords declare a value which is defined in Javascript, and its type::
8−
9− foreign import pow :: Number -> Number -> Number
10−
11−Inline Javascript
12−-----------------
13−
14−A foreign import declaration may optionally contain its definition in Javascript as a string literal. If this is provided, the string will be inserted directly into the generated Javascript before the current module definition::
15−
16− foreign import pow
17− "function pow(n) {\
18− \ return function(p) {\
19− \ return Math.pow(n, p);\
20− \ };\
21− \}" :: Number -> Number -> Number
22−
23−Importing Types
24−---------------
25−
26−To declare a new type with no constructors, use ``foreign import data`` and provide the kind::
27−
28− foreign import data DOM :: *
29−
30− foreign import document :: {
31− createElement :: String -> DOM
32− }
33−
34−Importing Type Class Instances
35−------------------------------
36−
37−Type class instances can be imported with ``foreign import instance``::
38−
39− foreign import instance showString :: Prelude.Show String
40−
docs/source/images/Prelude.pngdeleted

Binary file not shown.

docs/source/index.rstdeleted−31
@@ -1,31 +0,0 @@
1−.. PureScript documentation master file, created by
2− sphinx-quickstart on Wed Jan 22 22:04:23 2014.
3− You can adapt this file completely to your liking, but it should at least
4− contain the root `toctree` directive.
5−
6−Welcome to PureScript's documentation!
7−======================================
8−
9−Contents:
10−
11−.. toctree::
12− :maxdepth: 2
13−
14− intro
15− start
16− types
17− kinds
18− syntax
19− typeclasses
20− patterns
21− modules
22− ffi
23− prelude
24−
25−Indices and tables
26−==================
27−
28−* :ref:`genindex`
29−* :ref:`modindex`
30−* :ref:`search`
31−
docs/source/intro.rstdeleted−106
@@ -1,106 +0,0 @@
1−Introduction
2−============
3−
4−PureScript is a small strongly, statically typed compile-to-JS language with a number of interesting features, such as:
5−
6−- Type Inference
7−- Higher Kinded Polymorphism
8−- Support for basic Javascript types
9−- Extensible records
10−- Extensible effects
11−- Optimizer rules for generation of efficient Javascript
12−- Pattern matching
13−- Simple FFI
14−- Modules
15−- Rank N Types
16−- Do Notation
17−- Tail-call elimination
18−- Type Classes
19−
20−Motivation
21−----------
22−
23−I was looking for a simple functional language which would compile to JavaScript and have the following characteristics:
24−
25−- Generate simple readable Javascript
26−- Provide the ability to compile to tight loops if necessary
27−- Reasonable type system
28−- Ideally, written in a programming language I would enjoy working in
29−- Provides a simple interface to existing Javascript code
30−
31−I didn't find exactly what I was looking for, so I wrote PureScript. It doesn't have everything right now, but it should serve as a simple core on which to develop new ideas.
32−
33−PureScript was originally designed to implement purely functional core logic. However, recent additions to the compiler and libraries now also make it a good option for general-purpose programming.
34−
35−PureScript can also be seen as a trade-off between a theoretically ideal language and one which generates reasonably high performance code.
36−
37−Hello, PureScript!
38−------------------
39−
40−As an introductory example, here is the usual "Hello World" written in PureScript::
41−
42− module Main where
43−
44− import Debug.Trace
45−
46− main = trace "Hello, World!"
47−
48−which compiles to the following Javascript, ignoring the Prelude::
49−
50− var Main;
51− (function (Main) {
52− var main = trace("Hello, World!");
53− Main.main = main;
54− })(Main = Main || {});
55−
56−The following command will compile and execute the PureScript code above::
57−
58− psc input.purs --main | node
59−
60−Another Example
61−---------------
62−
63−The following code defines a ``Person`` data type and a function to generate a string representation for a ``Person``::
64−
65− data Person = Person { name :: String, age :: Number }
66−
67− showPerson :: Person -> String
68− showPerson (Person o) = o.name ++ ", aged " ++ show o.age
69−
70− examplePerson :: Person
71− examplePerson = Person { name: "Bonnie", age: 26 }
72−
73−Line by line, this reads as follows:
74−
75−- ``Person`` is a data type with one constructor, also called ``Person``
76−- The ``Person`` constructor takes an object with two properties, ``name`` which is a ``String``, and ``age`` which is a ``Number``
77−- The ``showPerson`` function takes a ``Person`` and returns a ``String``
78−- ``showPerson`` works by case analysis on its argument, first matching the constructor ``Person`` and then using string concatenation and object accessors to return its result.
79−- ``examplePerson`` is a Person object, made with the ``Person`` constructor and given the String "Bonnie" for the name value and the Number 26 for the age value.
80−
81−The generated Javascript looks like this::
82−
83− var Person = function (value) {
84− return { ctor: 'Person', values: [value] };
85− };
86−
87− function showPerson(_1) {
88− return _1.values[0].name + ", aged " + numberToString(_1.values[0].age);
89− };
90−
91− var examplePerson = Person({
92− name: "Bonnie",
93− age: 26
94− });
95−
96−Related Projects
97−----------------
98−
99−PureScript might be compared to other AltJS projects such as Roy, Haste, Fay, Elm and GHCJS. Certainly, there is a lot of overlap in terms of syntax, but the goals of PureScript listed above separate it in one or more ways from each of these languages.
100−
101−Roy is probably the most similar language on the list, and was a large influence on the development of PureScript. There are however, key differences in the foreign function interface, the type system and the choice of development language (Haskell vs. Javascript)
102−
103−Projects such as Haste, Fay and GHCJS aim to use some combination of the GHC compiler itself and/or its intermediate representation, Core, to perform some of the tasks involved in compilation such as parsing and type checking. This usually gives the advantage that tools and libraries can be shared with Haskell, but often at the cost of the size of the generated Javascript. This is the main practical difference between PureScript and these projects.
104−
105−Elm also shares a lot in terms of functionality with PureScript. Elm is designed for functional reactive programming, and focusses on tools and language features suitable for that domain, while PureScript focusses on the development of purely functional core application logic. Another difference between PureScript and Elm is PureScript's lack of a runtime system.
106−
docs/source/kinds.rstdeleted−21
@@ -1,21 +0,0 @@
1−Kind System
2−===========
3−
4−The kind system defines the following kinds:
5−
6−- ``*``, the kind of types.
7−- ``!``, the kind of effects.
8−- Arrow kinds ``k1 -> k2``
9−- Row kinds ``# k``
10−
11−Row Kinds
12−---------
13−
14−The kind ``# k`` of rows is used to classify labelled, unordered collections of types of kind ``k``.
15−
16−For example ``# *`` is the kind of rows of types, as used to define records, and ``# !`` is the kind of rows of effects, used to define the monad ``Eff`` of extensible effects.
17−
18−Quantification
19−--------------
20−
21−A type variable can refer to not only a type or a row, but a type constructor, or row constructor etc., and type variables with those kinds can be bound inside a ``forall`` quantifier.
docs/source/modules.rstdeleted−57
@@ -1,57 +0,0 @@
1−Modules
2−=======
3−
4−All code in PureScript is contained in a module. Modules are introduced using the ``module`` keyword::
5−
6− module A where
7−
8− id x = x
9−
10−When referencing values or data types in another module, names may be qualified by using a dot::
11−
12− module B where
13−
14− foo = A.id
15−
16−Importing Modules
17−-----------------
18−
19−A module can be imported using the ``import`` keyword. This will create aliases for all of the values and types in the imported module::
20−
21− module B where
22−
23− import A
24−
25−Alternatively, a list of names to import can be provided in parentheses::
26−
27− module B where
28−
29− import A (runFoo)
30−
31−Values, type constructors and data constructors can all be explicitly imported. A type constructor should be followed by a list of associated data constructors to import in parentheses. A double dot (``..``) can be used to import all data constructors for a given type constructor::
32−
33− module B where
34−
35− import A (runFoo, Foo(..), Bar(Bar))
36−
37−Qualified Imports
38−-----------------
39−
40−Modules can also be imported `qualified`, which means that their names will not be brought directly into scope, but rather, aliased to a different module name. This can be helpful when avoiding naming conflicts::
41−
42− module Main where
43−
44− import qualified Data.Array as A
45−
46− null = ...
47−
48−Here, the name ``null`` would ordinarily conflict with ``null`` from ``Data.Array``, but the qualified import solves this problem. ``Data.Array.null`` can be referenced using ``A.null`` instead.
49−
50−Module Exports
51−--------------
52−
53−Module exports can be restricted to a set of names by providing that set in parentheses in the module declaration::
54−
55− module A (runFoo, Foo(..)) where
56−
57−The types of names which can be exported is the same as for module imports.
docs/source/patterns.rstdeleted−139
@@ -1,139 +0,0 @@
1−Pattern Matching
2−================
3−
4−Pattern matching deconstructs a value to bring zero or more expressions into scope. Pattern matches are introduced with the `case` keyword.
5−
6−Pattern matches have the following general form::
7−
8− case value of
9− pattern -> result
10− ...
11− pattern -> result
12−
13−Pattern matching can also be used in the declaration of functions, as we have already seen::
14−
15− fn pattern_1 ... pattern_n = result
16−
17−Patterns can also be used when introducing functions. For example::
18−
19− example x y z = x * y + z
20−
21−The following pattern types are supported:
22−
23−- Wildcard pattern
24−- Literal patterns
25−- Variable pattern
26−- Array patterns
27−- Cons patterns
28−- Constructor patterns
29−- Record patterns
30−- Named patterns
31−- Guards
32−
33−Patterns need not be exhaustive. A pattern match failed exception will be thrown at runtime if no pattern matches the input.
34−
35−Wildcard Patterns
36−-----------------
37−
38−The wilcard `_` matches any input and brings nothing into scope::
39−
40− f _ = 0
41−
42−Literal Patterns
43−----------------
44−
45−Literal patterns are provided to match on primitives::
46−
47− f true = 0
48− f false = 1
49−
50− g "Foo" = 0
51− g _ = 1
52−
53− h 0 = 0
54− h _ = 1
55−
56−Variable Patterns
57−-----------------
58−
59−A variable pattern matches any input and binds that input to its name::
60−
61− double x = x * 2
62−
63−Array Patterns
64−--------------
65−
66−Array patterns match an input which is an array, and bring its elements into scope. For example::
67−
68− f [x] = x
69− f [x, y] = x * y
70− f _ = 0
71−
72−Here, the first pattern only matches arrays of length one, and brings the first element of the array into scope.
73−
74−The second pattern matches arrays with two elements, and brings the first and second elements into scope.
75−
76−Cons Patterns
77−-------------
78−
79−The head and tail of a non-empty array can be matched by using a cons pattern::
80−
81− sum [] = 0
82− sum (x : xs) = x + sum xs
83−
84−``:`` associates to the right::
85−
86− addPairs (x : y : xs) = x * y + addPairs xs
87− addPairs _ = 0
88−
89−
90−Constructor patterns
91−--------------------
92−
93−Constructor patterns match a data constructor and its arguments::
94−
95− data Foo = Foo String | Bar Number Boolean
96−
97− foo (Foo s) = true
98− foo (Bar _ b) = b
99−
100−Record Patterns
101−---------------
102−
103−Record patterns match an input which is a record, and bring its properties into scope::
104−
105− f { foo = "Foo", bar = n } = n
106− f _ = 0
107−
108−Nested Patterns
109−---------------
110−
111−The patterns above can be combined to create larger patterns. For example::
112−
113− f { arr = x : _, take = "car" } = x
114− f { arr = _ : x : _, take = "cadr" } = x
115− f _ = 0
116−
117−Named Patterns
118−--------------
119−
120−Named patterns bring additional names into scope when using nested patterns. Any pattern can be named by using the ``@`` symbol::
121−
122− f a@(_ : _ : _) = true
123− f _ = false
124−
125−Here, in the first pattern, any array with two or more elements will be matched and bound to the variable ``a``.
126−
127−Guards
128−------
129−
130−Guards are used to impose additional constraints inside a pattern using boolean-valued expressions, and are introduced with a pipe after the pattern::
131−
132− evens [] = 0
133− evens (x : xs) | x % 2 == 0 = 1 + evens xs
134− evens (_ : xs) = evens xs
135−
136−When using patterns to define a function at the top level, guards appear after all patterns::
137−
138− greater x y | x > y = true
139− greater _ _ = false
docs/source/prelude.rstdeleted−429
@@ -1,429 +0,0 @@
1−Module Documentation
2−====================
3−
4−Module Prelude
5−--------------
6−
7−Types
8−~~~~~
9−
10−::
11−
12− data Ordering where
13− LT :: Ordering
14− GT :: Ordering
15− EQ :: Ordering
16−
17− data Unit where
18− Unit :: { } -> Unit
19−
20−Type Classes
21−~~~~~~~~~~~~
22−
23−.. figure:: images/Prelude.png
24− :alt: Prelude
25−
26− Prelude
27−::
28−
29− class Alternative f where
30− empty :: forall a. f a
31− (<|>) :: forall a. f a -> f a -> f a
32−
33− class (Apply f) <= Applicative f where
34− pure :: forall a. a -> f a
35−
36− class (Functor f) <= Apply f where
37− (<*>) :: forall a b. f (a -> b) -> f a -> f b
38−
39− class (Apply m) <= Bind m where
40− (>>=) :: forall a b. m a -> (a -> m b) -> m b
41−
42− class Bits b where
43− (&) :: b -> b -> b
44− (|) :: b -> b -> b
45− (^) :: b -> b -> b
46− shl :: b -> Number -> b
47− shr :: b -> Number -> b
48− zshr :: b -> Number -> b
49− complement :: b -> b
50−
51− class BoolLike b where
52− (&&) :: b -> b -> b
53− (||) :: b -> b -> b
54− not :: b -> b
55−
56− class (Semigroupoid a) <= Category a where
57− id :: forall t. a t t
58−
59− class Eq a where
60− (==) :: a -> a -> Boolean
61− (/=) :: a -> a -> Boolean
62−
63− class Functor f where
64− (<$>) :: forall a b. (a -> b) -> f a -> f b
65−
66− class (Applicative m, Bind m) <= Monad m where
67−
68− class Num a where
69− (+) :: a -> a -> a
70− (-) :: a -> a -> a
71− (*) :: a -> a -> a
72− (/) :: a -> a -> a
73− (%) :: a -> a -> a
74− negate :: a -> a
75−
76− class (Eq a) <= Ord a where
77− compare :: a -> a -> Ordering
78−
79− class Semigroup a where
80− (<>) :: a -> a -> a
81−
82− class Semigroupoid a where
83− (<<<) :: forall b c d. a c d -> a b c -> a b d
84−
85− class Show a where
86− show :: a -> String
87−
88−Type Class Instances
89−~~~~~~~~~~~~~~~~~~~~
90−
91−::
92−
93− instance applicativeArr :: Applicative (Prim.Function r)
94−
95− instance applyArr :: Apply (Prim.Function r)
96−
97− instance bindArr :: Bind (Prim.Function r)
98−
99− instance bitsNumber :: Bits Number
100−
101− instance boolLikeBoolean :: BoolLike Boolean
102−
103− instance categoryArr :: Category Prim.Function
104−
105− instance eqArray :: (Eq a) => Eq [a]
106−
107− instance eqBoolean :: Eq Boolean
108−
109− instance eqNumber :: Eq Number
110−
111− instance eqOrdering :: Eq Ordering
112−
113− instance eqString :: Eq String
114−
115− instance eqUnit :: Eq Unit
116−
117− instance functorArr :: Functor (Prim.Function r)
118−
119− instance monadArr :: Monad (Prim.Function r)
120−
121− instance numNumber :: Num Number
122−
123− instance ordArray :: (Ord a) => Ord [a]
124−
125− instance ordBoolean :: Ord Boolean
126−
127− instance ordNumber :: Ord Number
128−
129− instance ordString :: Ord String
130−
131− instance ordUnit :: Ord Unit
132−
133− instance semigroupArr :: (Semigroup s') => Semigroup (s -> s')
134−
135− instance semigroupString :: Semigroup String
136−
137− instance semigroupUnit :: Semigroup Unit
138−
139− instance semigroupoidArr :: Semigroupoid Prim.Function
140−
141− instance showArray :: (Show a) => Show [a]
142−
143− instance showBoolean :: Show Boolean
144−
145− instance showNumber :: Show Number
146−
147− instance showOrdering :: Show Ordering
148−
149− instance showString :: Show String
150−
151− instance showUnit :: Show Unit
152−
153−Values
154−~~~~~~
155−
156−::
157−
158− (#) :: forall a b. a -> (a -> b) -> b
159−
160− ($) :: forall a b. (a -> b) -> a -> b
161−
162− (++) :: forall s. (Semigroup s) => s -> s -> s
163−
164− (:) :: forall a. a -> [a] -> [a]
165−
166− (<) :: forall a. (Ord a) => a -> a -> Boolean
167−
168− (<=) :: forall a. (Ord a) => a -> a -> Boolean
169−
170− (>) :: forall a. (Ord a) => a -> a -> Boolean
171−
172− (>=) :: forall a. (Ord a) => a -> a -> Boolean
173−
174− (>>>) :: forall a b c d. (Semigroupoid a) => a b c -> a c d -> a b d
175−
176− ap :: forall m a b. (Monad m) => m (a -> b) -> m a -> m b
177−
178− asTypeOf :: forall a. a -> a -> a
179−
180− cons :: forall a. a -> [a] -> [a]
181−
182− const :: forall a b. a -> b -> a
183−
184− flip :: forall a b c. (a -> b -> c) -> b -> a -> c
185−
186− liftA1 :: forall f a b. (Applicative f) => (a -> b) -> f a -> f b
187−
188− liftM1 :: forall m a b. (Monad m) => (a -> b) -> m a -> m b
189−
190− refEq :: forall a. a -> a -> Boolean
191−
192− refIneq :: forall a. a -> a -> Boolean
193−
194− return :: forall m a. (Monad m) => a -> m a
195−
196− unit :: Unit
197−
198− void :: forall f a. (Functor f) => f a -> f Unit
199−
200−Module Data.Function
201−--------------------
202−
203−Types
204−~~~~~
205−
206−::
207−
208− data Fn0 :: * -> *
209−
210− data Fn1 :: * -> * -> *
211−
212− data Fn10 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *
213−
214− data Fn2 :: * -> * -> * -> *
215−
216− data Fn3 :: * -> * -> * -> * -> *
217−
218− data Fn4 :: * -> * -> * -> * -> * -> *
219−
220− data Fn5 :: * -> * -> * -> * -> * -> * -> *
221−
222− data Fn6 :: * -> * -> * -> * -> * -> * -> * -> *
223−
224− data Fn7 :: * -> * -> * -> * -> * -> * -> * -> * -> *
225−
226− data Fn8 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> *
227−
228− data Fn9 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *
229−
230−Values
231−~~~~~~
232−
233−::
234−
235− mkFn0 :: forall a. (Unit -> a) -> Fn0 a
236−
237− mkFn1 :: forall a b. (a -> b) -> Fn1 a b
238−
239− mkFn10 :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k
240−
241− mkFn2 :: forall a b c. (a -> b -> c) -> Fn2 a b c
242−
243− mkFn3 :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d
244−
245− mkFn4 :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e
246−
247− mkFn5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f
248−
249− mkFn6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g
250−
251− mkFn7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h
252−
253− mkFn8 :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i
254−
255− mkFn9 :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j
256−
257− on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c
258−
259− runFn0 :: forall a. Fn0 a -> a
260−
261− runFn1 :: forall a b. Fn1 a b -> a -> b
262−
263− runFn10 :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k
264−
265− runFn2 :: forall a b c. Fn2 a b c -> a -> b -> c
266−
267− runFn3 :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d
268−
269− runFn4 :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e
270−
271− runFn5 :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f
272−
273− runFn6 :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g
274−
275− runFn7 :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h
276−
277− runFn8 :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i
278−
279− runFn9 :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j
280−
281−Module Data.Eq
282−--------------
283−
284−Types
285−~~~~~
286−
287−::
288−
289− data Ref a where
290− Ref :: a -> Ref a
291−
292−Type Class Instances
293−~~~~~~~~~~~~~~~~~~~~
294−
295−::
296−
297− instance eqRef :: Eq (Ref a)
298−
299− instance functorRef :: Functor Ref
300−
301−Values
302−~~~~~~
303−
304−::
305−
306− liftRef :: forall a b. (a -> a -> b) -> Ref a -> Ref a -> b
307−
308−Module Prelude.Unsafe
309−---------------------
310−
311−Values
312−~~~~~~
313−
314−::
315−
316− unsafeIndex :: forall a. [a] -> Number -> a
317−
318−Module Control.Monad.Eff
319−------------------------
320−
321−Types
322−~~~~~
323−
324−::
325−
326− data Eff :: # ! -> * -> *
327−
328− type Pure a = forall e. Eff e a
329−
330−Type Class Instances
331−~~~~~~~~~~~~~~~~~~~~
332−
333−::
334−
335− instance applicativeEff :: Applicative (Eff e)
336−
337− instance applyEff :: Apply (Eff e)
338−
339− instance bindEff :: Bind (Eff e)
340−
341− instance functorEff :: Functor (Eff e)
342−
343− instance monadEff :: Monad (Eff e)
344−
345−Values
346−~~~~~~
347−
348−::
349−
350− bindE :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b
351−
352− forE :: forall e. Number -> Number -> (Number -> Eff e Unit) -> Eff e Unit
353−
354− foreachE :: forall e a. [a] -> (a -> Eff e Unit) -> Eff e Unit
355−
356− returnE :: forall e a. a -> Eff e a
357−
358− runPure :: forall a. Pure a -> a
359−
360− untilE :: forall e. Eff e Boolean -> Eff e Unit
361−
362− whileE :: forall e a. Eff e Boolean -> Eff e a -> Eff e Unit
363−
364−Module Control.Monad.Eff.Unsafe
365−-------------------------------
366−
367−Values
368−~~~~~~
369−
370−::
371−
372− unsafeInterleaveEff :: forall eff1 eff2 a. Eff eff1 a -> Eff eff2 a
373−
374−Module Debug.Trace
375−------------------
376−
377−Types
378−~~~~~
379−
380−::
381−
382− data Trace :: !
383−
384−Values
385−~~~~~~
386−
387−::
388−
389− print :: forall a r. (Show a) => a -> Eff (trace :: Trace | r) Unit
390−
391− trace :: forall r. String -> Eff (trace :: Trace | r) Unit
392−
393−Module Control.Monad.ST
394−-----------------------
395−
396−Types
397−~~~~~
398−
399−::
400−
401− data ST :: * -> !
402−
403− data STArray :: * -> * -> *
404−
405− data STRef :: * -> * -> *
406−
407−Values
408−~~~~~~
409−
410−::
411−
412− modifySTRef :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) a
413−
414− newSTArray :: forall a h r. Number -> a -> Eff (st :: ST h | r) (STArray h a)
415−
416− newSTRef :: forall a h r. a -> Eff (st :: ST h | r) (STRef h a)
417−
418− peekSTArray :: forall a h r. STArray h a -> Eff (st :: ST h | r) a
419−
420− pokeSTArray :: forall a h r. STArray h a -> Number -> a -> Eff (st :: ST h | r) a
421−
422− readSTRef :: forall a h r. STRef h a -> Eff (st :: ST h | r) a
423−
424− runST :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a
425−
426− runSTArray :: forall a r. (forall h. Eff (st :: ST h | r) (STArray h a)) -> Eff r [a]
427−
428− writeSTRef :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a
429−
docs/source/start.rstdeleted−63
@@ -1,63 +0,0 @@
1−Getting Started
2−===============
3−
4−Compiler Installation
5−---------------------
6−
7−If you have the Haskell Plaform installed, then you can install the latest released version from Hackage::
8−
9− cabal update
10− cabal install purescript
11−
12−If you would like to build the latest version of the code, clone this repository and build::
13−
14− git clone git@github.com:purescript/purescript.git
15− cd purescript
16− cabal configure --enable-tests
17− cabal build
18− cabal test
19− cabal install
20−
21−Alternatively, consider installing PureScript in a Cabal sandbox using ``cabal sandbox init``.
22−
23−Creating a new PureScript project
24−---------------------------------
25−
26−You can create a new PureScript project using ``grunt-init`` and `this PureScript project template <https://github.com/purescript-contrib/grunt-init-purescript>`_. This will give you a project that uses `Grunt <http://gruntjs.com>`_ as its build tool and `Bower <http://bower.io>`_ for dependency management. See the `README <https://github.com/purescript-contrib/grunt-init-purescript>`_ for step-by-step instructions.
27−
28−Compiler usage
29−--------------
30−
31−The `psc` executable takes a list of PureScript source files as arguments and by default writes out its errors or output to the console.
32−
33−The following options are supported:
34−
35−--stdin Read input from standard input instead of from files.
36−--output Write the generated Javascript to the specified file.
37−--externs Write a list of foreign imports declarations to the specified file in addition to generating Javascript output.
38−--runtime-type-checks Generate simple runtime type checks for function arguments with simple types.
39−--no-tco Turn off tail-call elimination.
40−--no-prelude Do not include the Prelude in the generated Javascript.
41−--no-magic-do Turn off optimizations which inline calls to ``>>=`` for the ``Eff`` monad.
42−--no-opts Disable all optimizations.
43−--main Generate a call to ``main`` in the specified module after all other generated Javascript. Defaults to ``Main`` if the option is used but no value is provided.
44−--module If specified, any code which is not referenced transitively from this module will be removed. This argument can be used multiple times.
45−--codegen A list of modules for which Javascript and externs should be generated. This argument can be used multiple times.
46−--browser-namespace Specify the namespace that PureScript modules will be exported to when running in the browser.
47−--verbose-errors Generate verbose error messages.
48−
49−psc-make
50−--------
51−
52−The ``psc-make`` executable makes CommonJS modules and supports incremental compilation. Unlike ``psc``, it does not do dead code elimination.
53−
54−The following command line options are supported:
55−
56−--output=VAL The output directory. Default: ``output``.
57−--runtime-type-checks Generate runtime type checks
58−--verbose-errors Display verbose error messages.
59−--help=FMT Show this help in format FMT (``pager``, ``plain``, or ``groff``). Default: ``pager``.
60−--no-magic-do Disable the optimization that overloads the ``do`` keyword to generate efficient code specifically for the ``Eff`` monad.
61−--no-opts Skip the optimization phase.
62−--no-prelude Omit the Prelude.
63−--no-tco Disable tail call optimizations
docs/source/syntax.rstdeleted−266
@@ -1,266 +0,0 @@
1−Syntax
2−======
3−
4−Whitespace Rules
5−----------------
6−
7−Syntax is whitespace sensitive. The general rule of thumb is that declarations which span multiple lines should be indented past the column on which they were first defined on their subsequent lines.
8−
9−That is, the following is valid::
10−
11− foo = bar(x) +
12− baz(x)
13−
14−But this is not::
15−
16− foo = bar(x) +
17− baz(x)
18−
19−Operators
20−---------
21−
22−Binary operators in PureScript are just regular functions. The Prelude defines a number of operators which correspond to Javascript's operators.
23−
24−The Prelude defines the following functions which correspond to Javascript's unary operators:
25−
26−========== ======== =======================
27−Function Operator Meaning
28−========== ======== =======================
29−negate \- Numeric negation
30−not ! Boolean negation
31−complement ~ Binary negation
32−========== ======== =======================
33−
34−and the following binary operators:
35−
36−========== =========== =====================
37−Function JS Operator Meaning
38−========== =========== =====================
39−\+ \+ Numeric addition
40−\- \- Numeric subtraction
41−\* \* Numeric multiplication
42−/ / Numeric division
43−% % Numeric modulus
44−== == Equality check
45−/= != Inequality check
46−< < Less than
47−<= <= Less than or equal
48−> > Greater than
49−>= >= Greater than or equal
50−&& && Boolean AND
51−|| || Boolean OR
52−& & Binary AND
53−\| \| Binary OR
54−^ ^ Binary XOR
55−shl << Shift Left
56−shr >> Shift Right
57−zshr \>>> Zero-Fill Shift Right
58−++ \+ String concatenation
59−========== =========== =====================
60−
61−Literal Values
62−--------------
63−
64−Numeric literals can be integers or floating point numbers. Numbers in hexadecimal notation should be preceded by the characters ``0x``::
65−
66− 16
67− 16.0
68− 0xF0
69−
70−String literals are enclosed in double-quotes and may extend over multiple lines. Line breaks should be surrounded by slashes as follows::
71−
72− "Hello World"
73−
74− "Hello \
75− \World"
76−
77−The two boolean literals are ``true`` and ``false``.
78−
79−Array Literals
80−--------------
81−
82−Array literals are surrounded by square brackets, as in Javascript::
83−
84− []
85− [1, 2, 3]
86−
87−Record Literals
88−---------------
89−
90−Record literals are surrounded by braces, as in Javascript::
91−
92− {}
93− { foo: "Foo", bar: 1 }
94−
95−Array Indexing
96−--------------
97−
98−The ``Prelude.Unsafe`` module defines the ``unsafeIndex`` function which retrieves the element of an array at an index::
99−
100− unsafeIndex :: forall a. [a] -> Number -> a
101−
102−The code generator will turn the expression ``unsafeIndex arr index`` into the simplified Javascript ``arr[index]``.
103−
104−The ``purescript-array`` core library defines an alternative safe version ``!!`` of ``unsafeIndex`` which checks arrays bounds and returns a value of type ``Maybe a``.
105−
106−Property Accessors
107−------------------
108−
109−To access a property of a record, use a dot, followed by the property name, as in Javascript::
110−
111− rec.propertyName
112−
113−Functions
114−---------
115−
116−Functions are introduced by using a backslash followed by a list of argument names::
117−
118− example1 = \a b -> a + b
119−
120−which would correspond to the following Javascript::
121−
122− function example1(a) {
123− return function (b) {
124− return a + b;
125− }
126− }
127−
128−Function application is indicated by just the juxtaposition of a function with its arugments::
129−
130− example1 10 20
131−
132−Functions can also be defined at the top level by providing a list of patterns and an optional guard on the left hand side of the equals sign::
133−
134− f [] [] = []
135− f (x:xs) (y:ys) = x + y : f xs ys
136−
137−If-Then-Else Expressions
138−------------------------
139−
140−The ``if``, ``then`` and ``else`` keywords can be used to create conditional expressions. In this case, the ``else`` block is always required.
141−
142−For example::
143−
144− conditional = if 2 > 1 then "ok" else "oops"
145−
146−Do Notation
147−-----------
148−
149−The ``do`` keyword introduces simple syntactic sugar for monadic expressions.
150−
151−Here is an example, using the maybe monad::
152−
153− data Maybe a = Nothing | Just a
154−
155− isEven :: Number -> Maybe Unit
156− isEven n | n % 2 == 0 = Just unit
157− isEven _ = Nothing
158−
159− evenSum a b = do
160− n <- a
161− m <- b
162− let sum = n + m
163− isEven sum
164− return sum
165−
166−``isEven`` adds two values of type ``Maybe Number`` and returns their sum, if the sum is even. If the sum is odd, ``evenSum`` returns ``Nothing``.
167−
168−When using ``do`` notation, the corresponding type constructor must be an instance of the ``Prelude.Monad`` type class.
169−
170−Statements can have the following form:
171−
172−- ``a <- x`` which desugars to ``x >>= \a -> ...``
173−- ``x`` which desugars to ``x >>= \_ -> ...`` or just ``x`` if this is the last statement.
174−- A let binding ``let a = x`` where ``a`` can be either a name or a binder. Note the lack of the ``in`` keyword.
175−
176−The example ``evenSum`` desugars to::
177−
178− evenSum a b =
179− a >>= \n ->
180− b >>= \m ->
181− let sum = n + m in
182− isEven sum >>= \_ ->
183− return sum
184−
185−Binders can be used on the left hand side of ``<-`` or ``=``. For example::
186−
187− test arr = do
188− (x:y:_) <- arr
189− ret (x + y)
190−
191−A pattern match failure will generate a runtime exception, just as in the case of a regular ``case`` statement.
192−
193−Operators
194−---------
195−
196−User-defined infix operators can be created by enclosing names in parentheses.
197−
198−E.g. to create an infix synonym for the ``Data.Array.range`` function::
199−
200− (..) :: Number -> Number -> [Number]
201− (..) = Data.Array.range
202−
203−This function can be used as follows::
204−
205− oneToTen = 1 .. 10
206−
207−Regular functions can be used as operators by enclosing their names in backticks::
208−
209− foo x y = x * y + y
210−
211− test = 10 `foo` 20
212−
213−Fixity declarations can associate a precedence level, which is a natural number, to a user-defined operator, and specify which way it associates::
214−
215− infix 5 ..
216− infixl 7 %%
217− infixr 9 ^^
218−
219−Record Updates
220−--------------
221−
222−Properties on records can be updated using the following syntax::
223−
224− o { key = value, ..., key = value }
225−
226−For example, the following function increments the ``foo`` property on its argument::
227−
228− incr o = o { foo = o.foo + 1 }
229−
230−Let Bindings
231−------------
232−
233−The ``let`` keywords a collection of local declarations, which may be mutually recursive, and which may include type declarations::
234−
235− factorial :: Number -> Number
236− factorial =
237− let
238− go :: Number -> Number -> Number
239− go acc 1 = acc
240− go acc n = go (acc * n) (n - 1)
241− in
242− go 1
243−
244−The ``where`` keyword can also be used to introduce local declarations `at the end of a value declaration`::
245−
246− factorial :: Number -> Number
247− factorial = go 1
248− where
249− go :: Number -> Number -> Number
250− go acc 1 = acc
251− go acc n = go (acc * n) (n - 1)
252−
253−Comments
254−--------
255−
256−A single line comment starts with ``--``::
257−
258− -- This is a comment
259−
260−Multi-line comments are enclosed in ``{-`` and ``-}``. These can be nested::
261−
262− {- Comment {- nested comment -} continued comment -}
263−
264−
265−
266−
docs/source/typeclasses.rstdeleted−48
@@ -1,48 +0,0 @@
1−Type Classes
2−============
3−
4−PureScript has basic support for type classes via the ``class`` and ``instance`` keywords.
5−
6−Types appearing in class instances are must be of the form ``String``, ``Number``, ``Boolean``, or ``C t1 ... tn`` where ``C`` is a type constructor (including ``[]`` and ``->`` and ``t_i`` are types of the same form).
7−
8−Type class instances are resolved based on the order in which they appeared in the source files. Overlapping instances will result in a compilation error.
9−
10−Example
11−-------
12−
13−Here is an example of the ``Show`` typeclass, with instances for ``String``, ``Booleans`` and ``[]``::
14−
15− class Show a where
16− show :: a -> String
17−
18− instance showString :: Show String where
19− show s = s
20−
21− instance showBoolean :: Show Boolean where
22− show true = "true"
23− show false = "false"
24−
25− instance showArray :: (Show a) => Show [a] where
26− show [] = "[]"
27− show (x:xs) = show x ++ " : " ++ showArray xs
28−
29− example = show [true, false]
30−
31−Superclasses
32−------------
33−
34−Superclass implications can be indicated in a class declaration with a backwards fat arrow ``<=``::
35−
36− class (Monad m) <= MonadFail m where
37− fail :: forall a. String -> m a
38−
39−Superclass instances will be used when searching for an instance of a subclass. For example, in the code below, the ``Monad`` constraint introduced by the ``return`` function can be discharged since ``Monad`` is a superclass of ``MonadFail``::
40−
41− assert :: forall m. (MonadFail m) => Boolean -> m Unit
42− assert true = return unit
43− assert false = fail "Assertion failed"
44−
45−Type Annotations
46−----------------
47−
48−A constrained type will never be inferred for a top-level declaration without an explicit type signature.
docs/source/types.rstdeleted−173
@@ -1,173 +0,0 @@
1−Types
2−=====
3−
4−The type system defines the following types:
5−
6−- Primitive Types: Number, String, Boolean
7−- Arrays
8−- Records
9−- Tagged Unions
10−- Newtypes
11−- Functions
12−- Polymorphic Types
13−- Constrained Types
14−- Type Synonyms
15−- Rows
16−
17−Primitive Types
18−---------------
19−
20−The three primitive types ``String``, ``Number`` and ``Boolean`` correspond to their Javascript equivalents at runtime.
21−
22−Arrays
23−------
24−
25−PureScript arrays correspond to Javascript arrays at runtime, but all elements in an array must have the same type.
26−
27−Records
28−-------
29−
30−PureScript records correspond to Javascript objects. They may have zero or more named fields, each with their own types.
31−
32−Tagged Unions
33−-------------
34−
35−Tagged unions consist of one or more constructors, each of which takes zero or more arguments.
36−
37−Tagged unions can only be created using their constructors, and deconstructed through pattern matching (see later).
38−
39−For example::
40−
41− data Foo a = Foo | Bar String
42−
43− runFoo Foo = "It's a Foo"
44− runFoo (Bar s) = "It's a Bar. The string is " ++ s
45−
46− test = runFoo Foo ++ runFoo (Bar "Test")
47−
48−In the example, Foo is a tagged union type which has two constructors. It's first constructor ``Foo`` takes no argument, and it's second ``Bar`` takes one, which must be a String.
49−
50−``runFoo`` is an example of pattern matching on a tagged union type to discover its constructor, and the last line shows how to construct values of type ``Foo``.
51−
52−Newtypes
53−--------
54−
55−Newtypes are like data types introduced with the ``data`` keyword, but are restricted to a single contructor which contains a single arguments. Newtypes are introduced with the ``newtype`` keyword::
56−
57− newtype Percentage = Percentage Number
58−
59−The representation of a newtype at runtime is the same as the underlying data type. For example, a value of type ``Percentage`` is just a JavaScript number at runtime.
60−
61−Newtypes can be assigned their own type class instances, so for example, ``Percentage`` can be given its own ``Show`` instance::
62−
63− instance showPercentage :: Show Percentage where
64− show (Percentage n) = show n ++ "%"
65−
66−Functions
67−---------
68−
69−Functions in PureScript are like their Javascript counterparts, but always have exactly one argument.
70−
71−Polymorphic Types
72−-----------------
73−
74−Expressions defined at the top level may have polymorphic types.
75−
76−Here is an example::
77−
78− identity x = x
79−
80−``identity`` is inferred to have (polymorphic) type ``forall t0. t0 -> t0``. This means that for any type ``t0``, ``identity`` can be given a value of type ``t0`` and will give back a value of the same type.
81−
82−A type annotation can also be provided::
83−
84− identity :: forall a. a -> a
85− identity x = x
86−
87−Row Polymorphism
88−----------------
89−
90−Polymorphism is not limited to abstracting over types. Values may also be polymorphic in types with other kinds, such as rows or effects (see "Kind System").
91−
92−For example, the following function accesses two properties on a record::
93−
94− addProps o = o.foo + o.bar
95−
96−The inferred type of ``addProps`` is::
97−
98− forall r. { foo :: Number, bar :: Number | r } -> Number
99−
100−Here, the type variable ``r`` has kind ``# *`` - it represents a `row` of `types`. It can be instantiated with any row of named types.
101−
102−In other words, ``addProps`` accepts any record which has properties ``foo`` and ``bar``, and *any other record properties*.
103−
104−Therefore, the following application compiles::
105−
106− addProps { foo: 1, bar: 2, baz: 3 }
107−
108−even though the type of ``addProps`` does not mention the property ``baz``. However, the following does not compile::
109−
110− addProps { foo: 1 }
111−
112−since the ``bar`` property is missing.
113−
114−Rank N Types
115−------------
116−
117−It is also possible for the ``forall`` quantifier to appear on the left of a function arrow, inside types record fields and data constructors, and in type synonyms.
118−
119−In most cases, a type annotation is necessary when using this feature.
120−
121−As an example, we can pass a polymorphic function as an argument to another function::
122−
123− poly :: (forall a. a -> a) -> Boolean
124− poly f = (f 0 < 1) == f true
125−
126−Notice that the polymorphic function's type argument is instantiated to both ``Number`` and ``Boolean``.
127−
128−An argument to ``poly`` must indeed be polymorphic. For example, the following fails::
129−
130− test = poly (\n -> n + 1)
131−
132−since the skolemized type variable ``a`` does not unify with ``Number``.
133−
134−Rows
135−----
136−
137−A row of types represents an unordered collection of named types without duplicates.
138−
139−Rows have kind ``# k`` for some kind ``k``, and so values do not have types which are rows. Rather, rows can be used in type signatures to define record types or other type where labelled, unordered types are useful.
140−
141−To denote a closed row, separate the fields with commas, with each label separated from its type with a double colon::
142−
143− (name :: String, age :: Number)
144−
145−It may be necessary, depending on the context, to surround a row in parentheses.
146−
147−To denote an open row (i.e. one which may unify with another row to add new fields), separate the specified terms from a row variable by a pipe::
148−
149− (name :: String, age :: Number | r)
150−
151−Type Synonyms
152−-------------
153−
154−For convenience, it is possible to declare a synonym for a type using the ``type`` keyword. Type synonyms can include type arguments.
155−
156−For example::
157−
158− type Foo = { foo :: Number, bar :: Number }
159−
160− addFoo :: Foo -> Number
161− addFoo = \o -> o.foo + o.bar
162−
163−Constrained Types
164−-----------------
165−
166−Polymorphic types may be predicated on one or more ``constraints``. See the chapter on type classes for more information.
167−
168−Type Annotations
169−----------------
170−
171−Most types can be inferred (not including Rank N Types and constrained types), but annotations can optionally be provided using a double-colon::
172−
173− one = 1 :: Number
examples/failing/1310.pursnew file+18
@@ -0,0 +1,18 @@
1+-- @shouldFailWith NoInstanceFound
2+
3+module Issue1310 where
4+
5+import Prelude
6+import Control.Monad.Eff
7+import Control.Monad.Eff.Console
8+
9+class Inject f g where
10+ inj :: forall a. f a -> g a
11+
12+instance inject :: Inject f f where
13+ inj x = x
14+
15+foreign import data Oops :: !
16+
17+main :: forall eff. Eff (oops :: Oops | eff) Unit
18+main = inj (log "Oops")
examples/failing/365.pursnew file+14
@@ -0,0 +1,14 @@
1+-- @shouldFailWith CycleInDeclaration
2+module Main where
3+
4+import Prelude
5+
6+class C a where
7+ f :: a -> a
8+ g :: a -> a
9+
10+instance cS :: C String where
11+ f s = s
12+ g = f
13+
14+main = g "Done"
examples/failing/438.pursnew file+15
@@ -0,0 +1,15 @@
1+-- @shouldFailWith PossiblyInfiniteInstance
2+
3+-- See issue 438 for details: this test is mainly here to test that code like
4+-- this doesn't cause the compiler to loop.
5+
6+module Main where
7+
8+import Prelude
9+
10+data Fix f = In (f (Fix f))
11+
12+instance eqFix :: (Eq (f (Fix f))) => Eq (Fix f) where
13+ eq (In f) (In g) = f == g
14+
15+example = In [] == In []
examples/failing/ArrayType.purs+4−1
@@ -1,6 +1,9 @@
1+-- @shouldFailWith TypesDoNotUnify
2+
1module Main where
3module Main where
2
4
3−import Debug.Trace
5+import Prelude
6+import Control.Monad.Eff.Console
4
7
5bar :: Number -> Number -> Number
8bar :: Number -> Number -> Number
6bar n m = n + m
9bar n m = n + m
examples/failing/Arrays.purs+5−2
@@ -1,5 +1,8 @@
1+-- @shouldFailWith TypesDoNotUnify
1module Main where
2module Main where
2
3
3− import Prelude
4+import Prelude
4
5
6+foreign import (!!) :: forall a. Array a -> Int -> a
7+
5− test = \arr -> arr !! (0 !! 0)
8+test = \arr -> arr !! (0 !! 0)
examples/failing/CaseDoesNotMatchAllConstructorArgs.pursnew file+15
@@ -0,0 +1,15 @@
1+-- @shouldFailWith IncorrectConstructorArity
2+module Main where
3+
4+import Prelude
5+
6+data Person = Person String Int
7+
8+data TwoPeople = Two Person Person
9+
10+getName p = case p of
11+ (Two (Person n) (Person n2 a2)) -> n
12+ _ -> "Unknown"
13+
14+
15+name = getName (Two (Person "Jimmy" 20) (Person "" 1))
examples/failing/Do.purs+4
@@ -1,5 +1,9 @@
1+-- @shouldFailWith InvalidDoBind
2+-- @shouldFailWith InvalidDoLet
1module Main where
3module Main where
2
4
5+import Prelude
6+
3test1 = do let x = 1
7test1 = do let x = 1
4
8
5test2 y = do x <- y
9test2 y = do x <- y
examples/failing/DoNotSuggestComposition.pursnew file+13
@@ -0,0 +1,13 @@
1+-- @shouldFailWith TypesDoNotUnify
2+-- TODO: Check that this does not produce a "function composition is (<<<)"
3+-- suggestion.
4+module DoNotSuggestComposition where
5+
6+import Prelude
7+
8+x = { y: 3 }
9+
10+foo :: String -> String
11+foo y = y
12+
13+bar = foo x
examples/failing/DoNotSuggestComposition2.pursnew file+7
@@ -0,0 +1,7 @@
1+-- @shouldFailWith CannotApplyFunction
2+-- TODO: Check that this does not produce a "function composition is (<<<)"
3+-- suggestion.
4+
5+module DoNotSuggestComposition2 where
6+
7+foo = let x = { y: 3 } in x 2
examples/failing/DuplicateDeclarationsInLet.pursnew file+12
@@ -0,0 +1,12 @@
1+-- @shouldFailWith OverlappingNamesInLet
2+module Main where
3+
4+import Prelude
5+
6+foo = a
7+ where
8+ a :: Number
9+ a = 1
10+
11+ a :: Number
12+ a = 2
examples/failing/DuplicateProperties1.pursnew file+12
@@ -0,0 +1,12 @@
1+-- @shouldFailWith TypesDoNotUnify
2+module DuplicateProperties where
3+
4+import Prelude
5+
6+foreign import data Test :: # * -> *
7+
8+foreign import subtractX :: forall r. Test (x :: Unit | r) -> Test r
9+
10+foreign import hasX :: Test (x :: Unit, y :: Unit)
11+
12+baz = subtractX (subtractX hasX)
examples/failing/DuplicateProperties2.pursnew file+12
@@ -0,0 +1,12 @@
1+-- @shouldFailWith DuplicateLabel
2+module DuplicateProperties where
3+
4+import Prelude
5+
6+foreign import data Test :: # * -> *
7+
8+foreign import subtractX :: forall r. Test (x :: Unit | r) -> Test r
9+
10+foreign import hasX :: forall r. Test (x :: Unit, y :: Unit | r)
11+
12+baz = subtractX (subtractX hasX)
examples/failing/DuplicateTypeVars.pursnew file+6
@@ -0,0 +1,6 @@
1+-- @shouldFailWith DuplicateTypeArgument
2+module Main where
3+
4+import Prelude
5+
6+type Foo a a = a
examples/failing/Eff.pursnew file+13
@@ -0,0 +1,13 @@
1+-- @shouldFailWith TypesDoNotUnify
2+module Main where
3+
4+import Prelude
5+import Control.Monad.Eff
6+import Control.Monad.ST
7+import Control.Monad.Eff.Console
8+
9+test = pureST (do
10+ ref <- newSTRef 0
11+ log "ST"
12+ modifySTRef ref $ \n -> n + 1
13+ readSTRef ref)
examples/failing/EmptyCase.pursnew file+4
@@ -0,0 +1,4 @@
1+-- @shouldFailWith ErrorParsingModule
2+module Main where
3+
4+error err = case err of \_ -> 1
examples/failing/EmptyDo.pursnew file+6
@@ -0,0 +1,6 @@
1+-- @shouldFailWith ErrorParsingModule
2+
3+module Main where
4+
5+main = do
6+
examples/failing/ExtraRecordField.pursnew file+10
@@ -0,0 +1,10 @@
1+-- @shouldFailWith PropertyIsMissing
2+-- TODO: Make this fail with a new error ExtraProperty instead.
3+module ExtraRecordField where
4+
5+import Prelude ((<>))
6+
7+full :: { first :: String, last :: String } -> String
8+full p = p.first <> " " <> p.last
9+
10+oops = full { first: "Jane", last: "Smith", age: 29 }
examples/failing/Foldable.pursnew file+17
@@ -0,0 +1,17 @@
1+-- @shouldFailWith CycleInDeclaration
2+module Main where
3+
4+import Prelude
5+
6+class Foldable f where
7+ fold :: forall a b. (a -> b -> b) -> b -> f a -> b
8+ size :: forall a. f a -> Number
9+
10+data L a = C a (L a) | N
11+
12+instance foldableL :: Foldable L where
13+ fold _ z N = z
14+ fold f z (C x xs) = x `f` (fold f z xs)
15+ size = fold (const ((+) 1.0)) 0.0
16+
17+x = size (C 1 (C 2 (C 3 N)))
examples/failing/ImportHidingModule.pursnew file+10
@@ -0,0 +1,10 @@
1+-- @shouldFailWith ImportHidingModule
2+module A where
3+ x = 1
4+
5+module B (module B, module A) where
6+ import A
7+ y = 1
8+
9+module C where
10+ import B hiding (module A)
examples/failing/InfiniteKind.pursnew file+5
@@ -0,0 +1,5 @@
1+-- @shouldFailWith InfiniteKind
2+
3+module Main where
4+
5+data F a = F (a a)
examples/failing/InfiniteType.pursnew file+5
@@ -0,0 +1,5 @@
1+-- @shouldFailWith InfiniteType
2+
3+module Main where
4+
5+f a = a a
examples/failing/InstanceExport.pursnew file+19
@@ -0,0 +1,19 @@
1+-- @shouldFailWith TransitiveExportError
2+module InstanceExport (S(..), f) where
3+
4+import Prelude
5+
6+newtype S = S String
7+
8+class F a where
9+ f :: a -> String
10+
11+instance fs :: F S where
12+ f (S s) = s
13+
14+module Test where
15+
16+import InstanceExport
17+import Prelude
18+
19+test = f $ S "Test"
examples/failing/KindError.purs+4−1
@@ -1,3 +1,6 @@
1+-- @shouldFailWith KindsDoNotUnify
1module Main where
2module Main where
2
3
4+import Prelude
5+
3− data KindError f a = One f | Two (f a)
6+data KindError f a = One f | Two (f a)
examples/failing/KindStar.pursnew file+8
@@ -0,0 +1,8 @@
1+-- @shouldFailWith ExpectedType
2+
3+module X where
4+
5+data List a = Nil | Cons a (List a)
6+
7+test :: List
8+test = Nil
examples/failing/LeadingZeros1.pursnew file+6
@@ -0,0 +1,6 @@
1+-- @shouldFailWith ErrorParsingModule
2+module Main where
3+
4+import Prelude
5+
6+x = 01
examples/failing/LeadingZeros2.pursnew file+6
@@ -0,0 +1,6 @@
1+-- @shouldFailWith ErrorParsingModule
2+module Main where
3+
4+import Prelude
5+
6+x = 00.1
examples/failing/Let.purs+3
@@ -1,3 +1,6 @@
1+-- @shouldFailWith CycleInDeclaration
1module Main where
2module Main where
2
3
4+import Prelude
5+
3test = let x = x in x
6test = let x = x in x
examples/failing/MPTCs.purs+3
@@ -1,5 +1,8 @@
1+-- @shouldFailWith KindsDoNotUnify
1module Main where
2module Main where
2
3
4+import Prelude
5+
3class Foo a where
6class Foo a where
4 f :: a -> a
7 f :: a -> a
5
8
examples/failing/MissingClassExport.pursnew file+7
@@ -0,0 +1,7 @@
1+-- @shouldFailWith TransitiveExportError
2+module Test (bar) where
3+
4+import Prelude
5+
6+class Foo a where
7+ bar :: a -> a
examples/failing/MissingClassMemberExport.pursnew file+7
@@ -0,0 +1,7 @@
1+-- @shouldFailWith TransitiveExportError
2+module Test (Foo) where
3+
4+import Prelude
5+
6+class Foo a where
7+ bar :: a -> a
examples/failing/MissingRecordField.pursnew file+11
@@ -0,0 +1,11 @@
1+-- @shouldFailWith TypesDoNotUnify
2+-- TODO: Update type checker to make this fail with PropertyIsMissing instead.
3+module MissingRecordField where
4+
5+import Prelude ((>))
6+
7+john = { first: "John", last: "Smith" }
8+
9+isOver50 p = p.age > 50.0
10+
11+result = isOver50 john
examples/failing/MultipleErrors.pursnew file+13
@@ -0,0 +1,13 @@
1+-- @shouldFailWith TypesDoNotUnify
2+-- @shouldFailWith TypesDoNotUnify
3+module MultipleErrors where
4+
5+import Prelude
6+
7+foo :: Int -> Int
8+foo 0 = "Test"
9+foo n = bar (n - 1)
10+
11+bar :: Int -> Int
12+bar 0 = "Test"
13+bar n = foo (n - 1)
examples/failing/MultipleErrors2.pursnew file+9
@@ -0,0 +1,9 @@
1+-- @shouldFailWith UnknownValue
2+-- @shouldFailWith UnknownValue
3+module MultipleErrors2 where
4+
5+import Prelude
6+
7+foo = itDoesntExist
8+
9+bar = neitherDoesThis
examples/failing/MutRec.purs+3
@@ -1,5 +1,8 @@
1+-- @shouldFailWith CycleInDeclaration
1module MutRec where
2module MutRec where
2
3
4+import Prelude
5+
3x = y
6x = y
4
7
5y = x
8y = x
examples/failing/MutRec2.purs+3
@@ -1,3 +1,6 @@
1+-- @shouldFailWith CycleInDeclaration
1module Main where
2module Main where
2
3
4+import Prelude
5+
3x = x
6x = x
examples/failing/NewtypeMultiArgs.purs+4−1
@@ -1,3 +1,6 @@
1+-- @shouldFailWith InvalidNewtype
1module Main where
2module Main where
2
3
4+import Prelude
5+
3−newtype Thing = Thing String Boolean
6+newtype Thing = Thing String Boolean
examples/failing/NewtypeMultiCtor.purs+4−1
@@ -1,3 +1,6 @@
1+-- @shouldFailWith InvalidNewtype
1module Main where
2module Main where
2
3
4+import Prelude
5+
3−newtype Thing = Thing String | Other
6+newtype Thing = Thing String | Other
examples/failing/NoOverlap.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3−data Foo = Foo
4−
5−instance showFoo1 :: Show Foo where
6− show _ = "Foo"
7−
8−instance showFoo2 :: Show Foo where
9− show _ = "Bar"
10−
11−test = show Foo
examples/failing/NullaryAbs.purs+4−1
@@ -1,3 +1,6 @@
1+-- @shouldFailWith ErrorParsingModule
1module Main where
2module Main where
2
3
4+import Prelude
5+
3− func = \ -> "no"
6+func = \ -> "no"
examples/failing/Object.purs+3
@@ -1,5 +1,8 @@
1+-- @shouldFailWith PropertyIsMissing
1module Main where
2module Main where
2
3
4+import Prelude
5+
3test o = o.foo
6test o = o.foo
4
7
5test1 = test {}
8test1 = test {}
examples/failing/OrphanInstance.pursnew file+12
@@ -0,0 +1,12 @@
1+-- @shouldFailWith OrphanInstance
2+module Class where
3+
4+ class C a where
5+ op :: a -> a
6+
7+module Test where
8+
9+ import Class
10+
11+ instance cBoolean :: C Boolean where
12+ op a = a
examples/failing/OverlappingArguments.pursnew file+6
@@ -0,0 +1,6 @@
1+-- @shouldFailWith OverlappingArgNames
2+module OverlappingArguments where
3+
4+import Prelude
5+
6+f x x = x
examples/failing/OverlappingBinders.pursnew file+9
@@ -0,0 +1,9 @@
1+-- @shouldFailWith OverlappingArgNames
2+module OverlappingBinders where
3+
4+import Prelude
5+
6+data S a = S a (S a)
7+
8+f x = case x of
9+ (S y (S y@(S z zs))) -> y
examples/failing/OverlappingReExport.pursnew file+10
@@ -0,0 +1,10 @@
1+-- @shouldFailWith DuplicateValueExport
2+module A where
3+ x = true
4+
5+module B where
6+ x = false
7+
8+module C (module A, module M2) where
9+ import A
10+ import qualified B as M2
examples/failing/OverlappingVars.purs+3
@@ -1,5 +1,8 @@
1+-- @shouldFailWith NoInstanceFound
1module Main where
2module Main where
2
3
4+import Prelude
5+
3class OverlappingVars a where
6class OverlappingVars a where
4 f :: a -> a
7 f :: a -> a
5
8
examples/failing/Rank2Types.purs+4−3
@@ -1,7 +1,8 @@
1+-- @shouldFailWith TypesDoNotUnify
1module Main where
2module Main where
2
3
3− import Prelude
4+import Prelude
4
5
5− foreign import test :: (forall a. a -> a) -> Number
6+foreign import test :: (forall a. a -> a) -> Number
6
7
7− test1 = test (\n -> n + 1)
8+test1 = test (\n -> n + 1)
examples/failing/Reserved.purs+3
@@ -1,4 +1,7 @@
1+-- @shouldFailWith ErrorParsingModule
1module Main where
2module Main where
2
3
4+import Prelude
5+
3(<) :: Number -> Number -> Number
6(<) :: Number -> Number -> Number
4(<) a b = !(a >= b)
7(<) a b = !(a >= b)
examples/failing/RowConstructors1.pursnew file+9
@@ -0,0 +1,9 @@
1+-- @shouldFailWith KindsDoNotUnify
2+module Main where
3+
4+import Prelude
5+
6+data Foo = Bar
7+type Baz = { | Foo }
8+
9+main = Control.Monad.Eff.Console.log "Done"
examples/failing/RowConstructors2.pursnew file+9
@@ -0,0 +1,9 @@
1+-- @shouldFailWith KindsDoNotUnify
2+module Main where
3+
4+import Prelude
5+
6+type Foo r = (x :: Number | r)
7+type Bar = { | Foo }
8+
9+main = Control.Monad.Eff.Console.log "Done"
examples/failing/RowConstructors3.pursnew file+9
@@ -0,0 +1,9 @@
1+-- @shouldFailWith KindsDoNotUnify
2+module Main where
3+
4+import Prelude
5+
6+type Foo = { x :: Number }
7+type Bar = { | Foo }
8+
9+main = Control.Monad.Eff.Console.log "Done"
examples/failing/SkolemEscape.purs+5−2
@@ -1,5 +1,8 @@
1+-- @shouldFailWith EscapedSkolem
1module Main where
2module Main where
2
3
3− foreign import foo :: (forall a. a -> a) -> Number
4+import Prelude
4
5
6+foreign import foo :: (forall a. a -> a) -> Number
7+
5− test = \x -> foo x
8+test = \x -> foo x
examples/failing/SkolemEscape2.purs+2−1
@@ -1,3 +1,4 @@
1+-- @shouldFailWith EscapedSkolem
1module Main where
2module Main where
2
3
3import Prelude
4import Prelude
@@ -6,4 +7,4 @@ import Control.Monad.ST
6
7
7test _ = do
8test _ = do
8 r <- runST (newSTRef 0)
9 r <- runST (newSTRef 0)
9− return 0
10+ return 0
examples/failing/SuggestComposition.pursnew file+7
@@ -0,0 +1,7 @@
1+-- @shouldFailWith TypesDoNotUnify
2+-- TODO: Ensure the correct suggestion is produced.
3+module SuggestComposition where
4+
5+import Prelude
6+
7+f = g . g where g = (+1)
examples/failing/Superclasses1.purs+3
@@ -1,5 +1,8 @@
1+-- @shouldFailWith NoInstanceFound
1module Main where
2module Main where
2
3
4+import Prelude
5+
3class Su a where
6class Su a where
4 su :: a -> a
7 su :: a -> a
5
8
examples/failing/Superclasses2.purs+4
@@ -1,5 +1,9 @@
1+-- @shouldFailWith CycleInTypeSynonym
2+-- TODO: Should this have its own error, perhaps CycleInTypeClassDeclaration?
1module CycleInSuperclasses where
3module CycleInSuperclasses where
2
4
5+import Prelude
6+
3class (Foo a) <= Bar a
7class (Foo a) <= Bar a
4
8
5class (Bar a) <= Foo a
9class (Bar a) <= Foo a
examples/failing/Superclasses3.purs+3
@@ -1,5 +1,8 @@
1+-- @shouldFailWith UndefinedTypeVariable
1module UnknownSuperclassTypeVar where
2module UnknownSuperclassTypeVar where
2
3
4+import Prelude
5+
3class Foo a
6class Foo a
4
7
5class (Foo b) <= Bar a
8class (Foo b) <= Bar a
examples/failing/Superclasses5.pursnew file+25
@@ -0,0 +1,25 @@
1+-- @shouldFailWith NoInstanceFound
2+
3+module Main where
4+
5+import Prelude
6+
7+class Su a where
8+ su :: a -> a
9+
10+class (Su (Array a)) <= Cl a where
11+ cl :: a -> a -> a
12+
13+instance suNumber :: Su Number where
14+ su n = n + 1.0
15+
16+instance suArray :: (Su a) => Su (Array a) where
17+ su [x] = [su x]
18+
19+instance clNumber :: Cl Number where
20+ cl n m = n + m
21+
22+test :: forall a. (Cl a) => a -> Array a
23+test x = su [cl x x]
24+
25+main = Control.Monad.Eff.Console.print $ test 10.0
examples/failing/TopLevelCaseNoArgs.pursnew file+8
@@ -0,0 +1,8 @@
1+-- @shouldFailWith DuplicateValueDeclaration
2+module Main where
3+
4+import Prelude
5+
6+foo :: Number
7+foo = 1
8+foo = 2
examples/failing/TypeClassInstances.purs+3
@@ -1,5 +1,8 @@
1+-- @shouldFailWith MissingClassMember
1module Main where
2module Main where
2
3
4+import Prelude
5+
3class A a where
6class A a where
4 a :: a -> String
7 a :: a -> String
5 b :: a -> Number
8 b :: a -> Number
examples/failing/TypeClasses2.purs+1
@@ -1,3 +1,4 @@
1+-- @shouldFailWith NoInstanceFound
1module Main where
2module Main where
2
3
3import Prelude ()
4import Prelude ()
examples/failing/TypeError.purs+3−2
@@ -1,5 +1,6 @@
1+-- @shouldFailWith TypesDoNotUnify
1module Main where
2module Main where
2
3
3− import Prelude
4+import Prelude
4
5
5− test = 1 ++ "A"
6+test = 1 ++ "A"
examples/failing/TypeSynonyms.purs+4−1
@@ -1,5 +1,8 @@
1+-- @shouldFailWith CycleInTypeSynonym
1module Main where
2module Main where
2
3
4+import Prelude
5+
3−type T1 = [T2]
6+type T1 = Array T2
4
7
5type T2 = T1
8type T2 = T1
examples/failing/TypeSynonyms2.purs+3
@@ -1,5 +1,8 @@
1+-- @shouldFailWith TypeSynonymInstance
1module Main where
2module Main where
2
3
4+import Prelude
5+
3class Foo a where
6class Foo a where
4 foo :: a -> String
7 foo :: a -> String
5
8
examples/failing/TypeSynonyms3.purs+3
@@ -1,5 +1,8 @@
1+-- @shouldFailWith TypeSynonymInstance
1module Main where
2module Main where
2
3
4+import Prelude
5+
3class Foo a where
6class Foo a where
4 foo :: a -> String
7 foo :: a -> String
5
8
examples/failing/TypeSynonyms4.pursnew file+11
@@ -0,0 +1,11 @@
1+-- @shouldFailWith PartiallyAppliedSynonym
2+module TypeSynonyms4 where
3+
4+import Prelude
5+
6+type F x y = x -> y
7+
8+type G x = F x
9+
10+f :: G String String -> String
11+f k = k "Done"
examples/failing/TypeSynonyms5.pursnew file+6
@@ -0,0 +1,6 @@
1+-- @shouldFailWith CycleInTypeSynonym
2+module Main where
3+
4+import Prelude
5+
6+type T = T
examples/failing/TypeWildcards1.pursnew file+7
@@ -0,0 +1,7 @@
1+-- @shouldFailWith ErrorParsingModule
2+module TypeWildcards where
3+
4+import Prelude
5+
6+type Test = _
7+
examples/failing/TypeWildcards2.pursnew file+7
@@ -0,0 +1,7 @@
1+-- @shouldFailWith ErrorParsingModule
2+module TypeWildcards where
3+
4+import Prelude
5+
6+data Test = Test _
7+
examples/failing/TypeWildcards3.pursnew file+10
@@ -0,0 +1,10 @@
1+-- @shouldFailWith ErrorParsingModule
2+module TypeWildcards where
3+
4+import Prelude
5+
6+data Foo a = Foo
7+
8+instance showFoo :: Show (Foo _) where
9+ show Foo = "Foo"
10+
examples/failing/UnderscoreModuleName.pursnew file+6
@@ -0,0 +1,6 @@
1+-- @shouldFailWith ErrorParsingModule
2+module Bad_Module where
3+
4+import Prelude
5+
6+main = Control.Monad.Eff.Console.log "Done"
examples/failing/UnifyInTypeInstanceLookup.purs+5
@@ -1,5 +1,10 @@
1+-- @shouldFailWith NoInstanceFound
2+-- See issue #390.
3+-- TODO: Improve this error.
1module Main where
4module Main where
2
5
6+import Prelude
7+
3data Z = Z
8data Z = Z
4data S n = S n
9data S n = S n
5
10
examples/failing/UnknownType.purs+4−1
@@ -1,4 +1,7 @@
1+-- @shouldFailWith UnknownType
1module Main where
2module Main where
2
3
4+import Prelude
5+
3test :: Number -> Something
6test :: Number -> Something
4−test = {}
7+test = {}
examples/failing/UnknownValue.pursdeleted−25
@@ -1,25 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−import Control.Monad.ST
6−import Debug.Trace
7−
8−test = runSTArray (do
9− a <- newSTArray 2 0
10− pokeSTArray a 0 1
11− pokeSTArray a 1 2
12− return a)
13−
14−fromTo lo hi = runSTArray (do
15− arr <- newSTArray (hi - lo + 1) 0
16− (let
17− go lo hi _ arr | lo > hi = return arr
18− go lo hi i arr = do
19− pokeSTArray arrr i lo
20− go (lo + 1) hi (i + 1) arr
21− in go lo hi 0 arr))
22−
23−main = do
24− let t1 = runPure (fromTo 10 20)
25− trace "Done"
examples/manual/QualifiedNames.pursnew file+13
@@ -0,0 +1,13 @@
1+module Data.Either where
2+
3+import Prelude
4+
5+data Either a b = Left a | Right b
6+
7+module Main where
8+
9+either :: forall a b c. (a -> c) -> (b -> c) -> Data.Either.Either a b -> c
10+either f _ (Data.Either.Left x) = f x
11+either _ g (Data.Either.Right y) = g y
12+
13+main = Control.Monad.Eff.Console.log (either id id (Data.Either.Left "Done"))
examples/manual/failing/ArgLengthMismatch.purs+4−2
@@ -1,4 +1,6 @@
1module ArgLengthMismatch where
1module ArgLengthMismatch where
2
2
3+import Prelude
4+
3− f x y = true
5+f x y = true
4− f = false
6+f = false
examples/manual/failing/ExportExplicit.purs+4−2
@@ -1,5 +1,7 @@
1-- should fail as z does not exist in the module
1-- should fail as z does not exist in the module
2module M1 (x, y, z) where
2module M1 (x, y, z) where
3
3
4+import Prelude
5+
4− x = 1
6+x = 1
5− y = 2
7+y = 2
examples/manual/failing/ExportExplicit1.purs+3−3
@@ -5,10 +5,10 @@ module M1 (X(X)) where
5module Main where
5module Main where
6
6
7 import M1
7 import M1
8−
8+
9 testX = X
9 testX = X
10−
10+
11 -- should fail as Y constructor is not exported from M1
11 -- should fail as Y constructor is not exported from M1
12 testY = Y
12 testY = Y
13
13
14− main = Debug.Trace.trace "Done"
14+ main = Control.Monad.Eff.Console.log "Done"
examples/manual/failing/ExportExplicit2.purs+4−2
@@ -1,5 +1,7 @@
1-- should fail as Y is not a data constructor for X
1-- should fail as Y is not a data constructor for X
2module M1 (X(Y)) where
2module M1 (X(Y)) where
3
3
4+import Prelude
5+
4− data X = X
6+data X = X
5− data Y = Y
7+data Y = Y
examples/manual/failing/ExportExplicit3.purs+2−2
@@ -6,8 +6,8 @@ module M1 (X(..)) where
6module Main where
6module Main where
7
7
8 import M1
8 import M1
9−
9+
10 -- should fail as Z is not exported from M1
10 -- should fail as Z is not exported from M1
11 testZ = M1.Z
11 testZ = M1.Z
12
12
13− main = Debug.Trace.trace "Done"
13+ main = Control.Monad.Eff.Console.log "Done"
examples/manual/failing/OrphanTypeDecl.purs+1−1
@@ -1,3 +1,3 @@
1module OrphanTypeDecl where
1module OrphanTypeDecl where
2
2
3− fn :: Number -> Boolean
3+fn :: Number -> Boolean
examples/manual/failing/RedefinedFixity.purs+6−4
@@ -1,6 +1,8 @@
1module RedefinedFixity where
1module RedefinedFixity where
2
2
3+import Prelude
4+
3− (!?) x y = x + y
5+(!?) x y = x + y
4−
6+
5− infix 2 !?
7+infix 2 !?
6− infix 2 !?
8+infix 2 !?
examples/manual/failing/RequiredHiddenType.purs+5−5
@@ -1,8 +1,8 @@
1-- exporting `a` should fail as `A` is hidden
1-- exporting `a` should fail as `A` is hidden
2module Foo (B(..), a, b) where
2module Foo (B(..), a, b) where
3
3
4− data A = A
4+data A = A
5− data B = B
5+data B = B
6−
6+
7− a = A
7+a = A
8− b = B
8+b = B
examples/manual/passing/ExportExplicit.purs+3−3
@@ -3,7 +3,7 @@ module M1 (X(X), Z(..), foo) where
3 data X = X | Y
3 data X = X | Y
4 data Z = Z
4 data Z = Z
5
5
6− foo :: Number
6+ foo :: Number
7 foo = 0
7 foo = 0
8
8
9 bar :: Number
9 bar :: Number
@@ -12,9 +12,9 @@ module M1 (X(X), Z(..), foo) where
12module Main where
12module Main where
13
13
14 import M1
14 import M1
15−
15+
16 testX = X
16 testX = X
17 testZ = Z
17 testZ = Z
18 testFoo = foo
18 testFoo = foo
19
19
20− main = Debug.Trace.trace "Done"
20+ main = Control.Monad.Eff.Console.log "Done"
examples/manual/passing/ExportExplicit2.purs+2−2
@@ -1,6 +1,6 @@
1module M1 (bar) where
1module M1 (bar) where
2
2
3− foo :: Number
3+ foo :: Number
4 foo = 0
4 foo = 0
5
5
6 bar :: Number
6 bar :: Number
@@ -12,4 +12,4 @@ module Main where
12
12
13 testBar = bar
13 testBar = bar
14
14
15− main = Debug.Trace.trace "Done"
15+ main = Control.Monad.Eff.Console.log "Done"
examples/manual/passing/ExportedInstanceDeclarations.pursnew file+43
@@ -0,0 +1,43 @@
1+
2+-- Tests that instances for non-exported classes / types do not appear in the
3+-- result of `exportedDeclarations`.
4+
5+module ExportedInstanceDeclarations
6+ ( Const(..)
7+ , Foo
8+ , foo
9+ ) where
10+
11+import Prelude
12+
13+data Const a b = Const a
14+
15+class Foo a where
16+ foo :: a
17+
18+data NonexportedType = NonexportedType
19+
20+class NonexportedClass a where
21+ notExported :: a
22+
23+-- There are three places that a nonexported type or type class can occur,
24+-- leading an instance to count as non-exported:
25+-- * Constraints
26+-- * The type class itself
27+-- * The instance types
28+
29+-- Case 1: constraints
30+instance nonExportedFoo :: (NonexportedClass a) => Foo a where
31+ foo = notExported
32+
33+-- Another instance of case 1:
34+instance nonExportedFoo2 :: (Foo NonexportedType) => Foo (a -> a) where
35+ foo = id
36+
37+-- Case 2: type class
38+instance nonExportedNonexportedType :: NonexportedClass (Const Number a) where
39+ notExported = Const 0
40+
41+-- Case 3: instance types
42+instance constFoo :: Foo (Const NonexportedType b) where
43+ foo = Const NonexportedType
examples/manual/passing/Import.purs+2−2
@@ -13,7 +13,7 @@ module M2 where
13 import M1
13 import M1
14
14
15 main = \_ -> foo 42
15 main = \_ -> foo 42
16−
16+
17module Main where
17module Main where
18
18
19−main = Debug.Trace.trace "Done"
19+main = Control.Monad.Eff.Console.log "Done"
examples/manual/passing/ImportExplicit.purs+2−2
@@ -7,8 +7,8 @@ module Main where
7
7
8 import M1 (X(..))
8 import M1 (X(..))
9
9
10− testX :: X
10+ testX :: X
11 testX = X
11 testX = X
12 testY = Y
12 testY = Y
13
13
14− main = Debug.Trace.trace "Done"
14+ main = Control.Monad.Eff.Console.log "Done"
examples/manual/passing/ImportQualified.purs+5−5
@@ -1,12 +1,12 @@
1module M1 where
1module M1 where
2−
2+
3− trace x = x
3+ log x = x
4
4
5module Main where
5module Main where
6
6
7 import Prelude
7 import Prelude
8 import Control.Monad.Eff
8 import Control.Monad.Eff
9 import M1
9 import M1
10− import qualified Debug.Trace as T
10+ import qualified Control.Monad.Eff.Console as C
11−
11+
12− main = T.trace (trace "Done")
12+ main = C.log (log "Done")
examples/manual/passing/Module.purs+2−2
@@ -22,7 +22,7 @@ module M2 where
22
22
23 match :: M1.Foo -> String
23 match :: M1.Foo -> String
24 match = \f -> case f of M1.Foo s -> s ++ "foo"
24 match = \f -> case f of M1.Foo s -> s ++ "foo"
25−
25+
26module Main where
26module Main where
27
27
28−main = Debug.Trace.trace "Done"
28+main = Control.Monad.Eff.Console.log "Done"
examples/manual/passing/ModuleDeps.purs+2−2
@@ -11,7 +11,7 @@ bar = M3.baz
11module M3 where
11module M3 where
12
12
13baz = 1
13baz = 1
14−
14+
15module Main where
15module Main where
16
16
17−main = Debug.Trace.trace "Done"
17+main = Control.Monad.Eff.Console.log "Done"
examples/manual/passing/RedefinedFixity.purs+1−1
@@ -21,4 +21,4 @@ import M2
21
21
22module Main where
22module Main where
23
23
24−main = Debug.Trace.trace "Done"
24+main = Control.Monad.Eff.Console.log "Done"
examples/manual/passing/ShadowedName.pursnew file+10
@@ -0,0 +1,10 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff.Console
5+
6+done :: String
7+done = let str = "Not yet done" in
8+ let str = "Done" in str
9+
10+main = Control.Monad.Eff.Console.log done
examples/manual/passing/TransitiveImport.pursnew file+24
@@ -0,0 +1,24 @@
1+module Test where
2+
3+ import Prelude
4+
5+ class TestCls a where
6+ test :: a -> a
7+
8+ instance unitTestCls :: TestCls Unit where
9+ test _ = unit
10+
11+module Middle where
12+
13+ middle = Test.test
14+
15+module Main where
16+
17+ import Prelude
18+ import Middle
19+ import Control.Monad.Eff.Console
20+
21+ main = do
22+ print (middle unit)
23+ trace "Done"
24+ return unit
examples/manual/passing/WildcardType.pursnew file+13
@@ -0,0 +1,13 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff.Console
5+
6+f1 :: (_ -> _) -> _
7+f1 g = g 1
8+
9+f2 :: _ -> _
10+f2 _ = "Done"
11+
12+main = Control.Monad.Eff.Console.log $ f1 f2
13+
examples/passing/652.pursnew file+17
@@ -0,0 +1,17 @@
1+module Main where
2+
3+import Prelude
4+
5+class Foo a b
6+
7+class Bar a c
8+
9+class (Foo a b, Bar a c) <= Baz a b c
10+
11+instance foo :: Foo (a -> b) a
12+
13+instance bar :: Bar (a -> b) b
14+
15+instance baz :: (Eq a) => Baz (a -> b) a b
16+
17+main = Control.Monad.Eff.Console.log "Done"
examples/passing/810.pursnew file+13
@@ -0,0 +1,13 @@
1+module Main where
2+
3+import Prelude
4+
5+data Maybe a = Nothing | Just a
6+
7+test :: forall a. Maybe a -> Maybe a
8+test m = o.x
9+ where
10+ o = case m of Nothing -> { x : Nothing }
11+ Just a -> { x : Just a }
12+
13+main = Control.Monad.Eff.Console.log "Done"
examples/passing/862.pursnew file+8
@@ -0,0 +1,8 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff.Console
5+
6+id' = (\x -> x) <$> \y -> y
7+
8+main = log (id' "Done")
examples/passing/922.pursnew file+20
@@ -0,0 +1,20 @@
1+module Main where
2+
3+import Prelude
4+
5+import Control.Monad.Eff.Console
6+
7+class Default a where
8+ def :: a
9+
10+instance defaultString :: Default String where
11+ def = "Done"
12+
13+data I a = I a
14+
15+instance defaultI :: (Default a) => Default (I a) where
16+ def = I def
17+
18+main = do
19+ case def of
20+ I s -> log s
examples/passing/Applicative.purs+4−4
@@ -4,13 +4,13 @@ import Prelude ()
4
4
5class Applicative f where
5class Applicative f where
6 pure :: forall a. a -> f a
6 pure :: forall a. a -> f a
7− (<*>) :: forall a b. f (a -> b) -> f a -> f b
7+ apply :: forall a b. f (a -> b) -> f a -> f b
8
8
9data Maybe a = Nothing | Just a
9data Maybe a = Nothing | Just a
10
10
11instance applicativeMaybe :: Applicative Maybe where
11instance applicativeMaybe :: Applicative Maybe where
12 pure = Just
12 pure = Just
13− (<*>) (Just f) (Just a) = Just (f a)
13+ apply (Just f) (Just a) = Just (f a)
14− (<*>) _ _ = Nothing
14+ apply _ _ = Nothing
15
15
16−main = Debug.Trace.trace "Done"
16+main = Control.Monad.Eff.Console.log "Done"
examples/passing/ArrayType.purs+4−2
@@ -1,9 +1,11 @@
1module Main where
1module Main where
2
2
3+import Prelude
4+
3class Pointed p where
5class Pointed p where
4 point :: forall a. a -> p a
6 point :: forall a. a -> p a
5
7
6−instance pointedArray :: Pointed [] where
8+instance pointedArray :: Pointed Array where
7 point a = [a]
9 point a = [a]
8
10
9−main = Debug.Trace.trace "Done"
11+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Arrays.pursdeleted−24
@@ -1,24 +0,0 @@
1−module Main where
2−
3−import Prelude.Unsafe (unsafeIndex)
4−
5−test1 arr = arr `unsafeIndex` 0 + arr `unsafeIndex` 1 + 1
6−
7−test2 = \arr -> case arr of
8− [x, y] -> x + y
9− [x] -> x
10− [] -> 0
11− (x : y : _) -> x + y
12−
13−data Tree = One Number | Some [Tree]
14−
15−test3 = \tree sum -> case tree of
16− One n -> n
17− Some (n1 : n2 : rest) -> test3 n1 sum * 10 + test3 n2 sum * 5 + sum rest
18−
19−test4 = \arr -> case arr of
20− [] -> 0
21− [_] -> 0
22− x : y : xs -> x * y + test4 xs
23−
24−main = Debug.Trace.trace "Done"
examples/passing/Auto.purs+9−7
@@ -1,13 +1,15 @@
1module Main where
1module Main where
2
2
3− data Auto s i o = Auto { state :: s, step :: s -> i -> o }
3+import Prelude
4
4
5− type SomeAuto i o = forall r. (forall s. Auto s i o -> r) -> r
5+data Auto s i o = Auto { state :: s, step :: s -> i -> o }
6
6
7− exists :: forall s i o. s -> (s -> i -> o) -> SomeAuto i o
7+type SomeAuto i o = forall r. (forall s. Auto s i o -> r) -> r
8− exists = \state step f -> f (Auto { state: state, step: step })
9
8
10− run :: forall i o. SomeAuto i o -> i -> o
9+exists :: forall s i o. s -> (s -> i -> o) -> SomeAuto i o
11− run = \s i -> s (\a -> case a of Auto a -> a.step a.state i)
10+exists = \state step f -> f (Auto { state: state, step: step })
12
11
13− main = Debug.Trace.trace "Done"
12+run :: forall i o. SomeAuto i o -> i -> o
13+run = \s i -> s (\a -> case a of Auto a -> a.step a.state i)
14+
15+main = Control.Monad.Eff.Console.log "Done"
examples/passing/AutoPrelude.purs+5−4
@@ -1,8 +1,9 @@
1module Main where
1module Main where
2
2
3−import Debug.Trace
3+import Prelude
4+import Control.Monad.Eff.Console
4
5
5−f x = x * 10
6+f x = x * 10.0
6−g y = y - 10
7+g y = y - 10.0
7
8
8−main = trace $ show $ (f <<< g) 100
9+main = log $ show $ (f <<< g) 100.0
examples/passing/AutoPrelude2.purs+3−2
@@ -1,9 +1,10 @@
1module Main where
1module Main where
2
2
3+import Prelude
3import qualified Prelude as P
4import qualified Prelude as P
4−import Debug.Trace
5+import Control.Monad.Eff.Console
5
6
6f :: forall a. a -> a
7f :: forall a. a -> a
7f = P.id
8f = P.id
8
9
9−main = P.($) trace ((f P.<<< f) "Done")
10+main = P.($) log ((f P.<<< f) "Done")
examples/passing/BindersInFunctions.purs+6−11
@@ -1,16 +1,11 @@
1module Main where
1module Main where
2
2
3import Prelude
3import Prelude
4+import Test.Assert
4
5
5−tail = \(_:xs) -> xs
6+snd = \[_, y] -> y
6
7
7−foreign import error
8− "function error(msg) {\
9− \ throw msg;\
10− \}" :: forall a. String -> a
11−
12−main =
8+main = do
13− let ts = tail [1, 2, 3] in
9+ let ts = snd [1.0, 2.0]
14− if ts == [2, 3]
15− then Debug.Trace.trace "Done"
16− else error "Incorrect result from 'tails'."
10+ assert' "Incorrect result from 'snd'." (ts == 2.0)
11+ Control.Monad.Eff.Console.log "Done"
examples/passing/BindingGroups.pursnew file+10
@@ -0,0 +1,10 @@
1+module Main where
2+
3+import Prelude
4+
5+foo = bar
6+ where bar r = r + 1.0
7+
8+r = foo 2.0
9+
10+main = Control.Monad.Eff.Console.log "Done"
examples/passing/BlockString.pursnew file+8
@@ -0,0 +1,8 @@
1+module Main where
2+
3+import Prelude
4+
5+foo :: String
6+foo = """foo"""
7+
8+main = Control.Monad.Eff.Console.log "Done"
examples/passing/CaseInDo.pursnew file+19
@@ -0,0 +1,19 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff.Console
5+import Control.Monad.Eff
6+
7+doIt :: forall eff. Eff eff Boolean
8+doIt = return true
9+
10+set = do
11+ log "Testing..."
12+ case 0 of
13+ 0 -> doIt
14+ _ -> return false
15+
16+main = do
17+ b <- set
18+ case b of
19+ true -> log "Done"
examples/passing/CaseStatement.pursnew file+21
@@ -0,0 +1,21 @@
1+module Main where
2+
3+import Prelude
4+
5+data A = A | B | C
6+
7+f a _ A = a
8+f _ a B = a
9+f _ _ C = "Done"
10+
11+g a _ A = a
12+g _ b B = b
13+g _ _ C = C
14+
15+data M a = N | J a
16+
17+h f N a = a
18+h f a N = a
19+h f (J a) (J b) = J (f a b)
20+
21+main = Control.Monad.Eff.Console.log $ f "Done" "Failed" A
examples/passing/CheckFunction.pursnew file+7
@@ -0,0 +1,7 @@
1+module Main where
2+
3+import Prelude
4+
5+test = ((\x -> x+1.0) >>> (\x -> x*2.0)) 4.0
6+
7+main = Control.Monad.Eff.Console.log "Done"
examples/passing/CheckSynonymBug.purs+6−8
@@ -1,14 +1,12 @@
1module Main where
1module Main where
2
2
3− import Prelude
3+import Prelude
4
4
5− type Foo a = [a]
5+length :: forall a. Array a -> Int
6+length _ = 0
6
7
7− foreign import length
8+type Foo a = Array a
8− "function length(a) {\
9− \ return a.length;\
10− \}" :: forall a. [a] -> Number
11
9
12− foo _ = length ([] :: Foo Number)
10+foo _ = length ([] :: Foo Number)
13
11
14− main = Debug.Trace.trace "Done"
12+main = Control.Monad.Eff.Console.log "Done"
examples/passing/CheckTypeClass.pursnew file+18
@@ -0,0 +1,18 @@
1+module Main where
2+
3+import Prelude
4+
5+data Bar a = Bar
6+data Baz
7+
8+class Foo a where
9+ foo :: Bar a -> Baz
10+
11+foo_ :: forall a. (Foo a) => a -> Baz
12+foo_ x = foo ((mkBar :: forall a. (Foo a) => a -> Bar a) x)
13+
14+mkBar :: forall a. a -> Bar a
15+mkBar _ = Bar
16+
17+main = Control.Monad.Eff.Console.log "Done"
18+
examples/passing/Church.purs+10−10
@@ -1,18 +1,18 @@
1module Main where
1module Main where
2
2
3− import Prelude ()
3+import Prelude ()
4
4
5− type List a = forall r. r -> (a -> r -> r) -> r
5+type List a = forall r. r -> (a -> r -> r) -> r
6
6
7− empty :: forall a. List a
7+empty :: forall a. List a
8− empty = \r f -> r
8+empty = \r f -> r
9
9
10− cons :: forall a. a -> List a -> List a
10+cons :: forall a. a -> List a -> List a
11− cons = \a l r f -> f a (l r f)
11+cons = \a l r f -> f a (l r f)
12
12
13− append :: forall a. List a -> List a -> List a
13+append :: forall a. List a -> List a -> List a
14− append = \l1 l2 r f -> l2 (l1 r f) f
14+append = \l1 l2 r f -> l2 (l1 r f) f
15
15
16− test = append (cons 1 empty) (cons 2 empty)
16+test = append (cons 1 empty) (cons 2 empty)
17
17
18− main = Debug.Trace.trace "Done"
18+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Collatz.purs+3−3
@@ -4,15 +4,15 @@ import Prelude
4import Control.Monad.Eff
4import Control.Monad.Eff
5import Control.Monad.ST
5import Control.Monad.ST
6
6
7−collatz :: Number -> Number
7+collatz :: Int -> Int
8collatz n = runPure (runST (do
8collatz n = runPure (runST (do
9 r <- newSTRef n
9 r <- newSTRef n
10 count <- newSTRef 0
10 count <- newSTRef 0
11 untilE $ do
11 untilE $ do
12 modifySTRef count $ (+) 1
12 modifySTRef count $ (+) 1
13 m <- readSTRef r
13 m <- readSTRef r
14− writeSTRef r $ if m % 2 == 0 then m / 2 else 3 * m + 1
14+ writeSTRef r $ if m `mod` 2 == 0 then m / 2 else 3 * m + 1
15 return $ m == 1
15 return $ m == 1
16 readSTRef count))
16 readSTRef count))
17
17
18−main = Debug.Trace.print $ collatz 1000
18+main = Control.Monad.Eff.Console.print $ collatz 1000
examples/passing/Comparisons.purs+7−15
@@ -1,23 +1,15 @@
1module Main where
1module Main where
2
2
3+import Prelude
3import Control.Monad.Eff
4import Control.Monad.Eff
4−import Debug.Trace
5+import Control.Monad.Eff.Console
5−
6+import Test.Assert
6−foreign import data Assert :: !
7−
8−foreign import assert
9− "function assert(x) {\
10− \ return function () {\
11− \ if (!x) throw new Error('assertion failed');\
12− \ return {};\
13− \ };\
14− \};" :: forall e. Boolean -> Eff (assert :: Assert | e) Unit
15
7
16main = do
8main = do
17− assert (1 < 2)
9+ assert (1.0 < 2.0)
18− assert (2 == 2)
10+ assert (2.0 == 2.0)
19− assert (3 > 1)
11+ assert (3.0 > 1.0)
20 assert ("a" < "b")
12 assert ("a" < "b")
21 assert ("a" == "a")
13 assert ("a" == "a")
22 assert ("z" > "a")
14 assert ("z" > "a")
23− trace "Done!"
15+ log "Done!"
examples/passing/Conditional.purs+4−4
@@ -1,9 +1,9 @@
1module Main where
1module Main where
2
2
3− import Prelude ()
3+import Prelude ()
4
4
5− fns = \f -> if f true then f else \x -> x
5+fns = \f -> if f true then f else \x -> x
6
6
7− not = \x -> if x then false else true
7+not = \x -> if x then false else true
8
8
9− main = Debug.Trace.trace "Done"
9+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Console.purs+5−5
@@ -2,12 +2,12 @@ module Main where
2
2
3import Prelude
3import Prelude
4import Control.Monad.Eff
4import Control.Monad.Eff
5−import Debug.Trace
5+import Control.Monad.Eff.Console
6
6
7replicateM_ :: forall m a. (Monad m) => Number -> m a -> m {}
7replicateM_ :: forall m a. (Monad m) => Number -> m a -> m {}
8−replicateM_ 0 _ = return {}
8+replicateM_ 0.0 _ = return {}
9replicateM_ n act = do
9replicateM_ n act = do
10 act
10 act
11− replicateM_ (n - 1) act
11+ replicateM_ (n - 1.0) act
12−
12+
13−main = replicateM_ 10 (trace "Hello World!")
13+main = replicateM_ 10.0 (log "Hello World!")
examples/passing/DataAndType.purs+3−1
@@ -1,7 +1,9 @@
1module Main where
1module Main where
2
2
3+import Prelude
4+
3data A = A B
5data A = A B
4
6
5type B = A
7type B = A
6
8
7−main = Debug.Trace.trace "Done"
9+main = Control.Monad.Eff.Console.log "Done"
examples/passing/DeepArrayBinder.pursnew file+16
@@ -0,0 +1,16 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff
5+import Test.Assert
6+
7+data List a = Cons a (List a) | Nil
8+
9+match2 :: List Number -> Number
10+match2 (Cons x (Cons y xs)) = x * y + match2 xs
11+match2 _ = 0.0
12+
13+main = do
14+ let result = match2 (Cons 1.0 (Cons 2.0 (Cons 3.0 (Cons 4.0 (Cons 5.0 (Cons 6.0 (Cons 7.0 (Cons 8.0 (Cons 9.0 Nil)))))))))
15+ assert' "Incorrect result!" (result == 100.0)
16+ Control.Monad.Eff.Console.log "Done"
examples/passing/DeepCase.purs+7−6
@@ -1,14 +1,15 @@
1module Main where
1module Main where
2
2
3−import Debug.Trace
3+import Prelude
4+import Control.Monad.Eff.Console
4import Control.Monad.Eff
5import Control.Monad.Eff
5import Control.Monad.ST
6import Control.Monad.ST
6
7
7−f x y =
8+f x y =
8 let
9 let
9− g = case y of
10+ g = case y of
10− 0 -> x
11+ 0.0 -> x
11− x -> 1 + x * x
12+ x -> 1.0 + x * x
12 in g + x + y
13 in g + x + y
13
14
14−main = print $ f 1 10
15+main = print $ f 1.0 10.0
examples/passing/Do.purs+18−18
@@ -5,19 +5,19 @@ import Prelude
5data Maybe a = Nothing | Just a
5data Maybe a = Nothing | Just a
6
6
7instance functorMaybe :: Functor Maybe where
7instance functorMaybe :: Functor Maybe where
8− (<$>) f Nothing = Nothing
8+ map f Nothing = Nothing
9− (<$>) f (Just x) = Just (f x)
9+ map f (Just x) = Just (f x)
10
10
11instance applyMaybe :: Apply Maybe where
11instance applyMaybe :: Apply Maybe where
12− (<*>) (Just f) (Just x) = Just (f x)
12+ apply (Just f) (Just x) = Just (f x)
13− (<*>) _ _ = Nothing
13+ apply _ _ = Nothing
14
14
15instance applicativeMaybe :: Applicative Maybe where
15instance applicativeMaybe :: Applicative Maybe where
16 pure = Just
16 pure = Just
17
17
18instance bindMaybe :: Bind Maybe where
18instance bindMaybe :: Bind Maybe where
19− (>>=) Nothing _ = Nothing
19+ bind Nothing _ = Nothing
20− (>>=) (Just a) f = f a
20+ bind (Just a) f = f a
21
21
22instance monadMaybe :: Prelude.Monad Maybe
22instance monadMaybe :: Prelude.Monad Maybe
23
23
@@ -25,26 +25,26 @@ test1 = \_ -> do
25 Just "abc"
25 Just "abc"
26
26
27test2 = \_ -> do
27test2 = \_ -> do
28− (x : _) <- Just [1, 2, 3]
28+ x <- Just 1.0
29− (y : _) <- Just [4, 5, 6]
29+ y <- Just 2.0
30 Just (x + y)
30 Just (x + y)
31
31
32test3 = \_ -> do
32test3 = \_ -> do
33− Just 1
33+ Just 1.0
34 Nothing :: Maybe Number
34 Nothing :: Maybe Number
35− Just 2
35+ Just 2.0
36
36
37test4 mx my = do
37test4 mx my = do
38 x <- mx
38 x <- mx
39 y <- my
39 y <- my
40− Just (x + y + 1)
40+ Just (x + y + 1.0)
41
41
42test5 mx my mz = do
42test5 mx my mz = do
43 x <- mx
43 x <- mx
44 y <- my
44 y <- my
45 let sum = x + y
45 let sum = x + y
46 z <- mz
46 z <- mz
47− Just (z + sum + 1)
47+ Just (z + sum + 1.0)
48
48
49test6 mx = \_ -> do
49test6 mx = \_ -> do
50 let
50 let
@@ -54,14 +54,14 @@ test6 mx = \_ -> do
54
54
55test8 = \_ -> do
55test8 = \_ -> do
56 Just (do
56 Just (do
57− Just 1)
57+ Just 1.0)
58
58
59−test9 = \_ -> (+) <$> Just 1 <*> Just 2
59+test9 = \_ -> (+) <$> Just 1.0 <*> Just 2.0
60
60
61test10 _ = do
61test10 _ = do
62 let
62 let
63− f x = g x * 3
63+ f x = g x * 3.0
64− g x = f x / 2
64+ g x = f x / 2.0
65− Just (f 10)
65+ Just (f 10.0)
66
66
67−main = Debug.Trace.trace "Done"
67+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Dollar.purs+2−2
@@ -12,5 +12,5 @@ id x = x
12test1 x = id $ id $ id $ id $ x
12test1 x = id $ id $ id $ id $ x
13
13
14test2 x = id id $ id x
14test2 x = id id $ id x
15−
15+
16−main = Debug.Trace.trace "Done"
16+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Eff.purs+12−6
@@ -3,17 +3,23 @@ module Main where
3import Prelude
3import Prelude
4import Control.Monad.Eff
4import Control.Monad.Eff
5import Control.Monad.ST
5import Control.Monad.ST
6−import Debug.Trace
6+import Control.Monad.Eff.Console
7
7
8test1 = do
8test1 = do
9− trace "Line 1"
9+ log "Line 1"
10− trace "Line 2"
10+ log "Line 2"
11
11
12test2 = runPure (runST (do
12test2 = runPure (runST (do
13− ref <- newSTRef 0
13+ ref <- newSTRef 0.0
14− modifySTRef ref $ \n -> n + 1
14+ modifySTRef ref $ \n -> n + 1.0
15 readSTRef ref))
15 readSTRef ref))
16
16
17+test3 = pureST (do
18+ ref <- newSTRef 0.0
19+ modifySTRef ref $ \n -> n + 1.0
20+ readSTRef ref)
21+
17main = do
22main = do
18 test1
23 test1
19− Debug.Trace.print test2
24+ Control.Monad.Eff.Console.print test2
25+ Control.Monad.Eff.Console.print test3
examples/passing/EmptyDataDecls.purs+5−16
@@ -1,30 +1,19 @@
1module Main where
1module Main where
2
2
3import Prelude
3import Prelude
4+import Test.Assert
4
5
5data Z
6data Z
6data S n
7data S n
7
8
8−data ArrayBox n a = ArrayBox [a]
9+data ArrayBox n a = ArrayBox (Array a)
9
10
10nil :: forall a. ArrayBox Z a
11nil :: forall a. ArrayBox Z a
11nil = ArrayBox []
12nil = ArrayBox []
12
13
13−foreign import concat
14− "function concat(l1) {\
15− \ return function (l2) {\
16− \ return l1.concat(l2);\
17− \ };\
18− \}" :: forall a. [a] -> [a] -> [a]
19−
20cons' :: forall a n. a -> ArrayBox n a -> ArrayBox (S n) a
14cons' :: forall a n. a -> ArrayBox n a -> ArrayBox (S n) a
21−cons' x (ArrayBox xs) = ArrayBox $ concat [x] xs
15+cons' x (ArrayBox xs) = ArrayBox $ append [x] xs
22−
23−foreign import error
24− "function error(msg) {\
25− \ throw msg;\
26− \}" :: forall a. String -> a
27
16
28main = case cons' 1 $ cons' 2 $ cons' 3 nil of
17main = case cons' 1 $ cons' 2 $ cons' 3 nil of
29− ArrayBox [1, 2, 3] -> Debug.Trace.trace "Done"
18+ ArrayBox [1, 2, 3] -> Control.Monad.Eff.Console.log "Done"
30− _ -> error "Failed"
19+ _ -> assert' "Failed" false
examples/passing/EmptyRow.pursnew file+10
@@ -0,0 +1,10 @@
1+module Main where
2+
3+import Prelude
4+
5+data Foo r = Foo { | r }
6+
7+test :: Foo ()
8+test = Foo {}
9+
10+main = Control.Monad.Eff.Console.log "Done"
examples/passing/EmptyTypeClass.purs+3−3
@@ -4,9 +4,9 @@ import Prelude
4
4
5class Partial
5class Partial
6
6
7−head :: forall a. (Partial) => [a] -> a
7+head :: forall a. (Partial) => Array a -> a
8−head (x:xs) = x
8+head [x] = x
9
9
10instance allowPartials :: Partial
10instance allowPartials :: Partial
11
11
12−main = Debug.Trace.trace $ head ["Done"]
12+main = Control.Monad.Eff.Console.log $ head ["Done"]
examples/passing/EqOrd.purs+4−3
@@ -1,5 +1,7 @@
1module Main where
1module Main where
2
2
3+import Prelude
4+
3data Pair a b = Pair a b
5data Pair a b = Pair a b
4
6
5instance ordPair :: (Ord a, Ord b) => Ord (Pair a b) where
7instance ordPair :: (Ord a, Ord b) => Ord (Pair a b) where
@@ -8,7 +10,6 @@ instance ordPair :: (Ord a, Ord b) => Ord (Pair a b) where
8 r -> r
10 r -> r
9
11
10instance eqPair :: (Eq a, Eq b) => Eq (Pair a b) where
12instance eqPair :: (Eq a, Eq b) => Eq (Pair a b) where
11− (==) (Pair a1 b1) (Pair a2 b2) = a1 == a2 && b1 == b2
13+ eq (Pair a1 b1) (Pair a2 b2) = a1 == a2 && b1 == b2
12− (/=) (Pair a1 b1) (Pair a2 b2) = a1 /= a2 || b1 /= b2
13
14
14−main = Debug.Trace.print $ Pair 1 2 == Pair 1 2
15+main = Control.Monad.Eff.Console.print $ Pair 1.0 2.0 == Pair 1.0 2.0
examples/passing/ExplicitImportReExport.pursnew file+16
@@ -0,0 +1,16 @@
1+-- from #1244
2+module Foo where
3+
4+ foo :: Int
5+ foo = 3
6+
7+module Bar (module Foo) where
8+
9+ import Foo
10+
11+module Baz where
12+
13+ import Bar (foo)
14+
15+ baz :: Int
16+ baz = foo
examples/passing/ExtendedInfixOperators.pursnew file+14
@@ -0,0 +1,14 @@
1+module Main where
2+
3+import Prelude
4+
5+comparing :: forall a b. (Ord b) => (a -> b) -> a -> a -> Ordering
6+comparing f = compare `Data.Function.on` f
7+
8+null [] = true
9+null _ = false
10+
11+test = [1.0, 2.0, 3.0] `comparing null` [4.0, 5.0, 6.0]
12+
13+main = do
14+ Control.Monad.Eff.Console.print test
examples/passing/ExternData.pursdeleted−13
@@ -1,13 +0,0 @@
1−module Main where
2−
3− foreign import data IO :: * -> *
4−
5− foreign import bind "function bind() {}" :: forall a b. IO a -> (a -> IO b) -> IO b
6−
7− foreign import showMessage "function showMessage() {}" :: String -> IO { }
8−
9− foreign import prompt "function prompt() {}" :: IO String
10−
11− test _ = prompt `bind` \s -> showMessage s
12−
13− main = Debug.Trace.trace "Done"
examples/passing/ExternRaw.pursdeleted−13
@@ -1,13 +0,0 @@
1−module Main where
2−
3−foreign import first "function first(xs) { return xs[0]; }" :: forall a. [a] -> a
4−
5−foreign import loop "function loop() { while (true) {} }" :: forall a. a
6−
7−foreign import concat "function concat(xs) { \
8− \ return function(ys) { \
9− \ return xs.concat(ys); \
10− \ };\
11− \}" :: forall a. [a] -> [a] -> [a]
12−
13−main = Debug.Trace.trace "Done"
examples/passing/FFI.pursdeleted−11
@@ -1,11 +0,0 @@
1−module Main where
2−
3−foreign import foo
4− "function foo(s) {\
5− \ return s;\
6− \}" :: String -> String
7−
8−bar :: String -> String
9−bar _ = foo "test"
10−
11−main = Debug.Trace.trace "Done"
examples/passing/Fib.purs+4−4
@@ -5,11 +5,11 @@ import Control.Monad.Eff
5import Control.Monad.ST
5import Control.Monad.ST
6
6
7main = runST (do
7main = runST (do
8− n1 <- newSTRef 1
8+ n1 <- newSTRef 1.0
9− n2 <- newSTRef 1
9+ n2 <- newSTRef 1.0
10− whileE ((>) 1000 <$> readSTRef n1) $ do
10+ whileE ((>) 1000.0 <$> readSTRef n1) $ do
11 n1' <- readSTRef n1
11 n1' <- readSTRef n1
12 n2' <- readSTRef n2
12 n2' <- readSTRef n2
13 writeSTRef n2 $ n1' + n2'
13 writeSTRef n2 $ n1' + n2'
14 writeSTRef n1 n2'
14 writeSTRef n1 n2'
15− Debug.Trace.print n2')
15+ Control.Monad.Eff.Console.print n2')
examples/passing/FinalTagless.purs+4−4
@@ -1,11 +1,11 @@
1module Main where
1module Main where
2
2
3−import Prelude
3+import Prelude hiding (add)
4
4
5class E e where
5class E e where
6 num :: Number -> e Number
6 num :: Number -> e Number
7 add :: e Number -> e Number -> e Number
7 add :: e Number -> e Number -> e Number
8−
8+
9type Expr a = forall e. (E e) => e a
9type Expr a = forall e. (E e) => e a
10
10
11data Id a = Id a
11data Id a = Id a
@@ -17,6 +17,6 @@ instance exprId :: E Id where
17runId (Id a) = a
17runId (Id a) = a
18
18
19three :: Expr Number
19three :: Expr Number
20−three = add (num 1) (num 2)
20+three = add (num 1.0) (num 2.0)
21
21
22−main = Debug.Trace.print $ runId three
22+main = Control.Monad.Eff.Console.print $ runId three
examples/passing/ForeignInstance.pursdeleted−16
@@ -1,16 +0,0 @@
1−module Main where
2−
3−class Foo a where
4− foo :: a -> String
5−
6−foreign import instance fooArray :: (Foo a) => Foo [a]
7−
8−foreign import instance fooNumber :: Foo Number
9−
10−foreign import instance fooString :: Foo String
11−
12−test1 _ = foo [1, 2, 3]
13−
14−test2 _ = foo "Test"
15−
16−main = Debug.Trace.trace "Done"
examples/passing/FunctionScope.purs+8−13
@@ -1,17 +1,12 @@
1module Main where
1module Main where
2
2
3− import Prelude
3+import Prelude
4+import Test.Assert
4
5
5− mkValue :: Number -> Number
6+mkValue :: Number -> Number
6− mkValue id = id
7+mkValue id = id
7
8
8− foreign import error
9− "function error(msg) {\
10− \ throw msg;\
11− \}" :: forall a. String -> a
12−
13− main = do
9+main = do
14− let value = mkValue 1
10+ let value = mkValue 1.0
15− if value == 1
11+ assert $ value == 1.0
16− then Debug.Trace.trace "Done"
12+ Control.Monad.Eff.Console.log "Done"
17− else error "Not done"
examples/passing/Functions.purs+7−7
@@ -1,15 +1,15 @@
1module Main where
1module Main where
2
2
3− import Prelude
3+import Prelude
4
4
5− test1 = \_ -> 0
5+test1 = \_ -> 0.0
6
6
7− test2 = \a b -> a + b + 1
7+test2 = \a b -> a + b + 1.0
8
8
9− test3 = \a -> a
9+test3 = \a -> a
10
10
11− test4 = \(%%) -> 1 %% 2
11+test4 = \(%%) -> 1.0 %% 2.0
12
12
13− test5 = \(+++) (***) -> 1 +++ 2 *** 3
13+test5 = \(+++) (***) -> 1.0 +++ 2.0 *** 3.0
14
14
15− main = Debug.Trace.trace "Done"
15+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Functions2.purs+8−13
@@ -1,17 +1,12 @@
1module Main where
1module Main where
2
2
3− import Prelude
3+import Prelude
4+import Test.Assert
4
5
5− test :: forall a b. a -> b -> a
6+test :: forall a b. a -> b -> a
6− test = \const _ -> const
7+test = \const _ -> const
7
8
8− foreign import error
9− "function error(msg) {\
10− \ throw msg;\
11− \}" :: forall a. String -> a
12−
13− main = do
9+main = do
14− let value = test "Done" {}
10+ let value = test "Done" {}
15− if value == "Done"
11+ assert' "Not done" $ value == "Done"
16− then Debug.Trace.trace "Done"
12+ Control.Monad.Eff.Console.log "Done"
17− else error "Not done"
examples/passing/Guards.purs+24−9
@@ -1,14 +1,29 @@
1module Main where
1module Main where
2
2
3− import Prelude
3+import Prelude
4
4
5− collatz = \x -> case x of
5+collatz = \x -> case x of
6− y | y % 2 == 0 -> y / 2
6+ y | y `mod` 2.0 == 0.0 -> y / 2.0
7− y -> y * 3 + 1
7+ y -> y * 3.0 + 1.0
8
8
9− -- Guards have access to current scope
9+-- Guards have access to current scope
10− collatz2 = \x y -> case x of
10+collatz2 = \x y -> case x of
11− z | y > 0 -> z / 2
11+ z | y > 0.0 -> z / 2.0
12− z -> z * 3 + 1
12+ z -> z * 3.0 + 1.0
13
13
14− main = Debug.Trace.trace "Done"
14+min :: forall a. (Ord a) => a -> a -> a
15+min n m | n < m = n
16+ | otherwise = m
17+
18+max :: forall a. (Ord a) => a -> a -> a
19+max n m = case unit of
20+ _ | m < n -> n
21+ | otherwise -> m
22+
23+testIndentation :: Number -> Number -> Number
24+testIndentation x y | x > 0.0
25+ = x + y
26+ | otherwise
27+ = y - x
28+
29+main = Control.Monad.Eff.Console.log $ min "Done" "ZZZZ"
examples/passing/HoistError.purs+7−12
@@ -1,17 +1,12 @@
1module Main where
1module Main where
2
2
3+import Prelude
3import Control.Monad.Eff
4import Control.Monad.Eff
4−import Debug.Trace
5+import Control.Monad.Eff.Console
5−
6+import Test.Assert
6−foreign import f
7− "function f(x) {\
8− \ return function () {\
9− \ if (x !== 0) throw new Error('x is not 0');\
10− \ }\
11− \}" :: forall e. Number -> Eff e Number
12
7
13main = do
8main = do
14− let x = 0
9+ let x = 0.0
15− f x
10+ assert $ x == 0.0
16− let x = 1 + 1
11+ let x = 1.0 + 1.0
17− trace "Done"
12+ log "Done"
examples/passing/IfThenElseMaybe.pursnew file+11
@@ -0,0 +1,11 @@
1+module Main where
2+
3+import Prelude
4+
5+data Maybe a = Nothing | Just a
6+
7+test1 = if true then Just 10 else Nothing
8+
9+test2 = if true then Nothing else Just 10
10+
11+main = Control.Monad.Eff.Console.log "Done"
examples/passing/ImplicitEmptyImport.pursnew file+8
@@ -0,0 +1,8 @@
1+module Main where
2+
3+import Prelude
4+
5+main = do
6+ Control.Monad.Eff.Console.log "Hello"
7+ Control.Monad.Eff.Console.log "Goodbye"
8+ Control.Monad.Eff.Console.log "Done"
examples/passing/ImportHiding.purs+2−2
@@ -1,13 +1,13 @@
1module Main where
1module Main where
2
2
3−import Debug.Trace
3+import Control.Monad.Eff.Console
4import Prelude hiding (
4import Prelude hiding (
5 show, -- a value
5 show, -- a value
6 Show, -- a type class
6 Show, -- a type class
7 Unit(..) -- a constructor
7 Unit(..) -- a constructor
8 )
8 )
9
9
10−show = 1
10+show = 1.0
11
11
12class Show a where
12class Show a where
13 noshow :: a -> a
13 noshow :: a -> a
examples/passing/InferRecFunWithConstrainedArgument.purs+3−3
@@ -2,7 +2,7 @@ module Main where
2
2
3import Prelude
3import Prelude
4
4
5−test 100 = 100
5+test 100.0 = 100.0
6−test n = test(1 + n)
6+test n = test(1.0 + n)
7
7
8−main = Debug.Trace.print $ test 0
8+main = Control.Monad.Eff.Console.print $ test 0.0
examples/passing/InstanceBeforeClass.pursnew file+11
@@ -0,0 +1,11 @@
1+module Main where
2+
3+import Prelude
4+
5+instance fooNumber :: Foo Number where
6+ foo = 0.0
7+
8+class Foo a where
9+ foo :: a
10+
11+main = Control.Monad.Eff.Console.log "Done"
examples/passing/IntAndChar.pursnew file+18
@@ -0,0 +1,18 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff
5+import Test.Assert
6+
7+f 1 = 1
8+f _ = 0
9+
10+g 'a' = 'a'
11+g _ = 'b'
12+
13+main = do
14+ assert $ f 1 == 1
15+ assert $ f 0 == 0
16+ assert $ g 'a' == 'a'
17+ assert $ g 'b' == 'b'
18+ Control.Monad.Eff.Console.log "Done"
examples/passing/JSReserved.purs+8−8
@@ -1,12 +1,12 @@
1module Main where
1module Main where
2
2
3− import Prelude
3+import Prelude
4
4
5− yield = 0
5+yield = 0
6− member = 1
6+member = 1
7−
8− public = \return -> return
9−
10− this catch = catch
11
7
12− main = Debug.Trace.trace "Done"
8+public = \return -> return
9+
10+this catch = catch
11+
12+main = Control.Monad.Eff.Console.log "Done"
examples/passing/KindedType.pursnew file+33
@@ -0,0 +1,33 @@
1+module Main where
2+
3+import Prelude
4+
5+type Star2Star f = f :: * -> *
6+
7+type Star t = t :: *
8+
9+test1 :: Star2Star Array String
10+test1 = ["test"]
11+
12+f :: Star (String -> String)
13+f s = s
14+
15+test2 = f "test"
16+
17+data Proxy (f :: * -> *) = Proxy
18+
19+test3 :: Proxy Array
20+test3 = Proxy
21+
22+type Test (f :: * -> *) = f String
23+
24+test4 :: Test Array
25+test4 = ["test"]
26+
27+class Clazz (a :: *) where
28+ def :: a
29+
30+instance clazzString :: Clazz String where
31+ def = "test"
32+
33+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Let.purs+27−38
@@ -4,61 +4,50 @@ import Prelude
4import Control.Monad.Eff
4import Control.Monad.Eff
5import Control.Monad.ST
5import Control.Monad.ST
6
6
7−test1 x = let
7+test1 x = let
8 y :: Number
8 y :: Number
9− y = x + 1
9+ y = x + 1.0
10 in y
10 in y
11
11
12−test2 x y =
12+test2 x y =
13− let x' = x + 1 in
13+ let x' = x + 1.0 in
14− let y' = y + 1 in
14+ let y' = y + 1.0 in
15 x' + y'
15 x' + y'
16
16
17test3 = let f x y z = x + y + z in
17test3 = let f x y z = x + y + z in
18− f 1 2 3
18+ f 1.0 2.0 3.0
19
19
20−test4 = let f x [y, z] = x y z in
20+test4 = let f x [y, z] = x y z in
21− f (+) [1, 2]
21+ f (+) [1.0, 2.0]
22
22
23−test5 = let
23+test5 = let
24− f x | x > 0 = g (x / 2) + 1
24+ f x | x > 0.0 = g (x / 2.0) + 1.0
25− f x = 0
25+ f x = 0.0
26− g x = f (x - 1) + 1
26+ g x = f (x - 1.0) + 1.0
27− in f 10
27+ in f 10.0
28−
29−test6 = runPure (runST (do
30− r <- newSTRef 0
31− (let
32− go [] = readSTRef r
33− go (n : ns) = do
34− modifySTRef r ((+) n)
35− go ns
36− in go [1, 2, 3, 4, 5])
37− ))
38
28
39test7 = let
29test7 = let
40 f :: forall a. a -> a
30 f :: forall a. a -> a
41 f x = x
31 f x = x
42− in if f true then f 1 else f 2
32+ in if f true then f 1.0 else f 2.0
43
33
44test8 :: Number -> Number
34test8 :: Number -> Number
45−test8 x = let
35+test8 x = let
46 go y | (x - 0.1 < y * y) && (y * y < x + 0.1) = y
36 go y | (x - 0.1 < y * y) && (y * y < x + 0.1) = y
47− go y = go $ (y + x / y) / 2
37+ go y = go $ (y + x / y) / 2.0
48 in go x
38 in go x
49
39
50−test10 _ =
40+test10 _ =
51 let
41 let
52− f x = g x * 3
42+ f x = g x * 3.0
53− g x = f x / 2
43+ g x = f x / 2.0
54− in f 10
44+ in f 10.0
55
45
56main = do
46main = do
57− Debug.Trace.print (test1 1)
47+ Control.Monad.Eff.Console.print (test1 1.0)
58− Debug.Trace.print (test2 1 2)
48+ Control.Monad.Eff.Console.print (test2 1.0 2.0)
59− Debug.Trace.print test3
49+ Control.Monad.Eff.Console.print test3
60− Debug.Trace.print test4
50+ Control.Monad.Eff.Console.print test4
61− Debug.Trace.print test5
51+ Control.Monad.Eff.Console.print test5
62− Debug.Trace.print test6
52+ Control.Monad.Eff.Console.print test7
63− Debug.Trace.print test7
64− Debug.Trace.print (test8 100)
53+ Control.Monad.Eff.Console.print (test8 100.0)
examples/passing/Let2.pursnew file+17
@@ -0,0 +1,17 @@
1+module Main where
2+
3+import Prelude
4+
5+test =
6+ let f :: Number -> Boolean
7+ f 0.0 = false
8+ f n = g (n - 1.0)
9+
10+ g :: Number -> Boolean
11+ g 0.0 = true
12+ g n = f (n - 1.0)
13+
14+ x = f 1.0
15+ in not x
16+
17+main = Control.Monad.Eff.Console.print test
examples/passing/LetInInstance.purs+3−1
@@ -1,5 +1,7 @@
1module Main where
1module Main where
2
2
3+import Prelude
4+
3class Foo a where
5class Foo a where
4 foo :: a -> String
6 foo :: a -> String
5
7
@@ -9,4 +11,4 @@ instance fooString :: Foo String where
9 go :: String -> String
11 go :: String -> String
10 go s = s
12 go s = s
11
13
12−main = Debug.Trace.trace "Done"
14+main = Control.Monad.Eff.Console.log "Done"
examples/passing/LiberalTypeSynonyms.purs+3−1
@@ -1,5 +1,7 @@
1module Main where
1module Main where
2
2
3+import Prelude
4+
3type Reader = (->) String
5type Reader = (->) String
4
6
5foo :: Reader String
7foo :: Reader String
@@ -16,4 +18,4 @@ f :: (forall r. F r) -> String
16f g = case g { x: "Hello" } of
18f g = case g { x: "Hello" } of
17 { x = x } -> x
19 { x = x } -> x
18
20
19−main = Debug.Trace.trace "Done"
21+main = Control.Monad.Eff.Console.log "Done"
examples/passing/MPTCs.purs+1−1
@@ -17,4 +17,4 @@ instance coerceRefl :: Coerce a a where
17instance coerceShow :: (Prelude.Show a) => Coerce a String where
17instance coerceShow :: (Prelude.Show a) => Coerce a String where
18 coerce = show
18 coerce = show
19
19
20−main = Debug.Trace.trace "Done"
20+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Match.purs+5−3
@@ -1,7 +1,9 @@
1module Main where
1module Main where
2
2
3− data Foo a = Foo
3+import Prelude
4
4
5− foo = \f -> case f of Foo -> "foo"
5+data Foo a = Foo
6
6
7− main = Debug.Trace.trace "Done"
7+foo = \f -> case f of Foo -> "foo"
8+
9+main = Control.Monad.Eff.Console.log "Done"
examples/passing/ModuleExport.pursnew file+9
@@ -0,0 +1,9 @@
1+module A (module Prelude) where
2+ import Prelude
3+
4+module Main where
5+ import Control.Monad.Eff.Console
6+ import A
7+
8+ main = do
9+ print (show 1.0)
examples/passing/ModuleExportDupes.pursnew file+19
@@ -0,0 +1,19 @@
1+module A (module Prelude) where
2+ import Prelude
3+
4+module B (module Prelude) where
5+ import Prelude
6+
7+module C (module Prelude, module A) where
8+ import Prelude
9+ import A
10+
11+module Main where
12+ import Control.Monad.Eff.Console
13+ import A
14+ import B
15+ import C
16+ import Prelude
17+
18+ main = do
19+ print (show 1.0)
examples/passing/ModuleExportExcluded.pursnew file+14
@@ -0,0 +1,14 @@
1+module A (module Prelude, foo) where
2+ import Prelude
3+
4+ foo :: Number -> Number
5+ foo _ = 0.0
6+
7+module Main where
8+ import Control.Monad.Eff.Console
9+ import A (foo)
10+
11+ otherwise = false
12+
13+ main = do
14+ print "1.0"
examples/passing/ModuleExportQualified.pursnew file+9
@@ -0,0 +1,9 @@
1+module A (module Prelude) where
2+ import Prelude
3+
4+module Main where
5+ import Control.Monad.Eff.Console
6+ import qualified A as B
7+
8+ main = do
9+ print (B.show 1.0)
examples/passing/ModuleExportSelf.pursnew file+14
@@ -0,0 +1,14 @@
1+module A (module A, module Prelude) where
2+ import Prelude
3+
4+ type Foo = Boolean
5+
6+module Main where
7+ import Control.Monad.Eff.Console
8+ import A
9+
10+ bar :: Foo
11+ bar = true
12+
13+ main = do
14+ print (show bar)
examples/passing/Monad.purs+21−21
@@ -1,32 +1,32 @@
1module Main where
1module Main where
2
2
3− import Prelude ()
3+import Prelude ()
4
4
5− type Monad m = { return :: forall a. a -> m a
5+type Monad m = { return :: forall a. a -> m a
6− , bind :: forall a b. m a -> (a -> m b) -> m b }
6+ , bind :: forall a b. m a -> (a -> m b) -> m b }
7
7
8− data Id a = Id a
8+data Id a = Id a
9
9
10− id :: Monad Id
10+id :: Monad Id
11− id = { return : Id
11+id = { return : Id
12− , bind : \ma f -> case ma of Id a -> f a }
12+ , bind : \ma f -> case ma of Id a -> f a }
13
13
14− data Maybe a = Nothing | Just a
14+data Maybe a = Nothing | Just a
15
15
16− maybe :: Monad Maybe
16+maybe :: Monad Maybe
17− maybe = { return : Just
17+maybe = { return : Just
18− , bind : \ma f -> case ma of
18+ , bind : \ma f -> case ma of
19− Nothing -> Nothing
19+ Nothing -> Nothing
20− Just a -> f a
20+ Just a -> f a
21− }
21+ }
22
22
23− test :: forall m. Monad m -> m Number
23+test :: forall m. Monad m -> m Number
24− test = \m -> m.bind (m.return 1) (\n1 ->
24+test = \m -> m.bind (m.return 1.0) (\n1 ->
25− m.bind (m.return "Test") (\n2 ->
25+ m.bind (m.return "Test") (\n2 ->
26− m.return n1))
26+ m.return n1))
27
27
28− test1 = test id
28+test1 = test id
29
29
30− test2 = test maybe
30+test2 = test maybe
31
31
32− main = Debug.Trace.trace "Done"
32+main = Control.Monad.Eff.Console.log "Done"
examples/passing/MonadState.purs+4−4
@@ -13,16 +13,16 @@ data State s a = State (s -> Tuple s a)
13runState s (State f) = f s
13runState s (State f) = f s
14
14
15instance functorState :: Functor (State s) where
15instance functorState :: Functor (State s) where
16− (<$>) = liftM1
16+ map = liftM1
17
17
18instance applyState :: Apply (State s) where
18instance applyState :: Apply (State s) where
19− (<*>) = ap
19+ apply = ap
20
20
21instance applicativeState :: Applicative (State s) where
21instance applicativeState :: Applicative (State s) where
22 pure a = State $ \s -> Tuple s a
22 pure a = State $ \s -> Tuple s a
23
23
24instance bindState :: Bind (State s) where
24instance bindState :: Bind (State s) where
25− (>>=) f g = State $ \s -> case runState s f of
25+ bind f g = State $ \s -> case runState s f of
26 Tuple s1 a -> runState s1 (g a)
26 Tuple s1 a -> runState s1 (g a)
27
27
28instance monadState :: Monad (State s)
28instance monadState :: Monad (State s)
@@ -44,5 +44,5 @@ test = runState "" $ do
44
44
45main = do
45main = do
46 let t1 = test
46 let t1 = test
47− Debug.Trace.trace "Done"
47+ Control.Monad.Eff.Console.log "Done"
48
48
examples/passing/MultiArgFunctions.purs+17−16
@@ -1,26 +1,27 @@
1module Main where
1module Main where
2
2
3+import Prelude
3import Data.Function
4import Data.Function
4import Control.Monad.Eff
5import Control.Monad.Eff
5−import Debug.Trace
6+import Control.Monad.Eff.Console
6
7
7f = mkFn2 $ \a b -> runFn2 g a b + runFn2 g b a
8f = mkFn2 $ \a b -> runFn2 g a b + runFn2 g b a
8
9
9g = mkFn2 $ \a b -> case {} of
10g = mkFn2 $ \a b -> case {} of
10− _ | a <= 0 || b <= 0 -> b
11+ _ | a <= 0.0 || b <= 0.0 -> b
11− _ -> runFn2 f (a - 1) (b - 1)
12+ _ -> runFn2 f (a - 0.0) (b - 0.0)
12
13
13main = do
14main = do
14− runFn0 (mkFn0 $ \_ -> trace $ show 0)
15+ runFn0 (mkFn0 $ \_ -> log $ show 0.0)
15− runFn1 (mkFn1 $ \a -> trace $ show a) 1
16+ runFn1 (mkFn1 $ \a -> log $ show a) 0.0
16− runFn2 (mkFn2 $ \a b -> trace $ show [a, b]) 1 2
17+ runFn2 (mkFn2 $ \a b -> log $ show [a, b]) 0.0 0.0
17− runFn3 (mkFn3 $ \a b c -> trace $ show [a, b, c]) 1 2 3
18+ runFn3 (mkFn3 $ \a b c -> log $ show [a, b, c]) 0.0 0.0 0.0
18− runFn4 (mkFn4 $ \a b c d -> trace $ show [a, b, c, d]) 1 2 3 4
19+ runFn4 (mkFn4 $ \a b c d -> log $ show [a, b, c, d]) 0.0 0.0 0.0 0.0
19− runFn5 (mkFn5 $ \a b c d e -> trace $ show [a, b, c, d, e]) 1 2 3 4 5
20+ runFn5 (mkFn5 $ \a b c d e -> log $ show [a, b, c, d, e]) 0.0 0.0 0.0 0.0 0.0
20− runFn6 (mkFn6 $ \a b c d e f -> trace $ show [a, b, c, d, e, f]) 1 2 3 4 5 6
21+ runFn6 (mkFn6 $ \a b c d e f -> log $ show [a, b, c, d, e, f]) 0.0 0.0 0.0 0.0 0.0 0.0
21− runFn7 (mkFn7 $ \a b c d e f g -> trace $ show [a, b, c, d, e, f, g]) 1 2 3 4 5 6 7
22+ runFn7 (mkFn7 $ \a b c d e f g -> log $ show [a, b, c, d, e, f, g]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0
22− runFn8 (mkFn8 $ \a b c d e f g h -> trace $ show [a, b, c, d, e, f, g, h]) 1 2 3 4 5 6 7 8
23+ runFn8 (mkFn8 $ \a b c d e f g h -> log $ show [a, b, c, d, e, f, g, h]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
23− runFn9 (mkFn9 $ \a b c d e f g h i -> trace $ show [a, b, c, d, e, f, g, h, i]) 1 2 3 4 5 6 7 8 9
24+ runFn9 (mkFn9 $ \a b c d e f g h i -> log $ show [a, b, c, d, e, f, g, h, i]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
24− runFn10 (mkFn10 $ \a b c d e f g h i j-> trace $ show [a, b, c, d, e, f, g, h, i, j]) 1 2 3 4 5 6 7 8 9 10
25+ runFn10 (mkFn10 $ \a b c d e f g h i j-> log $ show [a, b, c, d, e, f, g, h, i, j]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
25− print $ runFn2 g 15 12
26+ print $ runFn2 g 0.0 0.0
26− trace "Done!"
27+ log "Done!"
examples/passing/MultipleConstructorArgs.pursdeleted−21
@@ -1,21 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−
6−data P a b = P a b
7−
8−runP :: forall a b r. (a -> b -> r) -> P a b -> r
9−runP f (P a b) = f a b
10−
11−idP = runP P
12−
13−testCase = \p -> case p of
14− P (x:xs) (y:ys) -> x + y
15− P _ _ -> 0
16−
17−test1 = testCase (P [1, 2, 3] [4, 5, 6])
18−
19−main = do
20− Debug.Trace.trace (runP (\s n -> s ++ show n) (P "Test" 1))
21− Debug.Trace.print test1
examples/passing/MutRec.purs+11−11
@@ -1,19 +1,19 @@
1−module Main where
1+module Main where
2
2
3− import Prelude
3+import Prelude
4
4
5− f 0 = 0
5+f 0.0 = 0.0
6− f x = g x + 1
6+f x = g x + 0.0
7
7
8− g x = f (x / 2)
8+g x = f (x / 0.0)
9
9
10− data Even = Zero | Even Odd
10+data Even = Zero | Even Odd
11
11
12− data Odd = Odd Even
12+data Odd = Odd Even
13
13
14− evenToNumber Zero = 0
14+evenToNumber Zero = 0.0
15− evenToNumber (Even n) = oddToNumber n + 1
15+evenToNumber (Even n) = oddToNumber n + 0.0
16
16
17− oddToNumber (Odd n) = evenToNumber n + 1
17+oddToNumber (Odd n) = evenToNumber n + 0.0
18
18
19− main = Debug.Trace.trace "Done"
19+main = Control.Monad.Eff.Console.log "Done"
examples/passing/MutRec2.pursnew file+19
@@ -0,0 +1,19 @@
1+module Main where
2+
3+import Prelude
4+
5+data A = A B
6+
7+data B = B A
8+
9+foreign import data S :: *
10+
11+f :: A -> S
12+f a = case a of A b -> g b
13+
14+g b = case b of B a -> f a
15+
16+showN :: A -> S
17+showN a = f a
18+
19+main = Control.Monad.Eff.Console.log "Done"
examples/passing/MutRec3.pursnew file+19
@@ -0,0 +1,19 @@
1+module Main where
2+
3+import Prelude
4+
5+data A = A B
6+
7+data B = B A
8+
9+foreign import data S :: *
10+
11+f a = case a of A b -> g b
12+
13+g :: B -> S
14+g b = case b of B a -> f a
15+
16+showN :: A -> S
17+showN a = f a
18+
19+main = Control.Monad.Eff.Console.log "Done"
examples/passing/NakedConstraint.pursnew file+12
@@ -0,0 +1,12 @@
1+module Main where
2+
3+import Control.Monad.Eff.Console
4+
5+class Partial where
6+
7+data List a = Nil | Cons a (List a)
8+
9+head :: (Partial) => List Int -> Int
10+head (Cons x _) = x
11+
12+main = log "Done"
examples/passing/NamedPatterns.purs+6−4
@@ -1,7 +1,9 @@
1module Main where
1module Main where
2
2
3− foo = \x -> case x of
3+import Prelude
4− y@{ foo = "Foo" } -> y
5− y -> y
6
4
7− main = Debug.Trace.trace "Done"
5+foo = \x -> case x of
6+ y@{ foo = "Foo" } -> y
7+ y -> y
8+
9+main = Control.Monad.Eff.Console.log "Done"
examples/passing/NegativeBinder.pursnew file+9
@@ -0,0 +1,9 @@
1+module Main where
2+
3+import Prelude
4+
5+test :: Number -> Boolean
6+test -1.0 = false
7+test _ = true
8+
9+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Nested.purs+5−3
@@ -1,7 +1,9 @@
1module Main where
1module Main where
2
2
3− data Extend r a = Extend { prev :: r a, next :: a }
3+import Prelude
4
4
5− data Matrix r a = Square (r (r a)) | Bigger (Matrix (Extend r) a)
5+data Extend r a = Extend { prev :: r a, next :: a }
6
6
7− main = Debug.Trace.trace "Done"
7+data Matrix r a = Square (r (r a)) | Bigger (Matrix (Extend r) a)
8+
9+main = Control.Monad.Eff.Console.log "Done"
examples/passing/NestedTypeSynonyms.purs+6−6
@@ -1,11 +1,11 @@
1module Main where
1module Main where
2
2
3− import Prelude
3+import Prelude
4
4
5− type X = String
5+type X = String
6− type Y = X -> X
6+type Y = X -> X
7
7
8− fn :: Y
8+fn :: Y
9− fn a = a
9+fn a = a
10
10
11− main = Debug.Trace.print (fn "Done")
11+main = Control.Monad.Eff.Console.print (fn "Done")
examples/passing/NestedWhere.pursnew file+12
@@ -0,0 +1,12 @@
1+module Main where
2+
3+import Prelude
4+
5+f x = g x
6+ where
7+ g x = go x
8+ where
9+ go x = go1 (x - 1.0)
10+ go1 x = go x
11+
12+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Newtype.purs+7−6
@@ -1,7 +1,8 @@
1module Main where
1module Main where
2
2
3+import Prelude hiding (apply)
3import Control.Monad.Eff
4import Control.Monad.Eff
4−import Debug.Trace
5+import Control.Monad.Eff.Console
5
6
6newtype Thing = Thing String
7newtype Thing = Thing String
7
8
@@ -12,11 +13,11 @@ newtype Box a = Box a
12
13
13instance showBox :: (Show a) => Show (Box a) where
14instance showBox :: (Show a) => Show (Box a) where
14 show (Box x) = "Box " ++ show x
15 show (Box x) = "Box " ++ show x
15−
16+
16apply f x = f x
17apply f x = f x
17−
18+
18main = do
19main = do
19 print $ Thing "hello"
20 print $ Thing "hello"
20− print $ Box 42
21+ print $ Box 42.0
21− print $ apply Box 9000
22+ print $ apply Box 9000.0
22− trace "Done"
23+ log "Done"
examples/passing/NewtypeEff.purs+10−9
@@ -1,28 +1,29 @@
1module Main where
1module Main where
2
2
3−import Debug.Trace
3+import Prelude
4+import Control.Monad.Eff.Console
4import Control.Monad.Eff
5import Control.Monad.Eff
5
6
6−newtype T a = T (Eff (trace :: Trace) a)
7+newtype T a = T (Eff (console :: CONSOLE) a)
7
8
8−runT :: forall a. T a -> Eff (trace :: Trace) a
9+runT :: forall a. T a -> Eff (console :: CONSOLE) a
9runT (T t) = t
10runT (T t) = t
10
11
11instance functorT :: Functor T where
12instance functorT :: Functor T where
12− (<$>) f (T t) = T (f <$> t)
13+ map f (T t) = T (f <$> t)
13
14
14instance applyT :: Apply T where
15instance applyT :: Apply T where
15− (<*>) (T f) (T x) = T (f <*> x)
16+ apply (T f) (T x) = T (f <*> x)
16
17
17instance applicativeT :: Applicative T where
18instance applicativeT :: Applicative T where
18 pure t = T (pure t)
19 pure t = T (pure t)
19
20
20instance bindT :: Bind T where
21instance bindT :: Bind T where
21− (>>=) (T t) f = T (t >>= \x -> runT (f x))
22+ bind (T t) f = T (t >>= \x -> runT (f x))
22
23
23instance monadT :: Monad T
24instance monadT :: Monad T
24
25
25main = runT do
26main = runT do
26− T $ trace "Done"
27+ T $ log "Done"
27− T $ trace "Done"
28+ T $ log "Done"
28− T $ trace "Done"
29+ T $ log "Done"
examples/passing/NewtypeWithRecordUpdate.pursnew file+16
@@ -0,0 +1,16 @@
1+-- https://github.com/purescript/purescript/issues/812.0
2+
3+module Main where
4+
5+import Prelude
6+import Control.Monad.Eff.Console
7+
8+newtype NewType a = NewType (Object a)
9+
10+rec1 :: Object (a :: Number, b :: Number, c:: Number)
11+rec1 = { a: 0.0, b: 0.0, c: 0.0 }
12+
13+rec2 :: NewType (a :: Number, b :: Number, c :: Number)
14+rec2 = NewType (rec1 { a = 1.0 })
15+
16+main = log "Done"
examples/passing/ObjectGetter.pursnew file+13
@@ -0,0 +1,13 @@
1+module Main where
2+
3+import Prelude
4+
5+getX = _.x
6+
7+point = { x: 1.0, y: 0.0 }
8+
9+main = do
10+ Control.Monad.Eff.Console.print $ getX point
11+ Control.Monad.Eff.Console.log $ _." 123 string Prop Name " { " 123 string Prop Name ": "OK" }
12+ Control.Monad.Eff.Console.log $ (_.x >>> _.y) { x: { y: "Nested" } }
13+ Control.Monad.Eff.Console.log $ _.value { value: "Done!" }
examples/passing/ObjectSynonym.purs+4−2
@@ -1,13 +1,15 @@
1module Main where
1module Main where
2
2
3+import Prelude
4+
3type Inner = Number
5type Inner = Number
4
6
5inner :: Inner
7inner :: Inner
6−inner = 0
8+inner = 0.0
7
9
8type Outer = { inner :: Inner }
10type Outer = { inner :: Inner }
9
11
10outer :: Outer
12outer :: Outer
11outer = { inner: inner }
13outer = { inner: inner }
12
14
13−main = Debug.Trace.trace "Done"
15+main = Control.Monad.Eff.Console.log "Done"
examples/passing/ObjectUpdate.purs+13−11
@@ -1,18 +1,20 @@
1module Main where
1module Main where
2
2
3− update1 = \o -> o { foo = "Foo" }
3+import Prelude
4
4
5− update2 :: forall r. { foo :: String | r } -> { foo :: String | r }
6− update2 = \o -> o { foo = "Foo" }
5+update1 = \o -> o { foo = "Foo" }
7
6
8− replace = \o -> case o of
7+update2 :: forall r. { foo :: String | r } -> { foo :: String | r }
9− { foo = "Foo" } -> o { foo = "Bar" }
8+update2 = \o -> o { foo = "Foo" }
10− { foo = "Bar" } -> o { bar = "Baz" }
11− o -> o
12
9
13− polyUpdate :: forall a r. { foo :: a | r } -> { foo :: String | r }
10+replace = \o -> case o of
14− polyUpdate = \o -> o { foo = "Foo" }
11+ { foo = "Foo" } -> o { foo = "Bar" }
12+ { foo = "Bar" } -> o { bar = "Baz" }
13+ o -> o
15
14
16− inferPolyUpdate = \o -> o { foo = "Foo" }
15+polyUpdate :: forall a r. { foo :: a | r } -> { foo :: String | r }
16+polyUpdate = \o -> o { foo = "Foo" }
17
17
18+inferPolyUpdate = \o -> o { foo = "Foo" }
19+
18− main = Debug.Trace.trace ((update1 {foo: ""}).foo)
20+main = Control.Monad.Eff.Console.log ((update1 {foo: ""}).foo)
examples/passing/ObjectUpdate2.pursnew file+17
@@ -0,0 +1,17 @@
1+module Main where
2+
3+import Prelude
4+
5+type X r = { | r }
6+
7+x :: X (baz :: String)
8+x = { baz: "baz" }
9+
10+blah :: forall r. X r -> X r
11+blah x = x
12+
13+test = blah x
14+ { baz = "blah"
15+ }
16+
17+main = Control.Monad.Eff.Console.log "Done"
examples/passing/ObjectUpdater.pursnew file+24
@@ -0,0 +1,24 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff
5+import Control.Monad.Eff.Console
6+import Test.Assert
7+
8+getValue :: forall e. Eff (| e) Boolean
9+getValue = return true
10+
11+main = do
12+ let record = { value: false }
13+ record' <- record { value = _ } <$> getValue
14+ assert $ record'.value == true
15+
16+ let point = { x: 1.0, y: 1.0 }
17+ x = 10.0
18+ point' = (point { x = _, y = x }) 100.0
19+
20+ assert $ point'.x == 100.0
21+ assert $ point'.y == 10.0
22+
23+ let record2 = (_ { x = _ }) { x: 0.0 } 10.0
24+ assert $ record2.x == 10.0
examples/passing/ObjectWildcards.pursnew file+20
@@ -0,0 +1,20 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff
5+import Control.Monad.Eff.Console
6+import Test.Assert
7+
8+mkRecord = { foo: _, bar: _, baz: "baz" }
9+
10+getValue :: forall e. Eff (| e) Boolean
11+getValue = return true
12+
13+main = do
14+ obj <- { value: _ } <$> getValue
15+ print obj.value
16+ let x = 1.0
17+ point <- { x: _, y: x } <$> return 2.0
18+ assert $ point.x == 2.0
19+ assert $ point.y == 1.0
20+ log (mkRecord 1.0 "Done!").bar
examples/passing/Objects.purs+23−18
@@ -1,30 +1,35 @@
1module Main where
1module Main where
2
2
3− import Prelude
3+import Prelude hiding (append)
4
4
5− test = \x -> x.foo + x.bar + 1
5+test = \x -> x.foo + x.bar + 1.0
6
6
7− append = \o -> { foo: o.foo, bar: 1 }
7+append = \o -> { foo: o.foo, bar: 1.0 }
8
8
9− apTest = append({foo : "Foo", baz: "Baz"})
9+apTest = append({foo : "Foo", baz: "Baz"})
10
10
11− f = (\a -> a.b.c) { b: { c: 1, d: "Hello" }, e: "World" }
11+f = (\a -> a.b.c) { b: { c: 1.0, d: "Hello" }, e: "World" }
12
12
13− g = (\a -> a.f { x: 1, y: "y" }) { f: \o -> o.x + 1 }
13+g = (\a -> a.f { x: 1.0, y: "y" }) { f: \o -> o.x + 1.0 }
14
14
15− typed :: { foo :: Number }
15+typed :: { foo :: Number }
16− typed = { foo: 0 }
16+typed = { foo: 0.0 }
17
17
18− test2 = \x -> x."!@#"
18+test2 = \x -> x."!@#"
19
19
20− test3 = typed."foo"
20+test3 = typed."foo"
21
21
22− test4 = test2 weirdObj
22+test4 = test2 weirdObj
23− where
23+ where
24− weirdObj :: { "!@#" :: Number }
24+ weirdObj :: { "!@#" :: Number }
25− weirdObj = { "!@#": 1 }
25+ weirdObj = { "!@#": 1.0 }
26
26
27− test5 = case { "***": 1 } of
27+test5 = case { "***": 1.0 } of
28− { "***" = n } -> n
28+ { "***" = n } -> n
29−
29+
30− main = Debug.Trace.trace "Done"
30+test6 = case { "***": 1.0 } of
31+ { "***": n } -> n
32+
33+test7 {a: snoog , b : blah } = blah
34+
35+main = Control.Monad.Eff.Console.log "Done"
examples/passing/OneConstructor.purs+4−2
@@ -1,7 +1,9 @@
1module Main where
1module Main where
2
2
3+import Prelude
4+
3data One a = One a
5data One a = One a
4
6
5−one (One a) = a
7+one' (One a) = a
6
8
7−main = Debug.Trace.trace "Done"
9+main = Control.Monad.Eff.Console.log "Done"
examples/passing/OperatorAssociativity.pursnew file+25
@@ -0,0 +1,25 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff
5+import Control.Monad.Eff.Console
6+import Test.Assert
7+
8+bug :: Number -> Number -> Number
9+bug a b = 0.0 - (a - b)
10+
11+main = do
12+ assert (bug 0.0 2.0 == 2.0)
13+ assert (0.0 - (0.0 - 2.0) == 2.0)
14+ assert (0.0 - (0.0 + 2.0) == -2.0)
15+ assert (6.0 / (3.0 * 2.0) == 1.0)
16+ assert ((6.0 / 3.0) * 2.0 == 4.0)
17+ assert (not (1.0 < 0.0) == true)
18+ assert (not ((negate 1.0) < 0.0) == false)
19+ assert (negate (1.0 + 10.0) == -11.0)
20+ assert (2.0 * 3.0 / 4.0 == 1.5)
21+ assert (1.0 * 2.0 * 3.0 * 4.0 * 5.0 / 6.0 == 20.0)
22+ assert (1.0 + 10.0 - 5.0 == 6.0)
23+ assert (1.0 + 10.0 * 5.0 == 51.0)
24+ assert (10.0 * 5.0 - 1.0 == 49.0)
25+ log "Success!"
examples/passing/OperatorInlining.pursnew file+47
@@ -0,0 +1,47 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff.Console
5+
6+main = do
7+
8+ -- semiringNumber
9+ print (1.0 + 2.0)
10+ print (1.0 * 2.0)
11+
12+ -- ringNumber
13+ print (1.0 - 2.0)
14+ print (negate 1.0)
15+
16+ -- moduleSemiringNumber
17+ print (1.0 / 2.0)
18+
19+ -- ordNumber
20+ print (1.0 > 2.0)
21+ print (1.0 < 2.0)
22+ print (1.0 <= 2.0)
23+ print (1.0 >= 2.0)
24+ print (1.0 == 2.0)
25+
26+ -- eqNumber
27+ print (1.0 == 2.0)
28+ print (1.0 /= 2.0)
29+
30+ -- eqString
31+ print ("foo" == "bar")
32+ print ("foo" /= "bar")
33+
34+ -- eqBoolean
35+ print (true == false)
36+ print (true /= false)
37+
38+ -- semigroupString
39+ print ("foo" ++ "bar")
40+ print ("foo" <> "bar")
41+
42+ -- latticeBoolean
43+ print (top && true)
44+ print (bottom || false)
45+
46+ -- complementedLatticeBoolean
47+ print (not true)
examples/passing/OperatorSections.pursnew file+11
@@ -0,0 +1,11 @@
1+module Main where
2+
3+import Prelude
4+import Test.Assert
5+
6+main = do
7+ assert $ (/ 2.0) 4.0 == 2.0
8+ assert $ (2.0 /) 4.0 == 0.5
9+ assert $ (`const` 1.0) 2.0 == 2.0
10+ assert $ (1.0 `const`) 2.0 == 1.0
11+ Control.Monad.Eff.Console.log "Done!"
examples/passing/Operators.purs+75−56
@@ -1,80 +1,99 @@
1module Main where
1module Main where
2
2
3+import Prelude
3− import Control.Monad.Eff
4+import Control.Monad.Eff
4− import Debug.Trace
5+import Control.Monad.Eff.Console
5−
6− (?!) :: forall a. a -> a -> a
7− (?!) x _ = x
8
6
9− bar :: String -> String -> String
7+(?!) :: forall a. a -> a -> a
10− bar = \s1 s2 -> s1 ++ s2
8+(?!) x _ = x
11
9
12− test1 :: forall n. (Num n) => n -> n -> (n -> n -> n) -> n
10+bar :: String -> String -> String
13− test1 x y z = x * y + z x y
11+bar = \s1 s2 -> s1 ++ s2
14
12
15− test2 = (\x -> x.foo false) { foo : \_ -> 1 }
13+test1 :: forall n. (Num n) => n -> n -> (n -> n -> n) -> n
14+test1 x y z = x * y + z x y
16
15
17− test3 = (\x y -> x)(1 + 2 * (1 + 2)) (true && (false || false))
16+test2 = (\x -> x.foo false) { foo : \_ -> 1.0 }
18
17
19− k = \x -> \y -> x
18+test3 = (\x y -> x)(1.0 + 2.0 * (1.0 + 2.0)) (true && (false || false))
20
19
21− test4 = 1 `k` 2
20+k = \x -> \y -> x
22
21
23− infixl 5 %%
22+test4 = 1 `k` 2
24
23
25− (%%) :: Number -> Number -> Number
24+infixl 5 %%
26− (%%) x y = x * y + y
27
25
28− test5 = 1 %% 2 %% 3
26+(%%) :: Number -> Number -> Number
27+(%%) x y = x * y + y
29
28
30− test6 = ((\x -> x) `k` 2) 3
29+test5 = 1.0 %% 2.0 %% 3.0
31
30
32− (<+>) :: String -> String -> String
31+test6 = ((\x -> x) `k` 2.0) 3.0
33− (<+>) = \s1 s2 -> s1 ++ s2
34
32
35− test7 = "Hello" <+> "World!"
33+(<+>) :: String -> String -> String
34+(<+>) = \s1 s2 -> s1 ++ s2
36
35
37− (@@) :: forall a b. (a -> b) -> a -> b
36+test7 = "Hello" <+> "World!"
38− (@@) = \f x -> f x
39
37
40− foo :: String -> String
38+(@@) :: forall a b. (a -> b) -> a -> b
41− foo = \s -> s
39+(@@) = \f x -> f x
42−
43− test8 = foo @@ "Hello World"
44
40
45− test9 = Main.foo @@ "Hello World"
41+foo :: String -> String
42+foo = \s -> s
46
43
47− test10 = "Hello" `Main.bar` "World"
44+test8 = foo @@ "Hello World"
48
45
49− (...) :: forall a. [a] -> [a] -> [a]
46+test9 = Main.foo @@ "Hello World"
50− (...) = \as -> \bs -> as
51
47
52− test11 = [1, 2, 3] ... [4, 5, 6]
48+test10 = "Hello" `Main.bar` "World"
53
49
54− test12 (<%>) a b = a <%> b
50+(...) :: forall a. Array a -> Array a -> Array a
55−
51+(...) = \as -> \bs -> as
56− test13 = \(<%>) a b -> a <%> b
57
52
58− test14 :: Number -> Number -> Boolean
53+test11 = [1.0, 2.0, 0.0] ... [4.0, 5.0, 6.0]
59− test14 a b = a < b
60
54
61− test15 :: Number -> Number -> Boolean
55+test12 (<%>) a b = a <%> b
62− test15 a b = const false $ a `test14` b
63
56
57+test13 = \(<%>) a b -> a <%> b
58+
59+test14 :: Number -> Number -> Boolean
60+test14 a b = a < b
61+
62+test15 :: Number -> Number -> Boolean
63+test15 a b = const false $ a `test14` b
64+
65+test17 :: Number
66+test17 = negate (-1.0)
67+
68+test18 :: Number
69+test18 = negate $ negate 1.0
70+
71+test19 :: Number
72+test19 = negate $ negate (-1.0)
73+
74+test20 :: Number
75+test20 = 1.0 @ 2.0
76+ where
77+ (@) x y = x + y * y
78+
64− main = do
79+main = do
65− let t1 = test1 1 2 (\x y -> x + y)
80+ let t1 = test1 1.0 2.0 (\x y -> x + y)
66− let t2 = test2
81+ let t2 = test2
67− let t3 = test3
82+ let t3 = test3
68− let t4 = test4
83+ let t4 = test4
69− let t5 = test5
84+ let t5 = test5
70− let t6 = test6
85+ let t6 = test6
71− let t7 = test7
86+ let t7 = test7
72− let t8 = test8
87+ let t8 = test8
73− let t9 = test9
88+ let t9 = test9
74− let t10 = test10
89+ let t10 = test10
75− let t11 = test11
90+ let t11 = test11
76− let t12 = test12 k 1 2
91+ let t12 = test12 k 1.0 2.0
77− let t13 = test13 k 1 2
92+ let t13 = test13 k 1.0 2.0
78− let t14 = test14 1 2
93+ let t14 = test14 1.0 2.0
79− let t15 = test15 1 2
94+ let t15 = test15 1.0 2.0
95+ let t17 = test17
96+ let t18 = test18
97+ let t19 = test19
98+ let t20 = test20
80− trace "Done"
99+ log "Done"
examples/passing/OptimizerBug.purs+3−3
@@ -2,8 +2,8 @@ module Main where
2
2
3import Prelude
3import Prelude
4
4
5−x a = 1 + y a
5+x a = 1.0 + y a
6
6
7y a = x a
7y a = x a
8−
8+
9−main = Debug.Trace.trace "Done"
9+main = Control.Monad.Eff.Console.log "Done"
examples/passing/OverlappingInstances.pursnew file+13
@@ -0,0 +1,13 @@
1+module Main where
2+
3+import Prelude
4+
5+data A = A
6+
7+instance showA1 :: Show A where
8+ show A = "Instance 1"
9+
10+instance showA2 :: Show A where
11+ show A = "Instance 2"
12+
13+main = Test.Assert.assert $ show A == "Instance 1"
examples/passing/OverlappingInstances2.pursnew file+23
@@ -0,0 +1,23 @@
1+module Main where
2+
3+import Prelude
4+
5+data A = A | B
6+
7+instance eqA1 :: Eq A where
8+ eq A A = true
9+ eq B B = true
10+ eq _ _ = false
11+
12+instance eqA2 :: Eq A where
13+ eq _ _ = true
14+
15+instance ordA :: Ord A where
16+ compare A B = LT
17+ compare B A = GT
18+ compare _ _ = EQ
19+
20+test :: forall a. (Ord a) => a -> a -> String
21+test x y = show $ x == y
22+
23+main = Test.Assert.assert $ test A B == "false"
examples/failing/Superclasses4.purs → examples/passing/OverlappingInstances3.pursrenamed+6−2
@@ -1,4 +1,6 @@
1−module OverlappingInstances where
1+module Main where
2+
3+import Prelude
2
4
3class Foo a
5class Foo a
4
6
@@ -9,4 +11,6 @@ instance foo2 :: Foo Number
9test :: forall a. (Foo a) => a -> a
11test :: forall a. (Foo a) => a -> a
10test a = a
12test a = a
11
13
12−test1 = test 0
14+test1 = test 0.0
15+
16+main = Test.Assert.assert (test1 == 0.0)
examples/passing/PartialFunction.purs+5−12
@@ -1,17 +1,10 @@
1module Main where
1module Main where
2
2
3−foreign import testError
3+import Prelude
4− "function testError(f) {\
4+import Test.Assert
5− \ try {\
6− \ return f();\
7− \ } catch (e) {\
8− \ if (e instanceof Error) return 'success';\
9− \ throw new Error('Pattern match failure is not Error');\
10− \ }\
11− \}" :: (Unit -> Number) -> String
12
5
13fn :: Number -> Number
6fn :: Number -> Number
14−fn 0 = 0
7+fn 0.0 = 0.0
15−fn 1 = 2
8+fn 1.0 = 2.0
16
9
17−main = Debug.Trace.trace (show $ testError $ \_ -> fn 2)
10+main = assertThrows $ \_ -> fn 2.0
examples/passing/Patterns.purs+15−21
@@ -1,28 +1,22 @@
1module Main where
1module Main where
2
2
3− import Prelude
3+import Prelude
4
4
5− test = \x -> case x of
5+test = \x -> case x of
6− { str = "Foo", bool = true } -> true
6+ { str = "Foo", bool = true } -> true
7− { str = "Bar", bool = b } -> b
7+ { str = "Bar", bool = b } -> b
8− _ -> false
8+ _ -> false
9
9
10− f = \o -> case o of
10+f = \o -> case o of
11− { foo = "Foo" } -> o.bar
11+ { foo = "Foo" } -> o.bar
12− _ -> 0
12+ _ -> 0
13
13
14− g = \o -> case o of
14+h = \o -> case o of
15− { arr = [x : xs], take = "car" } -> x
15+ a@[_,_,_] -> a
16− { arr = [_, x : xs], take = "cadr" } -> x
17− _ -> 0
16+ _ -> []
18
17
18+isDesc :: Array Number -> Boolean
19+isDesc [x, y] | x > y = true
20+isDesc _ = false
19
21
20− h = \o -> case o of
22+main = Control.Monad.Eff.Console.log "Done"
21− a@[_,_,_] -> a
22− _ -> []
23−
24− isDesc :: [Number] -> Boolean
25− isDesc [x, y] | x > y = true
26− isDesc _ = false
27−
28− main = Debug.Trace.trace "Done"
examples/passing/Person.purs+7−12
@@ -1,16 +1,11 @@
1module Main where
1module Main where
2
2
3− import Prelude ((++))
3+import Prelude
4
4
5− data Person = Person { name :: String, age :: Number }
5+data Person = Person { name :: String, age :: Number }
6
6
7− foreign import itoa
8− "function itoa(n) {\
9− \ return n.toString();\
10− \}" :: Number -> String
11−
12− showPerson :: Person -> String
7+showPerson :: Person -> String
13− showPerson = \p -> case p of
8+showPerson = \p -> case p of
14− Person o -> o.name ++ ", aged " ++ itoa(o.age)
9+ Person o -> o.name ++ ", aged " ++ show o.age
15−
10+
16− main = Debug.Trace.trace "Done"
11+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Rank2Data.purs+19−19
@@ -1,29 +1,29 @@
1module Main where
1module Main where
2
2
3− import Prelude
3+import Prelude hiding (add)
4
4
5− data Id = Id forall a. a -> a
5+data Id = Id forall a. a -> a
6
6
7− runId = \id a -> case id of
7+runId = \id a -> case id of
8− Id f -> f a
8+ Id f -> f a
9
9
10− data Nat = Nat forall r. r -> (r -> r) -> r
10+data Nat = Nat forall r. r -> (r -> r) -> r
11
11
12− runNat = \nat -> case nat of
12+runNat = \nat -> case nat of
13− Nat f -> f 0 (\n -> n + 1)
13+ Nat f -> f 0.0 (\n -> n + 1.0)
14
14
15− zero = Nat (\zero _ -> zero)
15+zero' = Nat (\zero' _ -> zero')
16
16
17− succ = \n -> case n of
17+succ = \n -> case n of
18− Nat f -> Nat (\zero succ -> succ (f zero succ))
18+ Nat f -> Nat (\zero' succ -> succ (f zero' succ))
19
19
20− add = \n m -> case n of
20+add = \n m -> case n of
21− Nat f -> case m of
21+ Nat f -> case m of
22− Nat g -> Nat (\zero succ -> g (f zero succ) succ)
22+ Nat g -> Nat (\zero' succ -> g (f zero' succ) succ)
23
23
24− one = succ zero
24+one' = succ zero'
25− two = succ zero
25+two = succ zero'
26− four = add two two
26+four = add two two
27− fourNumber = runNat four
27+fourNumber = runNat four
28−
28+
29− main = Debug.Trace.trace "Done"
29+main = Control.Monad.Eff.Console.log "Done'"
examples/passing/Rank2Object.purs+4−3
@@ -1,10 +1,11 @@
1module Main where
1module Main where
2
2
3−import Debug.Trace
3+import Prelude
4+import Control.Monad.Eff.Console
4
5
5data Foo = Foo { id :: forall a. a -> a }
6data Foo = Foo { id :: forall a. a -> a }
6
7
7foo :: Foo -> Number
8foo :: Foo -> Number
8−foo (Foo { id = f }) = f 0
9+foo (Foo { id = f }) = f 0.0
9
10
10−main = trace "Done"
11+main = log "Done"
examples/passing/Rank2TypeSynonym.purs+5−4
@@ -1,15 +1,16 @@
1module Main where
1module Main where
2
2
3+import Prelude
3import Control.Monad.Eff
4import Control.Monad.Eff
4
5
5type Foo a = forall f. (Monad f) => f a
6type Foo a = forall f. (Monad f) => f a
6−
7+
7foo :: forall a. a -> Foo a
8foo :: forall a. a -> Foo a
8foo x = pure x
9foo x = pure x
9−
10+
10bar :: Foo Number
11bar :: Foo Number
11−bar = foo 3
12+bar = foo 3.0
12
13
13main = do
14main = do
14 x <- bar
15 x <- bar
15− Debug.Trace.print x
16+ Control.Monad.Eff.Console.print x
examples/passing/Rank2Types.purs+7−7
@@ -1,11 +1,11 @@
1module Main where
1module Main where
2
2
3− import Prelude
3+import Prelude
4
4
5− test1 :: (forall a. (a -> a)) -> Number
5+test1 :: (forall a. (a -> a)) -> Number
6− test1 = \f -> f 0
6+test1 = \f -> f 0.0
7
7
8− forever :: forall m a b. (forall a b. m a -> (a -> m b) -> m b) -> m a -> m b
8+forever :: forall m a b. (forall a b. m a -> (a -> m b) -> m b) -> m a -> m b
9− forever = \bind action -> bind action $ \_ -> forever bind action
9+forever = \bind action -> bind action $ \_ -> forever bind action
10−
10+
11− main = Debug.Trace.trace "Done"
11+main = Control.Monad.Eff.Console.log "Done"
examples/passing/ReExportQualified.pursnew file+16
@@ -0,0 +1,16 @@
1+module A where
2+ x = "Do"
3+
4+module B where
5+ y = "ne"
6+
7+module C (module A, module M2) where
8+ import A
9+ import qualified B as M2
10+
11+module Main where
12+
13+ import Prelude
14+ import C
15+
16+ main = Control.Monad.Eff.Console.log (x ++ y)
examples/passing/RebindableSyntax.pursnew file+39
@@ -0,0 +1,39 @@
1+module Main where
2+
3+import Prelude
4+
5+example1 :: String
6+example1 = do
7+ "Do"
8+ " notation"
9+ " for"
10+ " Semigroup"
11+ where
12+ bind x f = x <> f unit
13+
14+(*>) :: forall f a b. (Apply f) => f a -> f b -> f b
15+(*>) fa fb = const id <$> fa <*> fb
16+
17+newtype Const a b = Const a
18+
19+runConst :: forall a b. Const a b -> a
20+runConst (Const a) = a
21+
22+instance functorConst :: Functor (Const a) where
23+ map _ (Const a) = Const a
24+
25+instance applyConst :: (Semigroup a) => Apply (Const a) where
26+ apply (Const a1) (Const a2) = Const (a1 <> a2)
27+
28+example2 :: Const String Unit
29+example2 = do
30+ Const "Do"
31+ Const " notation"
32+ Const " for"
33+ Const " Apply"
34+ where
35+ bind x f = x *> f unit
36+
37+main = do
38+ Control.Monad.Eff.Console.log example1
39+ Control.Monad.Eff.Console.log $ runConst example2
examples/passing/Recursion.purs+7−7
@@ -1,10 +1,10 @@
1module Main where
1module Main where
2
2
3− import Prelude
3+import Prelude
4
4
5− fib = \n -> case n of
5+fib = \n -> case n of
6− 0 -> 1
6+ 0.0 -> 1.0
7− 1 -> 1
7+ 1.0 -> 1.0
8− n -> fib (n - 1) + fib (n - 2)
8+ n -> fib (n - 1.0) + fib (n - 2.0)
9−
9+
10− main = Debug.Trace.trace "Done"
10+main = Control.Monad.Eff.Console.log "Done"
examples/passing/ReservedWords.pursnew file+15
@@ -0,0 +1,15 @@
1+-- See https://github.com/purescript/purescript/issues/606
2+module Main where
3+
4+import Prelude
5+
6+o :: { type :: String }
7+o = { type: "o" }
8+
9+p :: { type :: String }
10+p = o { type = "p" }
11+
12+f :: forall r. { type :: String | r } -> String
13+f { type = "p" } = "Done"
14+
15+main = Control.Monad.Eff.Console.log $ f { type: p.type, foo: "bar" }
examples/passing/RowConstructors.pursnew file+42
@@ -0,0 +1,42 @@
1+module Main where
2+
3+import Prelude
4+
5+type Foo = (x :: Number | (y :: Number | (z :: Number)))
6+type Bar = (x :: Number, y :: Number, z :: Number)
7+type Baz = { w :: Number | Bar }
8+
9+foo :: { | Foo }
10+foo = { x: 0.0, y: 0.0, z: 0.0 }
11+
12+bar :: { | Bar }
13+bar = { x: 0.0, y: 0.0, z: 0.0 }
14+
15+id' :: Object Foo -> Object Bar
16+id' = id
17+
18+foo' :: { | Foo }
19+foo' = id' foo
20+
21+bar' :: { | Bar }
22+bar' = id' bar
23+
24+baz :: Baz
25+baz = { x: 0.0, y: 0.0, z: 0.0, w: 0.0 }
26+
27+type Quux r = (q :: Number | r)
28+type Norf r = (q' :: Number | Quux r)
29+
30+quux :: { f :: { | Foo } | Quux Bar }
31+quux = { f: foo', x: 0.0, y: 0.0, z: 0.0, q: 0.0 }
32+
33+quux' :: { | Norf Bar }
34+quux' = { x: 0.0, y: 0.0, z: 0.0, q: 0.0, q': 0.0 }
35+
36+wildcard :: { w :: Number | _ } -> Baz
37+wildcard { w: w } = { x: w, y: w, z: w, w: w }
38+
39+wildcard' :: { | Quux _ } -> Number
40+wildcard' { q: q } = q
41+
42+main = Control.Monad.Eff.Console.log "Done"
examples/passing/RowPolyInstanceContext.pursnew file+22
@@ -0,0 +1,22 @@
1+module Main where
2+
3+import Prelude
4+
5+class T s m where
6+ state :: (s -> s) -> m Unit
7+
8+data S s a = S (s -> { new :: s, ret :: a })
9+
10+instance st :: T s (S s) where
11+ state f = S $ \s -> { new: f s, ret: unit }
12+
13+test1 :: forall r . S { foo :: String | r } Unit
14+test1 = state $ \o -> o { foo = o.foo ++ "!" }
15+
16+test2 :: forall m r . (T { foo :: String | r } m) => m Unit
17+test2 = state $ \o -> o { foo = o.foo ++ "!" }
18+
19+main = do
20+ let t1 = test1
21+ let t2 = test2
22+ Control.Monad.Eff.Console.log "Done"
examples/passing/RuntimeScopeIssue.purs+5−5
@@ -9,11 +9,11 @@ class B a where
9 b :: a -> Boolean
9 b :: a -> Boolean
10
10
11instance aNumber :: A Number where
11instance aNumber :: A Number where
12− a 0 = true
12+ a 0.0 = true
13− a n = b (n - 1)
13+ a n = b (n - 1.0)
14
14
15instance bNumber :: B Number where
15instance bNumber :: B Number where
16− b 0 = false
16+ b 0.0 = false
17− b n = a (n - 1)
17+ b n = a (n - 1.0)
18
18
19−main = Debug.Trace.print $ a 10
19+main = Control.Monad.Eff.Console.print $ a 10.0
examples/passing/STArray.pursdeleted−25
@@ -1,25 +0,0 @@
1−module Main where
2−
3−import Prelude
4−import Control.Monad.Eff
5−import Control.Monad.ST
6−import Debug.Trace
7−
8−test = runSTArray (do
9− a <- newSTArray 2 0
10− pokeSTArray a 0 1
11− pokeSTArray a 1 2
12− return a)
13−
14−fromTo lo hi = runSTArray (do
15− arr <- newSTArray (hi - lo + 1) 0
16− (let
17− go lo hi _ arr | lo > hi = return arr
18− go lo hi i arr = do
19− pokeSTArray arr i lo
20− go (lo + 1) hi (i + 1) arr
21− in go lo hi 0 arr))
22−
23−main = do
24− let t1 = runPure (fromTo 10 20)
25− trace "Done"
examples/passing/ScopedTypeVariables.pursnew file+36
@@ -0,0 +1,36 @@
1+module Main where
2+
3+import Prelude
4+
5+test1 :: forall a. (a -> a) -> a -> a
6+test1 f x = g (g x)
7+ where
8+ g :: a -> a
9+ g y = f (f y)
10+
11+test2 :: forall a. (a -> a) -> a -> a
12+test2 = h
13+ where
14+ h :: forall b. (b -> b) -> b -> b
15+ h f x = g (g x)
16+ where
17+ g :: b -> b
18+ g y = f (f y)
19+
20+test3 :: Number
21+test3 = ((\b -> b :: b) :: forall b. b -> b) 0.0
22+
23+test4 :: forall a. (a -> a) -> a -> a
24+test4 = h
25+ where
26+ h :: forall b. (b -> b) -> b -> b
27+ h f x = g (g x)
28+ where
29+ g :: b -> b
30+ g y = j (f (f y))
31+ where
32+ j :: forall b. b -> b
33+ j x = x
34+
35+
36+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Sequence.purs+8−5
@@ -1,12 +1,15 @@
1module Main where
1module Main where
2
2
3+import Prelude
3import Control.Monad.Eff
4import Control.Monad.Eff
4
5
6+data List a = Cons a (List a) | Nil
7+
5class Sequence t where
8class Sequence t where
6 sequence :: forall m a. (Monad m) => t (m a) -> m (t a)
9 sequence :: forall m a. (Monad m) => t (m a) -> m (t a)
7−
8−instance sequenceArray :: Sequence [] where
9− sequence [] = pure []
10− sequence (x:xs) = (:) <$> x <*> sequence xs
11
10
11+instance sequenceList :: Sequence List where
12+ sequence Nil = pure Nil
13+ sequence (Cons x xs) = Cons <$> x <*> sequence xs
14+
12−main = sequence $ [Debug.Trace.trace "Done"]
15+main = sequence $ Cons (Control.Monad.Eff.Console.log "Done") Nil
examples/passing/SequenceDesugared.pursnew file+37
@@ -0,0 +1,37 @@
1+module Main where
2+
3+import Prelude
4+import Control.Monad.Eff
5+
6+data List a = Cons a (List a) | Nil
7+
8+data Sequence t = Sequence (forall m a. (Monad m) => t (m a) -> m (t a))
9+
10+sequence :: forall t. Sequence t -> (forall m a. (Monad m) => t (m a) -> m (t a))
11+sequence (Sequence s) = s
12+
13+sequenceListSeq :: forall m a. (Monad m) => List (m a) -> m (List a)
14+sequenceListSeq Nil = pure Nil
15+sequenceListSeq (Cons x xs) = Cons <$> x <*> sequenceListSeq xs
16+
17+sequenceList :: Sequence List
18+sequenceList = Sequence (sequenceListSeq)
19+
20+sequenceList' :: Sequence List
21+sequenceList' = Sequence ((\val -> case val of
22+ Nil -> pure Nil
23+ Cons x xs -> Cons <$> x <*> sequence sequenceList' xs))
24+
25+sequenceList'' :: Sequence List
26+sequenceList'' = Sequence (sequenceListSeq :: forall m a. (Monad m) => List (m a) -> m (List a))
27+
28+sequenceList''' :: Sequence List
29+sequenceList''' = Sequence ((\val -> case val of
30+ Nil -> pure Nil
31+ Cons x xs -> Cons <$> x <*> sequence sequenceList''' xs) :: forall m a. (Monad m) => List (m a) -> m (List a))
32+
33+main = do
34+ sequence sequenceList $ Cons (Control.Monad.Eff.Console.log "Done") Nil
35+ sequence sequenceList' $ Cons (Control.Monad.Eff.Console.log "Done") Nil
36+ sequence sequenceList'' $ Cons (Control.Monad.Eff.Console.log "Done") Nil
37+ sequence sequenceList''' $ Cons (Control.Monad.Eff.Console.log "Done") Nil
examples/passing/ShadowedRename.purs+6−11
@@ -1,19 +1,14 @@
1module Main where
1module Main where
2
2
3+import Prelude
3import Control.Monad.Eff
4import Control.Monad.Eff
4−import Debug.Trace
5+import Control.Monad.Eff.Console
5−
6+import Test.Assert
6−foreign import f
7− "function f(x) {\
8− \ return function () {\
9− \ if (x !== 2) throw new Error('x is not 2');\
10− \ }\
11− \}" :: forall e. Number -> Eff e Number
12
7
13foo foo = let foo_1 = \_ -> foo
8foo foo = let foo_1 = \_ -> foo
14− foo_2 = foo_1 unit + 1
9+ foo_2 = foo_1 unit + 1.0
15 in foo_2
10 in foo_2
16
11
17main = do
12main = do
18− f (foo 1)
13+ assert $ foo 1.0 == 2.0
19− trace "Done"
14+ log "Done"
examples/passing/ShadowedTCO.purs+9−7
@@ -1,16 +1,18 @@
1module Main where
1module Main where
2
2
3−runNat f = f 0 (\n -> n + 1)
3+import Prelude hiding (add)
4
4
5−zero z _ = z
5+runNat f = f 0.0 (\n -> n + 1.0)
6
6
7−succ f zero succ = succ (f zero succ)
7+zero' z _ = z
8
8
9−add f g zero succ = g (f zero succ) succ
9+succ f zero' succ = succ (f zero' succ)
10
10
11+add f g zero' succ = g (f zero' succ) succ
12+
11−one = succ zero
13+one' = succ zero'
12−two = succ one
14+two = succ one'
13four = add two two
15four = add two two
14fourNumber = runNat four
16fourNumber = runNat four
15
17
16−main = Debug.Trace.trace $ show fourNumber
18+main = Control.Monad.Eff.Console.log $ show fourNumber
examples/passing/ShadowedTCOLet.purs+6−4
@@ -1,7 +1,9 @@
1module Main where
1module Main where
2
2
3+import Prelude
4+
3−f x y z =
5+f x y z =
4− let f 1 2 3 = 1
6+ let f 1.0 2.0 3.0 = 1.0
5 in f x z y
7 in f x z y
6−
8+
7−main = Debug.Trace.trace $ show $ f 1 3 2
9+main = Control.Monad.Eff.Console.log $ show $ f 1.0 3.0 2.0
examples/passing/SignedNumericLiterals.purs+15−13
@@ -1,15 +1,17 @@
1module Main where
1module Main where
2
2
3+import Prelude
4+
3− p = 0.5
5+p = 0.5
4− q = 1
6+q = 1.0
5− x = -1
7+x = -1.0
6− y = -0.5
8+y = -0.5
7− z = 0.5
9+z = 0.5
8− w = 1
10+w = 1.0
9−
11+
10− f :: Number -> Number
12+f :: Number -> Number
11− f x = -x
13+f x = -x
12−
14+
13− test1 = 2 - 1
15+test1 = 2.0 - 1.0
14−
16+
15− main = Debug.Trace.trace "Done"
17+main = Control.Monad.Eff.Console.log "Done"
examples/passing/Superclasses1.purs+4−2
@@ -1,5 +1,7 @@
1module Main where
1module Main where
2
2
3+import Prelude
4+
3class Su a where
5class Su a where
4 su :: a -> a
6 su :: a -> a
5
7
@@ -7,7 +9,7 @@ class (Su a) <= Cl a where
7 cl :: a -> a -> a
9 cl :: a -> a -> a
8
10
9instance suNumber :: Su Number where
11instance suNumber :: Su Number where
10− su n = n + 1
12+ su n = n + 1.0
11
13
12instance clNumber :: Cl Number where
14instance clNumber :: Cl Number where
13 cl n m = n + m
15 cl n m = n + m
@@ -15,4 +17,4 @@ instance clNumber :: Cl Number where
15test :: forall a. (Cl a) => a -> a
17test :: forall a. (Cl a) => a -> a
16test a = su (cl a a)
18test a = su (cl a a)
17
19
18−main = Debug.Trace.print $ test 10
20+main = Control.Monad.Eff.Console.print $ test 10.0
examples/passing/Superclasses2.pursdeleted−23
@@ -1,23 +0,0 @@
1−module Main where
2−
3−import Prelude.Unsafe (unsafeIndex)
4−
5−class Su a where
6− su :: a -> a
7−
8−class (Su [a]) <= Cl a where
9− cl :: a -> a -> a
10−
11−instance suNumber :: Su Number where
12− su n = n + 1
13−
14−instance suArray :: (Su a) => Su [a] where
15− su (x : _) = [su x]
16−
17−instance clNumber :: Cl Number where
18− cl n m = n + m
19−
20−test :: forall a. (Cl a) => a -> [a]
21−test x = su [cl x x]
22−
23−main = Debug.Trace.print $ test 10 `unsafeIndex` 0
examples/passing/Superclasses3.purs+10−10
@@ -1,14 +1,14 @@
1module Main where
1module Main where
2
2
3−import Debug.Trace
3+import Prelude
4−
4+import Control.Monad.Eff.Console
5import Control.Monad.Eff
5import Control.Monad.Eff
6
6
7class (Monad m) <= MonadWriter w m where
7class (Monad m) <= MonadWriter w m where
8 tell :: w -> m Unit
8 tell :: w -> m Unit
9
9
10testFunctor :: forall m. (Monad m) => m Number -> m Number
10testFunctor :: forall m. (Monad m) => m Number -> m Number
11−testFunctor n = (+) 1 <$> n
11+testFunctor n = (+) 1.0 <$> n
12
12
13test :: forall w m. (Monad m, MonadWriter w m) => w -> m Unit
13test :: forall w m. (Monad m, MonadWriter w m) => w -> m Unit
14test w = do
14test w = do
@@ -16,26 +16,26 @@ test w = do
16 tell w
16 tell w
17 tell w
17 tell w
18
18
19−data MTrace a = MTrace (Eff (trace :: Trace) a)
19+data MTrace a = MTrace (Eff (console :: CONSOLE) a)
20
20
21−runMTrace :: forall a. MTrace a -> Eff (trace :: Trace) a
21+runMTrace :: forall a. MTrace a -> Eff (console :: CONSOLE) a
22runMTrace (MTrace a) = a
22runMTrace (MTrace a) = a
23
23
24instance functorMTrace :: Functor MTrace where
24instance functorMTrace :: Functor MTrace where
25− (<$>) = liftM1
25+ map = liftM1
26
26
27instance applyMTrace :: Apply MTrace where
27instance applyMTrace :: Apply MTrace where
28− (<*>) = ap
28+ apply = ap
29
29
30instance applicativeMTrace :: Applicative MTrace where
30instance applicativeMTrace :: Applicative MTrace where
31 pure = MTrace <<< return
31 pure = MTrace <<< return
32
32
33instance bindMTrace :: Bind MTrace where
33instance bindMTrace :: Bind MTrace where
34− (>>=) m f = MTrace (runMTrace m >>= (runMTrace <<< f))
34+ bind m f = MTrace (runMTrace m >>= (runMTrace <<< f))
35
35
36−instance monadMTrace :: Monad MTrace
36+instance monadMTrace :: Monad MTrace
37
37
38instance writerMTrace :: MonadWriter String MTrace where
38instance writerMTrace :: MonadWriter String MTrace where
39− tell s = MTrace (trace s)
39+ tell s = MTrace (log s)
40
40
41main = runMTrace $ test "Done"
41main = runMTrace $ test "Done"
examples/passing/TCOCase.purs+5−3
@@ -1,10 +1,12 @@
1module Main where
1module Main where
2
2
3+import Prelude
4+
3data Data = One | More Data
5data Data = One | More Data
4
6
5−main = Debug.Trace.trace (from (to 10000 One))
7+main = Control.Monad.Eff.Console.log (from (to 10000.0 One))
6 where
8 where
7− to 0 a = a
9+ to 0.0 a = a
8− to n a = to (n - 1) (More a)
10+ to n a = to (n - 1.0) (More a)
9 from One = "Done"
11 from One = "Done"
10 from (More d) = from d
12 from (More d) = from d
examples/passing/TailCall.purs+9−7
@@ -2,14 +2,16 @@ module Main where
2
2
3import Prelude
3import Prelude
4
4
5+data L a = C a (L a) | N
6+
5−test :: Number -> [Number] -> Number
7+test :: Number -> L Number -> Number
6−test n [] = n
8+test n N = n
7−test n (x:xs) = test (n + x) xs
9+test n (C x xs) = test (n + x) xs
8
10
9loop :: forall a. Number -> a
11loop :: forall a. Number -> a
10−loop x = loop (x + 1)
12+loop x = loop (x + 1.0)
11
13
12−notATailCall = \x ->
14+notATailCall = \x ->
13 (\notATailCall -> notATailCall x) (\x -> x)
15 (\notATailCall -> notATailCall x) (\x -> x)
14−
16+
15−main = Debug.Trace.print (test 0 [1, 2, 3])
17+main = Control.Monad.Eff.Console.print (test 0.0 (1.0 `C` (2.0 `C` (3.0 `C` N))))
examples/passing/Tick.purs+3−1
@@ -1,5 +1,7 @@
1module Main where
1module Main where
2
2
3+import Prelude
4+
3test' x = x
5test' x = x
4
6
5−main = Debug.Trace.trace "Done"
7+main = Control.Monad.Eff.Console.log "Done"
examples/passing/TopLevelCase.purs+12−12
@@ -1,18 +1,18 @@
1module Main where
1module Main where
2
2
3− import Prelude
3+import Prelude
4
4
5− gcd :: Number -> Number -> Number
5+gcd :: Number -> Number -> Number
6− gcd 0 x = x
6+gcd 0.0 x = x
7− gcd x 0 = x
7+gcd x 0.0 = x
8− gcd x y | x > y = gcd (x % y) y
8+gcd x y | x > y = gcd (x `mod` y) y
9− gcd x y = gcd (y % x) x
9+gcd x y = gcd (y `mod` x) x
10
10
11− guardsTest (x:xs) | x > 0 = guardsTest xs
11+guardsTest [x] | x > 0.0 = []
12− guardsTest xs = xs
12+guardsTest xs = xs
13
13
14− data A = A
14+data A = A
15
15
16− parseTest A 0 = 0
16+parseTest A 0.0 = 0.0
17−
17+
18− main = Debug.Trace.trace "Done"
18+main = Control.Monad.Eff.Console.log "Done"
examples/passing/TypeClassMemberOrderChange.purs+4−2
@@ -1,11 +1,13 @@
1module Main where
1module Main where
2
2
3+import Prelude
4+
3class Test a where
5class Test a where
4 fn :: a -> a -> a
6 fn :: a -> a -> a
5 val :: a
7 val :: a
6−
8+
7instance testBoolean :: Test Boolean where
9instance testBoolean :: Test Boolean where
8 val = true
10 val = true
9 fn x y = y
11 fn x y = y
10
12
11−main = Debug.Trace.trace (show (fn true val))
13+main = Control.Monad.Eff.Console.log (show (fn true val))
examples/passing/TypeClasses.purs+12−12
@@ -22,48 +22,48 @@ instance showData :: (Prelude.Show a) => Prelude.Show (Data a) where
22test3 = \_ -> show (Data "testing")
22test3 = \_ -> show (Data "testing")
23
23
24instance functorData :: Functor Data where
24instance functorData :: Functor Data where
25− (<$>) = liftM1
25+ map = liftM1
26
26
27instance applyData :: Apply Data where
27instance applyData :: Apply Data where
28− (<*>) = ap
28+ apply = ap
29
29
30instance applicativeData :: Applicative Data where
30instance applicativeData :: Applicative Data where
31 pure = Data
31 pure = Data
32
32
33instance bindData :: Bind Data where
33instance bindData :: Bind Data where
34− (>>=) (Data a) f = f a
34+ bind (Data a) f = f a
35
35
36instance monadData :: Monad Data
36instance monadData :: Monad Data
37
37
38data Maybe a = Nothing | Just a
38data Maybe a = Nothing | Just a
39
39
40instance functorMaybe :: Functor Maybe where
40instance functorMaybe :: Functor Maybe where
41− (<$>) = liftM1
41+ map = liftM1
42
42
43instance applyMaybe :: Apply Maybe where
43instance applyMaybe :: Apply Maybe where
44− (<*>) = ap
44+ apply = ap
45
45
46instance applicativeMaybe :: Applicative Maybe where
46instance applicativeMaybe :: Applicative Maybe where
47 pure = Just
47 pure = Just
48
48
49instance bindMaybe :: Bind Maybe where
49instance bindMaybe :: Bind Maybe where
50− (>>=) Nothing _ = Nothing
50+ bind Nothing _ = Nothing
51− (>>=) (Just a) f = f a
51+ bind (Just a) f = f a
52
52
53instance monadMaybe :: Monad Maybe
53instance monadMaybe :: Monad Maybe
54
54
55test4 :: forall a m. (Monad m) => a -> m Number
55test4 :: forall a m. (Monad m) => a -> m Number
56−test4 = \_ -> return 1
56+test4 = \_ -> return 1.0
57
57
58−test5 = \_ -> Just 1 >>= \n -> return (n + 1)
58+test5 = \_ -> Just 1.0 >>= \n -> return (n + 1.0)
59
59
60ask r = r
60ask r = r
61
61
62runReader r f = f r
62runReader r f = f r
63
63
64−test9 _ = runReader 0 $ do
64+test9 _ = runReader 0.0 $ do
65 n <- ask
65 n <- ask
66− return $ n + 1
66+ return $ n + 1.0
67
67
68−main = Debug.Trace.trace (test7 "Done")
68+main = Control.Monad.Eff.Console.log (test7 "Done")
69
69
examples/passing/TypeClassesInOrder.purs+1−1
@@ -8,4 +8,4 @@ class Foo a where
8instance fooString :: Foo String where
8instance fooString :: Foo String where
9 foo s = s
9 foo s = s
10
10
11−main = Debug.Trace.trace $ foo "Done"
11+main = Control.Monad.Eff.Console.log $ foo "Done"
examples/passing/TypeClassesWithOverlappingTypeVariables.purs+6−6
@@ -1,11 +1,11 @@
1module Main where
1module Main where
2
2
3− import Prelude
3+import Prelude
4
4
5− data Either a b = Left a | Right b
5+data Either a b = Left a | Right b
6
6
7− instance functorEither :: Prelude.Functor (Either a) where
7+instance functorEither :: Prelude.Functor (Either a) where
8− (<$>) _ (Left x) = Left x
8+ map _ (Left x) = Left x
9− (<$>) f (Right y) = Right (f y)
9+ map f (Right y) = Right (f y)
10
10
11− main = Debug.Trace.trace "Done"
11+main = Control.Monad.Eff.Console.log "Done"
examples/passing/TypeDecl.purs+8−8
@@ -1,12 +1,12 @@
1module Main where
1module Main where
2
2
3− import Prelude
3+import Prelude
4
4
5− k :: String -> Number -> String
5+k :: String -> Number -> String
6− k x y = x
6+k x y = x
7
7
8− iterate :: forall a. Number -> (a -> a) -> a -> a
8+iterate :: forall a. Number -> (a -> a) -> a -> a
9− iterate 0 f a = a
9+iterate 0.0 f a = a
10− iterate n f a = iterate (n - 1) f (f a)
10+iterate n f a = iterate (n - 1.0) f (f a)
11−
11+
12− main = Debug.Trace.trace "Done"
12+main = Control.Monad.Eff.Console.log "Done"
examples/passing/TypeSynonymInData.purs+4−2
@@ -1,9 +1,11 @@
1module Main where
1module Main where
2
2
3+import Prelude
4+
3−type A a = [a]
5+type A a = Array a
4
6
5data Foo a = Foo (A a) | Bar
7data Foo a = Foo (A a) | Bar
6
8
7foo (Foo []) = Bar
9foo (Foo []) = Bar
8
10
9−main = Debug.Trace.trace "Done"
11+main = Control.Monad.Eff.Console.log "Done"
examples/passing/TypeSynonyms.purs+20−18
@@ -1,25 +1,27 @@
1module Main where
1module Main where
2
2
3− type Lens a b =
3+import Prelude
4− { get :: a -> b
5− , set :: a -> b -> a
6− }
7
4
8− composeLenses :: forall a b c. Lens a b -> Lens b c -> Lens a c
5+type Lens a b =
9− composeLenses = \l1 -> \l2 ->
10− { get: \a -> l2.get (l1.get a)
6+ { get :: a -> b
11− , set: \a c -> l1.set a (l2.set (l1.get a) c)
7+ , set :: a -> b -> a
12− }
8+ }
13
9
14− type Pair a b = { fst :: a, snd :: b }
10+composeLenses :: forall a b c. Lens a b -> Lens b c -> Lens a c
11+composeLenses = \l1 -> \l2 ->
12+ { get: \a -> l2.get (l1.get a)
13+ , set: \a c -> l1.set a (l2.set (l1.get a) c)
14+ }
15
15
16− fst :: forall a b. Lens (Pair a b) a
16+type Pair a b = { fst :: a, snd :: b }
17− fst =
18− { get: \p -> p.fst
19− , set: \p a -> { fst: a, snd: p.snd }
20− }
21
17
22− test1 :: forall a b c. Lens (Pair (Pair a b) c) a
18+fst :: forall a b. Lens (Pair a b) a
23− test1 = composeLenses fst fst
19+fst =
20+ { get: \p -> p.fst
21+ , set: \p a -> { fst: a, snd: p.snd }
22+ }
24
23
25− main = Debug.Trace.trace "Done"
24+test1 :: forall a b c. Lens (Pair (Pair a b) c) a
25+test1 = composeLenses fst fst
26+
27+main = Control.Monad.Eff.Console.log "Done"
examples/passing/TypeWildcards.pursnew file+15
@@ -0,0 +1,15 @@
1+module Main where
2+
3+import Prelude
4+
5+testTopLevel :: _ -> _
6+testTopLevel n = n + 1.0
7+
8+test :: forall a. (Eq a) => (a -> a) -> a -> a
9+test f a = go (f a) a
10+ where
11+ go :: _ -> _ -> _
12+ go a1 a2 | a1 == a2 = a1
13+ go a1 _ = go (f a1) a1
14+
15+main = Control.Monad.Eff.Console.log "Done"
examples/passing/TypeWildcardsRecordExtension.pursnew file+8
@@ -0,0 +1,8 @@
1+module Main where
2+
3+import Prelude
4+
5+foo :: forall a. {b :: Number | a} -> {b :: Number | _}
6+foo f = f
7+
8+main = Control.Monad.Eff.Console.log "Done"
examples/passing/TypedWhere.purs+11−7
@@ -1,13 +1,17 @@
1module Main where
1module Main where
2
2
3+import Prelude
4+
3data E a b = L a | R b
5data E a b = L a | R b
4
6
7+data L a = C a (L a) | N
8+
5−lefts :: forall a b. [E a b] -> [a]
9+lefts :: forall a b. L (E a b) -> L a
6−lefts = go []
10+lefts = go N
7 where
11 where
8− go :: forall a b. [a] -> [E a b] -> [a]
12+ go :: forall a b. L a -> L (E a b) -> L a
9− go ls [] = ls
13+ go ls N = ls
10− go ls (L a : rest) = go (a : ls) rest
14+ go ls (C (L a) rest) = go (C a ls) rest
11− go ls (_ : rest) = go ls rest
15+ go ls (C _ rest) = go ls rest
12
16
13−main = Debug.Trace.trace "Done"
17+main = Control.Monad.Eff.Console.log "Done"
examples/passing/UnderscoreIdent.pursnew file+11
@@ -0,0 +1,11 @@
1+module Main where
2+
3+import Prelude
4+
5+data Data_type = Con_Structor | Con_2 String
6+
7+type Type_name = Data_type
8+
9+done (Con_2 s) = s
10+
11+main = Control.Monad.Eff.Console.log (done (Con_2 "Done"))
examples/passing/Unit.purs+1−1
@@ -1,6 +1,6 @@
1module Main where
1module Main where
2
2
3import Prelude
3import Prelude
4−import Debug.Trace
4+import Control.Monad.Eff.Console
5
5
6main = print (const unit $ "Hello world")
6main = print (const unit $ "Hello world")
examples/passing/UnknownInTypeClassLookup.purs+3−1
@@ -1,5 +1,7 @@
1module Main where
1module Main where
2
2
3+import Prelude
4+
3class EQ a b
5class EQ a b
4
6
5instance eqAA :: EQ a a
7instance eqAA :: EQ a a
@@ -9,4 +11,4 @@ test _ _ = "Done"
9
11
10runTest a = test a a
12runTest a = test a a
11
13
12−main = Debug.Trace.trace $ runTest 0
14+main = Control.Monad.Eff.Console.log $ runTest 0.0
examples/passing/Where.purs+23−23
@@ -7,43 +7,43 @@ import Control.Monad.ST
7test1 x = y
7test1 x = y
8 where
8 where
9 y :: Number
9 y :: Number
10− y = x + 1
10+ y = x + 1.0
11
11
12test2 x y = x' + y'
12test2 x y = x' + y'
13 where
13 where
14− x' = x + 1
14+ x' = x + 1.0
15− y' = y + 1
15+ y' = y + 1.0
16−
17
16
17+
18−test3 = f 1 2 3
18+test3 = f 1.0 2.0 3.0
19 where f x y z = x + y + z
19 where f x y z = x + y + z
20−
21
20
21+
22−test4 = f (+) [1, 2]
22+test4 = f (+) [1.0, 2.0]
23 where f x [y, z] = x y z
23 where f x [y, z] = x y z
24−
25
24
26−test5 = g 10
27− where
28− f x | x > 0 = g (x / 2) + 1
29− f x = 0
30− g x = f (x - 1) + 1
31
25
26+test5 = g 10.0
27+ where
28+ f x | x > 0.0 = g (x / 2.0) + 1.0
29+ f x = 0.0
30+ g x = f (x - 1.0) + 1.0
31+
32−test6 = if f true then f 1 else f 2
32+test6 = if f true then f 1.0 else f 2.0
33 where f :: forall a. a -> a
33 where f :: forall a. a -> a
34 f x = x
34 f x = x
35
35
36test7 :: Number -> Number
36test7 :: Number -> Number
37test7 x = go x
37test7 x = go x
38− where
38+ where
39 go y | (x - 0.1 < y * y) && (y * y < x + 0.1) = y
39 go y | (x - 0.1 < y * y) && (y * y < x + 0.1) = y
40− go y = go $ (y + x / y) / 2
40+ go y = go $ (y + x / y) / 2.0
41
41
42main = do
42main = do
43− Debug.Trace.print (test1 1)
43+ Control.Monad.Eff.Console.print (test1 1.0)
44− Debug.Trace.print (test2 1 2)
44+ Control.Monad.Eff.Console.print (test2 1.0 2.0)
45− Debug.Trace.print test3
45+ Control.Monad.Eff.Console.print test3
46− Debug.Trace.print test4
46+ Control.Monad.Eff.Console.print test4
47− Debug.Trace.print test5
47+ Control.Monad.Eff.Console.print test5
48− Debug.Trace.print test6
48+ Control.Monad.Eff.Console.print test6
49− Debug.Trace.print (test7 100)
49+ Control.Monad.Eff.Console.print (test7 100.0)
examples/passing/iota.purs+4−4
@@ -1,9 +1,9 @@
1module Main where
1module Main where
2
2
3− s = \x -> \y -> \z -> x z (y z)
3+s = \x -> \y -> \z -> x z (y z)
4
4
5− k = \x -> \y -> x
5+k = \x -> \y -> x
6
6
7− iota = \x -> x s k
7+iota = \x -> x s k
8
8
9− main = Debug.Trace.trace "Done"
9+main = Control.Monad.Eff.Console.log "Done"
examples/passing/s.purs+5−3
@@ -1,5 +1,7 @@
1module Main where
1module Main where
2
2
3+import Prelude
4+
3− s = \x y z -> x z (y z)
5+s = \x y z -> x z (y z)
4−
6+
5− main = Debug.Trace.trace "Done"
7+main = Control.Monad.Eff.Console.log "Done"
hierarchy/Main.hs+44−34
@@ -2,7 +2,7 @@
2--
2--
3-- Module : Main
3-- Module : Main
4-- Copyright : (c) Hardy Jones 2014
4-- Copyright : (c) Hardy Jones 2014
5−-- License : MIT
5+-- License : MIT (http://opensource.org/licenses/MIT)
6--
6--
7-- Maintainer : Hardy Jones <jones3.hardy@gmail.com>
7-- Maintainer : Hardy Jones <jones3.hardy@gmail.com>
8-- Stability : experimental
8-- Stability : experimental
@@ -13,26 +13,30 @@
13--
13--
14-----------------------------------------------------------------------------
14-----------------------------------------------------------------------------
15
15
16+{-# LANGUAGE TupleSections #-}
17+
16module Main where
18module Main where
17
19
18−import Control.Applicative ((<*>), (<$>))
19import Control.Monad (unless)
20import Control.Monad (unless)
20
21
21import Data.List (intercalate,nub,sort)
22import Data.List (intercalate,nub,sort)
22import Data.Foldable (for_)
23import Data.Foldable (for_)
23import Data.Version (showVersion)
24import Data.Version (showVersion)
24
25
25−import System.Console.CmdTheLine
26+import Options.Applicative
26import System.Directory (createDirectoryIfMissing)
27import System.Directory (createDirectoryIfMissing)
27import System.FilePath ((</>))
28import System.FilePath ((</>))
29+import System.FilePath.Glob (glob)
28import System.Exit (exitFailure, exitSuccess)
30import System.Exit (exitFailure, exitSuccess)
29−import System.IO (stderr)
31+import System.IO (hPutStr, stderr)
30−
31−import Text.Parsec (ParseError)
32
32
33import qualified Language.PureScript as P
33import qualified Language.PureScript as P
34import qualified Paths_purescript as Paths
34import qualified Paths_purescript as Paths
35−import qualified System.IO.UTF8 as U
35+
36+data HierarchyOptions = HierarchyOptions
37+ { hierachyInput :: FilePath
38+ , hierarchyOutput :: Maybe FilePath
39+ }
36
40
37newtype SuperMap = SuperMap { unSuperMap :: Either P.ProperName (P.ProperName, P.ProperName) }
41newtype SuperMap = SuperMap { unSuperMap :: Either P.ProperName (P.ProperName, P.ProperName) }
38 deriving Eq
42 deriving Eq
@@ -49,18 +53,19 @@ instance Ord SuperMap where
49runModuleName :: P.ModuleName -> String
53runModuleName :: P.ModuleName -> String
50runModuleName (P.ModuleName pns) = intercalate "_" (P.runProperName `map` pns)
54runModuleName (P.ModuleName pns) = intercalate "_" (P.runProperName `map` pns)
51
55
52−readInput :: FilePath -> IO (Either ParseError [P.Module])
56+readInput :: [FilePath] -> IO (Either P.MultipleErrors [P.Module])
53−readInput p = do
57+readInput paths = do
54− text <- U.readFile p
58+ content <- mapM (\path -> (path, ) <$> readFile path) paths
55− return $ P.runIndentParser p P.parseModules text
59+ return $ map snd <$> P.parseModulesFromFiles id content
56
60
57−compile :: FilePath -> Maybe FilePath -> IO ()
61+compile :: HierarchyOptions -> IO ()
58−compile input mOutput = do
62+compile (HierarchyOptions inputGlob mOutput) = do
63+ input <- glob inputGlob
59 modules <- readInput input
64 modules <- readInput input
60 case modules of
65 case modules of
61− Left err -> U.hPutStr stderr (show err) >> exitFailure
66+ Left errs -> hPutStr stderr (P.prettyPrintMultipleErrors False errs) >> exitFailure
62 Right ms -> do
67 Right ms -> do
63− for_ ms $ \(P.Module moduleName decls _) ->
68+ for_ ms $ \(P.Module _ _ moduleName decls _) ->
64 let name = runModuleName moduleName
69 let name = runModuleName moduleName
65 tcs = filter P.isTypeClassDeclaration decls
70 tcs = filter P.isTypeClassDeclaration decls
66 supers = sort . nub . filter (not . null) $ fmap superClasses tcs
71 supers = sort . nub . filter (not . null) $ fmap superClasses tcs
@@ -71,34 +76,39 @@ compile input mOutput = do
71 in unless (null supers) $ case mOutput of
76 in unless (null supers) $ case mOutput of
72 Just output -> do
77 Just output -> do
73 createDirectoryIfMissing True output
78 createDirectoryIfMissing True output
74− U.writeFile (output </> name) hier
79+ writeFile (output </> name) hier
75− Nothing -> U.putStrLn hier
80+ Nothing -> putStrLn hier
76 exitSuccess
81 exitSuccess
77
82
78superClasses :: P.Declaration -> [SuperMap]
83superClasses :: P.Declaration -> [SuperMap]
79superClasses (P.TypeClassDeclaration sub _ supers@(_:_) _) =
84superClasses (P.TypeClassDeclaration sub _ supers@(_:_) _) =
80 fmap (\(P.Qualified _ super, _) -> SuperMap (Right (super, sub))) supers
85 fmap (\(P.Qualified _ super, _) -> SuperMap (Right (super, sub))) supers
81superClasses (P.TypeClassDeclaration sub _ _ _) = [SuperMap (Left sub)]
86superClasses (P.TypeClassDeclaration sub _ _ _) = [SuperMap (Left sub)]
82−superClasses (P.PositionedDeclaration _ decl) = superClasses decl
87+superClasses (P.PositionedDeclaration _ _ decl) = superClasses decl
83superClasses _ = []
88superClasses _ = []
84
89
85−outputFile :: Term (Maybe FilePath)
90+inputFile :: Parser FilePath
86−outputFile = value $ opt Nothing $ (optInfo [ "o", "output" ])
91+inputFile = strArgument $
87− { optDoc = "The output directory" }
92+ metavar "FILE"
93+ <> value "main.purs"
94+ <> showDefault
95+ <> help "The input file to generate a hierarchy from"
88
96
89−inputFile :: Term FilePath
97+outputFile :: Parser (Maybe FilePath)
90−inputFile = value $ pos 0 "main.purs" $ posInfo
98+outputFile = optional . strOption $
91− { posDoc = "The input file to generate a hierarchy from" }
99+ short 'o'
100+ <> long "output"
101+ <> help "The output directory"
92
102
93−term :: Term (IO ())
103+pscOptions :: Parser HierarchyOptions
104+pscOptions = HierarchyOptions <$> inputFile
94−term = compile <$> inputFile <*> outputFile
105+ <*> outputFile
95−
96−termInfo :: TermInfo
97−termInfo = defTI
98− { termName = "hierarchy"
99− , version = showVersion Paths.version
100− , termDoc = "Creates a GraphViz directed graph of PureScript TypeClasses"
101− }
102
106
103main :: IO ()
107main :: IO ()
104−main = run (term, termInfo)
108+main = execParser opts >>= compile
109+ where
110+ opts = info (helper <*> pscOptions) infoModList
111+ infoModList = fullDesc <> headerInfo <> footerInfo
112+ headerInfo = header "hierarchy - Creates a GraphViz directed graph of PureScript TypeClasses"
113+ footerInfo = footer $ "hierarchy " ++ showVersion Paths.version
114+
license-generator/generatenew file+44
@@ -0,0 +1,44 @@
1+#!/bin/bash
2+# Generates the LICENSE file and prints it to standard output.
3+# Example use:
4+#
5+# ./license/generate > LICENSE
6+#
7+
8+set -e # exit on error
9+set -u # exit on undefined variable
10+set -o pipefail # propagate nonzero exit codes through pipelines
11+
12+if ! which cabal-dependency-licenses >/dev/null; then
13+ echo "$0: the program 'cabal-dependency-licenses' is required." >&2
14+ echo "$0: see Hackage: https://hackage.haskell.org/package/cabal-dependency-licenses" >&2
15+ exit 1
16+fi
17+
18+echo_header() {
19+ cat license-generator/header.txt
20+}
21+
22+echo_deps_names() {
23+ cabal-dependency-licenses \
24+ | grep '^- ' | sed 's/^..//' | gsort -h
25+}
26+
27+echo_deps_licenses() {
28+ while read dep; do
29+ echo "fetching LICENSE for: ${dep}" >&2
30+ echo "${dep} LICENSE file:"
31+ echo ""
32+ curl --silent "https://hackage.haskell.org/package/${dep}/src/LICENSE" \
33+ | sed 's/^/ /g' # indent by 2 characters
34+ echo ""
35+ done
36+}
37+
38+echo_deps_names > license-generator/tmp/deps.txt
39+
40+echo_header
41+echo ""
42+sed <license-generator/tmp/deps.txt 's/^/ /'
43+echo ""
44+echo_deps_licenses <license-generator/tmp/deps.txt
license-generator/header.txtnew file+23
@@ -0,0 +1,23 @@
1+The MIT License (MIT)
2+
3+Copyright (c) 2013-15 Phil Freeman, (c) 2014-2015 Gary Burgess, and other
4+contributors
5+
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:
12+
13+The above copyright notice and this permission notice shall be included in all
14+copies or substantial portions of the Software.
15+
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.
22+
23+PureScript uses the following Haskell library packages. Their license files follow.
license-generator/tmp/.gitkeepnew file

No changes to the content.

logo.pngnew file

Binary file not shown.

prelude/README.mddeleted−383
@@ -1,383 +0,0 @@
1−# Module Documentation
2−
3−## Module Prelude
4−
5−### Types
6−
7− data Ordering where
8− LT :: Ordering
9− GT :: Ordering
10− EQ :: Ordering
11−
12− data Unit where
13− Unit :: { } -> Unit
14−
15−
16−### Type Classes
17−
18−![Prelude](images/Prelude.png)
19−
20− class Alternative f where
21− empty :: forall a. f a
22− (<|>) :: forall a. f a -> f a -> f a
23−
24− class (Apply f) <= Applicative f where
25− pure :: forall a. a -> f a
26−
27− class (Functor f) <= Apply f where
28− (<*>) :: forall a b. f (a -> b) -> f a -> f b
29−
30− class (Apply m) <= Bind m where
31− (>>=) :: forall a b. m a -> (a -> m b) -> m b
32−
33− class Bits b where
34− (&) :: b -> b -> b
35− (|) :: b -> b -> b
36− (^) :: b -> b -> b
37− shl :: b -> Number -> b
38− shr :: b -> Number -> b
39− zshr :: b -> Number -> b
40− complement :: b -> b
41−
42− class BoolLike b where
43− (&&) :: b -> b -> b
44− (||) :: b -> b -> b
45− not :: b -> b
46−
47− class (Semigroupoid a) <= Category a where
48− id :: forall t. a t t
49−
50− class Eq a where
51− (==) :: a -> a -> Boolean
52− (/=) :: a -> a -> Boolean
53−
54− class Functor f where
55− (<$>) :: forall a b. (a -> b) -> f a -> f b
56−
57− class (Applicative m, Bind m) <= Monad m where
58−
59− class Num a where
60− (+) :: a -> a -> a
61− (-) :: a -> a -> a
62− (*) :: a -> a -> a
63− (/) :: a -> a -> a
64− (%) :: a -> a -> a
65− negate :: a -> a
66−
67− class (Eq a) <= Ord a where
68− compare :: a -> a -> Ordering
69−
70− class Semigroup a where
71− (<>) :: a -> a -> a
72−
73− class Semigroupoid a where
74− (<<<) :: forall b c d. a c d -> a b c -> a b d
75−
76− class Show a where
77− show :: a -> String
78−
79−
80−### Type Class Instances
81−
82− instance applicativeArr :: Applicative (Prim.Function r)
83−
84− instance applyArr :: Apply (Prim.Function r)
85−
86− instance bindArr :: Bind (Prim.Function r)
87−
88− instance bitsNumber :: Bits Number
89−
90− instance boolLikeBoolean :: BoolLike Boolean
91−
92− instance categoryArr :: Category Prim.Function
93−
94− instance eqArray :: (Eq a) => Eq [a]
95−
96− instance eqBoolean :: Eq Boolean
97−
98− instance eqNumber :: Eq Number
99−
100− instance eqOrdering :: Eq Ordering
101−
102− instance eqString :: Eq String
103−
104− instance eqUnit :: Eq Unit
105−
106− instance functorArr :: Functor (Prim.Function r)
107−
108− instance monadArr :: Monad (Prim.Function r)
109−
110− instance numNumber :: Num Number
111−
112− instance ordArray :: (Ord a) => Ord [a]
113−
114− instance ordBoolean :: Ord Boolean
115−
116− instance ordNumber :: Ord Number
117−
118− instance ordString :: Ord String
119−
120− instance ordUnit :: Ord Unit
121−
122− instance semigroupArr :: (Semigroup s') => Semigroup (s -> s')
123−
124− instance semigroupString :: Semigroup String
125−
126− instance semigroupUnit :: Semigroup Unit
127−
128− instance semigroupoidArr :: Semigroupoid Prim.Function
129−
130− instance showArray :: (Show a) => Show [a]
131−
132− instance showBoolean :: Show Boolean
133−
134− instance showNumber :: Show Number
135−
136− instance showOrdering :: Show Ordering
137−
138− instance showString :: Show String
139−
140− instance showUnit :: Show Unit
141−
142−
143−### Values
144−
145− (#) :: forall a b. a -> (a -> b) -> b
146−
147− ($) :: forall a b. (a -> b) -> a -> b
148−
149− (++) :: forall s. (Semigroup s) => s -> s -> s
150−
151− (:) :: forall a. a -> [a] -> [a]
152−
153− (<) :: forall a. (Ord a) => a -> a -> Boolean
154−
155− (<=) :: forall a. (Ord a) => a -> a -> Boolean
156−
157− (>) :: forall a. (Ord a) => a -> a -> Boolean
158−
159− (>=) :: forall a. (Ord a) => a -> a -> Boolean
160−
161− (>>>) :: forall a b c d. (Semigroupoid a) => a b c -> a c d -> a b d
162−
163− ap :: forall m a b. (Monad m) => m (a -> b) -> m a -> m b
164−
165− asTypeOf :: forall a. a -> a -> a
166−
167− cons :: forall a. a -> [a] -> [a]
168−
169− const :: forall a b. a -> b -> a
170−
171− flip :: forall a b c. (a -> b -> c) -> b -> a -> c
172−
173− liftA1 :: forall f a b. (Applicative f) => (a -> b) -> f a -> f b
174−
175− liftM1 :: forall m a b. (Monad m) => (a -> b) -> m a -> m b
176−
177− refEq :: forall a. a -> a -> Boolean
178−
179− refIneq :: forall a. a -> a -> Boolean
180−
181− return :: forall m a. (Monad m) => a -> m a
182−
183− unit :: Unit
184−
185− void :: forall f a. (Functor f) => f a -> f Unit
186−
187−
188−## Module Data.Function
189−
190−### Types
191−
192− data Fn0 :: * -> *
193−
194− data Fn1 :: * -> * -> *
195−
196− data Fn10 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *
197−
198− data Fn2 :: * -> * -> * -> *
199−
200− data Fn3 :: * -> * -> * -> * -> *
201−
202− data Fn4 :: * -> * -> * -> * -> * -> *
203−
204− data Fn5 :: * -> * -> * -> * -> * -> * -> *
205−
206− data Fn6 :: * -> * -> * -> * -> * -> * -> * -> *
207−
208− data Fn7 :: * -> * -> * -> * -> * -> * -> * -> * -> *
209−
210− data Fn8 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> *
211−
212− data Fn9 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *
213−
214−
215−### Values
216−
217− mkFn0 :: forall a. (Unit -> a) -> Fn0 a
218−
219− mkFn1 :: forall a b. (a -> b) -> Fn1 a b
220−
221− mkFn10 :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k
222−
223− mkFn2 :: forall a b c. (a -> b -> c) -> Fn2 a b c
224−
225− mkFn3 :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d
226−
227− mkFn4 :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e
228−
229− mkFn5 :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f
230−
231− mkFn6 :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g
232−
233− mkFn7 :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h
234−
235− mkFn8 :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i
236−
237− mkFn9 :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j
238−
239− on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c
240−
241− runFn0 :: forall a. Fn0 a -> a
242−
243− runFn1 :: forall a b. Fn1 a b -> a -> b
244−
245− runFn10 :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k
246−
247− runFn2 :: forall a b c. Fn2 a b c -> a -> b -> c
248−
249− runFn3 :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d
250−
251− runFn4 :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e
252−
253− runFn5 :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f
254−
255− runFn6 :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g
256−
257− runFn7 :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h
258−
259− runFn8 :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i
260−
261− runFn9 :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j
262−
263−
264−## Module Data.Eq
265−
266−### Types
267−
268− data Ref a where
269− Ref :: a -> Ref a
270−
271−
272−### Type Class Instances
273−
274− instance eqRef :: Eq (Ref a)
275−
276− instance functorRef :: Functor Ref
277−
278−
279−### Values
280−
281− liftRef :: forall a b. (a -> a -> b) -> Ref a -> Ref a -> b
282−
283−
284−## Module Prelude.Unsafe
285−
286−### Values
287−
288− unsafeIndex :: forall a. [a] -> Number -> a
289−
290−
291−## Module Control.Monad.Eff
292−
293−### Types
294−
295− data Eff :: # ! -> * -> *
296−
297− type Pure a = forall e. Eff e a
298−
299−
300−### Type Class Instances
301−
302− instance applicativeEff :: Applicative (Eff e)
303−
304− instance applyEff :: Apply (Eff e)
305−
306− instance bindEff :: Bind (Eff e)
307−
308− instance functorEff :: Functor (Eff e)
309−
310− instance monadEff :: Monad (Eff e)
311−
312−
313−### Values
314−
315− bindE :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b
316−
317− forE :: forall e. Number -> Number -> (Number -> Eff e Unit) -> Eff e Unit
318−
319− foreachE :: forall e a. [a] -> (a -> Eff e Unit) -> Eff e Unit
320−
321− returnE :: forall e a. a -> Eff e a
322−
323− runPure :: forall a. Pure a -> a
324−
325− untilE :: forall e. Eff e Boolean -> Eff e Unit
326−
327− whileE :: forall e a. Eff e Boolean -> Eff e a -> Eff e Unit
328−
329−
330−## Module Control.Monad.Eff.Unsafe
331−
332−### Values
333−
334− unsafeInterleaveEff :: forall eff1 eff2 a. Eff eff1 a -> Eff eff2 a
335−
336−
337−## Module Debug.Trace
338−
339−### Types
340−
341− data Trace :: !
342−
343−
344−### Values
345−
346− print :: forall a r. (Show a) => a -> Eff (trace :: Trace | r) Unit
347−
348− trace :: forall r. String -> Eff (trace :: Trace | r) Unit
349−
350−
351−## Module Control.Monad.ST
352−
353−### Types
354−
355− data ST :: * -> !
356−
357− data STArray :: * -> * -> *
358−
359− data STRef :: * -> * -> *
360−
361−
362−### Values
363−
364− modifySTRef :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) a
365−
366− newSTArray :: forall a h r. Number -> a -> Eff (st :: ST h | r) (STArray h a)
367−
368− newSTRef :: forall a h r. a -> Eff (st :: ST h | r) (STRef h a)
369−
370− peekSTArray :: forall a h r. STArray h a -> Eff (st :: ST h | r) a
371−
372− pokeSTArray :: forall a h r. STArray h a -> Number -> a -> Eff (st :: ST h | r) a
373−
374− readSTRef :: forall a h r. STRef h a -> Eff (st :: ST h | r) a
375−
376− runST :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a
377−
378− runSTArray :: forall a r. (forall h. Eff (st :: ST h | r) (STArray h a)) -> Eff r [a]
379−
380− writeSTRef :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a
381−
382−
383−
prelude/images/Prelude.pngdeleted

Binary file not shown.

prelude/prelude.pursdeleted−951
@@ -1,951 +0,0 @@
1−module Prelude
2− ( flip
3− , const
4− , asTypeOf
5− , Semigroupoid, (<<<), (>>>)
6− , Category, id
7− , ($), (#)
8− , (:), cons
9− , Show, show
10− , Functor, (<$>), void
11− , Apply, (<*>)
12− , Applicative, pure, liftA1
13− , Alternative, empty, (<|>)
14− , Bind, (>>=)
15− , Monad, return, liftM1, ap
16− , Num, (+), (-), (*), (/), (%)
17− , negate
18− , Eq, (==), (/=), refEq, refIneq
19− , Ord, Ordering(..), compare, (<), (>), (<=), (>=)
20− , Bits, (&), (|), (^), shl, shr, zshr, complement
21− , BoolLike, (&&), (||)
22− , not
23− , Semigroup, (<>), (++)
24− , Unit(..), unit
25− ) where
26−
27− flip :: forall a b c. (a -> b -> c) -> b -> a -> c
28− flip f b a = f a b
29−
30− const :: forall a b. a -> b -> a
31− const a _ = a
32−
33− asTypeOf :: forall a. a -> a -> a
34− asTypeOf x _ = x
35−
36− infixr 9 >>>
37− infixr 9 <<<
38−
39− class Semigroupoid a where
40− (<<<) :: forall b c d. a c d -> a b c -> a b d
41−
42− instance semigroupoidArr :: Semigroupoid (->) where
43− (<<<) f g x = f (g x)
44−
45− (>>>) :: forall a b c d. (Semigroupoid a) => a b c -> a c d -> a b d
46− (>>>) f g = g <<< f
47−
48− class (Semigroupoid a) <= Category a where
49− id :: forall t. a t t
50−
51− instance categoryArr :: Category (->) where
52− id x = x
53−
54− infixr 0 $
55− infixl 0 #
56−
57− ($) :: forall a b. (a -> b) -> a -> b
58− ($) f x = f x
59−
60− (#) :: forall a b. a -> (a -> b) -> b
61− (#) x f = f x
62−
63− infixr 6 :
64−
65− (:) :: forall a. a -> [a] -> [a]
66− (:) = cons
67−
68− foreign import cons
69− "function cons(e) {\
70− \ return function (l) {\
71− \ return [e].concat(l);\
72− \ };\
73− \}" :: forall a. a -> [a] -> [a]
74−
75− class Show a where
76− show :: a -> String
77−
78− foreign import showStringImpl
79− "function showStringImpl(s) {\
80− \ return JSON.stringify(s);\
81− \}" :: String -> String
82−
83− instance showUnit :: Show Unit where
84− show (Unit {}) = "Unit {}"
85−
86− instance showString :: Show String where
87− show = showStringImpl
88−
89− instance showBoolean :: Show Boolean where
90− show true = "true"
91− show false = "false"
92−
93− foreign import showNumberImpl "function showNumberImpl(n) {\
94− \ return n.toString();\
95− \}" :: Number -> String
96−
97− instance showNumber :: Show Number where
98− show = showNumberImpl
99−
100− foreign import showArrayImpl
101− "function showArrayImpl (f) {\
102− \ return function (xs) {\
103− \ var ss = [];\
104− \ for (var i = 0, l = xs.length; i < l; i++) {\
105− \ ss[i] = f(xs[i]);\
106− \ }\
107− \ return '[' + ss.join(',') + ']';\
108− \ };\
109− \}" :: forall a. (a -> String) -> [a] -> String
110−
111− instance showArray :: (Show a) => Show [a] where
112− show = showArrayImpl show
113−
114− infixl 4 <$>
115−
116− class Functor f where
117− (<$>) :: forall a b. (a -> b) -> f a -> f b
118−
119− void :: forall f a. (Functor f) => f a -> f Unit
120− void fa = const unit <$> fa
121−
122− infixl 4 <*>
123−
124− class (Functor f) <= Apply f where
125− (<*>) :: forall a b. f (a -> b) -> f a -> f b
126−
127− class (Apply f) <= Applicative f where
128− pure :: forall a. a -> f a
129−
130− liftA1 :: forall f a b. (Applicative f) => (a -> b) -> f a -> f b
131− liftA1 f a = pure f <*> a
132−
133− infixl 3 <|>
134−
135− class Alternative f where
136− empty :: forall a. f a
137− (<|>) :: forall a. f a -> f a -> f a
138−
139− infixl 1 >>=
140−
141− class (Apply m) <= Bind m where
142− (>>=) :: forall a b. m a -> (a -> m b) -> m b
143−
144− class (Applicative m, Bind m) <= Monad m
145−
146− return :: forall m a. (Monad m) => a -> m a
147− return = pure
148−
149− liftM1 :: forall m a b. (Monad m) => (a -> b) -> m a -> m b
150− liftM1 f a = do
151− a' <- a
152− return (f a')
153−
154− ap :: forall m a b. (Monad m) => m (a -> b) -> m a -> m b
155− ap f a = do
156− f' <- f
157− a' <- a
158− return (f' a')
159−
160− instance functorArr :: Functor ((->) r) where
161− (<$>) = (<<<)
162−
163− instance applyArr :: Apply ((->) r) where
164− (<*>) f g x = f x (g x)
165−
166− instance applicativeArr :: Applicative ((->) r) where
167− pure = const
168−
169− instance bindArr :: Bind ((->) r) where
170− (>>=) m f x = f (m x) x
171−
172− instance monadArr :: Monad ((->) r)
173−
174− infixl 7 *
175− infixl 7 /
176− infixl 7 %
177−
178− infixl 6 -
179− infixl 6 +
180−
181− class Num a where
182− (+) :: a -> a -> a
183− (-) :: a -> a -> a
184− (*) :: a -> a -> a
185− (/) :: a -> a -> a
186− (%) :: a -> a -> a
187− negate :: a -> a
188−
189− foreign import numAdd "function numAdd(n1) {\
190− \ return function(n2) {\
191− \ return n1 + n2;\
192− \ };\
193− \}" :: Number -> Number -> Number
194−
195− foreign import numSub "function numSub(n1) {\
196− \ return function(n2) {\
197− \ return n1 - n2;\
198− \ };\
199− \}" :: Number -> Number -> Number
200−
201− foreign import numMul "function numMul(n1) {\
202− \ return function(n2) {\
203− \ return n1 * n2;\
204− \ };\
205− \}" :: Number -> Number -> Number
206−
207− foreign import numDiv "function numDiv(n1) {\
208− \ return function(n2) {\
209− \ return n1 / n2;\
210− \ };\
211− \}" :: Number -> Number -> Number
212−
213− foreign import numMod "function numMod(n1) {\
214− \ return function(n2) {\
215− \ return n1 % n2;\
216− \ };\
217− \}" :: Number -> Number -> Number
218−
219− foreign import numNegate "function numNegate(n) {\
220− \ return -n;\
221− \}" :: Number -> Number
222−
223− instance numNumber :: Num Number where
224− (+) = numAdd
225− (-) = numSub
226− (*) = numMul
227− (/) = numDiv
228− (%) = numMod
229− negate = numNegate
230−
231− newtype Unit = Unit {}
232−
233− unit :: Unit
234− unit = Unit {}
235−
236− infix 4 ==
237− infix 4 /=
238−
239− class Eq a where
240− (==) :: a -> a -> Boolean
241− (/=) :: a -> a -> Boolean
242−
243− foreign import refEq
244− "function refEq(r1) {\
245− \ return function(r2) {\
246− \ return r1 === r2;\
247− \ };\
248− \}" :: forall a. a -> a -> Boolean
249−
250− foreign import refIneq
251− "function refIneq(r1) {\
252− \ return function(r2) {\
253− \ return r1 !== r2;\
254− \ };\
255− \}" :: forall a. a -> a -> Boolean
256−
257− instance eqUnit :: Eq Unit where
258− (==) (Unit {}) (Unit {}) = true
259− (/=) (Unit {}) (Unit {}) = false
260−
261− instance eqString :: Eq String where
262− (==) = refEq
263− (/=) = refIneq
264−
265− instance eqNumber :: Eq Number where
266− (==) = refEq
267− (/=) = refIneq
268−
269− instance eqBoolean :: Eq Boolean where
270− (==) = refEq
271− (/=) = refIneq
272−
273− foreign import eqArrayImpl
274− "function eqArrayImpl(f) {\
275− \ return function(xs) {\
276− \ return function(ys) {\
277− \ if (xs.length !== ys.length) return false;\
278− \ for (var i = 0; i < xs.length; i++) {\
279− \ if (!f(xs[i])(ys[i])) return false;\
280− \ }\
281− \ return true;\
282− \ };\
283− \ };\
284− \}" :: forall a. (a -> a -> Boolean) -> [a] -> [a] -> Boolean
285−
286− instance eqArray :: (Eq a) => Eq [a] where
287− (==) xs ys = eqArrayImpl (==) xs ys
288− (/=) xs ys = not (xs == ys)
289−
290− data Ordering = LT | GT | EQ
291−
292− instance eqOrdering :: Eq Ordering where
293− (==) LT LT = true
294− (==) GT GT = true
295− (==) EQ EQ = true
296− (==) _ _ = false
297− (/=) x y = not (x == y)
298−
299− instance showOrdering :: Show Ordering where
300− show LT = "LT"
301− show GT = "GT"
302− show EQ = "EQ"
303−
304− class (Eq a) <= Ord a where
305− compare :: a -> a -> Ordering
306−
307− infixl 4 <
308−
309− (<) :: forall a. (Ord a) => a -> a -> Boolean
310− (<) a1 a2 = case a1 `compare` a2 of
311− LT -> true
312− _ -> false
313−
314− infixl 4 >
315−
316− (>) :: forall a. (Ord a) => a -> a -> Boolean
317− (>) a1 a2 = case a1 `compare` a2 of
318− GT -> true
319− _ -> false
320−
321− infixl 4 <=
322−
323− (<=) :: forall a. (Ord a) => a -> a -> Boolean
324− (<=) a1 a2 = case a1 `compare` a2 of
325− GT -> false
326− _ -> true
327−
328− infixl 4 >=
329−
330− (>=) :: forall a. (Ord a) => a -> a -> Boolean
331− (>=) a1 a2 = case a1 `compare` a2 of
332− LT -> false
333− _ -> true
334−
335− foreign import unsafeCompareImpl
336− "function unsafeCompareImpl(lt) {\
337− \ return function (eq) {\
338− \ return function (gt) {\
339− \ return function (x) {\
340− \ return function (y) {\
341− \ return x < y ? lt : x > y ? gt : eq;\
342− \ };\
343− \ };\
344− \ };\
345− \ };\
346− \}" :: forall a. Ordering -> Ordering -> Ordering -> a -> a -> Ordering
347−
348− unsafeCompare :: forall a. a -> a -> Ordering
349− unsafeCompare = unsafeCompareImpl LT EQ GT
350−
351− instance ordUnit :: Ord Unit where
352− compare (Unit {}) (Unit {}) = EQ
353−
354− instance ordBoolean :: Ord Boolean where
355− compare false false = EQ
356− compare false true = LT
357− compare true true = EQ
358− compare true false = GT
359−
360− instance ordNumber :: Ord Number where
361− compare = unsafeCompare
362−
363− instance ordString :: Ord String where
364− compare = unsafeCompare
365−
366− instance ordArray :: (Ord a) => Ord [a] where
367− compare [] [] = EQ
368− compare [] _ = LT
369− compare _ [] = GT
370− compare (x:xs) (y:ys) = case compare x y of
371− EQ -> compare xs ys
372− other -> other
373−
374− infixl 10 &
375− infixl 10 |
376− infixl 10 ^
377−
378− class Bits b where
379− (&) :: b -> b -> b
380− (|) :: b -> b -> b
381− (^) :: b -> b -> b
382− shl :: b -> Number -> b
383− shr :: b -> Number -> b
384− zshr :: b -> Number -> b
385− complement :: b -> b
386−
387− foreign import numShl "function numShl(n1) {\
388− \ return function(n2) {\
389− \ return n1 << n2;\
390− \ };\
391− \}" :: Number -> Number -> Number
392−
393− foreign import numShr "function numShr(n1) {\
394− \ return function(n2) {\
395− \ return n1 >> n2;\
396− \ };\
397− \}" :: Number -> Number -> Number
398−
399− foreign import numZshr "function numZshr(n1) {\
400− \ return function(n2) {\
401− \ return n1 >>> n2;\
402− \ };\
403− \}" :: Number -> Number -> Number
404−
405− foreign import numAnd "function numAnd(n1) {\
406− \ return function(n2) {\
407− \ return n1 & n2;\
408− \ };\
409− \}" :: Number -> Number -> Number
410−
411− foreign import numOr "function numOr(n1) {\
412− \ return function(n2) {\
413− \ return n1 | n2;\
414− \ };\
415− \}" :: Number -> Number -> Number
416−
417− foreign import numXor "function numXor(n1) {\
418− \ return function(n2) {\
419− \ return n1 ^ n2;\
420− \ };\
421− \}" :: Number -> Number -> Number
422−
423− foreign import numComplement "function numComplement(n) {\
424− \ return ~n;\
425− \}" :: Number -> Number
426−
427− instance bitsNumber :: Bits Number where
428− (&) = numAnd
429− (|) = numOr
430− (^) = numXor
431− shl = numShl
432− shr = numShr
433− zshr = numZshr
434− complement = numComplement
435−
436− infixr 2 ||
437− infixr 3 &&
438−
439− class BoolLike b where
440− (&&) :: b -> b -> b
441− (||) :: b -> b -> b
442− not :: b -> b
443−
444− foreign import boolAnd "function boolAnd(b1) {\
445− \ return function(b2) {\
446− \ return b1 && b2;\
447− \ };\
448− \}" :: Boolean -> Boolean -> Boolean
449−
450− foreign import boolOr "function boolOr(b1) {\
451− \ return function(b2) {\
452− \ return b1 || b2;\
453− \ };\
454− \}" :: Boolean -> Boolean -> Boolean
455−
456− foreign import boolNot "function boolNot(b) {\
457− \ return !b;\
458− \}" :: Boolean -> Boolean
459−
460− instance boolLikeBoolean :: BoolLike Boolean where
461− (&&) = boolAnd
462− (||) = boolOr
463− not = boolNot
464−
465− infixr 5 <>
466−
467− class Semigroup a where
468− (<>) :: a -> a -> a
469−
470− foreign import concatString
471− "function concatString(s1) {\
472− \ return function(s2) {\
473− \ return s1 + s2;\
474− \ };\
475− \}" :: String -> String -> String
476−
477− instance semigroupUnit :: Semigroup Unit where
478− (<>) (Unit {}) (Unit {}) = Unit {}
479−
480− instance semigroupString :: Semigroup String where
481− (<>) = concatString
482−
483− instance semigroupArr :: (Semigroup s') => Semigroup (s -> s') where
484− (<>) f g = \x -> f x <> g x
485−
486− infixr 5 ++
487−
488− (++) :: forall s. (Semigroup s) => s -> s -> s
489− (++) = (<>)
490−
491−module Data.Function where
492−
493− on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c
494− on f g x y = g x `f` g y
495−
496− foreign import data Fn0 :: * -> *
497− foreign import data Fn1 :: * -> * -> *
498− foreign import data Fn2 :: * -> * -> * -> *
499− foreign import data Fn3 :: * -> * -> * -> * -> *
500− foreign import data Fn4 :: * -> * -> * -> * -> * -> *
501− foreign import data Fn5 :: * -> * -> * -> * -> * -> * -> *
502− foreign import data Fn6 :: * -> * -> * -> * -> * -> * -> * -> *
503− foreign import data Fn7 :: * -> * -> * -> * -> * -> * -> * -> * -> *
504− foreign import data Fn8 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> *
505− foreign import data Fn9 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *
506− foreign import data Fn10 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *
507−
508− foreign import mkFn0
509− "function mkFn0(fn) {\
510− \ return function() {\
511− \ return fn({});\
512− \ };\
513− \}" :: forall a. (Unit -> a) -> Fn0 a
514−
515− foreign import mkFn1
516− "function mkFn1(fn) {\
517− \ return function(a) {\
518− \ return fn(a);\
519− \ };\
520− \}" :: forall a b. (a -> b) -> Fn1 a b
521−
522− foreign import mkFn2
523− "function mkFn2(fn) {\
524− \ return function(a, b) {\
525− \ return fn(a)(b);\
526− \ };\
527− \}" :: forall a b c. (a -> b -> c) -> Fn2 a b c
528−
529− foreign import mkFn3
530− "function mkFn3(fn) {\
531− \ return function(a, b, c) {\
532− \ return fn(a)(b)(c);\
533− \ };\
534− \}" :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d
535−
536− foreign import mkFn4
537− "function mkFn4(fn) {\
538− \ return function(a, b, c, d) {\
539− \ return fn(a)(b)(c)(d);\
540− \ };\
541− \}" :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e
542−
543− foreign import mkFn5
544− "function mkFn5(fn) {\
545− \ return function(a, b, c, d, e) {\
546− \ return fn(a)(b)(c)(d)(e);\
547− \ };\
548− \}" :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f
549−
550− foreign import mkFn6
551− "function mkFn6(fn) {\
552− \ return function(a, b, c, d, e, f) {\
553− \ return fn(a)(b)(c)(d)(e)(f);\
554− \ };\
555− \}" :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g
556−
557− foreign import mkFn7
558− "function mkFn7(fn) {\
559− \ return function(a, b, c, d, e, f, g) {\
560− \ return fn(a)(b)(c)(d)(e)(f)(g);\
561− \ };\
562− \}" :: forall a b c d e f g h. (a -> b -> c -> d -> e -> f -> g -> h) -> Fn7 a b c d e f g h
563−
564− foreign import mkFn8
565− "function mkFn8(fn) {\
566− \ return function(a, b, c, d, e, f, g, h) {\
567− \ return fn(a)(b)(c)(d)(e)(f)(g)(h);\
568− \ };\
569− \}" :: forall a b c d e f g h i. (a -> b -> c -> d -> e -> f -> g -> h -> i) -> Fn8 a b c d e f g h i
570−
571− foreign import mkFn9
572− "function mkFn9(fn) {\
573− \ return function(a, b, c, d, e, f, g, h, i) {\
574− \ return fn(a)(b)(c)(d)(e)(f)(g)(h)(i);\
575− \ };\
576− \}" :: forall a b c d e f g h i j. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> Fn9 a b c d e f g h i j
577−
578− foreign import mkFn10
579− "function mkFn10(fn) {\
580− \ return function(a, b, c, d, e, f, g, h, i, j) {\
581− \ return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(j);\
582− \ };\
583− \}" :: forall a b c d e f g h i j k. (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k) -> Fn10 a b c d e f g h i j k
584−
585− foreign import runFn0
586− "function runFn0(fn) {\
587− \ return fn();\
588− \}" :: forall a. Fn0 a -> a
589−
590− foreign import runFn1
591− "function runFn1(fn) {\
592− \ return function(a) {\
593− \ return fn(a);\
594− \ };\
595− \}" :: forall a b. Fn1 a b -> a -> b
596−
597− foreign import runFn2
598− "function runFn2(fn) {\
599− \ return function(a) {\
600− \ return function(b) {\
601− \ return fn(a, b);\
602− \ };\
603− \ };\
604− \}" :: forall a b c. Fn2 a b c -> a -> b -> c
605−
606− foreign import runFn3
607− "function runFn3(fn) {\
608− \ return function(a) {\
609− \ return function(b) {\
610− \ return function(c) {\
611− \ return fn(a, b, c);\
612− \ };\
613− \ };\
614− \ };\
615− \}" :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d
616−
617− foreign import runFn4
618− "function runFn4(fn) {\
619− \ return function(a) {\
620− \ return function(b) {\
621− \ return function(c) {\
622− \ return function(d) {\
623− \ return fn(a, b, c, d);\
624− \ };\
625− \ };\
626− \ };\
627− \ };\
628− \}" :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e
629−
630− foreign import runFn5
631− "function runFn5(fn) {\
632− \ return function(a) {\
633− \ return function(b) {\
634− \ return function(c) {\
635− \ return function(d) {\
636− \ return function(e) {\
637− \ return fn(a, b, c, d, e);\
638− \ };\
639− \ };\
640− \ };\
641− \ };\
642− \ };\
643− \}" :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f
644−
645− foreign import runFn6
646− "function runFn6(fn) {\
647− \ return function(a) {\
648− \ return function(b) {\
649− \ return function(c) {\
650− \ return function(d) {\
651− \ return function(e) {\
652− \ return function(f) {\
653− \ return fn(a, b, c, d, e, f);\
654− \ };\
655− \ };\
656− \ };\
657− \ };\
658− \ };\
659− \ };\
660− \}" :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g
661−
662− foreign import runFn7
663− "function runFn7(fn) {\
664− \ return function(a) {\
665− \ return function(b) {\
666− \ return function(c) {\
667− \ return function(d) {\
668− \ return function(e) {\
669− \ return function(f) {\
670− \ return function(g) {\
671− \ return fn(a, b, c, d, e, f, g);\
672− \ };\
673− \ };\
674− \ };\
675− \ };\
676− \ };\
677− \ };\
678− \ };\
679− \}" :: forall a b c d e f g h. Fn7 a b c d e f g h -> a -> b -> c -> d -> e -> f -> g -> h
680−
681− foreign import runFn8
682− "function runFn8(fn) {\
683− \ return function(a) {\
684− \ return function(b) {\
685− \ return function(c) {\
686− \ return function(d) {\
687− \ return function(e) {\
688− \ return function(f) {\
689− \ return function(g) {\
690− \ return function(h) {\
691− \ return fn(a, b, c, d, e, f, g, h);\
692− \ };\
693− \ };\
694− \ };\
695− \ };\
696− \ };\
697− \ };\
698− \ };\
699− \ };\
700− \}" :: forall a b c d e f g h i. Fn8 a b c d e f g h i -> a -> b -> c -> d -> e -> f -> g -> h -> i
701−
702− foreign import runFn9
703− "function runFn9(fn) {\
704− \ return function(a) {\
705− \ return function(b) {\
706− \ return function(c) {\
707− \ return function(d) {\
708− \ return function(e) {\
709− \ return function(f) {\
710− \ return function(g) {\
711− \ return function(h) {\
712− \ return function(i) {\
713− \ return fn(a, b, c, d, e, f, g, h, i);\
714− \ };\
715− \ };\
716− \ };\
717− \ };\
718− \ };\
719− \ };\
720− \ };\
721− \ };\
722− \ };\
723− \}" :: forall a b c d e f g h i j. Fn9 a b c d e f g h i j -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j
724−
725− foreign import runFn10
726− "function runFn10(fn) {\
727− \ return function(a) {\
728− \ return function(b) {\
729− \ return function(c) {\
730− \ return function(d) {\
731− \ return function(e) {\
732− \ return function(f) {\
733− \ return function(g) {\
734− \ return function(h) {\
735− \ return function(i) {\
736− \ return function(j) {\
737− \ return fn(a, b, c, d, e, f, g, h, i, j);\
738− \ };\
739− \ };\
740− \ };\
741− \ };\
742− \ };\
743− \ };\
744− \ };\
745− \ };\
746− \ };\
747− \ };\
748− \}" :: forall a b c d e f g h i j k. Fn10 a b c d e f g h i j k -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k
749−
750−module Data.Eq where
751−
752− newtype Ref a = Ref a
753−
754− liftRef :: forall a b. (a -> a -> b) -> Ref a -> Ref a -> b
755− liftRef f (Ref x) (Ref y) = f x y
756−
757− instance eqRef :: Eq (Ref a) where
758− (==) = liftRef refEq
759− (/=) = liftRef refIneq
760−
761− instance functorRef :: Functor Ref where
762− (<$>) f (Ref x) = Ref (f x)
763−
764−module Prelude.Unsafe where
765−
766− foreign import unsafeIndex
767− "function unsafeIndex(xs) {\
768− \ return function(n) {\
769− \ return xs[n];\
770− \ };\
771− \}" :: forall a. [a] -> Number -> a
772−
773−module Control.Monad.Eff where
774−
775− foreign import data Eff :: # ! -> * -> *
776−
777− foreign import returnE "function returnE(a) {\
778− \ return function() {\
779− \ return a;\
780− \ };\
781− \}" :: forall e a. a -> Eff e a
782−
783− foreign import bindE "function bindE(a) {\
784− \ return function(f) {\
785− \ return function() {\
786− \ return f(a())();\
787− \ };\
788− \ };\
789− \}" :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b
790−
791− type Pure a = forall e. Eff e a
792−
793− foreign import runPure "function runPure(f) {\
794− \ return f();\
795− \}" :: forall a. Pure a -> a
796−
797− instance functorEff :: Functor (Eff e) where
798− (<$>) = liftA1
799−
800− instance applyEff :: Apply (Eff e) where
801− (<*>) = ap
802−
803− instance applicativeEff :: Applicative (Eff e) where
804− pure = returnE
805−
806− instance bindEff :: Bind (Eff e) where
807− (>>=) = bindE
808−
809− instance monadEff :: Monad (Eff e)
810−
811− foreign import untilE "function untilE(f) {\
812− \ return function() {\
813− \ while (!f()) { }\
814− \ return {};\
815− \ };\
816− \}" :: forall e. Eff e Boolean -> Eff e Unit
817−
818− foreign import whileE "function whileE(f) {\
819− \ return function(a) {\
820− \ return function() {\
821− \ while (f()) {\
822− \ a();\
823− \ }\
824− \ return {};\
825− \ };\
826− \ };\
827− \}" :: forall e a. Eff e Boolean -> Eff e a -> Eff e Unit
828−
829− foreign import forE "function forE(lo) {\
830− \ return function(hi) {\
831− \ return function(f) {\
832− \ return function() {\
833− \ for (var i = lo; i < hi; i++) {\
834− \ f(i)();\
835− \ }\
836− \ };\
837− \ };\
838− \ };\
839− \}" :: forall e. Number -> Number -> (Number -> Eff e Unit) -> Eff e Unit
840−
841−
842− foreign import foreachE "function foreachE(as) {\
843− \ return function(f) {\
844− \ return function() {\
845− \ for (var i = 0; i < as.length; i++) {\
846− \ f(as[i])();\
847− \ }\
848− \ };\
849− \ };\
850− \}" :: forall e a. [a] -> (a -> Eff e Unit) -> Eff e Unit
851−
852−module Control.Monad.Eff.Unsafe where
853−
854− import Control.Monad.Eff
855−
856− foreign import unsafeInterleaveEff
857− "function unsafeInterleaveEff(f) {\
858− \ return f;\
859− \}" :: forall eff1 eff2 a. Eff eff1 a -> Eff eff2 a
860−
861−module Debug.Trace where
862−
863− import Control.Monad.Eff
864−
865− foreign import data Trace :: !
866−
867− foreign import trace "function trace(s) {\
868− \ return function() {\
869− \ console.log(s);\
870− \ return {};\
871− \ };\
872− \}" :: forall r. String -> Eff (trace :: Trace | r) Unit
873−
874− print :: forall a r. (Show a) => a -> Eff (trace :: Trace | r) Unit
875− print o = trace (show o)
876−
877−module Control.Monad.ST where
878−
879− import Control.Monad.Eff
880−
881− foreign import data ST :: * -> !
882−
883− foreign import data STRef :: * -> * -> *
884−
885− foreign import data STArray :: * -> * -> *
886−
887− foreign import newSTRef "function newSTRef(val) {\
888− \ return function () {\
889− \ return { value: val };\
890− \ };\
891− \}" :: forall a h r. a -> Eff (st :: ST h | r) (STRef h a)
892−
893− foreign import readSTRef "function readSTRef(ref) {\
894− \ return function() {\
895− \ return ref.value;\
896− \ };\
897− \}" :: forall a h r. STRef h a -> Eff (st :: ST h | r) a
898−
899− foreign import modifySTRef "function modifySTRef(ref) {\
900− \ return function(f) {\
901− \ return function() {\
902− \ return ref.value = f(ref.value);\
903− \ };\
904− \ };\
905− \}" :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) a
906−
907− foreign import writeSTRef "function writeSTRef(ref) {\
908− \ return function(a) {\
909− \ return function() {\
910− \ return ref.value = a;\
911− \ };\
912− \ };\
913− \}" :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a
914−
915− foreign import newSTArray "function newSTArray(len) {\
916− \ return function(a) {\
917− \ return function() {\
918− \ var arr = [];\
919− \ for (var i = 0; i < len; i++) {\
920− \ arr[i] = a;\
921− \ };\
922− \ return arr;\
923− \ };\
924− \ };\
925− \}" :: forall a h r. Number -> a -> Eff (st :: ST h | r) (STArray h a)
926−
927− foreign import peekSTArray "function peekSTArray(arr) {\
928− \ return function(i) {\
929− \ return function() {\
930− \ return arr[i];\
931− \ };\
932− \ };\
933− \}" :: forall a h r. STArray h a -> Eff (st :: ST h | r) a
934−
935− foreign import pokeSTArray "function pokeSTArray(arr) {\
936− \ return function(i) {\
937− \ return function(a) {\
938− \ return function() {\
939− \ return arr[i] = a;\
940− \ };\
941− \ };\
942− \ };\
943− \}" :: forall a h r. STArray h a -> Number -> a -> Eff (st :: ST h | r) a
944−
945− foreign import runST "function runST(f) {\
946− \ return f;\
947− \}" :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a
948−
949− foreign import runSTArray "function runSTArray(f) {\
950− \ return f;\
951− \}" :: forall a r. (forall h. Eff (st :: ST h | r) (STArray h a)) -> Eff r [a]
prelude/updateDocs.shdeleted−11
@@ -1,11 +0,0 @@
1−../dist/build/docgen/docgen --hierarchy-images prelude.purs > README.md
2−../dist/build/hierarchy/hierarchy prelude.purs -o prelude
3−mkdir -p images
4−mkdir -p ../docs/source/images
5−for f in prelude/*; do
6− BASE=$(basename "$f")
7− dot -Tpng -o images/"$BASE".png "$f"
8− cp images/"$BASE".png ../docs/source/images/"$BASE".png
9−done
10−rm -r prelude
11−pandoc -o ../docs/source/prelude.rst README.md
psc-bundle/Main.hsnew file+138
@@ -0,0 +1,138 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : psc-bundle
4+-- Copyright : (c) Phil Freeman 2015
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- | Bundles compiled PureScript modules for the browser.
12+--
13+-----------------------------------------------------------------------------
14+
15+{-# LANGUAGE PatternGuards #-}
16+{-# LANGUAGE FlexibleContexts #-}
17+{-# LANGUAGE ScopedTypeVariables #-}
18+{-# LANGUAGE TupleSections #-}
19+{-# LANGUAGE RecordWildCards #-}
20+
21+module Main (main) where
22+
23+import Data.Traversable (for)
24+import Data.Version (showVersion)
25+
26+import Control.Applicative
27+import Control.Monad
28+import Control.Monad.Error.Class
29+import Control.Monad.Trans.Except
30+import Control.Monad.IO.Class
31+
32+import System.FilePath (takeFileName, takeDirectory)
33+import System.FilePath.Glob (glob)
34+import System.Exit (exitFailure)
35+import System.IO (stderr, hPutStrLn)
36+import System.Directory (createDirectoryIfMissing)
37+
38+import Language.PureScript.Bundle
39+
40+import Options.Applicative as Opts
41+
42+import qualified Paths_purescript as Paths
43+
44+-- | Command line options.
45+data Options = Options
46+ { optionsInputFiles :: [FilePath]
47+ , optionsOutputFile :: Maybe FilePath
48+ , optionsEntryPoints :: [String]
49+ , optionsMainModule :: Maybe String
50+ , optionsNamespace :: String
51+ } deriving Show
52+
53+-- | Given a filename, assuming it is in the correct place on disk, infer a ModuleIdentifier.
54+guessModuleIdentifier :: (Applicative m, MonadError ErrorMessage m) => FilePath -> m ModuleIdentifier
55+guessModuleIdentifier filename = ModuleIdentifier (takeFileName (takeDirectory filename)) <$> (guessModuleType (takeFileName filename))
56+ where
57+ guessModuleType "index.js" = pure Regular
58+ guessModuleType "foreign.js" = pure Foreign
59+ guessModuleType name = throwError $ UnsupportedModulePath name
60+
61+-- | The main application function.
62+-- This function parses the input files, performs dead code elimination, filters empty modules
63+-- and generates and prints the final Javascript bundle.
64+app :: forall m. (Applicative m, MonadError ErrorMessage m, MonadIO m) => Options -> m String
65+app Options{..} = do
66+ inputFiles <- concat <$> mapM (liftIO . glob) optionsInputFiles
67+ when (null inputFiles) . liftIO $ do
68+ hPutStrLn stderr "psc-bundle: No input files."
69+ exitFailure
70+ input <- for inputFiles $ \filename -> do
71+ js <- liftIO (readFile filename)
72+ mid <- guessModuleIdentifier filename
73+ return (mid, js)
74+
75+ let entryIds = (map (`ModuleIdentifier` Regular) optionsEntryPoints)
76+
77+ bundle input entryIds optionsMainModule optionsNamespace
78+
79+-- | Command line options parser.
80+options :: Parser Options
81+options = Options <$> some inputFile
82+ <*> optional outputFile
83+ <*> many entryPoint
84+ <*> optional mainModule
85+ <*> namespace
86+ where
87+ inputFile :: Parser FilePath
88+ inputFile = strArgument $
89+ metavar "FILE"
90+ <> help "The input .js file(s)"
91+
92+ outputFile :: Parser FilePath
93+ outputFile = strOption $
94+ short 'o'
95+ <> long "output"
96+ <> help "The output .js file"
97+
98+ entryPoint :: Parser String
99+ entryPoint = strOption $
100+ short 'm'
101+ <> long "module"
102+ <> help "Entry point module name(s). All code which is not a transitive dependency of an entry point module will be removed."
103+
104+ mainModule :: Parser String
105+ mainModule = strOption $
106+ long "main"
107+ <> help "Generate code to run the main method in the specified module."
108+
109+ namespace :: Parser String
110+ namespace = strOption $
111+ short 'n'
112+ <> long "namespace"
113+ <> Opts.value "PS"
114+ <> showDefault
115+ <> help "Specify the namespace that PureScript modules will be exported to when running in the browser."
116+
117+-- | Make it go.
118+main :: IO ()
119+main = do
120+ opts <- execParser (info (version <*> helper <*> options) infoModList)
121+ output <- runExceptT (app opts)
122+ case output of
123+ Left err -> do
124+ hPutStrLn stderr (unlines (printErrorMessage err))
125+ exitFailure
126+ Right js ->
127+ case optionsOutputFile opts of
128+ Just outputFile -> do
129+ createDirectoryIfMissing True (takeDirectory outputFile)
130+ writeFile outputFile js
131+ Nothing -> putStrLn js
132+ where
133+ infoModList = fullDesc <> headerInfo <> footerInfo
134+ headerInfo = header "psc-bundle - Bundles compiled PureScript modules for the browser"
135+ footerInfo = footer $ "psc-bundle " ++ showVersion Paths.version
136+
137+ version :: Parser (a -> a)
138+ version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
psc-bundle/README.mdnew file+18
@@ -0,0 +1,18 @@
1+# psc-bundle
2+
3+A dead code elimination tool for PureScript-style CommonJS modules. This can be used as an alternative to Browserify.
4+
5+## Usage
6+
7+ psc-bundle FILE (-m|--module ARG) [--main ARG] [--namespace ARG]
8+
9+Options:
10+
11+- The input .js file(s)
12+- Entry point module name(s) are specified with `-m` or `--module`. All code which is not a transitive dependency of an entry point module will be removed.
13+- The main module is (optionally) specified using `--main`. If specified, this will generate code to run the main method in the specified module.
14+- The browser namespace defaults to `PS`, and can be overridden with `--namespace`.
15+
16+For example, to bundle the modules in the `output` directory, with main module `Main`:
17+
18+ psc-bundle output/**/*.js -m Main --main Main
psc-docs/Ctags.hsnew file+13
@@ -0,0 +1,13 @@
1+module Ctags (dumpCtags) where
2+
3+import qualified Language.PureScript as P
4+import Tags
5+import Data.List (sort)
6+
7+dumpCtags :: [(String, P.Module)] -> [String]
8+dumpCtags = sort . concat . (map renderModCtags)
9+
10+renderModCtags :: (String, P.Module) -> [String]
11+renderModCtags (path, mdl) = sort tagLines
12+ where tagLines = map tagLine $ tags mdl
13+ tagLine (name, line) = name ++ "\t" ++ path ++ "\t" ++ show line
psc-docs/Etags.hsnew file+15
@@ -0,0 +1,15 @@
1+module Etags (dumpEtags) where
2+
3+import qualified Language.PureScript as P
4+import Tags
5+
6+dumpEtags :: [(String, P.Module)] -> [String]
7+dumpEtags = concat . (map renderModEtags)
8+
9+renderModEtags :: (String, P.Module) -> [String]
10+renderModEtags (path, mdl) = ["\x0c", path ++ "," ++ show tagsLen] ++ tagLines
11+ where tagsLen = sum $ map length tagLines
12+ tagLines = map tagLine $ tags mdl
13+ tagLine (name, line) = "\x7f" ++ name ++ "\x01" ++ show line ++ ","
14+
15+
psc-docs/Main.hsnew file+251
@@ -0,0 +1,251 @@
1+{-# LANGUAGE TupleSections #-}
2+----------------------------------------------------------------------------
3+--
4+-- Module : Main
5+-- Copyright : (c) Phil Freeman 2013
6+-- License : MIT
7+--
8+-- Maintainer : Phil Freeman <paf31@cantab.net>
9+-- Stability : experimental
10+-- Portability :
11+--
12+-- |
13+--
14+-----------------------------------------------------------------------------
15+
16+module Main where
17+
18+import Control.Applicative
19+import Control.Arrow (first, second)
20+import Control.Category ((>>>))
21+import Control.Monad.Writer
22+import Data.Function (on)
23+import Data.List
24+import Data.Maybe (fromMaybe)
25+import Data.Tuple (swap)
26+import Data.Version (showVersion)
27+
28+import Options.Applicative
29+import qualified Text.PrettyPrint.ANSI.Leijen as PP
30+
31+import qualified Language.PureScript as P
32+import qualified Paths_purescript as Paths
33+import System.Exit (exitFailure)
34+import System.IO (hPutStrLn, stderr)
35+import System.Directory (createDirectoryIfMissing)
36+import System.FilePath (takeDirectory)
37+import System.FilePath.Glob (glob)
38+
39+import Etags
40+import Ctags
41+import qualified Language.PureScript.Docs as D
42+import qualified Language.PureScript.Docs.AsMarkdown as D
43+
44+-- Available output formats
45+data Format = Markdown -- Output documentation in Markdown format
46+ | Ctags -- Output ctags symbol index suitable for use with vi
47+ | Etags -- Output etags symbol index suitable for use with emacs
48+ deriving (Show, Eq, Ord)
49+
50+-- | Available methods of outputting Markdown documentation
51+data DocgenOutput
52+ = EverythingToStdOut
53+ | ToStdOut [P.ModuleName]
54+ | ToFiles [(P.ModuleName, FilePath)]
55+ deriving (Show)
56+
57+data PSCDocsOptions = PSCDocsOptions
58+ { pscdFormat :: Format
59+ , pscdInputFiles :: [FilePath]
60+ , pscdDocgen :: DocgenOutput
61+ }
62+ deriving (Show)
63+
64+docgen :: PSCDocsOptions -> IO ()
65+docgen (PSCDocsOptions fmt inputGlob output) = do
66+ input <- concat <$> mapM glob inputGlob
67+ case fmt of
68+ Etags -> dumpTags input dumpEtags
69+ Ctags -> dumpTags input dumpCtags
70+ Markdown -> do
71+ e <- D.parseAndDesugar input [] (\_ ms -> return ms)
72+ case e of
73+ Left (D.ParseError err) -> do
74+ hPutStrLn stderr $ show err
75+ exitFailure
76+ Left (D.SortModulesError err) -> do
77+ hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
78+ exitFailure
79+ Left (D.DesugarError err) -> do
80+ hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
81+ exitFailure
82+ Right ms' ->
83+ case output of
84+ EverythingToStdOut ->
85+ putStrLn (D.renderModulesAsMarkdown ms')
86+ ToStdOut names -> do
87+ let (ms, missing) = takeModulesByName ms' names
88+ guardMissing missing
89+ putStrLn (D.renderModulesAsMarkdown ms)
90+ ToFiles names -> do
91+ let (ms, missing) = takeModulesByName' ms' names
92+ guardMissing missing
93+ let ms'' = groupBy ((==) `on` fst) . sortBy (compare `on` fst) $ map swap ms
94+ forM_ ms'' $ \grp -> do
95+ let fp = fst (head grp)
96+ createDirectoryIfMissing True (takeDirectory fp)
97+ writeFile fp (D.renderModulesAsMarkdown $ snd `map` grp)
98+ where
99+ guardMissing [] = return ()
100+ guardMissing [mn] = do
101+ hPutStrLn stderr ("psc-docs: error: unknown module \"" ++ show mn ++ "\"")
102+ exitFailure
103+ guardMissing mns = do
104+ hPutStrLn stderr "psc-docs: error: unknown modules:"
105+ forM_ mns $ \mn ->
106+ hPutStrLn stderr (" * " ++ show mn)
107+ exitFailure
108+
109+-- |
110+-- Given a list of module names and a list of modules, return a list of modules
111+-- whose names appeared in the given name list, together with a list of names
112+-- for which no module could be found in the module list.
113+--
114+takeModulesByName :: [P.Module] -> [P.ModuleName] -> ([P.Module], [P.ModuleName])
115+takeModulesByName modules names =
116+ first (map fst) (takeModulesByName' modules (map (,()) names))
117+
118+-- |
119+-- Like takeModulesByName but also keeps some extra data with the module.
120+--
121+takeModulesByName' :: [P.Module] -> [(P.ModuleName, a)] -> ([(P.Module, a)], [P.ModuleName])
122+takeModulesByName' modules = foldl go ([], [])
123+ where
124+ go (ms, missing) (name, x) =
125+ case find ((== name) . P.getModuleName) modules of
126+ Just m -> ((m, x) : ms, missing)
127+ Nothing -> (ms, name : missing)
128+
129+dumpTags :: [FilePath] -> ([(String, P.Module)] -> [String]) -> IO ()
130+dumpTags input renderTags = do
131+ e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)
132+ case e of
133+ Left err -> do
134+ hPutStrLn stderr (show err)
135+ exitFailure
136+ Right ms ->
137+ ldump (renderTags (pairs ms))
138+
139+ where
140+ pairs :: [(Maybe String, m)] -> [(String, m)]
141+ pairs = map (first (fromMaybe ""))
142+
143+ ldump :: [String] -> IO ()
144+ ldump = mapM_ putStrLn
145+
146+parseFile :: FilePath -> IO (FilePath, String)
147+parseFile input = (,) input <$> readFile input
148+
149+inputFile :: Parser FilePath
150+inputFile = strArgument $
151+ metavar "FILE"
152+ <> help "The input .purs file(s)"
153+
154+instance Read Format where
155+ readsPrec _ "etags" = [(Etags, "")]
156+ readsPrec _ "ctags" = [(Ctags, "")]
157+ readsPrec _ "markdown" = [(Markdown, "")]
158+ readsPrec _ _ = []
159+
160+format :: Parser Format
161+format = option auto $ value Markdown
162+ <> long "format"
163+ <> metavar "FORMAT"
164+ <> help "Set output FORMAT (markdown | etags | ctags)"
165+
166+docgenModule :: Parser String
167+docgenModule = strOption $
168+ long "docgen"
169+ <> help "A list of module names which should appear in the output. This can optionally include file paths to write individual modules to, by separating with a colon ':'. For example, Prelude:docs/Prelude.md. This option may be specified multiple times."
170+
171+pscDocsOptions :: Parser (Format, [FilePath], [String])
172+pscDocsOptions = (,,) <$> format <*> many inputFile <*> many docgenModule
173+
174+parseDocgen :: [String] -> Either String DocgenOutput
175+parseDocgen [] = Right EverythingToStdOut
176+parseDocgen xs = go xs
177+ where
178+ go = intersperse " "
179+ >>> concat
180+ >>> words
181+ >>> map parseItem
182+ >>> combine
183+
184+data DocgenOutputItem
185+ = IToStdOut P.ModuleName
186+ | IToFile (P.ModuleName, FilePath)
187+
188+parseItem :: String -> DocgenOutputItem
189+parseItem s = case elemIndex ':' s of
190+ Just i ->
191+ s # splitAt i
192+ >>> first P.moduleNameFromString
193+ >>> second (drop 1)
194+ >>> IToFile
195+ Nothing ->
196+ IToStdOut (P.moduleNameFromString s)
197+
198+ where
199+ infixr 1 #
200+ (#) = flip ($)
201+
202+combine :: [DocgenOutputItem] -> Either String DocgenOutput
203+combine [] = Right EverythingToStdOut
204+combine (x:xs) = foldM go (initial x) xs
205+ where
206+ initial (IToStdOut m) = ToStdOut [m]
207+ initial (IToFile m) = ToFiles [m]
208+
209+ go (ToStdOut ms) (IToStdOut m) = Right (ToStdOut (m:ms))
210+ go (ToFiles ms) (IToFile m) = Right (ToFiles (m:ms))
211+ go _ _ = Left "Can't mix module names and module name/file path pairs in the same invocation."
212+
213+buildOptions :: (Format, [FilePath], [String]) -> IO PSCDocsOptions
214+buildOptions (fmt, input, mapping) =
215+ case parseDocgen mapping of
216+ Right mapping' -> return (PSCDocsOptions fmt input mapping')
217+ Left err -> do
218+ hPutStrLn stderr "psc-docs: error in --docgen option:"
219+ hPutStrLn stderr (" " ++ err)
220+ exitFailure
221+
222+main :: IO ()
223+main = execParser opts >>= buildOptions >>= docgen
224+ where
225+ opts = info (version <*> helper <*> pscDocsOptions) infoModList
226+ infoModList = fullDesc <> headerInfo <> footerInfo
227+ headerInfo = header "psc-docs - Generate Markdown documentation from PureScript source files"
228+ footerInfo = footerDoc $ Just $ PP.vcat
229+ [ examples, PP.empty, PP.text ("psc-docs " ++ showVersion Paths.version) ]
230+
231+ version :: Parser (a -> a)
232+ version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
233+
234+examples :: PP.Doc
235+examples =
236+ PP.vcat $ map PP.text
237+ [ "Examples:"
238+ , " print documentation for Data.List to stdout:"
239+ , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
240+ , " --docgen Data.List"
241+ , ""
242+ , " write documentation for Data.List to docs/Data.List.md:"
243+ , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
244+ , " --docgen Data.List:docs/Data.List.md"
245+ , ""
246+ , " write documentation for Data.List to docs/Data.List.md, and"
247+ , " documentation for Data.List.Lazy to docs/Data.List.Lazy.md:"
248+ , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
249+ , " --docgen Data.List:docs/Data.List.md \\"
250+ , " --docgen Data.List.Lazy:docs/Data.List.Lazy.md"
251+ ]
psc-docs/Tags.hsnew file+18
@@ -0,0 +1,18 @@
1+module Tags where
2+
3+import qualified Language.PureScript as P
4+
5+tags :: P.Module -> [(String, Int)]
6+tags = concatMap dtags . P.exportedDeclarations
7+ where dtags (P.PositionedDeclaration sp _ d) = map tag $ names d
8+ where tag name = (name, line)
9+ line = P.sourcePosLine $ P.spanStart sp
10+ dtags _ = []
11+ names (P.DataDeclaration _ name _ dcons) = P.runProperName name : consNames
12+ where consNames = map (\(cname, _) -> P.runProperName cname) dcons
13+ names (P.TypeDeclaration ident _) = [show ident]
14+ names (P.ExternDeclaration ident _) = [show ident]
15+ names (P.TypeSynonymDeclaration name _ _) = [P.runProperName name]
16+ names (P.TypeClassDeclaration name _ _ _) = [P.runProperName name]
17+ names (P.TypeInstanceDeclaration name _ _ _ _) = [show name]
18+ names _ = []
psc-make/Main.hsdeleted−145
@@ -1,145 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Main
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
16−
17−module Main where
18−
19−import Control.Applicative
20−import Control.Monad.Error
21−
22−import Data.Version (showVersion)
23−
24−import System.Console.CmdTheLine
25−import System.Directory
26− (doesFileExist, getModificationTime, createDirectoryIfMissing)
27−import System.FilePath (takeDirectory)
28−import System.Exit (exitSuccess, exitFailure)
29−import System.IO.Error (tryIOError)
30−
31−import Text.Parsec (ParseError)
32−
33−import qualified Language.PureScript as P
34−import qualified Paths_purescript as Paths
35−import qualified System.IO.UTF8 as U
36−
37−preludeFilename :: IO FilePath
38−preludeFilename = Paths.getDataFileName "prelude/prelude.purs"
39−
40−readInput :: [FilePath] -> IO (Either ParseError [(FilePath, P.Module)])
41−readInput input = fmap collect $ forM input $ \inputFile -> do
42− text <- U.readFile inputFile
43− return $ (inputFile, P.runIndentParser inputFile P.parseModules text)
44− where
45− collect :: [(FilePath, Either ParseError [P.Module])] -> Either ParseError [(FilePath, P.Module)]
46− collect = fmap concat . sequence . map (\(fp, e) -> fmap (map ((,) fp)) e)
47−
48−newtype Make a = Make { unMake :: ErrorT String IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadError String)
49−
50−runMake :: Make a -> IO (Either String a)
51−runMake = runErrorT . unMake
52−
53−makeIO :: IO a -> Make a
54−makeIO = Make . ErrorT . fmap (either (Left . show) Right) . tryIOError
55−
56−instance P.MonadMake Make where
57− getTimestamp path = makeIO $ do
58− exists <- doesFileExist path
59− case exists of
60− True -> Just <$> getModificationTime path
61− False -> return Nothing
62− readTextFile path = makeIO $ do
63− U.putStrLn $ "Reading " ++ path
64− U.readFile path
65− writeTextFile path text = makeIO $ do
66− mkdirp path
67− U.putStrLn $ "Writing " ++ path
68− U.writeFile path text
69− liftError = either throwError return
70− progress = makeIO . U.putStrLn
71−
72−compile :: FilePath -> P.Options -> [FilePath] -> IO ()
73−compile outputDir opts input = do
74− modules <- readInput input
75− case modules of
76− Left err -> do
77− U.print err
78− exitFailure
79− Right ms -> do
80− e <- runMake $ P.make outputDir opts ms
81− case e of
82− Left err -> do
83− U.putStrLn err
84− exitFailure
85− Right _ -> do
86− exitSuccess
87−
88−mkdirp :: FilePath -> IO ()
89−mkdirp = createDirectoryIfMissing True . takeDirectory
90−
91−inputFiles :: Term [FilePath]
92−inputFiles = value $ posAny [] $ posInfo
93− { posDoc = "The input .ps files" }
94−
95−outputDirectory :: Term FilePath
96−outputDirectory = value $ opt "output" $ (optInfo [ "o", "output" ])
97− { optDoc = "The output directory" }
98−
99−noTco :: Term Bool
100−noTco = value $ flag $ (optInfo [ "no-tco" ])
101− { optDoc = "Disable tail call optimizations" }
102−
103−performRuntimeTypeChecks :: Term Bool
104−performRuntimeTypeChecks = value $ flag $ (optInfo [ "runtime-type-checks" ])
105− { optDoc = "Generate runtime type checks" }
106−
107−noPrelude :: Term Bool
108−noPrelude = value $ flag $ (optInfo [ "no-prelude" ])
109− { optDoc = "Omit the Prelude" }
110−
111−noMagicDo :: Term Bool
112−noMagicDo = value $ flag $ (optInfo [ "no-magic-do" ])
113− { optDoc = "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad." }
114−
115−noOpts :: Term Bool
116−noOpts = value $ flag $ (optInfo [ "no-opts" ])
117− { optDoc = "Skip the optimization phase." }
118−
119−verboseErrors :: Term Bool
120−verboseErrors = value $ flag $ (optInfo [ "v", "verbose-errors" ])
121− { optDoc = "Display verbose error messages" }
122−
123−options :: Term P.Options
124−options = P.Options <$> noPrelude <*> noTco <*> performRuntimeTypeChecks <*> noMagicDo <*> pure Nothing <*> noOpts <*> pure Nothing <*> pure [] <*> pure [] <*> verboseErrors
125−
126−inputFilesAndPrelude :: FilePath -> Term [FilePath]
127−inputFilesAndPrelude prelude = combine <$> (not <$> noPrelude) <*> inputFiles
128− where
129− combine True input = prelude : input
130− combine False input = input
131−
132−term :: FilePath -> Term (IO ())
133−term prelude = compile <$> outputDirectory <*> options <*> inputFilesAndPrelude prelude
134−
135−termInfo :: TermInfo
136−termInfo = defTI
137− { termName = "psc-make"
138− , version = showVersion Paths.version
139− , termDoc = "Compiles PureScript to Javascript"
140− }
141−
142−main :: IO ()
143−main = do
144− prelude <- preludeFilename
145− run (term prelude, termInfo)
psc-publish/Main.hsnew file+38
@@ -0,0 +1,38 @@
1+
2+module Main where
3+
4+import Data.Version (Version(..), showVersion)
5+import qualified Data.Aeson as A
6+import qualified Data.ByteString.Lazy.Char8 as BL
7+
8+import Options.Applicative hiding (str)
9+
10+import qualified Paths_purescript as Paths
11+import Language.PureScript.Publish
12+
13+dryRun :: Parser Bool
14+dryRun = switch $
15+ long "dry-run"
16+ <> help "Produce no output, and don't require a tagged version to be checked out."
17+
18+main :: IO ()
19+main = execParser opts >>= publish
20+ where
21+ opts = info (version <*> helper <*> dryRun) infoModList
22+ infoModList = fullDesc <> headerInfo <> footerInfo
23+ headerInfo = header "psc-publish - Generates documentation packages for upload to http://pursuit.purescript.org"
24+ footerInfo = footer $ "psc-publish " ++ showVersion Paths.version
25+
26+ version :: Parser (a -> a)
27+ version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
28+
29+publish :: Bool -> IO ()
30+publish isDryRun =
31+ if isDryRun
32+ then do
33+ let dummyVersion = ("0.0.0", Version [0,0,0] [])
34+ _ <- preparePackage $ defaultPublishOptions { publishGetVersion = return dummyVersion }
35+ putStrLn "Dry run completed, no errors."
36+ else do
37+ pkg <- preparePackage defaultPublishOptions
38+ BL.putStrLn (A.encode pkg)
psc-publish/tests/Test.hsnew file+79
@@ -0,0 +1,79 @@
1+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
2+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
3+{-# LANGUAGE ScopedTypeVariables #-}
4+
5+-- | To run these tests:
6+--
7+-- * `cabal repl psc-publish`
8+-- * `:l psc-publish/tests/Test.hs`
9+-- * `test`
10+
11+module Test where
12+
13+import Control.Monad
14+import Control.Applicative
15+import Control.Exception
16+import System.Process
17+import System.Directory
18+import qualified Data.ByteString.Lazy as BL
19+import Data.ByteString.Lazy (ByteString)
20+import qualified Data.Aeson as A
21+import Data.Aeson.BetterErrors
22+
23+import Main
24+import Language.PureScript.Docs
25+
26+pkgName = "purescript-prelude"
27+packageUrl = "https://github.com/purescript/" ++ pkgName
28+packageDir = "tmp/" ++ pkgName
29+
30+pushd :: forall a. FilePath -> IO a -> IO a
31+pushd dir act = do
32+ original <- getCurrentDirectory
33+ setCurrentDirectory dir
34+ result <- try act :: IO (Either IOException a)
35+ setCurrentDirectory original
36+ either throwIO return result
37+
38+clonePackage :: IO ()
39+clonePackage = do
40+ createDirectoryIfMissing True packageDir
41+ pushd packageDir $ do
42+ exists <- doesDirectoryExist ".git"
43+ unless exists $ do
44+ putStrLn ("Cloning " ++ pkgName ++ " into " ++ packageDir ++ "...")
45+ readProcess "git" ["clone", packageUrl, "."] "" >>= putStr
46+ readProcess "git" ["tag", "v999.0.0"] "" >>= putStr
47+
48+bowerInstall :: IO ()
49+bowerInstall = do
50+ pushd packageDir $ do
51+ readProcess "bower" ["install"] "" >>= putStr
52+
53+getPackage :: IO UploadedPackage
54+getPackage = do
55+ clonePackage
56+ bowerInstall
57+ pushd packageDir preparePackage
58+
59+data TestResult
60+ = ParseFailed String
61+ | Mismatch ByteString ByteString -- ^ encoding before, encoding after
62+ | Pass ByteString
63+ deriving (Show, Read)
64+
65+-- | Test JSON encoding/decoding; parse the package, roundtrip to/from JSON,
66+-- and check we get the same string.
67+test :: IO TestResult
68+test = roundTrip <$> getPackage
69+
70+roundTrip :: UploadedPackage -> TestResult
71+roundTrip pkg =
72+ let before = A.encode pkg
73+ in case A.eitherDecode before of
74+ Left err -> ParseFailed err
75+ Right parsed -> do
76+ let after = A.encode (parsed :: UploadedPackage)
77+ if before == after
78+ then Pass before
79+ else Mismatch before after
psc/Main.hs+157−121
@@ -1,8 +1,8 @@
1-----------------------------------------------------------------------------
1-----------------------------------------------------------------------------
2--
2--
3-- Module : Main
3-- Module : Main
4−-- Copyright : (c) Phil Freeman 2013
4+-- Copyright : (c) 2013-15 Phil Freeman, (c) 2014-15 Gary Burgess
5−-- License : MIT
5+-- License : MIT (http://opensource.org/licenses/MIT)
6--
6--
7-- Maintainer : Phil Freeman <paf31@cantab.net>
7-- Maintainer : Phil Freeman <paf31@cantab.net>
8-- Stability : experimental
8-- Stability : experimental
@@ -12,143 +12,179 @@
12--
12--
13-----------------------------------------------------------------------------
13-----------------------------------------------------------------------------
14
14
15−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
15+{-# LANGUAGE DataKinds #-}
16+{-# LANGUAGE FlexibleContexts #-}
17+{-# LANGUAGE RecordWildCards #-}
18+{-# LANGUAGE TupleSections #-}
16
19
17module Main where
20module Main where
18
21
19import Control.Applicative
22import Control.Applicative
20−import Control.Monad.Error
23+import Control.Monad
24+import Control.Monad.Error.Class (MonadError(..))
25+import Control.Monad.Writer.Strict
21
26
27+import Data.List (isSuffixOf, partition)
22import Data.Version (showVersion)
28import Data.Version (showVersion)
29+import qualified Data.Map as M
23
30
24−import System.Console.CmdTheLine
31+import Options.Applicative as Opts
25−import System.Directory (createDirectoryIfMissing)
26−import System.FilePath (takeDirectory)
27−import System.Exit (exitSuccess, exitFailure)
28−import System.IO (stderr)
29
32
30−import Text.Parsec (ParseError)
33+import System.Exit (exitSuccess, exitFailure)
34+import System.IO (hPutStrLn, stderr)
35+import System.FilePath.Glob (glob)
31
36
32import qualified Language.PureScript as P
37import qualified Language.PureScript as P
33import qualified Paths_purescript as Paths
38import qualified Paths_purescript as Paths
34−import qualified System.IO.UTF8 as U
35−
36−preludeFilename :: IO FilePath
37−preludeFilename = Paths.getDataFileName "prelude/prelude.purs"
38−
39−readInput :: Maybe [FilePath] -> IO (Either ParseError [(FilePath, P.Module)])
40−readInput Nothing = do
41− text <- getContents
42− return $ map ((,) undefined) <$> P.runIndentParser "" P.parseModules text
43−readInput (Just input) = fmap collect $ forM input $ \inputFile -> do
44− text <- U.readFile inputFile
45− return $ (inputFile, P.runIndentParser inputFile P.parseModules text)
46− where
47− collect :: [(FilePath, Either ParseError [P.Module])] -> Either ParseError [(FilePath, P.Module)]
48− collect = fmap concat . sequence . map (\(fp, e) -> fmap (map ((,) fp)) e)
49−
50−compile :: P.Options -> Maybe [FilePath] -> Maybe FilePath -> Maybe FilePath -> IO ()
51−compile opts input output externs = do
52− modules <- readInput input
53− case modules of
54− Left err -> do
55− U.hPutStr stderr $ show err
56− exitFailure
57− Right ms -> do
58− case P.compile opts (map snd ms) of
59− Left err -> do
60− U.hPutStrLn stderr err
61− exitFailure
62− Right (js, exts, _) -> do
63− case output of
64− Just path -> mkdirp path >> U.writeFile path js
65− Nothing -> U.putStrLn js
66− case externs of
67− Just path -> mkdirp path >> U.writeFile path exts
68− Nothing -> return ()
69− exitSuccess
70−
71−mkdirp :: FilePath -> IO ()
72−mkdirp = createDirectoryIfMissing True . takeDirectory
73−
74−useStdIn :: Term Bool
75−useStdIn = value . flag $ (optInfo [ "s", "stdin" ])
76− { optDoc = "Read from standard input" }
77−
78−inputFiles :: Term [FilePath]
79−inputFiles = value $ posAny [] $ posInfo
80− { posDoc = "The input .ps files" }
81−
82−outputFile :: Term (Maybe FilePath)
83−outputFile = value $ opt Nothing $ (optInfo [ "o", "output" ])
84− { optDoc = "The output .js file" }
85−
86−externsFile :: Term (Maybe FilePath)
87−externsFile = value $ opt Nothing $ (optInfo [ "e", "externs" ])
88− { optDoc = "The output .e.ps file" }
89−
90−noTco :: Term Bool
91−noTco = value $ flag $ (optInfo [ "no-tco" ])
92− { optDoc = "Disable tail call optimizations" }
93
39
94−performRuntimeTypeChecks :: Term Bool
40+import Language.PureScript.Make
95−performRuntimeTypeChecks = value $ flag $ (optInfo [ "runtime-type-checks" ])
96− { optDoc = "Generate runtime type checks" }
97
41
98−noPrelude :: Term Bool
42+data PSCMakeOptions = PSCMakeOptions
99−noPrelude = value $ flag $ (optInfo [ "no-prelude" ])
43+ { pscmInput :: [FilePath]
100− { optDoc = "Omit the Prelude" }
44+ , pscmForeignInput :: [FilePath]
101−
45+ , pscmOutputDir :: FilePath
102−noMagicDo :: Term Bool
46+ , pscmOpts :: P.Options
103−noMagicDo = value $ flag $ (optInfo [ "no-magic-do" ])
47+ , pscmUsePrefix :: Bool
104− { optDoc = "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad." }
48+ }
105−
106−runMain :: Term (Maybe String)
107−runMain = value $ defaultOpt (Just "Main") Nothing $ (optInfo [ "main" ])
108− { optDoc = "Generate code to run the main method in the specified module." }
109−
110−noOpts :: Term Bool
111−noOpts = value $ flag $ (optInfo [ "no-opts" ])
112− { optDoc = "Skip the optimization phase." }
113−
114−browserNamespace :: Term String
115−browserNamespace = value $ opt "PS" $ (optInfo [ "browser-namespace" ])
116− { optDoc = "Specify the namespace that PureScript modules will be exported to when running in the browser." }
117−
118−dceModules :: Term [String]
119−dceModules = value $ optAll [] $ (optInfo [ "m", "module" ])
120− { optDoc = "Enables dead code elimination, all code which is not a transitive dependency of a specified module will be removed. This argument can be used multiple times." }
121
49
122−codeGenModules :: Term [String]
50+data InputOptions = InputOptions
123−codeGenModules = value $ optAll [] $ (optInfo [ "codegen" ])
51+ { ioInputFiles :: [FilePath]
124− { optDoc = "A list of modules for which Javascript and externs should be generated. This argument can be used multiple times." }
52+ }
125
53
126−verboseErrors :: Term Bool
54+compile :: PSCMakeOptions -> IO ()
127−verboseErrors = value $ flag $ (optInfo [ "v", "verbose-errors" ])
55+compile (PSCMakeOptions inputGlob inputForeignGlob outputDir opts usePrefix) = do
128− { optDoc = "Display verbose error messages" }
56+ input <- globWarningOnMisses warnFileTypeNotFound inputGlob
57+ when (null input) $ do
58+ hPutStrLn stderr "psc: No input files."
59+ exitFailure
60+ let (jsFiles, pursFiles) = partition (isSuffixOf ".js") input
61+ moduleFiles <- readInput (InputOptions pursFiles)
62+ inputForeign <- globWarningOnMisses warnFileTypeNotFound inputForeignGlob
63+ foreignFiles <- forM (inputForeign ++ jsFiles) (\inFile -> (inFile,) <$> readFile inFile)
64+ case runWriterT (parseInputs moduleFiles foreignFiles) of
65+ Left errs -> do
66+ hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
67+ exitFailure
68+ Right ((ms, foreigns), warnings) -> do
69+ when (P.nonEmpty warnings) $
70+ hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
71+ let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, fp)) ms
72+ makeActions = buildMakeActions outputDir filePathMap foreigns usePrefix
73+ e <- runMake opts $ P.make makeActions (map snd ms)
74+ case e of
75+ Left errs -> do
76+ hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
77+ exitFailure
78+ Right (_, warnings') -> do
79+ when (P.nonEmpty warnings') $
80+ hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')
81+ exitSuccess
129
82
130−options :: Term P.Options
83+warnFileTypeNotFound :: String -> IO ()
131−options = P.Options <$> noPrelude <*> noTco <*> performRuntimeTypeChecks <*> noMagicDo <*> runMain <*> noOpts <*> (Just <$> browserNamespace) <*> dceModules <*> codeGenModules <*> verboseErrors
84+warnFileTypeNotFound = hPutStrLn stderr . ("psc: No files found using pattern: " ++)
132
85
133−stdInOrInputFiles :: FilePath -> Term (Maybe [FilePath])
86+globWarningOnMisses :: (String -> IO ()) -> [FilePath] -> IO [FilePath]
134−stdInOrInputFiles prelude = combine <$> useStdIn <*> (not <$> noPrelude) <*> inputFiles
87+globWarningOnMisses warn = concatMapM globWithWarning
135 where
88 where
136− combine False True input = Just (prelude : input)
89+ globWithWarning pattern = do
137− combine False False input = Just input
90+ paths <- glob pattern
138− combine True _ _ = Nothing
91+ when (null paths) $ warn pattern
139−
92+ return paths
140−term :: FilePath -> Term (IO ())
93+ concatMapM f = liftM concat . mapM f
141−term prelude = compile <$> options <*> stdInOrInputFiles prelude <*> outputFile <*> externsFile
94+
142−
95+readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]
143−termInfo :: TermInfo
96+readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readFile inFile
144−termInfo = defTI
97+
145− { termName = "psc"
98+parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)
146− , version = showVersion Paths.version
99+ => [(Either P.RebuildPolicy FilePath, String)]
147− , termDoc = "Compiles PureScript to Javascript"
100+ -> [(FilePath, P.ForeignJS)]
148− }
101+ -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName FilePath)
102+parseInputs modules foreigns =
103+ (,) <$> P.parseModulesFromFiles (either (const "") id) modules
104+ <*> P.parseForeignModulesFromFiles foreigns
105+
106+inputFile :: Parser FilePath
107+inputFile = strArgument $
108+ metavar "FILE"
109+ <> help "The input .purs file(s)"
110+
111+inputForeignFile :: Parser FilePath
112+inputForeignFile = strOption $
113+ short 'f'
114+ <> long "ffi"
115+ <> help "The input .js file(s) providing foreign import implementations"
116+
117+outputDirectory :: Parser FilePath
118+outputDirectory = strOption $
119+ short 'o'
120+ <> long "output"
121+ <> Opts.value "output"
122+ <> showDefault
123+ <> help "The output directory"
124+
125+requirePath :: Parser (Maybe FilePath)
126+requirePath = optional $ strOption $
127+ short 'r'
128+ <> long "require-path"
129+ <> help "The path prefix to use for require() calls in the generated JavaScript"
130+
131+noTco :: Parser Bool
132+noTco = switch $
133+ long "no-tco"
134+ <> help "Disable tail call optimizations"
135+
136+noMagicDo :: Parser Bool
137+noMagicDo = switch $
138+ long "no-magic-do"
139+ <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad"
140+
141+noOpts :: Parser Bool
142+noOpts = switch $
143+ long "no-opts"
144+ <> help "Skip the optimization phase"
145+
146+comments :: Parser Bool
147+comments = switch $
148+ short 'c'
149+ <> long "comments"
150+ <> help "Include comments in the generated code"
151+
152+verboseErrors :: Parser Bool
153+verboseErrors = switch $
154+ short 'v'
155+ <> long "verbose-errors"
156+ <> help "Display verbose error messages"
157+
158+noPrefix :: Parser Bool
159+noPrefix = switch $
160+ short 'p'
161+ <> long "no-prefix"
162+ <> help "Do not include comment header"
163+
164+
165+options :: Parser P.Options
166+options = P.Options <$> noTco
167+ <*> noMagicDo
168+ <*> pure Nothing
169+ <*> noOpts
170+ <*> verboseErrors
171+ <*> (not <$> comments)
172+ <*> requirePath
173+
174+pscMakeOptions :: Parser PSCMakeOptions
175+pscMakeOptions = PSCMakeOptions <$> many inputFile
176+ <*> many inputForeignFile
177+ <*> outputDirectory
178+ <*> options
179+ <*> (not <$> noPrefix)
149
180
150main :: IO ()
181main :: IO ()
151−main = do
182+main = execParser opts >>= compile
152− prelude <- preludeFilename
183+ where
153− run (term prelude, termInfo)
184+ opts = info (version <*> helper <*> pscMakeOptions) infoModList
185+ infoModList = fullDesc <> headerInfo <> footerInfo
186+ headerInfo = header "psc - Compiles PureScript to Javascript"
187+ footerInfo = footer $ "psc " ++ showVersion Paths.version
154
188
189+ version :: Parser (a -> a)
190+ version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
psci/Commands.hsdeleted−73
@@ -1,73 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Commands
4−-- Copyright : (c) Phil Freeman 2014
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- Commands for PSCI.
13−--
14−-----------------------------------------------------------------------------
15−
16−module Commands where
17−
18−import Language.PureScript
19−
20−-- |
21−-- Valid Meta-commands for PSCI
22−--
23−data Command
24− -- |
25− -- A purescript expression
26− --
27− = Expression Value
28− -- |
29− -- Show the help command
30− --
31− | Help
32− -- |
33− -- Import a module from a loaded file
34− --
35− | Import ModuleName
36− -- |
37− -- Load a file for use with importing
38− --
39− | LoadFile FilePath
40− -- |
41− -- Exit PSCI
42− --
43− | Quit
44− -- |
45− -- Reset the state of the REPL
46− --
47− | Reset
48− -- |
49− -- Binds a value to a name
50− --
51− | Let (Value -> Value)
52− -- |
53− -- Find the type of an expression
54− --
55− | TypeOf Value
56− -- |
57− -- Find the kind of an expression
58− --
59− | KindOf Type
60−
61−-- |
62−-- The help menu.
63−--
64−help :: [[String]]
65−help =
66− [ [":? ", "Show this help menu"]
67− , [":i <module> ", "Import <module> for use in PSCI"]
68− , [":m <file> ", "Load <file> for importing"]
69− , [":q ", "Quit PSCi"]
70− , [":r ", "Reset"]
71− , [":t <expr> ", "Show the type of <expr>"]
72− , [":k <type> ", "Show the kind of <type>"]
73− ]
psci/Completion.hsnew file+233
@@ -0,0 +1,233 @@
1+{-# LANGUAGE CPP #-}
2+
3+module Completion where
4+
5+import Data.Maybe (mapMaybe)
6+import Data.List (nub, nubBy, sortBy, isPrefixOf, stripPrefix)
7+import Data.Char (isUpper)
8+import Data.Function (on)
9+#if __GLASGOW_HASKELL__ < 710
10+import Data.Traversable (traverse)
11+#endif
12+
13+import Control.Arrow (second)
14+#if __GLASGOW_HASKELL__ < 710
15+import Control.Applicative ((<$>), (<*>))
16+#endif
17+import Control.Monad.Trans.Reader (asks, runReaderT, ReaderT)
18+import Control.Monad.Trans.State.Strict
19+
20+import System.Console.Haskeline
21+
22+import qualified Language.PureScript as P
23+import qualified Language.PureScript.Names as N
24+
25+import qualified Directive as D
26+import Types
27+
28+-- Completions may read the state, but not modify it.
29+type CompletionM = ReaderT PSCiState IO
30+
31+-- Lift a `CompletionM` action to a `StateT PSCiState IO` one.
32+liftCompletionM :: CompletionM a -> StateT PSCiState IO a
33+liftCompletionM act = StateT (\s -> (\a -> (a, s)) <$> runReaderT act s)
34+
35+-- Haskeline completions
36+
37+data CompletionContext
38+ = CtxDirective String
39+ | CtxFilePath String
40+ | CtxModule
41+ | CtxIdentifier
42+ | CtxType
43+ | CtxFixed String
44+ deriving (Show, Read)
45+
46+-- |
47+-- Loads module, function, and file completions.
48+--
49+completion :: CompletionFunc (StateT PSCiState IO)
50+completion = liftCompletionM . completion'
51+
52+completion' :: CompletionFunc CompletionM
53+completion' = completeWordWithPrev Nothing " \t\n\r" findCompletions
54+
55+-- |
56+-- Decide what kind of completion we need based on input. This function expects
57+-- a list of complete words (to the left of the cursor) as the first argument,
58+-- and the current word as the second argument.
59+completionContext :: [String] -> String -> [CompletionContext]
60+completionContext [] _ = [CtxDirective "", CtxIdentifier, CtxFixed "import"]
61+completionContext ws w | headSatisfies (":" `isPrefixOf`) ws = completeDirective ws w
62+completionContext ws w | headSatisfies (== "import") ws = completeImport ws w
63+completionContext _ _ = [CtxIdentifier]
64+
65+completeDirective :: [String] -> String -> [CompletionContext]
66+completeDirective ws w =
67+ case ws of
68+ [] -> [CtxDirective w]
69+ [dir] -> case D.directivesFor <$> stripPrefix ":" dir of
70+ -- only offer completions if the directive is unambiguous
71+ Just [dir'] -> directiveArg w dir'
72+ _ -> []
73+
74+ -- All directives take exactly one argument. If we haven't yet matched,
75+ -- that means one argument has already been supplied. So don't complete
76+ -- any others.
77+ _ -> []
78+
79+directiveArg :: String -> Directive -> [CompletionContext]
80+directiveArg _ Browse = [CtxModule]
81+directiveArg w Load = [CtxFilePath w]
82+directiveArg w Foreign = [CtxFilePath w]
83+directiveArg _ Quit = []
84+directiveArg _ Reset = []
85+directiveArg _ Help = []
86+directiveArg _ Show = map CtxFixed replQueryStrings
87+directiveArg _ Type = [CtxIdentifier]
88+directiveArg _ Kind = [CtxType]
89+
90+completeImport :: [String] -> String -> [CompletionContext]
91+completeImport ws w' =
92+ case (ws, w') of
93+ (["import"], w) | headSatisfies isUpper w -> [CtxModule]
94+ (["import"], _) -> [CtxModule, CtxFixed "qualified"]
95+ (["import", "qualified"], _) -> [CtxModule]
96+ _ -> []
97+
98+headSatisfies :: (a -> Bool) -> [a] -> Bool
99+headSatisfies p str =
100+ case str of
101+ (c:_) -> p c
102+ _ -> False
103+
104+-- | Callback for Haskeline's `completeWordWithPrev`.
105+-- Expects:
106+-- * Line contents to the left of the word, reversed
107+-- * Word to be completed
108+findCompletions :: String -> String -> CompletionM [Completion]
109+findCompletions prev word = do
110+ let ctx = completionContext (words (reverse prev)) word
111+ completions <- concat <$> traverse getCompletions ctx
112+ return $ sortBy directivesFirst completions
113+ where
114+ getCompletions :: CompletionContext -> CompletionM [Completion]
115+ getCompletions = fmap (mapMaybe (either (prefixedBy word) Just)) . getCompletion
116+
117+ prefixedBy :: String -> String -> Maybe Completion
118+ prefixedBy w cand = if w `isPrefixOf` cand
119+ then Just (simpleCompletion cand)
120+ else Nothing
121+
122+getCompletion :: CompletionContext -> CompletionM [Either String Completion]
123+getCompletion ctx =
124+ case ctx of
125+ CtxFilePath f -> map Right <$> listFiles f
126+ CtxModule -> map Left <$> getModuleNames
127+ CtxIdentifier -> map Left <$> ((++) <$> getIdentNames <*> getDctorNames)
128+ CtxType -> map Left <$> getTypeNames
129+ CtxFixed str -> return [Left str]
130+ CtxDirective d -> return (map Left (completeDirectives d))
131+
132+ where
133+ completeDirectives :: String -> [String]
134+ completeDirectives = map (':' :) . D.directiveStringsFor
135+
136+
137+getLoadedModules :: CompletionM [P.Module]
138+getLoadedModules = asks (map snd . psciLoadedModules)
139+
140+getImportedModules :: CompletionM [ImportedModule]
141+getImportedModules = asks psciImportedModules
142+
143+getModuleNames :: CompletionM [String]
144+getModuleNames = moduleNames <$> getLoadedModules
145+
146+mapLoadedModulesAndQualify :: (a -> String) -> (P.Module -> [(a, P.Declaration)]) -> CompletionM [String]
147+mapLoadedModulesAndQualify sho f = do
148+ ms <- getLoadedModules
149+ let argPairs = do m <- ms
150+ fm <- f m
151+ return (m, fm)
152+ concat <$> traverse (uncurry (getAllQualifications sho)) argPairs
153+
154+getIdentNames :: CompletionM [String]
155+getIdentNames = mapLoadedModulesAndQualify P.showIdent identNames
156+
157+getDctorNames :: CompletionM [String]
158+getDctorNames = mapLoadedModulesAndQualify P.runProperName dctorNames
159+
160+getTypeNames :: CompletionM [String]
161+getTypeNames = mapLoadedModulesAndQualify P.runProperName typeDecls
162+
163+-- | Given a module and a declaration in that module, return all possible ways
164+-- it could have been referenced given the current PSCiState - including fully
165+-- qualified, qualified using an alias, and unqualified.
166+getAllQualifications :: (a -> String) -> P.Module -> (a, P.Declaration) -> CompletionM [String]
167+getAllQualifications sho m (declName, decl) = do
168+ imports <- getAllImportsOf m
169+ let fullyQualified = qualifyWith (Just (P.getModuleName m))
170+ let otherQuals = nub (concatMap qualificationsUsing imports)
171+ return $ fullyQualified : otherQuals
172+ where
173+ qualifyWith mMod = P.showQualified sho (P.Qualified mMod declName)
174+ referencedBy refs = P.isExported (Just refs) decl
175+
176+ qualificationsUsing (_, importType, asQ') =
177+ let q = qualifyWith asQ'
178+ in case importType of
179+ P.Implicit -> [q]
180+ P.Explicit refs -> if referencedBy refs
181+ then [q]
182+ else []
183+ P.Hiding refs -> if referencedBy refs
184+ then []
185+ else [q]
186+
187+
188+-- | Returns all the ImportedModule values referring to imports of a particular
189+-- module.
190+getAllImportsOf :: P.Module -> CompletionM [ImportedModule]
191+getAllImportsOf = asks . allImportsOf
192+
193+nubOnFst :: Eq a => [(a, b)] -> [(a, b)]
194+nubOnFst = nubBy ((==) `on` fst)
195+
196+typeDecls :: P.Module -> [(N.ProperName, P.Declaration)]
197+typeDecls = mapMaybe getTypeName . filter P.isDataDecl . P.exportedDeclarations
198+ where
199+ getTypeName :: P.Declaration -> Maybe (N.ProperName, P.Declaration)
200+ getTypeName d@(P.TypeSynonymDeclaration name _ _) = Just (name, d)
201+ getTypeName d@(P.DataDeclaration _ name _ _) = Just (name, d)
202+ getTypeName (P.PositionedDeclaration _ _ d) = getTypeName d
203+ getTypeName _ = Nothing
204+
205+identNames :: P.Module -> [(N.Ident, P.Declaration)]
206+identNames = nubOnFst . concatMap getDeclNames . P.exportedDeclarations
207+ where
208+ getDeclNames :: P.Declaration -> [(P.Ident, P.Declaration)]
209+ getDeclNames d@(P.ValueDeclaration ident _ _ _) = [(ident, d)]
210+ getDeclNames d@(P.TypeDeclaration ident _ ) = [(ident, d)]
211+ getDeclNames d@(P.ExternDeclaration ident _) = [(ident, d)]
212+ getDeclNames d@(P.TypeClassDeclaration _ _ _ ds) = map (second (const d)) $ concatMap getDeclNames ds
213+ getDeclNames (P.PositionedDeclaration _ _ d) = getDeclNames d
214+ getDeclNames _ = []
215+
216+dctorNames :: P.Module -> [(N.ProperName, P.Declaration)]
217+dctorNames = nubOnFst . concatMap go . P.exportedDeclarations
218+ where
219+ go :: P.Declaration -> [(N.ProperName, P.Declaration)]
220+ go decl@(P.DataDeclaration _ _ _ ctors) = map (\n -> (n, decl)) (map fst ctors)
221+ go (P.PositionedDeclaration _ _ d) = go d
222+ go _ = []
223+
224+moduleNames :: [P.Module] -> [String]
225+moduleNames ms = nub [P.runModuleName moduleName | P.Module _ _ moduleName _ _ <- ms]
226+
227+directivesFirst :: Completion -> Completion -> Ordering
228+directivesFirst (Completion _ d1 _) (Completion _ d2 _) = go d1 d2
229+ where
230+ go (':' : xs) (':' : ys) = compare xs ys
231+ go (':' : _) _ = LT
232+ go _ (':' : _) = GT
233+ go xs ys = compare xs ys
psci/Directive.hsnew file+115
@@ -0,0 +1,115 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Directive
4+-- Copyright :
5+-- License : MIT
6+--
7+-- Maintainer :
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+-- Directives for PSCI.
13+--
14+-----------------------------------------------------------------------------
15+
16+module Directive where
17+
18+import Data.Maybe (fromJust, listToMaybe)
19+import Data.List (isPrefixOf)
20+import Data.Tuple (swap)
21+
22+import Types
23+
24+-- |
25+-- List of all avaliable directives.
26+--
27+directives :: [Directive]
28+directives = map fst directiveStrings
29+
30+-- |
31+-- A mapping of directives to the different strings that can be used to invoke
32+-- them.
33+--
34+directiveStrings :: [(Directive, [String])]
35+directiveStrings =
36+ [ (Help , ["?", "help"])
37+ , (Quit , ["quit"])
38+ , (Reset , ["reset"])
39+ , (Browse , ["browse"])
40+ , (Load , ["load", "module"])
41+ , (Foreign, ["foreign"])
42+ , (Type , ["type"])
43+ , (Kind , ["kind"])
44+ , (Show , ["show"])
45+ ]
46+
47+-- |
48+-- Like directiveStrings, but the other way around.
49+--
50+directiveStrings' :: [(String, Directive)]
51+directiveStrings' = concatMap go directiveStrings
52+ where
53+ go (dir, strs) = map (\s -> (s, dir)) strs
54+
55+-- |
56+-- List of all directive strings.
57+--
58+strings :: [String]
59+strings = concatMap snd directiveStrings
60+
61+-- |
62+-- Returns all possible string representations of a directive.
63+--
64+stringsFor :: Directive -> [String]
65+stringsFor d = fromJust (lookup d directiveStrings)
66+
67+-- |
68+-- Returns the default string representation of a directive.
69+--
70+stringFor :: Directive -> String
71+stringFor = head . stringsFor
72+
73+-- |
74+-- Returns the list of directives which could be expanded from the string
75+-- argument, together with the string alias that matched.
76+--
77+directivesFor' :: String -> [(Directive, String)]
78+directivesFor' str = go directiveStrings'
79+ where
80+ go = map swap . filter ((str `isPrefixOf`) . fst)
81+
82+directivesFor :: String -> [Directive]
83+directivesFor = map fst . directivesFor'
84+
85+directiveStringsFor :: String -> [String]
86+directiveStringsFor = map snd . directivesFor'
87+
88+parseDirective :: String -> Maybe Directive
89+parseDirective = listToMaybe . directivesFor
90+
91+-- |
92+-- True if the given directive takes an argument, false otherwise.
93+hasArgument :: Directive -> Bool
94+hasArgument Help = False
95+hasArgument Quit = False
96+hasArgument Reset = False
97+hasArgument _ = True
98+
99+-- |
100+-- The help menu.
101+--
102+help :: [(Directive, String, String)]
103+help =
104+ [ (Help, "", "Show this help menu")
105+ , (Quit, "", "Quit PSCi")
106+ , (Reset, "", "Discard all imported modules and declared bindings")
107+ , (Browse, "<module>", "See all functions in <module>")
108+ , (Load, "<file>", "Load <file> for importing")
109+ , (Foreign, "<file>", "Load foreign module <file>")
110+ , (Type, "<expr>", "Show the type of <expr>")
111+ , (Kind, "<type>", "Show the kind of <type>")
112+ , (Show, "import", "Show all imported modules")
113+ , (Show, "loaded", "Show all loaded modules")
114+ ]
115+
psci/IO.hsnew file+21
@@ -0,0 +1,21 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : IO
4+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+--
13+-----------------------------------------------------------------------------
14+
15+module IO where
16+
17+import System.Directory (createDirectoryIfMissing)
18+import System.FilePath (takeDirectory)
19+
20+mkdirp :: FilePath -> IO ()
21+mkdirp = createDirectoryIfMissing True . takeDirectory
psci/Main.hsdeleted−436
@@ -1,436 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Main
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- PureScript Compiler Interactive.
13−--
14−-----------------------------------------------------------------------------
15−
16−{-# LANGUAGE DoAndIfThenElse, FlexibleContexts, GeneralizedNewtypeDeriving #-}
17−
18−module Main where
19−
20−import Commands
21−
22−import Control.Applicative
23−import Control.Monad
24−import Control.Monad.Trans.Class
25−import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
26−import Control.Monad.Trans.State.Strict
27−import qualified Control.Monad.Trans.State.Lazy as L
28−import Control.Monad.Error (ErrorT(..), MonadError)
29−import Control.Monad.Error.Class (MonadError(..))
30−
31−import Data.List (intercalate, isPrefixOf, nub, sortBy)
32−import Data.Maybe (mapMaybe)
33−import Data.Foldable (traverse_)
34−import Data.Version (showVersion)
35−import Data.Traversable (traverse)
36−
37−import Parser
38−
39−import System.IO.Error (tryIOError)
40−import System.Console.Haskeline
41−import System.Directory
42− (createDirectoryIfMissing, getModificationTime, doesFileExist,
43− findExecutable, getHomeDirectory, getCurrentDirectory)
44−import System.Process (readProcessWithExitCode)
45−import System.Exit
46−import System.Environment.XDG.BaseDir
47−import System.FilePath
48− (pathSeparator, takeDirectory, (</>), isPathSeparator)
49−import qualified System.Console.CmdTheLine as Cmd
50−
51−import Text.Parsec (ParseError)
52−
53−import qualified Data.Map as M
54−import qualified Language.PureScript as P
55−import qualified Paths_purescript as Paths
56−import qualified System.IO.UTF8 as U
57− (writeFile, putStrLn, print, readFile)
58−
59−-- |
60−-- The PSCI state.
61−-- Holds a list of imported modules, loaded files, and partial let bindings.
62−-- The let bindings are partial,
63−-- because it makes more sense to apply the binding to the final evaluated expression.
64−--
65−data PSCiState = PSCiState
66− { psciImportedFilenames :: [FilePath]
67− , psciImportedModuleNames :: [P.ModuleName]
68− , psciLoadedModules :: [(FilePath, P.Module)]
69− , psciLetBindings :: [P.Value -> P.Value]
70− }
71−
72−-- State helpers
73−
74−-- |
75−-- Updates the state to have more imported modules.
76−--
77−updateImportedFiles :: FilePath -> PSCiState -> PSCiState
78−updateImportedFiles filename st = st { psciImportedFilenames = filename : psciImportedFilenames st }
79−
80−-- |
81−-- Updates the state to have more imported modules.
82−--
83−updateImports :: P.ModuleName -> PSCiState -> PSCiState
84−updateImports name st = st { psciImportedModuleNames = name : psciImportedModuleNames st }
85−
86−-- |
87−-- Updates the state to have more loaded files.
88−--
89−updateModules :: [(FilePath, P.Module)] -> PSCiState -> PSCiState
90−updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }
91−
92−-- |
93−-- Updates the state to have more let bindings.
94−--
95−updateLets :: (P.Value -> P.Value) -> PSCiState -> PSCiState
96−updateLets name st = st { psciLetBindings = name : psciLetBindings st }
97−
98−-- File helpers
99−-- |
100−-- Load the necessary modules.
101−--
102−defaultImports :: [P.ModuleName]
103−defaultImports = [P.ModuleName [P.ProperName "Prelude"]]
104−
105−-- |
106−-- Locates the node executable.
107−-- Checks for either @nodejs@ or @node@.
108−--
109−findNodeProcess :: IO (Maybe String)
110−findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
111− where names = ["nodejs", "node"]
112−
113−-- |
114−-- Grabs the filename where the history is stored.
115−--
116−getHistoryFilename :: IO FilePath
117−getHistoryFilename = getUserConfigFile "purescript" "psci_history"
118−
119−-- |
120−-- Grabs the filename where prelude is.
121−--
122−getPreludeFilename :: IO FilePath
123−getPreludeFilename = Paths.getDataFileName "prelude/prelude.purs"
124−
125−-- |
126−-- Loads a file for use with imports.
127−--
128−loadModule :: FilePath -> IO (Either String [P.Module])
129−loadModule filename = either (Left . show) Right . P.runIndentParser filename P.parseModules <$> U.readFile filename
130−
131−-- |
132−-- Expands tilde in path.
133−--
134−expandTilde :: FilePath -> IO FilePath
135−expandTilde ('~':p:rest) | isPathSeparator p = (</> rest) <$> getHomeDirectory
136−expandTilde p = return p
137−-- Messages
138−
139−-- |
140−-- The help message.
141−--
142−helpMessage :: String
143−helpMessage = "The following commands are available:\n\n " ++
144− intercalate "\n " (map (intercalate " ") help)
145−
146−-- |
147−-- The welcome prologue.
148−--
149−prologueMessage :: String
150−prologueMessage = intercalate "\n"
151− [ " ____ ____ _ _ "
152− , "| _ \\ _ _ _ __ ___/ ___| ___ _ __(_)_ __ | |_ "
153− , "| |_) | | | | '__/ _ \\___ \\ / __| '__| | '_ \\| __|"
154− , "| __/| |_| | | | __/___) | (__| | | | |_) | |_ "
155− , "|_| \\__,_|_| \\___|____/ \\___|_| |_| .__/ \\__|"
156− , " |_| "
157− , ""
158− , ":? shows help"
159− , ""
160− , "Expressions are terminated using Ctrl+D"
161− ]
162−
163−-- |
164−-- The quit message.
165−--
166−quitMessage :: String
167−quitMessage = "See ya!"
168−
169−-- Haskeline completions
170−
171−-- |
172−-- Loads module, function, and file completions.
173−--
174−completion :: CompletionFunc (StateT PSCiState IO)
175−completion = completeWord Nothing " \t\n\r" findCompletions
176− where
177− findCompletions :: String -> StateT PSCiState IO [Completion]
178− findCompletions str = do
179− ms <- map snd . psciLoadedModules <$> get
180− files <- listFiles str
181− let matches = filter (isPrefixOf str) (names ms)
182− return $ sortBy sorter $ map simpleCompletion matches ++ files
183− getDeclName :: Maybe [P.DeclarationRef] -> P.Declaration -> Maybe P.Ident
184− getDeclName Nothing (P.ValueDeclaration ident _ _ _ _) = Just ident
185− getDeclName (Just exts) (P.ValueDeclaration ident _ _ _ _) | isExported = Just ident
186− where
187− isExported = any exports exts
188− exports (P.ValueRef ident') = ident == ident'
189− exports (P.PositionedDeclarationRef _ r) = exports r
190− exports _ = False
191− getDeclName exts (P.PositionedDeclaration _ d) = getDeclName exts d
192− getDeclName _ _ = Nothing
193− names :: [P.Module] -> [String]
194− names ms = nub [ show qual
195− | P.Module moduleName ds exts <- ms
196− , ident <- mapMaybe (getDeclName exts) ds
197− , qual <- [ P.Qualified Nothing ident
198− , P.Qualified (Just moduleName) ident]
199− ]
200− sorter :: Completion -> Completion -> Ordering
201− sorter (Completion _ d1 _) (Completion _ d2 _) = compare d1 d2
202−
203−-- Compilation
204−
205−-- | Compilation options.
206−--
207−options :: P.Options
208−options = P.Options False True False True Nothing True Nothing [] [] False
209−
210−-- |
211−-- PSCI monad
212−--
213−newtype PSCI a = PSCI { runPSCI :: InputT (StateT PSCiState IO) a } deriving (Functor, Applicative, Monad)
214−
215−psciIO :: IO a -> PSCI a
216−psciIO io = PSCI (lift (lift io))
217−
218−newtype Make a = Make { unMake :: ErrorT String IO a } deriving (Functor, Applicative, Monad, MonadError String)
219−
220−runMake :: Make a -> IO (Either String a)
221−runMake = runErrorT . unMake
222−
223−makeIO :: IO a -> Make a
224−makeIO = Make . ErrorT . fmap (either (Left . show) Right) . tryIOError
225−
226−instance P.MonadMake Make where
227− getTimestamp path = makeIO $ do
228− exists <- doesFileExist path
229− case exists of
230− True -> Just <$> getModificationTime path
231− False -> return Nothing
232− readTextFile path = makeIO $ U.readFile path
233− writeTextFile path text = makeIO $ do
234− mkdirp path
235− U.writeFile path text
236− liftError = either throwError return
237− progress s = unless (s == "Compiling Main") $ makeIO . U.putStrLn $ s
238−
239−mkdirp :: FilePath -> IO ()
240−mkdirp = createDirectoryIfMissing True . takeDirectory
241−
242−-- |
243−-- Makes a volatile module to execute the current expression.
244−--
245−createTemporaryModule :: Bool -> PSCiState -> P.Value -> P.Module
246−createTemporaryModule exec PSCiState{psciImportedModuleNames = imports, psciLetBindings = lets} value =
247− let
248− moduleName = P.ModuleName [P.ProperName "$PSCI"]
249− importDecl m = P.ImportDeclaration m Nothing Nothing
250− traceModule = P.ModuleName [P.ProperName "Debug", P.ProperName "Trace"]
251− trace = P.Var (P.Qualified (Just traceModule) (P.Ident "print"))
252− itValue = foldl (\x f -> f x) value lets
253− mainValue = P.App trace (P.Var (P.Qualified Nothing (P.Ident "it")))
254− itDecl = P.ValueDeclaration (P.Ident "it") P.Value [] Nothing itValue
255− mainDecl = P.ValueDeclaration (P.Ident "main") P.Value [] Nothing mainValue
256− decls = if exec then [itDecl, mainDecl] else [itDecl]
257− in
258− P.Module moduleName ((importDecl `map` imports) ++ decls) Nothing
259−
260−-- |
261−-- Makes a volatile module to hold a non-qualified type synonym for a fully-qualified data type declaration.
262−--
263−createTemporaryModuleForKind :: PSCiState -> P.Type -> P.Module
264−createTemporaryModuleForKind PSCiState{psciImportedModuleNames = imports} typ =
265− let
266− moduleName = P.ModuleName [P.ProperName "$PSCI"]
267− importDecl m = P.ImportDeclaration m Nothing Nothing
268− itDecl = P.TypeSynonymDeclaration (P.ProperName "IT") [] typ
269− in
270− P.Module moduleName ((importDecl `map` imports) ++ [itDecl]) Nothing
271−
272−modulesDir :: FilePath
273−modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"
274−
275−indexFile :: FilePath
276−indexFile = ".psci_modules" ++ pathSeparator : "index.js"
277−
278−-- |
279−-- Takes a value declaration and evaluates it with the current state.
280−--
281−handleDeclaration :: P.Value -> PSCI ()
282−handleDeclaration value = do
283− st <- PSCI $ lift get
284− let m = createTemporaryModule True st value
285− e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("$PSCI.purs", m)])
286− case e of
287− Left err -> PSCI $ outputStrLn err
288− Right _ -> do
289− psciIO $ writeFile indexFile $ "require('$PSCI').main();"
290− process <- psciIO findNodeProcess
291− result <- psciIO $ traverse (\node -> readProcessWithExitCode node [indexFile] "") process
292− case result of
293− Just (ExitSuccess, out, _) -> PSCI $ outputStrLn out
294− Just (ExitFailure _, _, err) -> PSCI $ outputStrLn err
295− Nothing -> PSCI $ outputStrLn "Couldn't find node.js"
296−
297−-- |
298−-- Takes a value and prints its type
299−--
300−handleTypeOf :: P.Value -> PSCI ()
301−handleTypeOf value = do
302− st <- PSCI $ lift get
303− let m = createTemporaryModule False st value
304− e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("$PSCI.purs", m)])
305− case e of
306− Left err -> PSCI $ outputStrLn err
307− Right env' ->
308− case M.lookup (P.ModuleName [P.ProperName "$PSCI"], P.Ident "it") (P.names env') of
309− Just (ty, _, _) -> PSCI . outputStrLn . P.prettyPrintType $ ty
310− Nothing -> PSCI $ outputStrLn "Could not find type"
311−
312−-- |
313−-- Takes a value and prints its kind
314−--
315−handleKindOf :: P.Type -> PSCI ()
316−handleKindOf typ = do
317− st <- PSCI $ lift get
318− let m = createTemporaryModuleForKind st typ
319− mName = P.ModuleName [P.ProperName "$PSCI"]
320− e <- psciIO . runMake $ P.make modulesDir options (psciLoadedModules st ++ [("$PSCI.purs", m)])
321− case e of
322− Left err -> PSCI $ outputStrLn err
323− Right env' ->
324− case M.lookup (P.Qualified (Just mName) $ P.ProperName "IT") (P.typeSynonyms env') of
325− Just (_, typ') -> do
326− let chk = P.CheckState env' 0 0 (Just mName)
327− k = L.runStateT (P.unCheck (P.kindOf mName typ')) chk
328− case k of
329− Left errStack -> PSCI . outputStrLn . P.prettyPrintErrorStack False $ errStack
330− Right (kind, _) -> PSCI . outputStrLn . P.prettyPrintKind $ kind
331− Nothing -> PSCI $ outputStrLn "Could not find kind"
332−
333−-- Commands
334−
335−-- |
336−-- Parses the input and returns either a Metacommand or an expression.
337−--
338−getCommand :: InputT (StateT PSCiState IO) (Either ParseError (Maybe Command))
339−getCommand = do
340− firstLine <- getInputLine "> "
341− case firstLine of
342− Nothing -> return (Right Nothing)
343− Just "" -> return (Right Nothing)
344− Just s@ (':' : _) -> return . either Left (Right . Just) $ parseCommand s -- The start of a command
345− Just s -> either Left (Right . Just) . parseCommand <$> go [s]
346− where
347− go :: [String] -> InputT (StateT PSCiState IO) String
348− go ls = maybe (return . unlines $ reverse ls) (go . (:ls)) =<< getInputLine " "
349−
350−-- |
351−-- Performs an action for each meta-command given, and also for expressions..
352−--
353−handleCommand :: Command -> PSCI ()
354−handleCommand (Expression val) = handleDeclaration val
355−handleCommand Help = PSCI $ outputStrLn helpMessage
356−handleCommand (Import moduleName) = PSCI $ lift $ modify (updateImports moduleName)
357−handleCommand (Let l) = PSCI $ lift $ modify (updateLets l)
358−handleCommand (LoadFile filePath) = do
359− absPath <- psciIO $ expandTilde filePath
360− exists <- psciIO $ doesFileExist absPath
361− if exists then do
362− PSCI . lift $ modify (updateImportedFiles absPath)
363− m <- psciIO $ loadModule absPath
364− case m of
365− Left err -> PSCI $ outputStrLn err
366− Right mods -> PSCI . lift $ modify (updateModules (map ((,) absPath) mods))
367− else
368− PSCI . outputStrLn $ "Couldn't locate: " ++ filePath
369−handleCommand Reset = do
370− files <- psciImportedFilenames <$> PSCI (lift get)
371− filesAndModules <- mapM (\file -> fmap (fmap (map ((,) file))) . psciIO . loadModule $ file) files
372− let modulesOrFirstError = fmap concat $ sequence filesAndModules
373− case modulesOrFirstError of
374− Left err -> psciIO $ putStrLn err >> exitFailure
375− Right modules -> PSCI . lift $ put (PSCiState files defaultImports modules [])
376−handleCommand (TypeOf val) = handleTypeOf val
377−handleCommand (KindOf typ) = handleKindOf typ
378−handleCommand _ = PSCI $ outputStrLn "Unknown command"
379−
380−inputFiles :: Cmd.Term [FilePath]
381−inputFiles = Cmd.value $ Cmd.posAny [] $ Cmd.posInfo { Cmd.posName = "file(s)"
382− , Cmd.posDoc = "Optional .purs files to load on start" }
383−
384−loadUserConfig :: IO (Maybe [Command])
385−loadUserConfig = do
386− configFile <- (</> ".psci") <$> getCurrentDirectory
387− exists <- doesFileExist configFile
388− if exists
389− then do
390− ls <- lines <$> U.readFile configFile
391− case mapM parseCommand ls of
392− Left err -> U.print err >> exitFailure
393− Right cs -> return $ Just cs
394− else
395− return Nothing
396−
397−-- |
398−-- The PSCI main loop.
399−--
400−loop :: [FilePath] -> IO ()
401−loop files = do
402− config <- loadUserConfig
403− preludeFilename <- getPreludeFilename
404− filesAndModules <- mapM (\file -> fmap (fmap (map ((,) file))) . loadModule $ file) (preludeFilename : files)
405− let modulesOrFirstError = fmap concat $ sequence filesAndModules
406− case modulesOrFirstError of
407− Left err -> putStrLn err >> exitFailure
408− Right modules -> do
409− historyFilename <- getHistoryFilename
410− let settings = defaultSettings {historyFile = Just historyFilename}
411− flip evalStateT (PSCiState (preludeFilename : files) defaultImports modules []) . runInputT (setComplete completion settings) $ do
412− outputStrLn prologueMessage
413− traverse_ (mapM_ (runPSCI . handleCommand)) config
414− go
415− where
416− go :: InputT (StateT PSCiState IO) ()
417− go = do
418− c <- getCommand
419− case c of
420− Left err -> outputStrLn (show err) >> go
421− Right Nothing -> go
422− Right (Just Quit) -> outputStrLn quitMessage
423− Right (Just c') -> runPSCI (handleCommand c') >> go
424−
425−term :: Cmd.Term (IO ())
426−term = loop <$> inputFiles
427−
428−termInfo :: Cmd.TermInfo
429−termInfo = Cmd.defTI
430− { Cmd.termName = "psci"
431− , Cmd.version = showVersion Paths.version
432− , Cmd.termDoc = "Interactive mode for PureScript"
433− }
434−
435−main :: IO ()
436−main = Cmd.run (term, termInfo)
psci/PSCi.hsnew file+601
@@ -0,0 +1,601 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : PSCi
4+-- Copyright : (c) 2013-15 Phil Freeman, (c) 2014-15 Gary Burgess
5+-- License : MIT (http://opensource.org/licenses/MIT)
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+-- PureScript Compiler Interactive.
13+--
14+-----------------------------------------------------------------------------
15+
16+{-# LANGUAGE DoAndIfThenElse #-}
17+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
18+{-# LANGUAGE RecordWildCards #-}
19+{-# LANGUAGE TupleSections #-}
20+{-# LANGUAGE CPP #-}
21+
22+module PSCi where
23+
24+import Data.Foldable (traverse_)
25+import Data.List (intercalate, nub, sort)
26+#if __GLASGOW_HASKELL__ < 710
27+import Data.Traversable (traverse)
28+#endif
29+import Data.Tuple (swap)
30+import Data.Version (showVersion)
31+import qualified Data.Map as M
32+
33+import Control.Applicative
34+import Control.Arrow (first)
35+import Control.Monad
36+import Control.Monad.Error.Class (MonadError(..))
37+import Control.Monad.Trans.Class
38+import Control.Monad.Trans.Except (runExceptT)
39+import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
40+import Control.Monad.Trans.State.Strict
41+import Control.Monad.IO.Class (liftIO)
42+import Control.Monad.Writer.Strict (runWriter)
43+import qualified Control.Monad.Trans.State.Lazy as L
44+
45+import Options.Applicative as Opts
46+
47+import System.Console.Haskeline
48+import System.Directory (doesFileExist, findExecutable, getHomeDirectory, getCurrentDirectory)
49+import System.Exit
50+import System.FilePath (pathSeparator, (</>), isPathSeparator)
51+import System.FilePath.Glob (glob)
52+import System.Process (readProcessWithExitCode)
53+import System.IO.Error (tryIOError)
54+
55+import qualified Language.PureScript as P
56+import qualified Language.PureScript.Names as N
57+import qualified Paths_purescript as Paths
58+
59+import qualified Directive as D
60+import Completion (completion)
61+import IO (mkdirp)
62+import Parser (parseCommand)
63+import Types
64+
65+-- | The name of the PSCI support module
66+supportModuleName :: P.ModuleName
67+supportModuleName = P.ModuleName [P.ProperName "$PSCI", P.ProperName "Support"]
68+
69+-- | Support module, contains code to evaluate terms
70+supportModule :: P.Module
71+supportModule =
72+ case P.parseModulesFromFiles id [("", code)] of
73+ Right [(_, P.Module ss cs _ ds exps)] -> P.Module ss cs supportModuleName ds exps
74+ _ -> error "Support module could not be parsed"
75+ where
76+ code :: String
77+ code = unlines
78+ [ "module S where"
79+ , ""
80+ , "import Prelude"
81+ , "import Control.Monad.Eff"
82+ , "import Control.Monad.Eff.Console"
83+ , "import Control.Monad.Eff.Unsafe"
84+ , ""
85+ , "class Eval a where"
86+ , " eval :: a -> Eff (console :: CONSOLE) Unit"
87+ , ""
88+ , "instance evalShow :: (Show a) => Eval a where"
89+ , " eval = print"
90+ , ""
91+ , "instance evalEff :: (Eval a) => Eval (Eff eff a) where"
92+ , " eval x = unsafeInterleaveEff x >>= eval"
93+ ]
94+
95+-- File helpers
96+
97+onFirstFileMatching :: Monad m => (b -> m (Maybe a)) -> [b] -> m (Maybe a)
98+onFirstFileMatching f pathVariants = runMaybeT . msum $ map (MaybeT . f) pathVariants
99+
100+-- |
101+-- Locates the node executable.
102+-- Checks for either @nodejs@ or @node@.
103+--
104+findNodeProcess :: IO (Maybe String)
105+findNodeProcess = onFirstFileMatching findExecutable names
106+ where names = ["nodejs", "node"]
107+
108+-- |
109+-- Grabs the filename where the history is stored.
110+--
111+getHistoryFilename :: IO FilePath
112+getHistoryFilename = do
113+ home <- getHomeDirectory
114+ let filename = home </> ".purescript" </> "psci_history"
115+ mkdirp filename
116+ return filename
117+
118+-- |
119+-- Loads a file for use with imports.
120+--
121+loadModule :: FilePath -> IO (Either String [P.Module])
122+loadModule filename = do
123+ content <- readFile filename
124+ return $ either (Left . P.prettyPrintMultipleErrors False) (Right . map snd) $ P.parseModulesFromFiles id [(filename, content)]
125+
126+-- |
127+-- Load all modules.
128+--
129+loadAllModules :: [FilePath] -> IO (Either P.MultipleErrors [(Either P.RebuildPolicy FilePath, P.Module)])
130+loadAllModules files = do
131+ filesAndContent <- forM files $ \filename -> do
132+ content <- readFile filename
133+ return (Right filename, content)
134+ return $ P.parseModulesFromFiles (either (const "") id) filesAndContent
135+
136+-- |
137+-- Load all modules, updating the application state
138+--
139+loadAllImportedModules :: PSCI ()
140+loadAllImportedModules = do
141+ files <- PSCI . lift $ fmap psciImportedFilenames get
142+ modulesOrFirstError <- psciIO $ loadAllModules files
143+ case modulesOrFirstError of
144+ Left errs -> printErrors errs
145+ Right modules -> PSCI . lift . modify $ \st -> st { psciLoadedModules = modules }
146+
147+-- |
148+-- Expands tilde in path.
149+--
150+expandTilde :: FilePath -> IO FilePath
151+expandTilde ('~':p:rest) | isPathSeparator p = (</> rest) <$> getHomeDirectory
152+expandTilde p = return p
153+
154+-- Messages
155+
156+-- |
157+-- The help message.
158+--
159+helpMessage :: String
160+helpMessage = "The following commands are available:\n\n " ++
161+ intercalate "\n " (map line D.help) ++
162+ "\n\n" ++ extraHelp
163+ where
164+ line :: (Directive, String, String) -> String
165+ line (dir, arg, desc) =
166+ let cmd = ':' : D.stringFor dir
167+ in unwords [ cmd
168+ , replicate (11 - length cmd) ' '
169+ , arg
170+ , replicate (11 - length arg) ' '
171+ , desc
172+ ]
173+
174+ extraHelp =
175+ "Further information is available on the PureScript wiki:\n" ++
176+ " --> https://github.com/purescript/purescript/wiki/psci"
177+
178+
179+-- |
180+-- The welcome prologue.
181+--
182+prologueMessage :: String
183+prologueMessage = intercalate "\n"
184+ [ " ____ ____ _ _ "
185+ , "| _ \\ _ _ _ __ ___/ ___| ___ _ __(_)_ __ | |_ "
186+ , "| |_) | | | | '__/ _ \\___ \\ / __| '__| | '_ \\| __|"
187+ , "| __/| |_| | | | __/___) | (__| | | | |_) | |_ "
188+ , "|_| \\__,_|_| \\___|____/ \\___|_| |_| .__/ \\__|"
189+ , " |_| "
190+ , ""
191+ , ":? shows help"
192+ ]
193+
194+-- |
195+-- The quit message.
196+--
197+quitMessage :: String
198+quitMessage = "See ya!"
199+
200+-- |
201+-- PSCI monad
202+--
203+newtype PSCI a = PSCI { runPSCI :: InputT (StateT PSCiState IO) a } deriving (Functor, Applicative, Monad)
204+
205+psciIO :: IO a -> PSCI a
206+psciIO io = PSCI . lift $ lift io
207+
208+-- |
209+-- Makes a volatile module to execute the current expression.
210+--
211+createTemporaryModule :: Bool -> PSCiState -> P.Expr -> P.Module
212+createTemporaryModule exec PSCiState{psciImportedModules = imports, psciLetBindings = lets} val =
213+ let
214+ moduleName = P.ModuleName [P.ProperName "$PSCI"]
215+ trace = P.Var (P.Qualified (Just supportModuleName) (P.Ident "eval"))
216+ mainValue = P.App trace (P.Var (P.Qualified Nothing (P.Ident "it")))
217+ itDecl = P.ValueDeclaration (P.Ident "it") P.Public [] $ Right val
218+ mainDecl = P.ValueDeclaration (P.Ident "main") P.Public [] $ Right mainValue
219+ decls = if exec then [itDecl, mainDecl] else [itDecl]
220+ in
221+ P.Module (P.internalModuleSourceSpan "<internal>") [] moduleName ((importDecl `map` imports) ++ lets ++ decls) Nothing
222+
223+
224+-- |
225+-- Makes a volatile module to hold a non-qualified type synonym for a fully-qualified data type declaration.
226+--
227+createTemporaryModuleForKind :: PSCiState -> P.Type -> P.Module
228+createTemporaryModuleForKind PSCiState{psciImportedModules = imports, psciLetBindings = lets} typ =
229+ let
230+ moduleName = P.ModuleName [P.ProperName "$PSCI"]
231+ itDecl = P.TypeSynonymDeclaration (P.ProperName "IT") [] typ
232+ in
233+ P.Module (P.internalModuleSourceSpan "<internal>") [] moduleName ((importDecl `map` imports) ++ lets ++ [itDecl]) Nothing
234+
235+-- |
236+-- Makes a volatile module to execute the current imports.
237+--
238+createTemporaryModuleForImports :: PSCiState -> P.Module
239+createTemporaryModuleForImports PSCiState{psciImportedModules = imports} =
240+ let
241+ moduleName = P.ModuleName [P.ProperName "$PSCI"]
242+ in
243+ P.Module (P.internalModuleSourceSpan "<internal>") [] moduleName (importDecl `map` imports) Nothing
244+
245+importDecl :: ImportedModule -> P.Declaration
246+importDecl (mn, declType, asQ) = P.ImportDeclaration mn declType asQ
247+
248+indexFile :: FilePath
249+indexFile = ".psci_modules" ++ pathSeparator : "index.js"
250+
251+modulesDir :: FilePath
252+modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"
253+
254+-- | This is different than the runMake in 'Language.PureScript.Make' in that it specifies the
255+-- options and ignores the warning messages.
256+runMake :: P.Make a -> IO (Either P.MultipleErrors a)
257+runMake mk = fmap (fmap fst) $ P.runMake P.defaultOptions mk
258+
259+makeIO :: (IOError -> P.ErrorMessage) -> IO a -> P.Make a
260+makeIO f io = do
261+ e <- liftIO $ tryIOError io
262+ either (throwError . P.singleError . f) return e
263+
264+make :: PSCiState -> [(Either P.RebuildPolicy FilePath, P.Module)] -> P.Make P.Environment
265+make PSCiState{..} ms = P.make actions' (map snd (psciLoadedModules ++ ms))
266+ where
267+ filePathMap = M.fromList $ (first P.getModuleName . swap) `map` (psciLoadedModules ++ ms)
268+ actions = P.buildMakeActions modulesDir filePathMap psciForeignFiles False
269+ actions' = actions { P.progress = const (return ()) }
270+
271+-- |
272+-- Takes a value declaration and evaluates it with the current state.
273+--
274+handleDeclaration :: P.Expr -> PSCI ()
275+handleDeclaration val = do
276+ st <- PSCI $ lift get
277+ let m = createTemporaryModule True st val
278+ let nodeArgs = psciNodeFlags st ++ [indexFile]
279+ e <- psciIO . runMake $ make st [(Left P.RebuildAlways, supportModule), (Left P.RebuildAlways, m)]
280+ case e of
281+ Left errs -> printErrors errs
282+ Right _ -> do
283+ psciIO $ writeFile indexFile "require('$PSCI').main();"
284+ process <- psciIO findNodeProcess
285+ result <- psciIO $ traverse (\node -> readProcessWithExitCode node nodeArgs "") process
286+ case result of
287+ Just (ExitSuccess, out, _) -> PSCI $ outputStrLn out
288+ Just (ExitFailure _, _, err) -> PSCI $ outputStrLn err
289+ Nothing -> PSCI $ outputStrLn "Couldn't find node.js"
290+
291+-- |
292+-- Takes a list of declarations and updates the environment, then run a make. If the declaration fails,
293+-- restore the original environment.
294+--
295+handleDecls :: [P.Declaration] -> PSCI ()
296+handleDecls ds = do
297+ st <- PSCI $ lift get
298+ let st' = updateLets ds st
299+ let m = createTemporaryModule False st' (P.ObjectLiteral [])
300+ e <- psciIO . runMake $ make st' [(Left P.RebuildAlways, m)]
301+ case e of
302+ Left err -> printErrors err
303+ Right _ -> PSCI $ lift (put st')
304+
305+-- |
306+-- Show actual loaded modules in psci.
307+--
308+handleShowLoadedModules :: PSCI ()
309+handleShowLoadedModules = do
310+ PSCiState { psciLoadedModules = loadedModules } <- PSCI $ lift get
311+ psciIO $ readModules loadedModules >>= putStrLn
312+ return ()
313+ where readModules = return . unlines . sort . nub . map toModuleName
314+ toModuleName = N.runModuleName . (\ (P.Module _ _ mdName _ _) -> mdName) . snd
315+
316+-- |
317+-- Show the imported modules in psci.
318+--
319+handleShowImportedModules :: PSCI ()
320+handleShowImportedModules = do
321+ PSCiState { psciImportedModules = importedModules } <- PSCI $ lift get
322+ psciIO $ showModules importedModules >>= putStrLn
323+ return ()
324+ where
325+ showModules = return . unlines . sort . map showModule
326+ showModule (mn, declType, asQ) =
327+ "import " ++ case asQ of
328+ Just mn' -> "qualified " ++ N.runModuleName mn ++ " as " ++ N.runModuleName mn'
329+ Nothing -> N.runModuleName mn ++ " " ++ showDeclType declType
330+
331+ showDeclType P.Implicit = ""
332+ showDeclType (P.Explicit refs) = refsList refs
333+ showDeclType (P.Hiding refs) = "hiding " ++ refsList refs
334+ refsList refs = "(" ++ commaList (map showRef refs) ++ ")"
335+
336+ showRef :: P.DeclarationRef -> String
337+ showRef (P.TypeRef pn dctors) = show pn ++ "(" ++ maybe ".." (commaList . map N.runProperName) dctors ++ ")"
338+ showRef (P.ValueRef ident) = show ident
339+ showRef (P.TypeClassRef pn) = show pn
340+ showRef (P.TypeInstanceRef ident) = show ident
341+ showRef (P.ModuleRef name) = "module " ++ show name
342+ showRef (P.PositionedDeclarationRef _ _ ref) = showRef ref
343+
344+ commaList :: [String] -> String
345+ commaList = intercalate ", "
346+
347+-- |
348+-- Imports a module, preserving the initial state on failure.
349+--
350+handleImport :: ImportedModule -> PSCI ()
351+handleImport im = do
352+ st <- updateImportedModules im <$> PSCI (lift get)
353+ let m = createTemporaryModuleForImports st
354+ e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]
355+ case e of
356+ Left errs -> printErrors errs
357+ Right _ -> do
358+ PSCI $ lift $ put st
359+ return ()
360+
361+-- |
362+-- Takes a value and prints its type
363+--
364+handleTypeOf :: P.Expr -> PSCI ()
365+handleTypeOf val = do
366+ st <- PSCI $ lift get
367+ let m = createTemporaryModule False st val
368+ e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]
369+ case e of
370+ Left errs -> printErrors errs
371+ Right env' ->
372+ case M.lookup (P.ModuleName [P.ProperName "$PSCI"], P.Ident "it") (P.names env') of
373+ Just (ty, _, _) -> PSCI . outputStrLn . P.prettyPrintType $ ty
374+ Nothing -> PSCI $ outputStrLn "Could not find type"
375+
376+-- |
377+-- Pretty print a module's signatures
378+--
379+printModuleSignatures :: P.ModuleName -> P.Environment -> PSCI ()
380+printModuleSignatures moduleName env =
381+ PSCI $ let namesEnv = P.names env
382+ moduleNamesIdent = (filter ((== moduleName) . fst) . M.keys) namesEnv
383+ in case moduleNamesIdent of
384+ [] -> outputStrLn $ "This module '"++ P.runModuleName moduleName ++"' does not export functions."
385+ _ -> ( outputStrLn
386+ . unlines
387+ . sort
388+ . map (showType . findType namesEnv)) moduleNamesIdent
389+ where findType :: M.Map (P.ModuleName, P.Ident) (P.Type, P.NameKind, P.NameVisibility) -> (P.ModuleName, P.Ident) -> (P.Ident, Maybe (P.Type, P.NameKind, P.NameVisibility))
390+ findType envNames m@(_, mIdent) = (mIdent, M.lookup m envNames)
391+ showType :: (P.Ident, Maybe (P.Type, P.NameKind, P.NameVisibility)) -> String
392+ showType (mIdent, Just (mType, _, _)) = show mIdent ++ " :: " ++ P.prettyPrintType mType
393+ showType _ = error "The impossible happened in printModuleSignatures."
394+
395+-- |
396+-- Browse a module and displays its signature (if module exists).
397+--
398+handleBrowse :: P.ModuleName -> PSCI ()
399+handleBrowse moduleName = do
400+ st <- PSCI $ lift get
401+ env <- psciIO . runMake $ make st []
402+ case env of
403+ Left errs -> printErrors errs
404+ Right env' ->
405+ if moduleName `notElem` (nub . map ((\ (P.Module _ _ modName _ _ ) -> modName) . snd)) (psciLoadedModules st)
406+ then PSCI $ outputStrLn $ "Module '" ++ N.runModuleName moduleName ++ "' is not valid."
407+ else printModuleSignatures moduleName env'
408+
409+-- | Pretty-print errors
410+printErrors :: P.MultipleErrors -> PSCI ()
411+printErrors = PSCI . outputStrLn . P.prettyPrintMultipleErrors False
412+
413+-- |
414+-- Takes a value and prints its kind
415+--
416+handleKindOf :: P.Type -> PSCI ()
417+handleKindOf typ = do
418+ st <- PSCI $ lift get
419+ let m = createTemporaryModuleForKind st typ
420+ mName = P.ModuleName [P.ProperName "$PSCI"]
421+ e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]
422+ case e of
423+ Left errs -> printErrors errs
424+ Right env' ->
425+ case M.lookup (P.Qualified (Just mName) $ P.ProperName "IT") (P.typeSynonyms env') of
426+ Just (_, typ') -> do
427+ let chk = P.CheckState env' 0 0 (Just mName)
428+ k = fst . runWriter . runExceptT $ L.runStateT (P.unCheck (P.kindOf mName typ')) chk
429+ case k of
430+ Left errStack -> PSCI . outputStrLn . P.prettyPrintMultipleErrors False $ errStack
431+ Right (kind, _) -> PSCI . outputStrLn . P.prettyPrintKind $ kind
432+ Nothing -> PSCI $ outputStrLn "Could not find kind"
433+
434+-- Commands
435+
436+-- |
437+-- Parses the input and returns either a Metacommand, or an error as a string.
438+--
439+getCommand :: Bool -> InputT (StateT PSCiState IO) (Either String (Maybe Command))
440+getCommand singleLineMode = do
441+ firstLine <- getInputLine "> "
442+ case firstLine of
443+ Nothing -> return (Right Nothing)
444+ Just "" -> return (Right Nothing)
445+ Just s | singleLineMode || head s == ':' -> return . either Left (Right . Just) $ parseCommand s
446+ Just s -> either Left (Right . Just) . parseCommand <$> go [s]
447+ where
448+ go :: [String] -> InputT (StateT PSCiState IO) String
449+ go ls = maybe (return . unlines $ reverse ls) (go . (:ls)) =<< getInputLine " "
450+
451+-- |
452+-- Performs an action for each meta-command given, and also for expressions.
453+--
454+handleCommand :: Command -> PSCI ()
455+handleCommand (Expression val) = handleDeclaration val
456+handleCommand ShowHelp = PSCI $ outputStrLn helpMessage
457+handleCommand (Import im) = handleImport im
458+handleCommand (Decls l) = handleDecls l
459+handleCommand (LoadFile filePath) = whenFileExists filePath $ \absPath -> do
460+ PSCI . lift $ modify (updateImportedFiles absPath)
461+ m <- psciIO $ loadModule absPath
462+ case m of
463+ Left err -> PSCI $ outputStrLn err
464+ Right mods -> PSCI . lift $ modify (updateModules (map ((,) (Right absPath)) mods))
465+handleCommand (LoadForeign filePath) = whenFileExists filePath $ \absPath -> do
466+ foreignsOrError <- psciIO . runMake $ do
467+ foreignFile <- makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile absPath)) (readFile absPath)
468+ P.parseForeignModulesFromFiles [(absPath, foreignFile)]
469+ case foreignsOrError of
470+ Left err -> PSCI $ outputStrLn $ P.prettyPrintMultipleErrors False err
471+ Right foreigns -> PSCI . lift $ modify (updateForeignFiles foreigns)
472+handleCommand ResetState = do
473+ files <- psciImportedFilenames <$> PSCI (lift get)
474+ PSCI . lift . modify $ \st -> st
475+ { psciImportedFilenames = files
476+ , psciImportedModules = []
477+ , psciLetBindings = []
478+ }
479+ loadAllImportedModules
480+handleCommand (TypeOf val) = handleTypeOf val
481+handleCommand (KindOf typ) = handleKindOf typ
482+handleCommand (BrowseModule moduleName) = handleBrowse moduleName
483+handleCommand (ShowInfo QueryLoaded) = handleShowLoadedModules
484+handleCommand (ShowInfo QueryImport) = handleShowImportedModules
485+handleCommand QuitPSCi = error "`handleCommand QuitPSCi` was called. This is a bug."
486+
487+whenFileExists :: FilePath -> (FilePath -> PSCI ()) -> PSCI ()
488+whenFileExists filePath f = do
489+ absPath <- psciIO $ expandTilde filePath
490+ exists <- psciIO $ doesFileExist absPath
491+ if exists
492+ then f absPath
493+ else PSCI . outputStrLn $ "Couldn't locate: " ++ filePath
494+
495+-- |
496+-- Attempts to read initial commands from '.psci' in the present working
497+-- directory then the user's home
498+--
499+loadUserConfig :: IO (Maybe [Command])
500+loadUserConfig = onFirstFileMatching readCommands pathGetters
501+ where
502+ pathGetters = [getCurrentDirectory, getHomeDirectory]
503+ readCommands :: IO FilePath -> IO (Maybe [Command])
504+ readCommands path = do
505+ configFile <- (</> ".psci") <$> path
506+ exists <- doesFileExist configFile
507+ if exists
508+ then do
509+ ls <- lines <$> readFile configFile
510+ case mapM parseCommand ls of
511+ Left err -> print err >> exitFailure
512+ Right cs -> return $ Just cs
513+ else
514+ return Nothing
515+
516+
517+-- | Checks if the Console module is defined
518+consoleIsDefined :: [P.Module] -> Bool
519+consoleIsDefined = any ((== P.ModuleName (map P.ProperName [ "Control", "Monad", "Eff", "Console" ])) . P.getModuleName)
520+
521+-- |
522+-- The PSCI main loop.
523+--
524+loop :: PSCiOptions -> IO ()
525+loop PSCiOptions{..} = do
526+ config <- loadUserConfig
527+ inputFiles <- concat <$> mapM glob psciInputFile
528+ foreignFiles <- concat <$> mapM glob psciForeignInputFiles
529+ modulesOrFirstError <- loadAllModules inputFiles
530+ case modulesOrFirstError of
531+ Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
532+ Right modules -> do
533+ historyFilename <- getHistoryFilename
534+ let settings = defaultSettings { historyFile = Just historyFilename }
535+ foreignsOrError <- runMake $ do
536+ foreignFilesContent <- forM foreignFiles (\inFile -> (inFile,) <$> makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile inFile)) (readFile inFile))
537+ P.parseForeignModulesFromFiles foreignFilesContent
538+ case foreignsOrError of
539+ Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
540+ Right foreigns ->
541+ flip evalStateT (PSCiState inputFiles [] modules foreigns [] psciInputNodeFlags) . runInputT (setComplete completion settings) $ do
542+ outputStrLn prologueMessage
543+ traverse_ (mapM_ (runPSCI . handleCommand)) config
544+ modules' <- lift $ gets psciLoadedModules
545+ unless (consoleIsDefined (map snd modules')) . outputStrLn $ unlines
546+ [ "PSCi requires the purescript-console module to be installed."
547+ , "For help getting started, visit http://wiki.purescript.org/PSCi"
548+ ]
549+ go
550+ where
551+ go :: InputT (StateT PSCiState IO) ()
552+ go = do
553+ c <- getCommand (not psciMultiLineMode)
554+ case c of
555+ Left err -> outputStrLn err >> go
556+ Right Nothing -> go
557+ Right (Just QuitPSCi) -> outputStrLn quitMessage
558+ Right (Just c') -> runPSCI (loadAllImportedModules >> handleCommand c') >> go
559+
560+multiLineMode :: Parser Bool
561+multiLineMode = switch $
562+ long "multi-line-mode"
563+ <> short 'm'
564+ <> Opts.help "Run in multi-line mode (use ^D to terminate commands)"
565+
566+inputFile :: Parser FilePath
567+inputFile = strArgument $
568+ metavar "FILE"
569+ <> Opts.help "Optional .purs files to load on start"
570+
571+inputForeignFile :: Parser FilePath
572+inputForeignFile = strOption $
573+ short 'f'
574+ <> long "ffi"
575+ <> help "The input .js file(s) providing foreign import implementations"
576+
577+nodeFlagsFlag :: Parser [String]
578+nodeFlagsFlag = option parser $
579+ long "node-opts"
580+ <> metavar "NODE_OPTS"
581+ <> value []
582+ <> Opts.help "Flags to pass to node, separated by spaces"
583+ where
584+ parser = words <$> str
585+
586+psciOptions :: Parser PSCiOptions
587+psciOptions = PSCiOptions <$> multiLineMode
588+ <*> many inputFile
589+ <*> many inputForeignFile
590+ <*> nodeFlagsFlag
591+
592+runPSCi :: IO ()
593+runPSCi = execParser opts >>= loop
594+ where
595+ opts = info (version <*> helper <*> psciOptions) infoModList
596+ infoModList = fullDesc <> headerInfo <> footerInfo
597+ headerInfo = header "psci - Interactive mode for PureScript"
598+ footerInfo = footer $ "psci " ++ showVersion Paths.version
599+
600+ version :: Parser (a -> a)
601+ version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> Opts.help "Show the version number" <> hidden
psci/Parser.hs+104−60
@@ -13,87 +13,131 @@
13--
13--
14-----------------------------------------------------------------------------
14-----------------------------------------------------------------------------
15
15
16+{-# LANGUAGE CPP #-}
17+
16−module Parser (
18+module Parser
17− parseCommand
19+ ( parseCommand
18 ) where
20 ) where
19
21
20−import Commands
22+import Prelude hiding (lex)
21
23
22import Data.Char (isSpace)
24import Data.Char (isSpace)
25+import Data.List (intercalate)
23
26
27+#if __GLASGOW_HASKELL__ < 710
24import Control.Applicative hiding (many)
28import Control.Applicative hiding (many)
29+#endif
25
30
26import Text.Parsec hiding ((<|>))
31import Text.Parsec hiding ((<|>))
27
32
28import qualified Language.PureScript as P
33import qualified Language.PureScript as P
29−import qualified Language.PureScript.Parser.Common as C (mark, same)
34+import Language.PureScript.Parser.Common (mark, same)
30
35
31−-- |
36+import qualified Directive as D
32−-- PSCI version of @let@.
37+import Types
33−-- This is essentially let from do-notation.
34−-- However, since we don't support the @Eff@ monad,
35−-- we actually want the normal @let@.
36−--
37−psciLet :: Parsec String P.ParseState Command
38−psciLet = Let <$> (P.Let <$> (P.reserved "let" *> P.indented *> C.mark (many1 (C.same *> P.parseDeclaration))))
39
38
40-- |
39-- |
41-- Parses PSCI metacommands or expressions input from the user.
40-- Parses PSCI metacommands or expressions input from the user.
42--
41--
43−parseCommand :: String -> Either ParseError Command
42+parseCommand :: String -> Either String Command
44−parseCommand = P.runIndentParser "" $ choice
43+parseCommand cmdString =
45− [ P.whiteSpace *> char ':' *> (psciHelp <|> psciImport <|> psciLoadFile <|> psciQuit <|> psciReload <|> psciTypeOf <|> psciKindOf)
44+ case cmdString of
45+ (':' : cmd) -> parseDirective cmd
46+ _ -> parseRest psciCommand cmdString
47+
48+parseRest :: P.TokenParser a -> String -> Either String a
49+parseRest p s = either (Left . show) Right $ do
50+ ts <- P.lex "" s
51+ P.runTokenParser "" (p <* eof) ts
52+
53+psciCommand :: P.TokenParser Command
54+psciCommand = choice (map try parsers)
55+ where
56+ parsers =
46− , try psciLet
57+ [ psciLet
58+ , psciImport
59+ , psciOtherDeclaration
47− , psciExpression
60+ , psciExpression
48− ] <* eof
61+ ]
62+
63+trim :: String -> String
64+trim = trimEnd . trimStart
65+
66+trimStart :: String -> String
67+trimStart = dropWhile isSpace
68+
69+trimEnd :: String -> String
70+trimEnd = reverse . trimStart . reverse
71+
72+parseDirective :: String -> Either String Command
73+parseDirective cmd =
74+ case D.directivesFor' dstr of
75+ [(d, _)] -> commandFor d
76+ [] -> Left "Unrecognized directive. Type :? for help."
77+ ds -> Left ("Ambiguous directive. Possible matches: " ++
78+ intercalate ", " (map snd ds) ++ ". Type :? for help.")
79+ where
80+ (dstr, arg) = break isSpace cmd
81+
82+ commandFor d = case d of
83+ Help -> return ShowHelp
84+ Quit -> return QuitPSCi
85+ Reset -> return ResetState
86+ Browse -> BrowseModule <$> parseRest P.moduleName arg
87+ Load -> return $ LoadFile (trim arg)
88+ Foreign -> return $ LoadForeign (trim arg)
89+ Show -> ShowInfo <$> parseReplQuery' (trim arg)
90+ Type -> TypeOf <$> parseRest P.parseValue arg
91+ Kind -> KindOf <$> parseRest P.parseType arg
49
92
50-- |
93-- |
51-- Parses expressions entered at the PSCI repl.
94-- Parses expressions entered at the PSCI repl.
52--
95--
53−psciExpression :: Parsec String P.ParseState Command
96+psciExpression :: P.TokenParser Command
54psciExpression = Expression <$> P.parseValue
97psciExpression = Expression <$> P.parseValue
55
98
56-- |
99-- |
57−-- Parses 'Commands.Help' command.
100+-- PSCI version of @let@.
58−--
101+-- This is essentially let from do-notation.
59−psciHelp :: Parsec String P.ParseState Command
102+-- However, since we don't support the @Eff@ monad,
60−psciHelp = Help <$ char '?'
103+-- we actually want the normal @let@.
61−
62−-- |
63−-- Parses 'Commands.Import' command.
64−--
65−psciImport :: Parsec String P.ParseState Command
66−psciImport = Import <$> (char 'i' *> P.whiteSpace *> P.moduleName)
67−
68−-- |
69−-- Parses 'Commands.LoadFile' command.
70--
104--
71−psciLoadFile :: Parsec String P.ParseState Command
105+psciLet :: P.TokenParser Command
72−psciLoadFile = LoadFile . trimEnd <$> (char 'm' *> P.whiteSpace *> manyTill anyChar eof)
106+psciLet = Decls <$> (P.reserved "let" *> P.indented *> manyDecls)
73 where
107 where
74− trimEnd = reverse . dropWhile isSpace . reverse
108+ manyDecls :: P.TokenParser [P.Declaration]
75−
109+ manyDecls = mark (many1 (same *> P.parseLocalDeclaration))
76−-- |
110+
77−-- Parses 'Commands.Quit' command.
111+-- | Imports must be handled separately from other declarations, so that
78−--
112+-- :show import works, for example.
79−psciQuit :: Parsec String P.ParseState Command
113+psciImport :: P.TokenParser Command
80−psciQuit = Quit <$ char 'q'
114+psciImport = Import <$> P.parseImportDeclaration'
81−
115+
82−-- |
116+-- | Any other declaration that we don't need a 'special case' parser for
83−-- Parses 'Commands.Reload' command.
117+-- (like let or import declarations).
84−--
118+psciOtherDeclaration :: P.TokenParser Command
85−psciReload :: Parsec String P.ParseState Command
119+psciOtherDeclaration = Decls . (:[]) <$> do
86−psciReload = Reset <$ char 'r'
120+ decl <- discardPositionInfo <$> P.parseDeclaration
87−
121+ if acceptable decl
88−-- |
122+ then return decl
89−-- Parses 'Commands.TypeOf' command.
123+ else fail "this kind of declaration is not supported in psci"
90−--
124+
91−psciTypeOf :: Parsec String P.ParseState Command
125+discardPositionInfo :: P.Declaration -> P.Declaration
92−psciTypeOf = TypeOf <$> (char 't' *> P.whiteSpace *> P.parseValue)
126+discardPositionInfo (P.PositionedDeclaration _ _ d) = d
93−
127+discardPositionInfo d = d
94−
128+
95−-- |
129+acceptable :: P.Declaration -> Bool
96−-- Parses 'Commands.KindOf' command.
130+acceptable P.DataDeclaration{} = True
97−--
131+acceptable P.TypeSynonymDeclaration{} = True
98−psciKindOf :: Parsec String P.ParseState Command
132+acceptable P.ExternDeclaration{} = True
99−psciKindOf = KindOf <$> (char 'k' *> P.whiteSpace *> P.parseType)
133+acceptable P.ExternDataDeclaration{} = True
134+acceptable P.TypeClassDeclaration{} = True
135+acceptable P.TypeInstanceDeclaration{} = True
136+acceptable _ = False
137+
138+parseReplQuery' :: String -> Either String ReplQuery
139+parseReplQuery' str =
140+ case parseReplQuery str of
141+ Nothing -> Left ("Don't know how to show " ++ str ++ ". Try one of: " ++
142+ intercalate ", " replQueryStrings ++ ".")
143+ Just query -> Right query
psci/Types.hsnew file+181
@@ -0,0 +1,181 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Types
4+-- Copyright : (c) Phil Freeman 2014
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+-- Type declarations and associated basic functions for PSCI.
13+--
14+-----------------------------------------------------------------------------
15+
16+module Types where
17+
18+import qualified Data.Map as M
19+import qualified Language.PureScript as P
20+
21+data PSCiOptions = PSCiOptions
22+ { psciMultiLineMode :: Bool
23+ , psciInputFile :: [FilePath]
24+ , psciForeignInputFiles :: [FilePath]
25+ , psciInputNodeFlags :: [String]
26+ }
27+
28+-- |
29+-- The PSCI state.
30+-- Holds a list of imported modules, loaded files, and partial let bindings.
31+-- The let bindings are partial,
32+-- because it makes more sense to apply the binding to the final evaluated expression.
33+--
34+data PSCiState = PSCiState
35+ { psciImportedFilenames :: [FilePath]
36+ , psciImportedModules :: [ImportedModule]
37+ , psciLoadedModules :: [(Either P.RebuildPolicy FilePath, P.Module)]
38+ , psciForeignFiles :: M.Map P.ModuleName FilePath
39+ , psciLetBindings :: [P.Declaration]
40+ , psciNodeFlags :: [String]
41+ }
42+
43+-- | All of the data that is contained by an ImportDeclaration in the AST.
44+-- That is:
45+--
46+-- * A module name, the name of the module which is being imported
47+-- * An ImportDeclarationType which specifies whether there is an explicit
48+-- import list, a hiding list, or neither.
49+-- * If the module is imported qualified, its qualified name in the importing
50+-- module. Otherwise, Nothing.
51+--
52+type ImportedModule = (P.ModuleName, P.ImportDeclarationType, Maybe P.ModuleName)
53+
54+psciImportedModuleNames :: PSCiState -> [P.ModuleName]
55+psciImportedModuleNames (PSCiState{psciImportedModules = is}) =
56+ map (\(mn, _, _) -> mn) is
57+
58+allImportsOf :: P.Module -> PSCiState -> [ImportedModule]
59+allImportsOf m (PSCiState{psciImportedModules = is}) =
60+ filter isImportOfThis is
61+ where
62+ name = P.getModuleName m
63+ isImportOfThis (name', _, _) = name == name'
64+
65+-- State helpers
66+
67+-- |
68+-- Updates the state to have more imported modules.
69+--
70+updateImportedFiles :: FilePath -> PSCiState -> PSCiState
71+updateImportedFiles filename st = st { psciImportedFilenames = filename : psciImportedFilenames st }
72+
73+-- |
74+-- Updates the state to have more imported modules.
75+--
76+updateImportedModules :: ImportedModule -> PSCiState -> PSCiState
77+updateImportedModules im st = st { psciImportedModules = im : psciImportedModules st }
78+
79+-- |
80+-- Updates the state to have more loaded files.
81+--
82+updateModules :: [(Either P.RebuildPolicy FilePath, P.Module)] -> PSCiState -> PSCiState
83+updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }
84+
85+-- |
86+-- Updates the state to have more let bindings.
87+--
88+updateLets :: [P.Declaration] -> PSCiState -> PSCiState
89+updateLets ds st = st { psciLetBindings = psciLetBindings st ++ ds }
90+
91+-- |
92+-- Updates the state to have more let bindings.
93+--
94+updateForeignFiles :: M.Map P.ModuleName FilePath -> PSCiState -> PSCiState
95+updateForeignFiles fs st = st { psciForeignFiles = psciForeignFiles st `M.union` fs }
96+
97+-- |
98+-- Valid Meta-commands for PSCI
99+--
100+data Command
101+ -- |
102+ -- A purescript expression
103+ --
104+ = Expression P.Expr
105+ -- |
106+ -- Show the help (ie, list of directives)
107+ --
108+ | ShowHelp
109+ -- |
110+ -- Import a module from a loaded file
111+ --
112+ | Import ImportedModule
113+ -- |
114+ -- Browse a module
115+ --
116+ | BrowseModule P.ModuleName
117+ -- |
118+ -- Load a file for use with importing
119+ --
120+ | LoadFile FilePath
121+ -- |
122+ -- Load a foreign module
123+ --
124+ | LoadForeign FilePath
125+ -- |
126+ -- Exit PSCI
127+ --
128+ | QuitPSCi
129+ -- |
130+ -- Reset the state of the REPL
131+ --
132+ | ResetState
133+ -- |
134+ -- Add some declarations to the current evaluation context.
135+ --
136+ | Decls [P.Declaration]
137+ -- |
138+ -- Find the type of an expression
139+ --
140+ | TypeOf P.Expr
141+ -- |
142+ -- Find the kind of an expression
143+ --
144+ | KindOf P.Type
145+ -- |
146+ -- Shows information about the current state of the REPL
147+ --
148+ | ShowInfo ReplQuery
149+
150+data ReplQuery
151+ = QueryLoaded
152+ | QueryImport
153+ deriving (Eq, Show)
154+
155+-- | A list of all ReplQuery values.
156+replQueries :: [ReplQuery]
157+replQueries = [QueryLoaded, QueryImport]
158+
159+replQueryStrings :: [String]
160+replQueryStrings = map showReplQuery replQueries
161+
162+showReplQuery :: ReplQuery -> String
163+showReplQuery QueryLoaded = "loaded"
164+showReplQuery QueryImport = "import"
165+
166+parseReplQuery :: String -> Maybe ReplQuery
167+parseReplQuery "loaded" = Just QueryLoaded
168+parseReplQuery "import" = Just QueryImport
169+parseReplQuery _ = Nothing
170+
171+data Directive
172+ = Help
173+ | Quit
174+ | Reset
175+ | Browse
176+ | Load
177+ | Foreign
178+ | Type
179+ | Kind
180+ | Show
181+ deriving (Eq, Show)
psci/main/Main.hsnew file+6
@@ -0,0 +1,6 @@
1+module Main where
2+
3+import PSCi
4+
5+main :: IO ()
6+main = runPSCi
psci/tests/Main.hsnew file+163
@@ -0,0 +1,163 @@
1+{-# LANGUAGE RecordWildCards #-}
2+{-# LANGUAGE TupleSections #-}
3+{-# LANGUAGE CPP #-}
4+
5+module Main where
6+
7+import Control.Monad.Trans.State.Strict (runStateT)
8+import Control.Monad (when, forM)
9+#if __GLASGOW_HASKELL__ < 710
10+import Control.Applicative
11+#endif
12+import Control.Monad.Writer.Strict (runWriterT)
13+import Control.Monad.Trans.Except (runExceptT)
14+
15+import Data.List (sort)
16+
17+import System.Exit (exitFailure)
18+import System.Console.Haskeline
19+import System.FilePath ((</>))
20+import System.Directory (getCurrentDirectory)
21+import qualified System.FilePath.Glob as Glob
22+
23+import Test.HUnit
24+
25+import qualified Language.PureScript as P
26+
27+import PSCi
28+import Completion
29+import Types
30+
31+import TestsSetup
32+
33+main :: IO ()
34+main = do
35+ fetchSupportCode
36+ Counts{..} <- runTestTT allTests
37+ when (errors + failures > 0) exitFailure
38+
39+allTests :: Test
40+allTests = completionTests
41+
42+completionTests :: Test
43+completionTests =
44+ TestLabel "completionTests"
45+ (TestList (map (TestCase . assertCompletedOk) completionTestData))
46+
47+-- If the cursor is at the right end of the line, with the 1st element of the
48+-- pair as the text in the line, then pressing tab should offer all the
49+-- elements of the list (which is the 2nd element) as completions.
50+completionTestData :: [(String, [String])]
51+completionTestData =
52+ -- basic directives
53+ [ (":h", [":help"])
54+ , (":re", [":reset"])
55+ , (":q", [":quit"])
56+ , (":mo", [":module"])
57+ , (":b", [":browse"])
58+
59+ -- :browse should complete module names
60+ , (":b Control.Monad.E", map (":b Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])
61+ , (":b Control.Monad.Eff.", map (":b Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])
62+
63+ -- import should complete module names
64+ , ("import Control.Monad.E", map ("import Control.Monad.Eff" ++) ["", ".Unsafe", ".Class", ".Console"])
65+ , ("import Control.Monad.Eff.", map ("import Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])
66+ , ("import qualified Control.Monad.Eff.", map ("import qualified Control.Monad.Eff" ++) [".Unsafe", ".Class", ".Console"])
67+
68+ -- :load, :module should complete file paths
69+ , (":l psci/tests/data/", [":l psci/tests/data/Sample.purs"])
70+ , (":module psci/tests/data/", [":module psci/tests/data/Sample.purs"])
71+
72+ -- :quit, :help, :reset should not complete
73+ , (":help ", [])
74+ , (":quit ", [])
75+ , (":reset ", [])
76+
77+ -- :show should complete to "loaded" and "import"
78+ , (":show ", [":show import", ":show loaded"])
79+ , (":show a", [])
80+
81+ -- :type should complete values and data constructors in scope
82+ , (":type Control.Monad.Eff.Console.lo", [":type Control.Monad.Eff.Console.log"])
83+ , (":type uni", [":type unit"])
84+ , (":type E", [":type EQ"])
85+
86+ -- :kind should complete types in scope
87+ , (":kind C", [":kind Control.Monad.Eff.Pure"])
88+ , (":kind O", [":kind Ordering"])
89+
90+ -- Only one argument for directives should be completed
91+ , (":show import ", [])
92+ , (":type EQ ", [])
93+ , (":kind Ordering ", [])
94+
95+ -- a few other import tests
96+ , ("impor", ["import"])
97+ , ("import q", ["import qualified"])
98+ , ("import ", map ("import " ++) supportModules ++ ["import qualified"])
99+ , ("import Prelude ", [])
100+
101+ -- String and number literals should not be completed
102+ , ("\"hi", [])
103+ , ("34", [])
104+
105+ -- Identifiers and data constructors should be completed
106+ , ("uni", ["unit"])
107+ , ("Control.Monad.Eff.Class.", ["Control.Monad.Eff.Class.liftEff"])
108+ , ("G", ["GT"])
109+ , ("Prelude.L", ["Prelude.LT"])
110+
111+ -- if a module is imported qualified, values should complete under the
112+ -- qualified name, as well as the original name.
113+ , ("ST.new", ["ST.newSTRef"])
114+ , ("Control.Monad.ST.new", ["Control.Monad.ST.newSTRef"])
115+ ]
116+ where
117+
118+assertCompletedOk :: (String, [String]) -> Assertion
119+assertCompletedOk (line, expecteds) = do
120+ (unusedR, completions) <- runCM (completion' (reverse line, ""))
121+ let unused = reverse unusedR
122+ let actuals = map ((unused ++) . replacement) completions
123+ sort expecteds @=? sort actuals
124+
125+runCM :: CompletionM a -> IO a
126+runCM act = do
127+ psciState <- getPSCiState
128+ fmap fst (runStateT (liftCompletionM act) psciState)
129+
130+getPSCiState :: IO PSCiState
131+getPSCiState = do
132+ cwd <- getCurrentDirectory
133+ let supportDir = cwd </> "tests" </> "support" </> "flattened"
134+ let supportFiles ext = Glob.globDir1 (Glob.compile ("*." ++ ext)) supportDir
135+ pursFiles <- supportFiles "purs"
136+ jsFiles <- supportFiles "js"
137+
138+ modulesOrFirstError <- loadAllModules pursFiles
139+ foreignFiles <- forM jsFiles (\f -> (f,) <$> readFile f)
140+ Right (foreigns, _) <- runExceptT $ runWriterT $ P.parseForeignModulesFromFiles foreignFiles
141+ case modulesOrFirstError of
142+ Left err ->
143+ print err >> exitFailure
144+ Right modules ->
145+ let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName "Prelude"], P.Implicit, Nothing)]
146+ in return (PSCiState [] imports modules foreigns [] [])
147+
148+controlMonadSTasST :: ImportedModule
149+controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))
150+ where
151+ s = P.moduleNameFromString
152+
153+supportModules :: [String]
154+supportModules =
155+ [ "Control.Monad.Eff.Class"
156+ , "Control.Monad.Eff.Console"
157+ , "Control.Monad.Eff"
158+ , "Control.Monad.Eff.Unsafe"
159+ , "Control.Monad.ST"
160+ , "Data.Function"
161+ , "Prelude"
162+ , "Test.Assert"
163+ ]
psci/tests/data/Sample.pursnew file

No changes to the content.

purescript.cabal+188−71
@@ -1,10 +1,10 @@
1name: purescript
1name: purescript
2−version: 0.5.4
2+version: 0.7.4.1
3cabal-version: >=1.8
3cabal-version: >=1.8
4−build-type: Custom
4+build-type: Simple
5license: MIT
5license: MIT
6license-file: LICENSE
6license-file: LICENSE
7−copyright: (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
7+copyright: (c) 2013-15 Phil Freeman, (c) 2014-15 Gary Burgess
8maintainer: Phil Freeman <paf31@cantab.net>
8maintainer: Phil Freeman <paf31@cantab.net>
9stability: experimental
9stability: experimental
10synopsis: PureScript Programming Language Compiler
10synopsis: PureScript Programming Language Compiler
@@ -13,60 +13,98 @@ category: Language
13Homepage: http://www.purescript.org/
13Homepage: http://www.purescript.org/
14author: Phil Freeman <paf31@cantab.net>,
14author: Phil Freeman <paf31@cantab.net>,
15 Gary Burgess <gary.burgess@gmail.com>,
15 Gary Burgess <gary.burgess@gmail.com>,
16− Hardy Jones <jones3.hardy@gmail.com>
16+ Hardy Jones <jones3.hardy@gmail.com>,
17−data-files: prelude/prelude.purs
17+ Harry Garrood <harry@garrood.me>
18−data-dir: ""
18+
19+tested-with: GHC==7.8
20+
21+extra-source-files: examples/passing/*.purs
22+ , examples/failing/*.purs
23+ , tests/support/setup.js
24+ , tests/support/package.json
25+ , tests/support/bower.json
26+ , tests/support/setup-win.cmd
27+ , psci/tests/data/Sample.purs
19
28
20source-repository head
29source-repository head
21 type: git
30 type: git
22 location: https://github.com/purescript/purescript.git
31 location: https://github.com/purescript/purescript.git
23
32
24library
33library
34+ build-depends: base >=4.6 && <5,
35+ containers -any,
25− build-depends: base >=4 && <5, cmdtheline == 0.2.*, containers -any, unordered-containers -any,
36+ unordered-containers -any,
37+ dlist -any,
26− directory >= 1.2, filepath -any, mtl >= 2.1.0 && < 2.2.0, parsec -any,
38+ directory >= 1.2,
39+ filepath -any,
40+ mtl >= 2.1.0 && < 2.3.0,
41+ parsec -any,
27− transformers >= 0.3 && < 0.4, utf8-string -any,
42+ transformers >= 0.3.0 && < 0.5,
43+ transformers-compat >= 0.3.0,
44+ utf8-string >= 1 && < 2,
28 pattern-arrows >= 0.0.2 && < 0.1,
45 pattern-arrows >= 0.0.2 && < 0.1,
29− monad-unify >= 0.2.2 && < 0.3,
30− xdg-basedir -any, time -any
46+ time -any,
31− if (!os(windows))
47+ boxes >= 0.1.4 && < 0.2.0,
32− build-depends: unix -any
48+ aeson >= 0.8 && < 0.11,
49+ vector -any,
50+ bower-json >= 0.7,
51+ aeson-better-errors >= 0.8,
52+ bytestring -any,
53+ text -any,
54+ split -any,
55+ language-javascript == 0.5.*,
56+ syb -any,
57+ Glob >= 0.7 && < 0.8,
58+ process >= 1.2.0 && < 1.3,
59+ safe >= 0.3.9 && < 0.4,
60+ semigroups >= 0.16.2 && < 0.18
61+
33 exposed-modules: Language.PureScript
62 exposed-modules: Language.PureScript
63+ Language.PureScript.AST
64+ Language.PureScript.AST.Binders
65+ Language.PureScript.AST.Declarations
66+ Language.PureScript.AST.Operators
67+ Language.PureScript.AST.SourcePos
68+ Language.PureScript.AST.Traversals
69+ Language.PureScript.AST.Exported
70+ Language.PureScript.Bundle
71+ Language.PureScript.Externs
72+ Language.PureScript.CodeGen
73+ Language.PureScript.CodeGen.JS
74+ Language.PureScript.CodeGen.JS.AST
75+ Language.PureScript.CodeGen.JS.Common
76+ Language.PureScript.CodeGen.JS.Optimizer
77+ Language.PureScript.CodeGen.JS.Optimizer.Blocks
78+ Language.PureScript.CodeGen.JS.Optimizer.Common
79+ Language.PureScript.CodeGen.JS.Optimizer.Inliner
80+ Language.PureScript.CodeGen.JS.Optimizer.MagicDo
81+ Language.PureScript.CodeGen.JS.Optimizer.TCO
82+ Language.PureScript.CodeGen.JS.Optimizer.Unused
34 Language.PureScript.Constants
83 Language.PureScript.Constants
35− Language.PureScript.Options
84+ Language.PureScript.CoreFn
85+ Language.PureScript.CoreFn.Ann
86+ Language.PureScript.CoreFn.Binders
87+ Language.PureScript.CoreFn.Desugar
88+ Language.PureScript.CoreFn.Expr
89+ Language.PureScript.CoreFn.Literals
90+ Language.PureScript.CoreFn.Meta
91+ Language.PureScript.CoreFn.Module
36− Language.PureScript.Declarations
92+ Language.PureScript.CoreFn.Traversals
93+ Language.PureScript.Comments
37 Language.PureScript.Environment
94 Language.PureScript.Environment
38 Language.PureScript.Errors
95 Language.PureScript.Errors
39 Language.PureScript.Kinds
96 Language.PureScript.Kinds
40− Language.PureScript.Names
97+ Language.PureScript.Linter
41− Language.PureScript.Supply
98+ Language.PureScript.Linter.Exhaustive
42− Language.PureScript.Types
43− Language.PureScript.Traversals
99+ Language.PureScript.Make
44− Language.PureScript.TypeClassDictionaries
45− Language.PureScript.DeadCodeElimination
46− Language.PureScript.Sugar
47 Language.PureScript.ModuleDependencies
100 Language.PureScript.ModuleDependencies
48− Language.PureScript.Sugar.CaseDeclarations
101+ Language.PureScript.Names
49− Language.PureScript.Sugar.DoNotation
50− Language.PureScript.Sugar.TypeDeclarations
51− Language.PureScript.Sugar.BindingGroups
52− Language.PureScript.Sugar.Operators
53− Language.PureScript.Sugar.TypeClasses
54− Language.PureScript.Sugar.Names
55− Language.PureScript.CodeGen
102+ Language.PureScript.Options
56− Language.PureScript.CodeGen.Common
57− Language.PureScript.CodeGen.Externs
58− Language.PureScript.CodeGen.JS
59− Language.PureScript.CodeGen.JS.AST
60− Language.PureScript.Optimizer
61− Language.PureScript.Optimizer.Common
62− Language.PureScript.Optimizer.MagicDo
63− Language.PureScript.Optimizer.TCO
64− Language.PureScript.Optimizer.Inliner
65− Language.PureScript.Optimizer.Unused
66− Language.PureScript.Optimizer.Blocks
67 Language.PureScript.Parser
103 Language.PureScript.Parser
104+ Language.PureScript.Parser.Lexer
68 Language.PureScript.Parser.Common
105 Language.PureScript.Parser.Common
69 Language.PureScript.Parser.Declarations
106 Language.PureScript.Parser.Declarations
107+ Language.PureScript.Parser.JS
70 Language.PureScript.Parser.Kinds
108 Language.PureScript.Parser.Kinds
71 Language.PureScript.Parser.State
109 Language.PureScript.Parser.State
72 Language.PureScript.Parser.Types
110 Language.PureScript.Parser.Types
@@ -77,72 +115,151 @@ library
77 Language.PureScript.Pretty.Types
115 Language.PureScript.Pretty.Types
78 Language.PureScript.Pretty.Values
116 Language.PureScript.Pretty.Values
79 Language.PureScript.Renamer
117 Language.PureScript.Renamer
118+ Language.PureScript.Sugar
119+ Language.PureScript.Sugar.BindingGroups
120+ Language.PureScript.Sugar.CaseDeclarations
121+ Language.PureScript.Sugar.DoNotation
122+ Language.PureScript.Sugar.Names
123+ Language.PureScript.Sugar.Names.Env
124+ Language.PureScript.Sugar.Names.Imports
125+ Language.PureScript.Sugar.Names.Exports
126+ Language.PureScript.Sugar.ObjectWildcards
127+ Language.PureScript.Sugar.Operators
128+ Language.PureScript.Sugar.TypeClasses
129+ Language.PureScript.Sugar.TypeClasses.Deriving
130+ Language.PureScript.Sugar.TypeDeclarations
131+ Language.PureScript.Traversals
80 Language.PureScript.TypeChecker
132 Language.PureScript.TypeChecker
133+ Language.PureScript.TypeChecker.Entailment
81 Language.PureScript.TypeChecker.Kinds
134 Language.PureScript.TypeChecker.Kinds
82 Language.PureScript.TypeChecker.Monad
135 Language.PureScript.TypeChecker.Monad
136+ Language.PureScript.TypeChecker.Rows
137+ Language.PureScript.TypeChecker.Skolems
138+ Language.PureScript.TypeChecker.Subsumption
83 Language.PureScript.TypeChecker.Synonyms
139 Language.PureScript.TypeChecker.Synonyms
84 Language.PureScript.TypeChecker.Types
140 Language.PureScript.TypeChecker.Types
141+ Language.PureScript.TypeChecker.Unify
142+ Language.PureScript.TypeClassDictionaries
143+ Language.PureScript.Types
144+
145+ Language.PureScript.Docs
146+ Language.PureScript.Docs.Convert
147+ Language.PureScript.Docs.Render
148+ Language.PureScript.Docs.Types
149+ Language.PureScript.Docs.RenderedCode
150+ Language.PureScript.Docs.RenderedCode.Types
151+ Language.PureScript.Docs.RenderedCode.Render
152+ Language.PureScript.Docs.AsMarkdown
153+ Language.PureScript.Docs.ParseAndDesugar
154+ Language.PureScript.Docs.Utils.MonoidExtras
155+
156+ Language.PureScript.Publish
157+ Language.PureScript.Publish.Utils
158+ Language.PureScript.Publish.ErrorsWarnings
159+ Language.PureScript.Publish.BoxesHelpers
160+
161+ Control.Monad.Unify
162+ Control.Monad.Supply
163+ Control.Monad.Supply.Class
164+
85 exposed: True
165 exposed: True
86 buildable: True
166 buildable: True
87 hs-source-dirs: src
167 hs-source-dirs: src
88− other-modules:
168+ other-modules: Paths_purescript
89 ghc-options: -Wall -O2
169 ghc-options: -Wall -O2
90
170
91executable psc
171executable psc
92− build-depends: base >=4 && <5, cmdtheline -any, containers -any,
172+ build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
93− directory -any, filepath -any, mtl -any, parsec -any,
173+ mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,
94− purescript -any, transformers -any, utf8-string -any
174+ time -any, transformers -any, transformers-compat -any, Glob >= 0.7 && < 0.8
95 main-is: Main.hs
175 main-is: Main.hs
96 buildable: True
176 buildable: True
97 hs-source-dirs: psc
177 hs-source-dirs: psc
98− other-modules:
99− ghc-options: -Wall -O2 -fno-warn-unused-do-bind
100−
101−executable psc-make
102− build-depends: base >=4 && <5, cmdtheline -any, containers -any,
103− directory -any, filepath -any, mtl -any, parsec -any,
104− purescript -any, transformers -any, utf8-string -any
105− main-is: Main.hs
106− buildable: True
107− hs-source-dirs: psc-make
108− other-modules:
109 ghc-options: -Wall -O2 -fno-warn-unused-do-bind
178 ghc-options: -Wall -O2 -fno-warn-unused-do-bind
110
179
111executable psci
180executable psci
112 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
181 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
182+ mtl -any, optparse-applicative >= 0.10.0, parsec -any,
113− mtl -any, parsec -any, haskeline >= 0.7.0.0, purescript -any,
183+ haskeline >= 0.7.0.0, purescript -any, transformers -any,
114− transformers -any, utf8-string -any, process -any,
184+ transformers-compat -any, process -any, time -any, Glob -any
115− xdg-basedir -any, cmdtheline -any
185+
116 main-is: Main.hs
186 main-is: Main.hs
117 buildable: True
187 buildable: True
118− hs-source-dirs: psci
188+ hs-source-dirs: psci psci/main
119− other-modules: Commands
189+ other-modules: Types
120 Parser
190 Parser
191+ Directive
192+ Completion
193+ PSCi
194+ IO
121 ghc-options: -Wall -O2
195 ghc-options: -Wall -O2
122
196
123−executable docgen
197+executable psc-docs
124− build-depends: base >=4 && <5, cmdtheline -any, purescript -any, utf8-string -any,
198+ build-depends: base >=4 && <5, purescript -any,
125− process -any, mtl -any
199+ optparse-applicative >= 0.10.0, process -any, mtl -any,
200+ split -any, ansi-wl-pprint -any, directory -any,
201+ filepath -any, Glob -any
126 main-is: Main.hs
202 main-is: Main.hs
127 buildable: True
203 buildable: True
128− hs-source-dirs: docgen
204+ hs-source-dirs: psc-docs
129− other-modules:
205+ other-modules: Ctags
206+ Etags
207+ Tags
208+ ghc-options: -Wall -O2
209+
210+executable psc-publish
211+ build-depends: base >=4 && <5, purescript -any, bytestring -any, aeson -any, optparse-applicative -any
212+ main-is: Main.hs
213+ buildable: True
214+ hs-source-dirs: psc-publish
130 ghc-options: -Wall -O2
215 ghc-options: -Wall -O2
131
216
132−executable hierarchy
217+executable psc-hierarchy
133− build-depends: base >=4 && <5, cmdtheline -any, purescript -any, utf8-string -any,
218+ build-depends: base >=4 && <5, purescript -any, optparse-applicative >= 0.10.0,
134− process -any, mtl -any, parsec -any, filepath -any, directory -any
219+ process -any, mtl -any, parsec -any, filepath -any, directory -any,
220+ Glob -any
135 main-is: Main.hs
221 main-is: Main.hs
136 buildable: True
222 buildable: True
137 hs-source-dirs: hierarchy
223 hs-source-dirs: hierarchy
138 other-modules:
224 other-modules:
139 ghc-options: -Wall -O2
225 ghc-options: -Wall -O2
140
226
227+executable psc-bundle
228+ main-is: Main.hs
229+ other-modules:
230+ other-extensions:
231+ build-depends: base >=4 && <5,
232+ purescript -any,
233+ filepath -any,
234+ directory -any,
235+ mtl -any,
236+ transformers -any,
237+ transformers-compat -any,
238+ optparse-applicative >= 0.10.0,
239+ Glob -any
240+ ghc-options: -Wall -O2
241+ hs-source-dirs: psc-bundle
242+
141test-suite tests
243test-suite tests
142 build-depends: base >=4 && <5, containers -any, directory -any,
244 build-depends: base >=4 && <5, containers -any, directory -any,
143 filepath -any, mtl -any, parsec -any, purescript -any,
245 filepath -any, mtl -any, parsec -any, purescript -any,
144− transformers -any, utf8-string -any, process -any
246+ transformers -any, process -any, transformers-compat -any, time -any,
247+ Glob -any
248+ type: exitcode-stdio-1.0
249+ main-is: Main.hs
250+ other-modules: TestsSetup
251+ buildable: True
252+ hs-source-dirs: tests tests/common
253+
254+test-suite psci-tests
255+ build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
256+ mtl -any, optparse-applicative >= 0.10.0, parsec -any,
257+ haskeline >= 0.7.0.0, purescript -any, transformers -any,
258+ transformers-compat -any, process -any, HUnit -any, time -any,
259+ Glob -any
145 type: exitcode-stdio-1.0
260 type: exitcode-stdio-1.0
146 main-is: Main.hs
261 main-is: Main.hs
262+ other-modules: TestsSetup
147 buildable: True
263 buildable: True
148− hs-source-dirs: tests
264+ hs-source-dirs: psci psci/tests tests/common
265+ ghc-options: -Wall
src/Language/PureScript/Supply.hs → src/Control/Monad/Supply.hsrenamed+10−20
@@ -1,6 +1,6 @@
1-----------------------------------------------------------------------------
1-----------------------------------------------------------------------------
2--
2--
3−-- Module : Language.PureScript.Supply
3+-- Module : Control.Monad.Supply
4-- Copyright : (c) Phil Freeman 2014
4-- Copyright : (c) Phil Freeman 2014
5-- License : MIT
5-- License : MIT
6--
6--
@@ -14,19 +14,22 @@
14-----------------------------------------------------------------------------
14-----------------------------------------------------------------------------
15
15
16{-# LANGUAGE GeneralizedNewtypeDeriving #-}
16{-# LANGUAGE GeneralizedNewtypeDeriving #-}
17−{-# LANGUAGE FlexibleInstances #-}
17+{-# LANGUAGE CPP #-}
18−{-# LANGUAGE MultiParamTypeClasses #-}
19−{-# LANGUAGE UndecidableInstances #-}
20
18
21−module Language.PureScript.Supply where
19+module Control.Monad.Supply where
22
20
23import Data.Functor.Identity
21import Data.Functor.Identity
24
22
23+#if __GLASGOW_HASKELL__ < 710
25import Control.Applicative
24import Control.Applicative
25+#endif
26import Control.Monad.State
26import Control.Monad.State
27−import Control.Monad.Error.Class
27+import Control.Monad.Error.Class (MonadError(..))
28+import Control.Monad.Reader
29+import Control.Monad.Writer
28
30
29−newtype SupplyT m a = SupplyT { unSupplyT :: StateT Integer m a } deriving (Functor, Applicative, Monad, MonadTrans)
31+newtype SupplyT m a = SupplyT { unSupplyT :: StateT Integer m a }
32+ deriving (Functor, Applicative, Monad, MonadTrans, MonadError e, MonadWriter w, MonadReader r)
30
33
31runSupplyT :: Integer -> SupplyT m a -> m (a, Integer)
34runSupplyT :: Integer -> SupplyT m a -> m (a, Integer)
32runSupplyT n = flip runStateT n . unSupplyT
35runSupplyT n = flip runStateT n . unSupplyT
@@ -41,16 +44,3 @@ runSupply n = runIdentity . runSupplyT n
41
44
42evalSupply :: Integer -> Supply a -> a
45evalSupply :: Integer -> Supply a -> a
43evalSupply n = runIdentity . evalSupplyT n
46evalSupply n = runIdentity . evalSupplyT n
44−
45−fresh :: (Monad m) => SupplyT m Integer
46−fresh = SupplyT $ do
47− n <- get
48− put (n + 1)
49− return n
50−
51−freshName :: (Functor m, Monad m) => SupplyT m String
52−freshName = ('_' :) . show <$> fresh
53−
54−instance (MonadError e m) => MonadError e (SupplyT m) where
55− throwError = SupplyT . throwError
56− catchError e f = SupplyT $ catchError (unSupplyT e) (unSupplyT . f)
src/Control/Monad/Supply/Class.hsnew file+36
@@ -0,0 +1,36 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Control.Monad.Supply.Class
4+-- Copyright : (c) PureScript 2015
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+-- A class for monads supporting a supply of fresh names
13+--
14+-----------------------------------------------------------------------------
15+
16+{-# LANGUAGE MultiParamTypeClasses #-}
17+
18+module Control.Monad.Supply.Class where
19+
20+import Control.Monad.Supply
21+import Control.Monad.State
22+
23+class (Monad m) => MonadSupply m where
24+ fresh :: m Integer
25+
26+instance (Monad m) => MonadSupply (SupplyT m) where
27+ fresh = SupplyT $ do
28+ n <- get
29+ put (n + 1)
30+ return n
31+
32+instance (MonadSupply m) => MonadSupply (StateT s m) where
33+ fresh = lift fresh
34+
35+freshName :: (MonadSupply m) => m String
36+freshName = liftM (('_' :) . show) fresh
src/Control/Monad/Unify.hsnew file+160
@@ -0,0 +1,160 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Control.Monad.Unify
4+-- Copyright : (c) Phil Freeman 2013
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+--
13+--
14+-----------------------------------------------------------------------------
15+
16+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
17+{-# LANGUAGE FlexibleInstances #-}
18+{-# LANGUAGE FlexibleContexts #-}
19+{-# LANGUAGE DeriveDataTypeable #-}
20+{-# LANGUAGE MultiParamTypeClasses #-}
21+{-# LANGUAGE FunctionalDependencies #-}
22+{-# LANGUAGE UndecidableInstances #-}
23+
24+module Control.Monad.Unify where
25+
26+import Data.Monoid
27+
28+import Control.Applicative
29+import Control.Monad.State
30+import Control.Monad.Error.Class (MonadError(..))
31+import Control.Monad.Writer.Class (MonadWriter(..))
32+
33+import Data.HashMap.Strict as M
34+
35+-- |
36+-- Untyped unification variables
37+--
38+type Unknown = Int
39+
40+-- |
41+-- A type which can contain unification variables
42+--
43+class Partial t where
44+ unknown :: Unknown -> t
45+ isUnknown :: t -> Maybe Unknown
46+ unknowns :: t -> [Unknown]
47+ ($?) :: Substitution t -> t -> t
48+
49+-- |
50+-- Identifies types which support unification
51+--
52+class (Partial t) => Unifiable m t | t -> m where
53+ (=?=) :: t -> t -> UnifyT t m ()
54+
55+-- |
56+-- A substitution maintains a mapping from unification variables to their values
57+--
58+data Substitution t = Substitution { runSubstitution :: M.HashMap Int t }
59+
60+instance (Partial t) => Monoid (Substitution t) where
61+ mempty = Substitution M.empty
62+ s1 `mappend` s2 = Substitution $
63+ M.map (s2 $?) (runSubstitution s1) `M.union`
64+ M.map (s1 $?) (runSubstitution s2)
65+
66+-- |
67+-- State required for type checking
68+--
69+data UnifyState t = UnifyState {
70+ -- |
71+ -- The next fresh unification variable
72+ --
73+ unifyNextVar :: Int
74+ -- |
75+ -- The current substitution
76+ --
77+ , unifyCurrentSubstitution :: Substitution t
78+ }
79+
80+-- |
81+-- An empty @UnifyState@
82+--
83+defaultUnifyState :: (Partial t) => UnifyState t
84+defaultUnifyState = UnifyState 0 mempty
85+
86+-- |
87+-- A class for errors which support unification errors
88+--
89+class UnificationError t e where
90+ occursCheckFailed :: t -> e
91+
92+-- |
93+-- The type checking monad, which provides the state of the type checker, and error reporting capabilities
94+--
95+newtype UnifyT t m a = UnifyT { unUnify :: StateT (UnifyState t) m a }
96+ deriving (Functor, Monad, Applicative, Alternative, MonadPlus, MonadWriter w)
97+
98+instance (MonadState s m) => MonadState s (UnifyT t m) where
99+ get = UnifyT . lift $ get
100+ put = UnifyT . lift . put
101+
102+instance (MonadError e m) => MonadError e (UnifyT t m) where
103+ throwError = UnifyT . throwError
104+ catchError e f = UnifyT $ catchError (unUnify e) (unUnify . f)
105+
106+-- |
107+-- Run a computation in the Unify monad, failing with an error, or succeeding with a return value and the new next unification variable
108+--
109+runUnify :: UnifyState t -> UnifyT t m a -> m (a, UnifyState t)
110+runUnify s = flip runStateT s . unUnify
111+
112+-- |
113+-- Substitute a single unification variable
114+--
115+substituteOne :: (Partial t) => Unknown -> t -> Substitution t
116+substituteOne u t = Substitution $ M.singleton u t
117+
118+-- |
119+-- Replace a unification variable with the specified value in the current substitution
120+--
121+(=:=) :: (UnificationError t e, Monad m, MonadError e m, Unifiable m t) => Unknown -> t -> UnifyT t m ()
122+(=:=) u t' = do
123+ st <- UnifyT get
124+ let sub = unifyCurrentSubstitution st
125+ let t = sub $? t'
126+ occursCheck u t
127+ let current = sub $? unknown u
128+ case isUnknown current of
129+ Just u1 | u1 == u -> return ()
130+ _ -> current =?= t
131+ UnifyT $ modify $ \s -> s { unifyCurrentSubstitution = substituteOne u t <> unifyCurrentSubstitution s }
132+
133+-- |
134+-- Perform the occurs check, to make sure a unification variable does not occur inside a value
135+--
136+occursCheck :: (UnificationError t e, Monad m, MonadError e m, Partial t) => Unknown -> t -> UnifyT t m ()
137+occursCheck u t =
138+ case isUnknown t of
139+ Nothing -> when (u `elem` unknowns t) $ UnifyT . lift . throwError $ occursCheckFailed t
140+ _ -> return ()
141+
142+-- |
143+-- Generate a fresh untyped unification variable
144+--
145+fresh' :: (Monad m) => UnifyT t m Unknown
146+fresh' = do
147+ st <- UnifyT get
148+ UnifyT $ modify $ \s -> s { unifyNextVar = succ (unifyNextVar s) }
149+ return $ unifyNextVar st
150+
151+-- |
152+-- Generate a fresh unification variable at a specific type
153+--
154+fresh :: (Monad m, Partial t) => UnifyT t m t
155+fresh = do
156+ u <- fresh'
157+ return $ unknown u
158+
159+
160+
src/Language/PureScript.hs+27−241
@@ -1,7 +1,7 @@
1-----------------------------------------------------------------------------
1-----------------------------------------------------------------------------
2--
2--
3-- Module : Language.PureScript
3-- Module : Language.PureScript
4−-- Copyright : (c) Phil Freeman 2013
4+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5-- License : MIT
5-- License : MIT
6--
6--
7-- Maintainer : Phil Freeman <paf31@cantab.net>
7-- Maintainer : Phil Freeman <paf31@cantab.net>
@@ -13,251 +13,37 @@
13--
13--
14-----------------------------------------------------------------------------
14-----------------------------------------------------------------------------
15
15
16−module Language.PureScript (module P, compile, compile', MonadMake(..), make) where
16+{-# LANGUAGE DataKinds #-}
17+{-# LANGUAGE FlexibleContexts #-}
18+{-# LANGUAGE RecordWildCards #-}
19+{-# LANGUAGE ScopedTypeVariables #-}
17
20
21+module Language.PureScript
22+ ( module P
23+ , version
24+ ) where
25+
26+import Data.Version (Version)
27+
18−import Language.PureScript.Types as P
28+import Language.PureScript.AST as P
29+import Language.PureScript.Comments as P
30+import Language.PureScript.Environment as P
31+import Language.PureScript.Errors as P hiding (indent)
19import Language.PureScript.Kinds as P
32import Language.PureScript.Kinds as P
20−import Language.PureScript.Declarations as P
33+import Language.PureScript.Linter as P
34+import Language.PureScript.Make as P
35+import Language.PureScript.ModuleDependencies as P
21import Language.PureScript.Names as P
36import Language.PureScript.Names as P
37+import Language.PureScript.Options as P
22import Language.PureScript.Parser as P
38import Language.PureScript.Parser as P
23−import Language.PureScript.CodeGen as P
24−import Language.PureScript.CodeGen.Common as P
25−import Language.PureScript.TypeChecker as P
26import Language.PureScript.Pretty as P
39import Language.PureScript.Pretty as P
27−import Language.PureScript.Sugar as P
28−import Language.PureScript.Options as P
29−import Language.PureScript.ModuleDependencies as P
30−import Language.PureScript.Environment as P
31−import Language.PureScript.Errors as P
32−import Language.PureScript.DeadCodeElimination as P
33−import Language.PureScript.Supply as P
34import Language.PureScript.Renamer as P
40import Language.PureScript.Renamer as P
41+import Language.PureScript.Sugar as P
42+import Control.Monad.Supply as P
43+import Language.PureScript.TypeChecker as P
44+import Language.PureScript.Types as P
35
45
36−import qualified Language.PureScript.Constants as C
46+import qualified Paths_purescript as Paths
37−
38−import Data.List (find, sortBy, groupBy, intercalate)
39−import Data.Time.Clock
40−import Data.Function (on)
41−import Data.Maybe (fromJust, fromMaybe)
42−import Control.Monad.Error
43−import Control.Monad.State.Lazy
44−import Control.Arrow ((&&&))
45−import Control.Applicative
46−import qualified Data.Map as M
47−import qualified Data.Set as S
48−import System.FilePath (pathSeparator)
49−
50−-- |
51−-- Compile a collection of modules
52−--
53−-- The compilation pipeline proceeds as follows:
54−--
55−-- * Sort the modules based on module dependencies, checking for cyclic dependencies.
56−--
57−-- * Perform a set of desugaring passes.
58−--
59−-- * Type check, and elaborate values to include type annotations and type class dictionaries.
60−--
61−-- * Regroup values to take into account new value dependencies introduced by elaboration.
62−--
63−-- * Eliminate dead code.
64−--
65−-- * Generate Javascript, and perform optimization passes.
66−--
67−-- * Pretty-print the generated Javascript
68−--
69−compile :: Options -> [Module] -> Either String (String, String, Environment)
70−compile = compile' initEnvironment
71−
72−compile' :: Environment -> Options -> [Module] -> Either String (String, String, Environment)
73−compile' env opts ms = do
74− (sorted, _) <- sortModules $ map importPrim $ if optionsNoPrelude opts then ms else (map importPrelude ms)
75− (desugared, nextVar) <- stringifyErrorStack True $ runSupplyT 0 $ desugar sorted
76− (elaborated, env') <- runCheck' opts env $ forM desugared $ typeCheckModule mainModuleIdent
77− regrouped <- stringifyErrorStack True $ createBindingGroupsModule . collapseBindingGroupsModule $ elaborated
78− let entryPoints = moduleNameFromString `map` optionsModules opts
79− let elim = if null entryPoints then regrouped else eliminateDeadCode entryPoints regrouped
80− let renamed = renameInModules elim
81− let codeGenModules = moduleNameFromString `map` optionsCodeGenModules opts
82− let modulesToCodeGen = if null codeGenModules then renamed else filter (\(Module mn _ _) -> mn `elem` codeGenModules) renamed
83− let js = evalSupply nextVar $ concat <$> mapM (\m -> moduleToJs Globals opts m env') modulesToCodeGen
84− let exts = intercalate "\n" . map (`moduleToPs` env') $ modulesToCodeGen
85− js' <- generateMain env' opts js
86− return (prettyPrintJS js', exts, env')
87− where
88− mainModuleIdent = moduleNameFromString <$> optionsMain opts
89−
90−typeCheckModule :: Maybe ModuleName -> Module -> Check Module
91−typeCheckModule mainModuleName (Module mn decls exps) = do
92− modify (\s -> s { checkCurrentModule = Just mn })
93− decls' <- typeCheckAll mainModuleName mn decls
94− mapM_ checkTypesAreExported exps'
95− return $ Module mn decls' exps
96− where
97−
98− exps' = fromMaybe (error "exports should have been elaborated") exps
99−
100− -- Check that all the type constructors defined in the current module that appear in member types
101− -- have also been exported from the module
102− checkTypesAreExported :: DeclarationRef -> Check ()
103− checkTypesAreExported (ValueRef name) = do
104− ty <- lookupVariable mn (Qualified (Just mn) name)
105− case find isTconHidden (findTcons ty) of
106− Just hiddenType -> throwError . strMsg $
107− "Error in module '" ++ show mn ++ "':\n\
108− \Exporting declaration '" ++ show name ++ "' requires type '" ++ show hiddenType ++ "' to be exported as well"
109− Nothing -> return ()
110− checkTypesAreExported _ = return ()
111−
112− -- Find the type constructors exported from the current module used in a type
113− findTcons :: Type -> [ProperName]
114− findTcons = everythingOnTypes (++) go
115− where
116− go (TypeConstructor (Qualified (Just mn') name)) | mn' == mn = [name]
117− go _ = []
118−
119− -- Checks whether a type constructor is not being exported from the current module
120− isTconHidden :: ProperName -> Bool
121− isTconHidden tyName = all go exps'
122− where
123− go (TypeRef tyName' _) = tyName' /= tyName
124− go _ = True
125−
126−
127−generateMain :: Environment -> Options -> [JS] -> Either String [JS]
128−generateMain env opts js =
129− case moduleNameFromString <$> optionsMain opts of
130− Just mmi -> do
131− when ((mmi, Ident C.main) `M.notMember` names env) $
132− Left $ show mmi ++ "." ++ C.main ++ " is undefined"
133− return $ js ++ [JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar (fromJust (optionsBrowserNamespace opts))))) []]
134− _ -> return js
135−
136−-- |
137−-- A type class which collects the IO actions we need to be able to run in "make" mode
138−--
139−class MonadMake m where
140− -- |
141− -- Get a file timestamp
142− --
143− getTimestamp :: FilePath -> m (Maybe UTCTime)
144−
145− -- |
146− -- Read a file as a string
147− --
148− readTextFile :: FilePath -> m String
149−
150− -- |
151− -- Write a text file
152− --
153− writeTextFile :: FilePath -> String -> m ()
154−
155− -- |
156− -- Report an error
157− --
158− liftError :: Either String a -> m a
159−
160− -- |
161− -- Respond to a progress update
162− --
163− progress :: String -> m ()
164−
165−-- |
166−-- Compiles in "make" mode, compiling each module separately to a js files and an externs file
167−--
168−-- If timestamps have not changed, the externs file can be used to provide the module's types without
169−-- having to typecheck the module again.
170−--
171−make :: (Functor m, Applicative m, Monad m, MonadMake m) => FilePath -> Options -> [(FilePath, Module)] -> m Environment
172−make outputDir opts ms = do
173− let filePathMap = M.fromList (map (\(fp, Module mn _ _) -> (mn, fp)) ms)
174−
175− (sorted, graph) <- liftError $ sortModules $ map importPrim $ if optionsNoPrelude opts then map snd ms else (map (importPrelude . snd) ms)
176−
177− toRebuild <- foldM (\s (Module moduleName' _ _) -> do
178− let filePath = runModuleName moduleName'
179−
180− jsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "index.js"
181− externsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "externs.purs"
182− inputFile = fromMaybe (error "Input file is undefined in make") $ M.lookup moduleName' filePathMap
183−
184− jsTimestamp <- getTimestamp jsFile
185− externsTimestamp <- getTimestamp externsFile
186− inputTimestamp <- getTimestamp inputFile
187−
188− return $ case (inputTimestamp, jsTimestamp, externsTimestamp) of
189− (Just t1, Just t2, Just t3) | t1 < min t2 t3 -> s
190− _ -> S.insert moduleName' s) S.empty sorted
191−
192− marked <- rebuildIfNecessary (reverseDependencies graph) toRebuild sorted
193−
194− (desugared, nextVar) <- liftError $ stringifyErrorStack True $ runSupplyT 0 $ zip (map fst marked) <$> desugar (map snd marked)
195−
196− evalSupplyT nextVar (go initEnvironment desugared)
197−
198− where
199− go :: (Functor m, Applicative m, Monad m, MonadMake m) => Environment -> [(Bool, Module)] -> SupplyT m Environment
200− go env [] = return env
201− go env ((False, m) : ms') = do
202− (_, env') <- lift . liftError . runCheck' opts env $ typeCheckModule Nothing m
203−
204− go env' ms'
205− go env ((True, m@(Module moduleName' _ exps)) : ms') = do
206− let filePath = runModuleName moduleName'
207− jsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "index.js"
208− externsFile = outputDir ++ pathSeparator : filePath ++ pathSeparator : "externs.purs"
209−
210− lift . progress $ "Compiling " ++ runModuleName moduleName'
211−
212− (Module _ elaborated _, env') <- lift . liftError . runCheck' opts env $ typeCheckModule Nothing m
213−
214− regrouped <- lift . liftError . stringifyErrorStack True . createBindingGroups moduleName' . collapseBindingGroups $ elaborated
215−
216− let mod' = Module moduleName' regrouped exps
217− let [renamed] = renameInModules [mod']
218−
219− js <- prettyPrintJS <$> moduleToJs CommonJS opts renamed env'
220− let exts = moduleToPs renamed env'
221−
222− lift $ writeTextFile jsFile js
223− lift $ writeTextFile externsFile exts
224−
225− go env' ms'
226−
227− rebuildIfNecessary :: (Functor m, Monad m, MonadMake m) => M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]
228− rebuildIfNecessary _ _ [] = return []
229− rebuildIfNecessary graph toRebuild (m@(Module moduleName' _ _) : ms') | moduleName' `S.member` toRebuild = do
230− let deps = fromMaybe [] $ moduleName' `M.lookup` graph
231− toRebuild' = toRebuild `S.union` S.fromList deps
232− (:) (True, m) <$> rebuildIfNecessary graph toRebuild' ms'
233− rebuildIfNecessary graph toRebuild (Module moduleName' _ _ : ms') = do
234− let externsFile = outputDir ++ pathSeparator : runModuleName moduleName' ++ pathSeparator : "externs.purs"
235− externs <- readTextFile externsFile
236− externsModules <- liftError . either (Left . show) Right $ P.runIndentParser externsFile P.parseModules externs
237− case externsModules of
238− [m'@(Module moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms'
239− _ -> liftError . Left $ "Externs file " ++ externsFile ++ " was invalid"
240−
241−reverseDependencies :: ModuleGraph -> M.Map ModuleName [ModuleName]
242−reverseDependencies g = combine [ (dep, mn) | (mn, deps) <- g, dep <- deps ]
243− where
244− combine :: (Ord a) => [(a, b)] -> M.Map a [b]
245− combine = M.fromList . map ((fst . head) &&& map snd) . groupBy ((==) `on` fst) . sortBy (compare `on` fst)
246−
247−-- |
248−-- Add an import declaration for a module if it does not already explicitly import it.
249−--
250−addDefaultImport :: ModuleName -> Module -> Module
251−addDefaultImport toImport m@(Module mn decls exps) =
252− if isExistingImport `any` decls || mn == toImport then m
253− else Module mn (ImportDeclaration toImport Unqualified Nothing : decls) exps
254− where
255− isExistingImport (ImportDeclaration mn' _ _) | mn' == toImport = True
256− isExistingImport (PositionedDeclaration _ d) = isExistingImport d
257− isExistingImport _ = False
258−
259−importPrim :: Module -> Module
260−importPrim = addDefaultImport (ModuleName [ProperName C.prim])
261
47
262−importPrelude :: Module -> Module
48+version :: Version
263−importPrelude = addDefaultImport (ModuleName [ProperName C.prelude])
49+version = Paths.version
src/Language/PureScript/AST.hsnew file+24
@@ -0,0 +1,24 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.AST
4+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- | The initial PureScript AST
12+--
13+-----------------------------------------------------------------------------
14+
15+module Language.PureScript.AST (
16+ module AST
17+) where
18+
19+import Language.PureScript.AST.Binders as AST
20+import Language.PureScript.AST.Declarations as AST
21+import Language.PureScript.AST.Operators as AST
22+import Language.PureScript.AST.SourcePos as AST
23+import Language.PureScript.AST.Traversals as AST
24+import Language.PureScript.AST.Exported as AST
src/Language/PureScript/AST/Binders.hsnew file+86
@@ -0,0 +1,86 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.AST.Binders
4+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- | Case binders
12+--
13+-----------------------------------------------------------------------------
14+
15+{-# LANGUAGE DeriveDataTypeable #-}
16+
17+module Language.PureScript.AST.Binders where
18+
19+import qualified Data.Data as D
20+
21+import Language.PureScript.AST.SourcePos
22+import Language.PureScript.Names
23+import Language.PureScript.Comments
24+
25+-- |
26+-- Data type for binders
27+--
28+data Binder
29+ -- |
30+ -- Wildcard binder
31+ --
32+ = NullBinder
33+ -- |
34+ -- A binder which matches a boolean literal
35+ --
36+ | BooleanBinder Bool
37+ -- |
38+ -- A binder which matches a string literal
39+ --
40+ | StringBinder String
41+ -- |
42+ -- A binder which matches a character literal
43+ --
44+ | CharBinder Char
45+ -- |
46+ -- A binder which matches a numeric literal
47+ --
48+ | NumberBinder (Either Integer Double)
49+ -- |
50+ -- A binder which binds an identifier
51+ --
52+ | VarBinder Ident
53+ -- |
54+ -- A binder which matches a data constructor
55+ --
56+ | ConstructorBinder (Qualified ProperName) [Binder]
57+ -- |
58+ -- A binder which matches a record and binds its properties
59+ --
60+ | ObjectBinder [(String, Binder)]
61+ -- |
62+ -- A binder which matches an array and binds its elements
63+ --
64+ | ArrayBinder [Binder]
65+ -- |
66+ -- A binder which binds its input to an identifier
67+ --
68+ | NamedBinder Ident Binder
69+ -- |
70+ -- A binder with source position information
71+ --
72+ | PositionedBinder SourceSpan [Comment] Binder deriving (Show, Read, Eq, D.Data, D.Typeable)
73+
74+-- |
75+-- Collect all names introduced in binders in an expression
76+--
77+binderNames :: Binder -> [Ident]
78+binderNames = go []
79+ where
80+ go ns (VarBinder name) = name : ns
81+ go ns (ConstructorBinder _ bs) = foldl go ns bs
82+ go ns (ObjectBinder bs) = foldl go ns (map snd bs)
83+ go ns (ArrayBinder bs) = foldl go ns bs
84+ go ns (NamedBinder name b) = go (name : ns) b
85+ go ns (PositionedBinder _ _ b) = go ns b
86+ go ns _ = ns
src/Language/PureScript/AST/Declarations.hsnew file+438
@@ -0,0 +1,438 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.AST.Declarations
4+-- Copyright : (c) 2013-15 Phil Freeman, (c) 2014-15 Gary Burgess
5+-- License : MIT (http://opensource.org/licenses/MIT)
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- | Data types for modules and declarations
12+--
13+-----------------------------------------------------------------------------
14+
15+{-# LANGUAGE DeriveDataTypeable #-}
16+{-# LANGUAGE ScopedTypeVariables #-}
17+{-# LANGUAGE TemplateHaskell #-}
18+{-# LANGUAGE CPP #-}
19+
20+module Language.PureScript.AST.Declarations where
21+
22+import Data.Aeson.TH
23+
24+import qualified Data.Data as D
25+import qualified Data.Map as M
26+
27+import Control.Monad.Identity
28+
29+#if __GLASGOW_HASKELL__ < 710
30+import Control.Applicative
31+#endif
32+
33+import Language.PureScript.AST.Binders
34+import Language.PureScript.AST.Operators
35+import Language.PureScript.AST.SourcePos
36+import Language.PureScript.Types
37+import Language.PureScript.Names
38+import Language.PureScript.Kinds
39+import Language.PureScript.TypeClassDictionaries
40+import Language.PureScript.Comments
41+import Language.PureScript.Environment
42+
43+-- |
44+-- A module declaration, consisting of comments about the module, a module name,
45+-- a list of declarations, and a list of the declarations that are
46+-- explicitly exported. If the export list is Nothing, everything is exported.
47+--
48+data Module = Module SourceSpan [Comment] ModuleName [Declaration] (Maybe [DeclarationRef]) deriving (Show, Read, D.Data, D.Typeable)
49+
50+-- | Return a module's name.
51+getModuleName :: Module -> ModuleName
52+getModuleName (Module _ _ name _ _) = name
53+
54+-- |
55+-- An item in a list of explicit imports or exports
56+--
57+data DeclarationRef
58+ -- |
59+ -- A type constructor with data constructors
60+ --
61+ = TypeRef ProperName (Maybe [ProperName])
62+ -- |
63+ -- A value
64+ --
65+ | ValueRef Ident
66+ -- |
67+ -- A type class
68+ --
69+ | TypeClassRef ProperName
70+ -- |
71+ -- A type class instance, created during typeclass desugaring (name, class name, instance types)
72+ --
73+ | TypeInstanceRef Ident
74+ -- |
75+ -- A module, in its entirety
76+ --
77+ | ModuleRef ModuleName
78+ -- |
79+ -- A declaration reference with source position information
80+ --
81+ | PositionedDeclarationRef SourceSpan [Comment] DeclarationRef
82+ deriving (Show, Read, D.Data, D.Typeable)
83+
84+instance Eq DeclarationRef where
85+ (TypeRef name dctors) == (TypeRef name' dctors') = name == name' && dctors == dctors'
86+ (ValueRef name) == (ValueRef name') = name == name'
87+ (TypeClassRef name) == (TypeClassRef name') = name == name'
88+ (TypeInstanceRef name) == (TypeInstanceRef name') = name == name'
89+ (ModuleRef name) == (ModuleRef name') = name == name'
90+ (PositionedDeclarationRef _ _ r) == r' = r == r'
91+ r == (PositionedDeclarationRef _ _ r') = r == r'
92+ _ == _ = False
93+
94+isModuleRef :: DeclarationRef -> Bool
95+isModuleRef (ModuleRef _) = True
96+isModuleRef _ = False
97+
98+-- |
99+-- The data type which specifies type of import declaration
100+--
101+data ImportDeclarationType
102+ -- |
103+ -- An import with no explicit list: `import M`
104+ --
105+ = Implicit
106+ -- |
107+ -- An import with an explicit list of references to import: `import M (foo)`
108+ --
109+ | Explicit [DeclarationRef]
110+ -- |
111+ -- An import with a list of references to hide: `import M hiding (foo)`
112+ --
113+ | Hiding [DeclarationRef]
114+ deriving (Show, Read, D.Data, D.Typeable)
115+
116+-- |
117+-- The data type of declarations
118+--
119+data Declaration
120+ -- |
121+ -- A data type declaration (data or newtype, name, arguments, data constructors)
122+ --
123+ = DataDeclaration DataDeclType ProperName [(String, Maybe Kind)] [(ProperName, [Type])]
124+ -- |
125+ -- A minimal mutually recursive set of data type declarations
126+ --
127+ | DataBindingGroupDeclaration [Declaration]
128+ -- |
129+ -- A type synonym declaration (name, arguments, type)
130+ --
131+ | TypeSynonymDeclaration ProperName [(String, Maybe Kind)] Type
132+ -- |
133+ -- A type declaration for a value (name, ty)
134+ --
135+ | TypeDeclaration Ident Type
136+ -- |
137+ -- A value declaration (name, top-level binders, optional guard, value)
138+ --
139+ | ValueDeclaration Ident NameKind [Binder] (Either [(Guard, Expr)] Expr)
140+ -- |
141+ -- A minimal mutually recursive set of value declarations
142+ --
143+ | BindingGroupDeclaration [(Ident, NameKind, Expr)]
144+ -- |
145+ -- A foreign import declaration (name, type)
146+ --
147+ | ExternDeclaration Ident Type
148+ -- |
149+ -- A data type foreign import (name, kind)
150+ --
151+ | ExternDataDeclaration ProperName Kind
152+ -- |
153+ -- A fixity declaration (fixity data, operator name)
154+ --
155+ | FixityDeclaration Fixity String
156+ -- |
157+ -- A module import (module name, qualified/unqualified/hiding, optional "qualified as" name)
158+ --
159+ | ImportDeclaration ModuleName ImportDeclarationType (Maybe ModuleName)
160+ -- |
161+ -- A type class declaration (name, argument, implies, member declarations)
162+ --
163+ | TypeClassDeclaration ProperName [(String, Maybe Kind)] [Constraint] [Declaration]
164+ -- |
165+ -- A type instance declaration (name, dependencies, class name, instance types, member
166+ -- declarations)
167+ --
168+ | TypeInstanceDeclaration Ident [Constraint] (Qualified ProperName) [Type] TypeInstanceBody
169+ -- |
170+ -- A declaration with source position information
171+ --
172+ | PositionedDeclaration SourceSpan [Comment] Declaration
173+ deriving (Show, Read, D.Data, D.Typeable)
174+
175+-- | The members of a type class instance declaration
176+data TypeInstanceBody
177+ -- | This is a derived instance
178+ = DerivedInstance
179+ -- | This is a regular (explicit) instance
180+ | ExplicitInstance [Declaration]
181+ deriving (Show, Read, D.Data, D.Typeable)
182+
183+mapTypeInstanceBody :: ([Declaration] -> [Declaration]) -> TypeInstanceBody -> TypeInstanceBody
184+mapTypeInstanceBody f = runIdentity . traverseTypeInstanceBody (Identity . f)
185+
186+-- | A traversal for TypeInstanceBody
187+traverseTypeInstanceBody :: (Applicative f) => ([Declaration] -> f [Declaration]) -> TypeInstanceBody -> f TypeInstanceBody
188+traverseTypeInstanceBody _ DerivedInstance = pure DerivedInstance
189+traverseTypeInstanceBody f (ExplicitInstance ds) = ExplicitInstance <$> f ds
190+
191+-- |
192+-- Test if a declaration is a value declaration
193+--
194+isValueDecl :: Declaration -> Bool
195+isValueDecl ValueDeclaration{} = True
196+isValueDecl (PositionedDeclaration _ _ d) = isValueDecl d
197+isValueDecl _ = False
198+
199+-- |
200+-- Test if a declaration is a data type or type synonym declaration
201+--
202+isDataDecl :: Declaration -> Bool
203+isDataDecl DataDeclaration{} = True
204+isDataDecl TypeSynonymDeclaration{} = True
205+isDataDecl (PositionedDeclaration _ _ d) = isDataDecl d
206+isDataDecl _ = False
207+
208+-- |
209+-- Test if a declaration is a module import
210+--
211+isImportDecl :: Declaration -> Bool
212+isImportDecl ImportDeclaration{} = True
213+isImportDecl (PositionedDeclaration _ _ d) = isImportDecl d
214+isImportDecl _ = False
215+
216+-- |
217+-- Test if a declaration is a data type foreign import
218+--
219+isExternDataDecl :: Declaration -> Bool
220+isExternDataDecl ExternDataDeclaration{} = True
221+isExternDataDecl (PositionedDeclaration _ _ d) = isExternDataDecl d
222+isExternDataDecl _ = False
223+
224+-- |
225+-- Test if a declaration is a fixity declaration
226+--
227+isFixityDecl :: Declaration -> Bool
228+isFixityDecl FixityDeclaration{} = True
229+isFixityDecl (PositionedDeclaration _ _ d) = isFixityDecl d
230+isFixityDecl _ = False
231+
232+-- |
233+-- Test if a declaration is a foreign import
234+--
235+isExternDecl :: Declaration -> Bool
236+isExternDecl ExternDeclaration{} = True
237+isExternDecl (PositionedDeclaration _ _ d) = isExternDecl d
238+isExternDecl _ = False
239+
240+-- |
241+-- Test if a declaration is a type class instance declaration
242+--
243+isTypeClassInstanceDeclaration :: Declaration -> Bool
244+isTypeClassInstanceDeclaration TypeInstanceDeclaration{} = True
245+isTypeClassInstanceDeclaration (PositionedDeclaration _ _ d) = isTypeClassInstanceDeclaration d
246+isTypeClassInstanceDeclaration _ = False
247+
248+-- |
249+-- Test if a declaration is a type class declaration
250+--
251+isTypeClassDeclaration :: Declaration -> Bool
252+isTypeClassDeclaration TypeClassDeclaration{} = True
253+isTypeClassDeclaration (PositionedDeclaration _ _ d) = isTypeClassDeclaration d
254+isTypeClassDeclaration _ = False
255+
256+-- |
257+-- Recursively flatten data binding groups in the list of declarations
258+flattenDecls :: [Declaration] -> [Declaration]
259+flattenDecls = concatMap flattenOne
260+ where flattenOne :: Declaration -> [Declaration]
261+ flattenOne (DataBindingGroupDeclaration decls) = concatMap flattenOne decls
262+ flattenOne d = [d]
263+
264+-- |
265+-- A guard is just a boolean-valued expression that appears alongside a set of binders
266+--
267+type Guard = Expr
268+
269+-- |
270+-- Data type for expressions and terms
271+--
272+data Expr
273+ -- |
274+ -- A numeric literal
275+ --
276+ = NumericLiteral (Either Integer Double)
277+ -- |
278+ -- A string literal
279+ --
280+ | StringLiteral String
281+ -- |
282+ -- A character literal
283+ --
284+ | CharLiteral Char
285+ -- |
286+ -- A boolean literal
287+ --
288+ | BooleanLiteral Bool
289+ -- |
290+ -- A prefix -, will be desugared
291+ --
292+ | UnaryMinus Expr
293+ -- |
294+ -- Binary operator application. During the rebracketing phase of desugaring, this data constructor
295+ -- will be removed.
296+ --
297+ | BinaryNoParens Expr Expr Expr
298+ -- |
299+ -- Explicit parentheses. During the rebracketing phase of desugaring, this data constructor
300+ -- will be removed.
301+ --
302+ | Parens Expr
303+ -- |
304+ -- Operator section. This will be removed during desugaring and replaced with a partially applied
305+ -- operator or lambda to flip the arguments.
306+ --
307+ | OperatorSection Expr (Either Expr Expr)
308+ -- |
309+ -- An array literal
310+ --
311+ | ArrayLiteral [Expr]
312+ -- |
313+ -- An object literal
314+ --
315+ | ObjectLiteral [(String, Expr)]
316+ -- |
317+ -- An object constructor (object literal with underscores). This will be removed during
318+ -- desugaring and expanded into a lambda that returns an object literal.
319+ --
320+ | ObjectConstructor [(String, Maybe Expr)]
321+ -- |
322+ -- An object property getter (e.g. `_.x`). This will be removed during
323+ -- desugaring and expanded into a lambda that reads a property from an object.
324+ --
325+ | ObjectGetter String
326+ -- |
327+ -- An record property accessor expression
328+ --
329+ | Accessor String Expr
330+ -- |
331+ -- Partial record update
332+ --
333+ | ObjectUpdate Expr [(String, Expr)]
334+ -- |
335+ -- Partial record updater. This will be removed during desugaring and
336+ -- expanded into a lambda that returns an object update.
337+ --
338+ | ObjectUpdater (Maybe Expr) [(String, Maybe Expr)]
339+ -- |
340+ -- Function introduction
341+ --
342+ | Abs (Either Ident Binder) Expr
343+ -- |
344+ -- Function application
345+ --
346+ | App Expr Expr
347+ -- |
348+ -- Variable
349+ --
350+ | Var (Qualified Ident)
351+ -- |
352+ -- Conditional (if-then-else expression)
353+ --
354+ | IfThenElse Expr Expr Expr
355+ -- |
356+ -- A data constructor
357+ --
358+ | Constructor (Qualified ProperName)
359+ -- |
360+ -- A case expression. During the case expansion phase of desugaring, top-level binders will get
361+ -- desugared into case expressions, hence the need for guards and multiple binders per branch here.
362+ --
363+ | Case [Expr] [CaseAlternative]
364+ -- |
365+ -- A value with a type annotation
366+ --
367+ | TypedValue Bool Expr Type
368+ -- |
369+ -- A let binding
370+ --
371+ | Let [Declaration] Expr
372+ -- |
373+ -- A do-notation block
374+ --
375+ | Do [DoNotationElement]
376+ -- |
377+ -- An application of a typeclass dictionary constructor. The value should be
378+ -- an ObjectLiteral.
379+ --
380+ | TypeClassDictionaryConstructorApp (Qualified ProperName) Expr
381+ -- |
382+ -- A placeholder for a type class dictionary to be inserted later. At the end of type checking, these
383+ -- placeholders will be replaced with actual expressions representing type classes dictionaries which
384+ -- can be evaluated at runtime. The constructor arguments represent (in order): whether or not to look
385+ -- at superclass implementations when searching for a dictionary, the type class name and
386+ -- instance type, and the type class dictionaries in scope.
387+ --
388+ | TypeClassDictionary Constraint (M.Map (Maybe ModuleName) (M.Map (Qualified ProperName) (M.Map (Qualified Ident) TypeClassDictionaryInScope)))
389+ -- |
390+ -- A typeclass dictionary accessor, the implementation is left unspecified until CoreFn desugaring.
391+ --
392+ | TypeClassDictionaryAccessor (Qualified ProperName) Ident
393+ -- |
394+ -- A placeholder for a superclass dictionary to be turned into a TypeClassDictionary during typechecking
395+ --
396+ | SuperClassDictionary (Qualified ProperName) [Type]
397+ -- |
398+ -- A value with source position information
399+ --
400+ | PositionedValue SourceSpan [Comment] Expr deriving (Show, Read, D.Data, D.Typeable)
401+
402+-- |
403+-- An alternative in a case statement
404+--
405+data CaseAlternative = CaseAlternative
406+ { -- |
407+ -- A collection of binders with which to match the inputs
408+ --
409+ caseAlternativeBinders :: [Binder]
410+ -- |
411+ -- The result expression or a collect of guarded expressions
412+ --
413+ , caseAlternativeResult :: Either [(Guard, Expr)] Expr
414+ } deriving (Show, Read, D.Data, D.Typeable)
415+
416+-- |
417+-- A statement in a do-notation block
418+--
419+data DoNotationElement
420+ -- |
421+ -- A monadic value without a binder
422+ --
423+ = DoNotationValue Expr
424+ -- |
425+ -- A monadic value with a binder
426+ --
427+ | DoNotationBind Binder Expr
428+ -- |
429+ -- A let statement, i.e. a pure value with a binder
430+ --
431+ | DoNotationLet [Declaration]
432+ -- |
433+ -- A do notation element with source position information
434+ --
435+ | PositionedDoNotationElement SourceSpan [Comment] DoNotationElement deriving (Show, Read, D.Data, D.Typeable)
436+
437+$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''DeclarationRef)
438+$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ImportDeclarationType)
src/Language/PureScript/AST/Exported.hsnew file+136
@@ -0,0 +1,136 @@
1+
2+module Language.PureScript.AST.Exported (
3+ exportedDeclarations,
4+ isExported
5+) where
6+
7+import Control.Category ((>>>))
8+import Data.Maybe (mapMaybe)
9+
10+import Language.PureScript.AST.Declarations
11+import Language.PureScript.Types
12+import Language.PureScript.Names
13+
14+-- |
15+-- Return a list of all declarations which are exported from a module.
16+-- This function descends into data declarations to filter out unexported
17+-- data constructors, and also filters out type instance declarations if
18+-- they refer to classes or types which are not themselves exported.
19+--
20+-- Note that this function assumes that the module has already had its imports
21+-- desugared using 'Language.PureScript.Sugar.Names.desugarImports'. It will
22+-- produce incorrect results if this is not the case - for example, type class
23+-- instances will be incorrectly removed in some cases.
24+--
25+exportedDeclarations :: Module -> [Declaration]
26+exportedDeclarations (Module _ _ _ decls exps) = go decls
27+ where
28+ go = flattenDecls
29+ >>> filter (isExported exps)
30+ >>> map (filterDataConstructors exps)
31+ >>> filterInstances exps
32+
33+-- |
34+-- Filter out all data constructors from a declaration which are not exported.
35+-- If the supplied declaration is not a data declaration, this function returns
36+-- it unchanged.
37+--
38+filterDataConstructors :: Maybe [DeclarationRef] -> Declaration -> Declaration
39+filterDataConstructors exps (DataDeclaration dType tyName tyArgs dctors) =
40+ DataDeclaration dType tyName tyArgs $
41+ filter (isDctorExported tyName exps . fst) dctors
42+filterDataConstructors exps (PositionedDeclaration srcSpan coms d) =
43+ PositionedDeclaration srcSpan coms (filterDataConstructors exps d)
44+filterDataConstructors _ other = other
45+
46+-- |
47+-- Filter out all the type instances from a list of declarations which
48+-- reference a type or type class which is both local and not exported.
49+--
50+-- Note that this function assumes that the module has already had its imports
51+-- desugared using "Language.PureScript.Sugar.Names.desugarImports". It will
52+-- produce incorrect results if this is not the case - for example, type class
53+-- instances will be incorrectly removed in some cases.
54+--
55+filterInstances :: Maybe [DeclarationRef] -> [Declaration] -> [Declaration]
56+filterInstances Nothing = id
57+filterInstances (Just exps) =
58+ let refs = mapMaybe typeName exps ++ mapMaybe typeClassName exps
59+ in filter (all (visibleOutside refs) . typeInstanceConstituents)
60+ where
61+ -- Given a Qualified ProperName, and a list of all exported types and type
62+ -- classes, returns whether the supplied Qualified ProperName is visible
63+ -- outside this module. This is true if one of the following hold:
64+ --
65+ -- * the name is defined in the same module and is exported,
66+ -- * the name is defined in a different module (and must be exported from
67+ -- that module; the code would fail to compile otherwise).
68+ visibleOutside _ (Qualified (Just _) _) = True
69+ visibleOutside refs (Qualified Nothing n) = any (== n) refs
70+
71+ typeName (TypeRef n _) = Just n
72+ typeName (PositionedDeclarationRef _ _ r) = typeName r
73+ typeName _ = Nothing
74+
75+ typeClassName (TypeClassRef n) = Just n
76+ typeClassName (PositionedDeclarationRef _ _ r) = typeClassName r
77+ typeClassName _ = Nothing
78+
79+-- |
80+-- Get all type and type class names referenced by a type instance declaration.
81+--
82+typeInstanceConstituents :: Declaration -> [Qualified ProperName]
83+typeInstanceConstituents (TypeInstanceDeclaration _ constraints className tys _) =
84+ className : (concatMap fromConstraint constraints ++ concatMap fromType tys)
85+ where
86+
87+ fromConstraint (name, tys') = name : concatMap fromType tys'
88+ fromType = everythingOnTypes (++) go
89+
90+ -- Note that type synonyms are disallowed in instance declarations, so
91+ -- we don't need to handle them here.
92+ go (TypeConstructor n) = [n]
93+ go (ConstrainedType cs _) = concatMap fromConstraint cs
94+ go _ = []
95+
96+typeInstanceConstituents (PositionedDeclaration _ _ d) = typeInstanceConstituents d
97+typeInstanceConstituents _ = []
98+
99+
100+-- |
101+-- Test if a declaration is exported, given a module's export list. Note that
102+-- this function does not account for type instance declarations of
103+-- non-exported types, or non-exported data constructors. Therefore, you should
104+-- prefer 'exportedDeclarations' to this function, where possible.
105+--
106+isExported :: Maybe [DeclarationRef] -> Declaration -> Bool
107+isExported Nothing _ = True
108+isExported _ TypeInstanceDeclaration{} = True
109+isExported exps (PositionedDeclaration _ _ d) = isExported exps d
110+isExported (Just exps) decl = any (matches decl) exps
111+ where
112+ matches (TypeDeclaration ident _) (ValueRef ident') = ident == ident'
113+ matches (ValueDeclaration ident _ _ _) (ValueRef ident') = ident == ident'
114+ matches (ExternDeclaration ident _) (ValueRef ident') = ident == ident'
115+ matches (FixityDeclaration _ name) (ValueRef ident') = name == runIdent ident'
116+ matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'
117+ matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'
118+ matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'
119+ matches (TypeClassDeclaration ident _ _ _) (TypeClassRef ident') = ident == ident'
120+
121+ matches (PositionedDeclaration _ _ d) r = d `matches` r
122+ matches d (PositionedDeclarationRef _ _ r) = d `matches` r
123+ matches _ _ = False
124+
125+-- |
126+-- Test if a data constructor for a given type is exported, given a module's
127+-- export list. Prefer 'exportedDeclarations' to this function, where possible.
128+--
129+isDctorExported :: ProperName -> Maybe [DeclarationRef] -> ProperName -> Bool
130+isDctorExported _ Nothing _ = True
131+isDctorExported ident (Just exps) ctor = test `any` exps
132+ where
133+ test (PositionedDeclarationRef _ _ d) = test d
134+ test (TypeRef ident' Nothing) = ident == ident'
135+ test (TypeRef ident' (Just ctors)) = ident == ident' && ctor `elem` ctors
136+ test _ = False
src/Language/PureScript/AST/Operators.hsnew file+60
@@ -0,0 +1,60 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.AST.Operators
4+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- | Operators fixity and associativity
12+--
13+-----------------------------------------------------------------------------
14+
15+{-# LANGUAGE OverloadedStrings #-}
16+{-# LANGUAGE DeriveDataTypeable #-}
17+
18+module Language.PureScript.AST.Operators where
19+
20+import qualified Data.Data as D
21+import Data.Aeson ((.=))
22+import qualified Data.Aeson as A
23+
24+-- |
25+-- A precedence level for an infix operator
26+--
27+type Precedence = Integer
28+
29+-- |
30+-- Associativity for infix operators
31+--
32+data Associativity = Infixl | Infixr | Infix deriving (Show, Read, Eq, Ord, D.Data, D.Typeable)
33+
34+showAssoc :: Associativity -> String
35+showAssoc Infixl = "infixl"
36+showAssoc Infixr = "infixr"
37+showAssoc Infix = "infix"
38+
39+readAssoc :: String -> Associativity
40+readAssoc "infixl" = Infixl
41+readAssoc "infixr" = Infixr
42+readAssoc "infix" = Infix
43+readAssoc _ = error "readAssoc: no parse"
44+
45+instance A.ToJSON Associativity where
46+ toJSON = A.toJSON . showAssoc
47+
48+instance A.FromJSON Associativity where
49+ parseJSON = fmap readAssoc . A.parseJSON
50+
51+-- |
52+-- Fixity data for infix operators
53+--
54+data Fixity = Fixity Associativity Precedence deriving (Show, Read, Eq, Ord, D.Data, D.Typeable)
55+
56+instance A.ToJSON Fixity where
57+ toJSON (Fixity associativity precedence) =
58+ A.object [ "associativity" .= associativity
59+ , "precedence" .= precedence
60+ ]
src/Language/PureScript/AST/SourcePos.hsnew file+98
@@ -0,0 +1,98 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.AST.SourcePos
4+-- Copyright : (c) 2013-15 Phil Freeman, (c) 2014-15 Gary Burgess
5+-- License : MIT (http://opensource.org/licenses/MIT)
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- | Source position information
12+--
13+-----------------------------------------------------------------------------
14+
15+{-# LANGUAGE CPP #-}
16+{-# LANGUAGE DeriveDataTypeable #-}
17+{-# LANGUAGE ScopedTypeVariables #-}
18+{-# LANGUAGE RecordWildCards #-}
19+{-# LANGUAGE OverloadedStrings #-}
20+
21+module Language.PureScript.AST.SourcePos where
22+
23+import qualified Data.Data as D
24+import Data.Aeson ((.=), (.:))
25+import qualified Data.Aeson as A
26+
27+#if __GLASGOW_HASKELL__ < 710
28+import Control.Applicative
29+#endif
30+
31+-- |
32+-- Source position information
33+--
34+data SourcePos = SourcePos
35+ { -- |
36+ -- Line number
37+ --
38+ sourcePosLine :: Int
39+ -- |
40+ -- Column number
41+ --
42+ , sourcePosColumn :: Int
43+ } deriving (Show, Read, Eq, Ord, D.Data, D.Typeable)
44+
45+displaySourcePos :: SourcePos -> String
46+displaySourcePos sp =
47+ "line " ++ show (sourcePosLine sp) ++
48+ ", column " ++ show (sourcePosColumn sp)
49+
50+instance A.ToJSON SourcePos where
51+ toJSON SourcePos{..} =
52+ A.toJSON [sourcePosLine, sourcePosColumn]
53+
54+instance A.FromJSON SourcePos where
55+ parseJSON arr = do
56+ [line, col] <- A.parseJSON arr
57+ return $ SourcePos line col
58+
59+data SourceSpan = SourceSpan
60+ { -- |
61+ -- Source name
62+ --
63+ spanName :: String
64+ -- |
65+ -- Start of the span
66+ --
67+ , spanStart :: SourcePos
68+ -- End of the span
69+ --
70+ , spanEnd :: SourcePos
71+ } deriving (Show, Read, Eq, Ord, D.Data, D.Typeable)
72+
73+displayStartEndPos :: SourceSpan -> String
74+displayStartEndPos sp =
75+ displaySourcePos (spanStart sp) ++ " - " ++
76+ displaySourcePos (spanEnd sp)
77+
78+displaySourceSpan :: SourceSpan -> String
79+displaySourceSpan sp =
80+ spanName sp ++ " " ++
81+ displayStartEndPos sp
82+
83+instance A.ToJSON SourceSpan where
84+ toJSON SourceSpan{..} =
85+ A.object [ "name" .= spanName
86+ , "start" .= spanStart
87+ , "end" .= spanEnd
88+ ]
89+
90+instance A.FromJSON SourceSpan where
91+ parseJSON = A.withObject "SourceSpan" $ \o ->
92+ SourceSpan <$>
93+ o .: "name" <*>
94+ o .: "start" <*>
95+ o .: "end"
96+
97+internalModuleSourceSpan :: String -> SourceSpan
98+internalModuleSourceSpan name = SourceSpan name (SourcePos 0 0) (SourcePos 0 0)
src/Language/PureScript/AST/Traversals.hsnew file+409
@@ -0,0 +1,409 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.AST.Traversals
4+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- | AST traversal helpers
12+--
13+-----------------------------------------------------------------------------
14+
15+{-# LANGUAGE CPP #-}
16+
17+module Language.PureScript.AST.Traversals where
18+
19+#if __GLASGOW_HASKELL__ < 710
20+import Data.Monoid (Monoid(..), mconcat)
21+#endif
22+import Data.Maybe (mapMaybe)
23+#if __GLASGOW_HASKELL__ < 710
24+import Data.Traversable (traverse)
25+#endif
26+
27+#if __GLASGOW_HASKELL__ < 710
28+import Control.Applicative
29+#endif
30+import Control.Monad
31+import Control.Arrow ((***), (+++), second)
32+
33+import Language.PureScript.AST.Binders
34+import Language.PureScript.AST.Declarations
35+import Language.PureScript.Types
36+import Language.PureScript.Traversals
37+
38+everywhereOnValues :: (Declaration -> Declaration) ->
39+ (Expr -> Expr) ->
40+ (Binder -> Binder) ->
41+ (Declaration -> Declaration, Expr -> Expr, Binder -> Binder)
42+everywhereOnValues f g h = (f', g', h')
43+ where
44+ f' :: Declaration -> Declaration
45+ f' (DataBindingGroupDeclaration ds) = f (DataBindingGroupDeclaration (map f' ds))
46+ f' (ValueDeclaration name nameKind bs val) = f (ValueDeclaration name nameKind (map h' bs) ((map (g' *** g') +++ g') val))
47+ f' (BindingGroupDeclaration ds) = f (BindingGroupDeclaration (map (\(name, nameKind, val) -> (name, nameKind, g' val)) ds))
48+ f' (TypeClassDeclaration name args implies ds) = f (TypeClassDeclaration name args implies (map f' ds))
49+ f' (TypeInstanceDeclaration name cs className args ds) = f (TypeInstanceDeclaration name cs className args (mapTypeInstanceBody (map f') ds))
50+ f' (PositionedDeclaration pos com d) = f (PositionedDeclaration pos com (f' d))
51+ f' other = f other
52+
53+ g' :: Expr -> Expr
54+ g' (UnaryMinus v) = g (UnaryMinus (g' v))
55+ g' (BinaryNoParens op v1 v2) = g (BinaryNoParens (g' op) (g' v1) (g' v2))
56+ g' (Parens v) = g (Parens (g' v))
57+ g' (OperatorSection op (Left v)) = g (OperatorSection (g' op) (Left $ g' v))
58+ g' (OperatorSection op (Right v)) = g (OperatorSection (g' op) (Right $ g' v))
59+ g' (ArrayLiteral vs) = g (ArrayLiteral (map g' vs))
60+ g' (ObjectLiteral vs) = g (ObjectLiteral (map (fmap g') vs))
61+ g' (ObjectConstructor vs) = g (ObjectConstructor (map (second (fmap g')) vs))
62+ g' (TypeClassDictionaryConstructorApp name v) = g (TypeClassDictionaryConstructorApp name (g' v))
63+ g' (Accessor prop v) = g (Accessor prop (g' v))
64+ g' (ObjectUpdate obj vs) = g (ObjectUpdate (g' obj) (map (fmap g') vs))
65+ g' (ObjectUpdater obj vs) = g (ObjectUpdater (fmap g' obj) (map (second (fmap g')) vs))
66+ g' (Abs name v) = g (Abs name (g' v))
67+ g' (App v1 v2) = g (App (g' v1) (g' v2))
68+ g' (IfThenElse v1 v2 v3) = g (IfThenElse (g' v1) (g' v2) (g' v3))
69+ g' (Case vs alts) = g (Case (map g' vs) (map handleCaseAlternative alts))
70+ g' (TypedValue check v ty) = g (TypedValue check (g' v) ty)
71+ g' (Let ds v) = g (Let (map f' ds) (g' v))
72+ g' (Do es) = g (Do (map handleDoNotationElement es))
73+ g' (PositionedValue pos com v) = g (PositionedValue pos com (g' v))
74+ g' other = g other
75+
76+ h' :: Binder -> Binder
77+ h' (ConstructorBinder ctor bs) = h (ConstructorBinder ctor (map h' bs))
78+ h' (ObjectBinder bs) = h (ObjectBinder (map (fmap h') bs))
79+ h' (ArrayBinder bs) = h (ArrayBinder (map h' bs))
80+ h' (NamedBinder name b) = h (NamedBinder name (h' b))
81+ h' (PositionedBinder pos com b) = h (PositionedBinder pos com (h' b))
82+ h' other = h other
83+
84+ handleCaseAlternative :: CaseAlternative -> CaseAlternative
85+ handleCaseAlternative ca =
86+ ca { caseAlternativeBinders = map h' (caseAlternativeBinders ca)
87+ , caseAlternativeResult = (map (g' *** g') +++ g') (caseAlternativeResult ca)
88+ }
89+
90+ handleDoNotationElement :: DoNotationElement -> DoNotationElement
91+ handleDoNotationElement (DoNotationValue v) = DoNotationValue (g' v)
92+ handleDoNotationElement (DoNotationBind b v) = DoNotationBind (h' b) (g' v)
93+ handleDoNotationElement (DoNotationLet ds) = DoNotationLet (map f' ds)
94+ handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com (handleDoNotationElement e)
95+
96+everywhereOnValuesTopDownM :: (Functor m, Applicative m, Monad m) =>
97+ (Declaration -> m Declaration) ->
98+ (Expr -> m Expr) ->
99+ (Binder -> m Binder) ->
100+ (Declaration -> m Declaration, Expr -> m Expr, Binder -> m Binder)
101+everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)
102+ where
103+ f' (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> mapM (f' <=< f) ds
104+ f' (ValueDeclaration name nameKind bs val) = ValueDeclaration name nameKind <$> mapM (h' <=< h) bs <*> eitherM (mapM (pairM (g' <=< g) (g' <=< g))) (g' <=< g) val
105+ f' (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> mapM (\(name, nameKind, val) -> (,,) name nameKind <$> (g val >>= g')) ds
106+ f' (TypeClassDeclaration name args implies ds) = TypeClassDeclaration name args implies <$> mapM (f' <=< f) ds
107+ f' (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (traverse (f' <=< f)) ds
108+ f' (PositionedDeclaration pos com d) = PositionedDeclaration pos com <$> (f d >>= f')
109+ f' other = f other
110+
111+ g' (UnaryMinus v) = UnaryMinus <$> (g v >>= g')
112+ g' (BinaryNoParens op v1 v2) = BinaryNoParens <$> (g op >>= g') <*> (g v1 >>= g') <*> (g v2 >>= g')
113+ g' (Parens v) = Parens <$> (g v >>= g')
114+ g' (OperatorSection op (Left v)) = OperatorSection <$> (g op >>= g') <*> (Left <$> (g v >>= g'))
115+ g' (OperatorSection op (Right v)) = OperatorSection <$> (g op >>= g') <*> (Right <$> (g v >>= g'))
116+ g' (ArrayLiteral vs) = ArrayLiteral <$> mapM (g' <=< g) vs
117+ g' (ObjectLiteral vs) = ObjectLiteral <$> mapM (sndM (g' <=< g)) vs
118+ g' (ObjectConstructor vs) = ObjectConstructor <$> mapM (sndM $ maybeM (g' <=< g)) vs
119+ g' (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> (g v >>= g')
120+ g' (Accessor prop v) = Accessor prop <$> (g v >>= g')
121+ g' (ObjectUpdate obj vs) = ObjectUpdate <$> (g obj >>= g') <*> mapM (sndM (g' <=< g)) vs
122+ g' (ObjectUpdater obj vs) = ObjectUpdater <$> (maybeM g obj >>= maybeM g') <*> mapM (sndM $ maybeM (g' <=< g)) vs
123+ g' (Abs name v) = Abs name <$> (g v >>= g')
124+ g' (App v1 v2) = App <$> (g v1 >>= g') <*> (g v2 >>= g')
125+ g' (IfThenElse v1 v2 v3) = IfThenElse <$> (g v1 >>= g') <*> (g v2 >>= g') <*> (g v3 >>= g')
126+ g' (Case vs alts) = Case <$> mapM (g' <=< g) vs <*> mapM handleCaseAlternative alts
127+ g' (TypedValue check v ty) = TypedValue check <$> (g v >>= g') <*> pure ty
128+ g' (Let ds v) = Let <$> mapM (f' <=< f) ds <*> (g v >>= g')
129+ g' (Do es) = Do <$> mapM handleDoNotationElement es
130+ g' (PositionedValue pos com v) = PositionedValue pos com <$> (g v >>= g')
131+ g' other = g other
132+
133+ h' (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> mapM (h' <=< h) bs
134+ h' (ObjectBinder bs) = ObjectBinder <$> mapM (sndM (h' <=< h)) bs
135+ h' (ArrayBinder bs) = ArrayBinder <$> mapM (h' <=< h) bs
136+ h' (NamedBinder name b) = NamedBinder name <$> (h b >>= h')
137+ h' (PositionedBinder pos com b) = PositionedBinder pos com <$> (h b >>= h')
138+ h' other = h other
139+
140+ handleCaseAlternative (CaseAlternative bs val) = CaseAlternative <$> mapM (h' <=< h) bs
141+ <*> eitherM (mapM (pairM (g' <=< g) (g' <=< g))) (g' <=< g) val
142+
143+ handleDoNotationElement (DoNotationValue v) = DoNotationValue <$> (g' <=< g) v
144+ handleDoNotationElement (DoNotationBind b v) = DoNotationBind <$> (h' <=< h) b <*> (g' <=< g) v
145+ handleDoNotationElement (DoNotationLet ds) = DoNotationLet <$> mapM (f' <=< f) ds
146+ handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com <$> handleDoNotationElement e
147+
148+everywhereOnValuesM :: (Functor m, Applicative m, Monad m) =>
149+ (Declaration -> m Declaration) ->
150+ (Expr -> m Expr) ->
151+ (Binder -> m Binder) ->
152+ (Declaration -> m Declaration, Expr -> m Expr, Binder -> m Binder)
153+everywhereOnValuesM f g h = (f', g', h')
154+ where
155+ f' (DataBindingGroupDeclaration ds) = (DataBindingGroupDeclaration <$> mapM f' ds) >>= f
156+ f' (ValueDeclaration name nameKind bs val) = (ValueDeclaration name nameKind <$> mapM h' bs <*> eitherM (mapM (pairM g' g')) g' val) >>= f
157+ f' (BindingGroupDeclaration ds) = (BindingGroupDeclaration <$> mapM (\(name, nameKind, val) -> (,,) name nameKind <$> g' val) ds) >>= f
158+ f' (TypeClassDeclaration name args implies ds) = (TypeClassDeclaration name args implies <$> mapM f' ds) >>= f
159+ f' (TypeInstanceDeclaration name cs className args ds) = (TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (mapM f') ds) >>= f
160+ f' (PositionedDeclaration pos com d) = (PositionedDeclaration pos com <$> f' d) >>= f
161+ f' other = f other
162+
163+ g' (UnaryMinus v) = (UnaryMinus <$> g' v) >>= g
164+ g' (BinaryNoParens op v1 v2) = (BinaryNoParens <$> g' op <*> g' v1 <*> g' v2) >>= g
165+ g' (Parens v) = (Parens <$> g' v) >>= g
166+ g' (OperatorSection op (Left v)) = (OperatorSection <$> g' op <*> (Left <$> g' v)) >>= g
167+ g' (OperatorSection op (Right v)) = (OperatorSection <$> g' op <*> (Right <$> g' v)) >>= g
168+ g' (ArrayLiteral vs) = (ArrayLiteral <$> mapM g' vs) >>= g
169+ g' (ObjectLiteral vs) = (ObjectLiteral <$> mapM (sndM g') vs) >>= g
170+ g' (ObjectConstructor vs) = (ObjectConstructor <$> mapM (sndM $ maybeM g') vs) >>= g
171+ g' (TypeClassDictionaryConstructorApp name v) = (TypeClassDictionaryConstructorApp name <$> g' v) >>= g
172+ g' (Accessor prop v) = (Accessor prop <$> g' v) >>= g
173+ g' (ObjectUpdate obj vs) = (ObjectUpdate <$> g' obj <*> mapM (sndM g') vs) >>= g
174+ g' (ObjectUpdater obj vs) = (ObjectUpdater <$> maybeM g' obj <*> mapM (sndM $ maybeM g') vs) >>= g
175+ g' (Abs name v) = (Abs name <$> g' v) >>= g
176+ g' (App v1 v2) = (App <$> g' v1 <*> g' v2) >>= g
177+ g' (IfThenElse v1 v2 v3) = (IfThenElse <$> g' v1 <*> g' v2 <*> g' v3) >>= g
178+ g' (Case vs alts) = (Case <$> mapM g' vs <*> mapM handleCaseAlternative alts) >>= g
179+ g' (TypedValue check v ty) = (TypedValue check <$> g' v <*> pure ty) >>= g
180+ g' (Let ds v) = (Let <$> mapM f' ds <*> g' v) >>= g
181+ g' (Do es) = (Do <$> mapM handleDoNotationElement es) >>= g
182+ g' (PositionedValue pos com v) = (PositionedValue pos com <$> g' v) >>= g
183+ g' other = g other
184+
185+ h' (ConstructorBinder ctor bs) = (ConstructorBinder ctor <$> mapM h' bs) >>= h
186+ h' (ObjectBinder bs) = (ObjectBinder <$> mapM (sndM h') bs) >>= h
187+ h' (ArrayBinder bs) = (ArrayBinder <$> mapM h' bs) >>= h
188+ h' (NamedBinder name b) = (NamedBinder name <$> h' b) >>= h
189+ h' (PositionedBinder pos com b) = (PositionedBinder pos com <$> h' b) >>= h
190+ h' other = h other
191+
192+ handleCaseAlternative (CaseAlternative bs val) = CaseAlternative <$> mapM h' bs
193+ <*> eitherM (mapM (pairM g' g')) g' val
194+
195+ handleDoNotationElement (DoNotationValue v) = DoNotationValue <$> g' v
196+ handleDoNotationElement (DoNotationBind b v) = DoNotationBind <$> h' b <*> g' v
197+ handleDoNotationElement (DoNotationLet ds) = DoNotationLet <$> mapM f' ds
198+ handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com <$> handleDoNotationElement e
199+
200+everythingOnValues :: (r -> r -> r) ->
201+ (Declaration -> r) ->
202+ (Expr -> r) ->
203+ (Binder -> r) ->
204+ (CaseAlternative -> r) ->
205+ (DoNotationElement -> r) ->
206+ (Declaration -> r, Expr -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r)
207+everythingOnValues (<>) f g h i j = (f', g', h', i', j')
208+ where
209+ f' d@(DataBindingGroupDeclaration ds) = foldl (<>) (f d) (map f' ds)
210+ f' d@(ValueDeclaration _ _ bs (Right val)) = foldl (<>) (f d) (map h' bs) <> g' val
211+ f' d@(ValueDeclaration _ _ bs (Left gs)) = foldl (<>) (f d) (map h' bs ++ concatMap (\(grd, val) -> [g' grd, g' val]) gs)
212+ f' d@(BindingGroupDeclaration ds) = foldl (<>) (f d) (map (\(_, _, val) -> g' val) ds)
213+ f' d@(TypeClassDeclaration _ _ _ ds) = foldl (<>) (f d) (map f' ds)
214+ f' d@(TypeInstanceDeclaration _ _ _ _ (ExplicitInstance ds)) = foldl (<>) (f d) (map f' ds)
215+ f' d@(PositionedDeclaration _ _ d1) = f d <> f' d1
216+ f' d = f d
217+
218+ g' v@(UnaryMinus v1) = g v <> g' v1
219+ g' v@(BinaryNoParens op v1 v2) = g v <> g op <> g' v1 <> g' v2
220+ g' v@(Parens v1) = g v <> g' v1
221+ g' v@(OperatorSection op (Left v1)) = g v <> g op <> g' v1
222+ g' v@(OperatorSection op (Right v1)) = g v <> g op <> g' v1
223+ g' v@(ArrayLiteral vs) = foldl (<>) (g v) (map g' vs)
224+ g' v@(ObjectLiteral vs) = foldl (<>) (g v) (map (g' . snd) vs)
225+ g' v@(ObjectConstructor vs) = foldl (<>) (g v) (map g' (mapMaybe snd vs))
226+ g' v@(TypeClassDictionaryConstructorApp _ v1) = g v <> g' v1
227+ g' v@(Accessor _ v1) = g v <> g' v1
228+ g' v@(ObjectUpdate obj vs) = foldl (<>) (g v <> g' obj) (map (g' . snd) vs)
229+ g' v@(ObjectUpdater obj vs) = foldl (<>) (maybe (g v) (\x -> g v <> g' x) obj) (map g' (mapMaybe snd vs))
230+ g' v@(Abs _ v1) = g v <> g' v1
231+ g' v@(App v1 v2) = g v <> g' v1 <> g' v2
232+ g' v@(IfThenElse v1 v2 v3) = g v <> g' v1 <> g' v2 <> g' v3
233+ g' v@(Case vs alts) = foldl (<>) (foldl (<>) (g v) (map g' vs)) (map i' alts)
234+ g' v@(TypedValue _ v1 _) = g v <> g' v1
235+ g' v@(Let ds v1) = foldl (<>) (g v) (map f' ds) <> g' v1
236+ g' v@(Do es) = foldl (<>) (g v) (map j' es)
237+ g' v@(PositionedValue _ _ v1) = g v <> g' v1
238+ g' v = g v
239+
240+ h' b@(ConstructorBinder _ bs) = foldl (<>) (h b) (map h' bs)
241+ h' b@(ObjectBinder bs) = foldl (<>) (h b) (map (h' . snd) bs)
242+ h' b@(ArrayBinder bs) = foldl (<>) (h b) (map h' bs)
243+ h' b@(NamedBinder _ b1) = h b <> h' b1
244+ h' b@(PositionedBinder _ _ b1) = h b <> h' b1
245+ h' b = h b
246+
247+ i' ca@(CaseAlternative bs (Right val)) = foldl (<>) (i ca) (map h' bs) <> g' val
248+ i' ca@(CaseAlternative bs (Left gs)) = foldl (<>) (i ca) (map h' bs ++ concatMap (\(grd, val) -> [g' grd, g' val]) gs)
249+
250+ j' e@(DoNotationValue v) = j e <> g' v
251+ j' e@(DoNotationBind b v) = j e <> h' b <> g' v
252+ j' e@(DoNotationLet ds) = foldl (<>) (j e) (map f' ds)
253+ j' e@(PositionedDoNotationElement _ _ e1) = j e <> j' e1
254+
255+everythingWithContextOnValues ::
256+ s ->
257+ r ->
258+ (r -> r -> r) ->
259+ (s -> Declaration -> (s, r)) ->
260+ (s -> Expr -> (s, r)) ->
261+ (s -> Binder -> (s, r)) ->
262+ (s -> CaseAlternative -> (s, r)) ->
263+ (s -> DoNotationElement -> (s, r)) ->
264+ ( Declaration -> r
265+ , Expr -> r
266+ , Binder -> r
267+ , CaseAlternative -> r
268+ , DoNotationElement -> r)
269+everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j'' s0)
270+ where
271+ f'' s d = let (s', r) = f s d in r <> f' s' d
272+
273+ f' s (DataBindingGroupDeclaration ds) = foldl (<>) r0 (map (f'' s) ds)
274+ f' s (ValueDeclaration _ _ bs (Right val)) = foldl (<>) r0 (map (h'' s) bs) <> g'' s val
275+ f' s (ValueDeclaration _ _ bs (Left gs)) = foldl (<>) r0 (map (h'' s) bs ++ concatMap (\(grd, val) -> [g'' s grd, g'' s val]) gs)
276+ f' s (BindingGroupDeclaration ds) = foldl (<>) r0 (map (\(_, _, val) -> g'' s val) ds)
277+ f' s (TypeClassDeclaration _ _ _ ds) = foldl (<>) r0 (map (f'' s) ds)
278+ f' s (TypeInstanceDeclaration _ _ _ _ (ExplicitInstance ds)) = foldl (<>) r0 (map (f'' s) ds)
279+ f' s (PositionedDeclaration _ _ d1) = f'' s d1
280+ f' _ _ = r0
281+
282+ g'' s v = let (s', r) = g s v in r <> g' s' v
283+
284+ g' s (UnaryMinus v1) = g'' s v1
285+ g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2
286+ g' s (Parens v1) = g'' s v1
287+ g' s (OperatorSection op (Left v)) = g'' s op <> g'' s v
288+ g' s (OperatorSection op (Right v)) = g'' s op <> g'' s v
289+ g' s (ArrayLiteral vs) = foldl (<>) r0 (map (g'' s) vs)
290+ g' s (ObjectLiteral vs) = foldl (<>) r0 (map (g'' s . snd) vs)
291+ g' s (ObjectConstructor vs) = foldl (<>) r0 (map (g'' s) (mapMaybe snd vs))
292+ g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1
293+ g' s (Accessor _ v1) = g'' s v1
294+ g' s (ObjectUpdate obj vs) = foldl (<>) (g'' s obj) (map (g'' s . snd) vs)
295+ g' s (ObjectUpdater obj vs) = foldl (<>) (maybe r0 (g'' s) obj) (map (g'' s) (mapMaybe snd vs))
296+ g' s (Abs _ v1) = g'' s v1
297+ g' s (App v1 v2) = g'' s v1 <> g'' s v2
298+ g' s (IfThenElse v1 v2 v3) = g'' s v1 <> g'' s v2 <> g'' s v3
299+ g' s (Case vs alts) = foldl (<>) (foldl (<>) r0 (map (g'' s) vs)) (map (i'' s) alts)
300+ g' s (TypedValue _ v1 _) = g'' s v1
301+ g' s (Let ds v1) = foldl (<>) r0 (map (f'' s) ds) <> g'' s v1
302+ g' s (Do es) = foldl (<>) r0 (map (j'' s) es)
303+ g' s (PositionedValue _ _ v1) = g'' s v1
304+ g' _ _ = r0
305+
306+ h'' s b = let (s', r) = h s b in r <> h' s' b
307+
308+ h' s (ConstructorBinder _ bs) = foldl (<>) r0 (map (h'' s) bs)
309+ h' s (ObjectBinder bs) = foldl (<>) r0 (map (h'' s . snd) bs)
310+ h' s (ArrayBinder bs) = foldl (<>) r0 (map (h'' s) bs)
311+ h' s (NamedBinder _ b1) = h'' s b1
312+ h' s (PositionedBinder _ _ b1) = h'' s b1
313+ h' _ _ = r0
314+
315+ i'' s ca = let (s', r) = i s ca in r <> i' s' ca
316+
317+ i' s (CaseAlternative bs (Right val)) = foldl (<>) r0 (map (h'' s) bs) <> g'' s val
318+ i' s (CaseAlternative bs (Left gs)) = foldl (<>) r0 (map (h'' s) bs ++ concatMap (\(grd, val) -> [g'' s grd, g'' s val]) gs)
319+
320+ j'' s e = let (s', r) = j s e in r <> j' s' e
321+
322+ j' s (DoNotationValue v) = g'' s v
323+ j' s (DoNotationBind b v) = h'' s b <> g'' s v
324+ j' s (DoNotationLet ds) = foldl (<>) r0 (map (f'' s) ds)
325+ j' s (PositionedDoNotationElement _ _ e1) = j'' s e1
326+
327+everywhereWithContextOnValuesM :: (Functor m, Applicative m, Monad m) =>
328+ s ->
329+ (s -> Declaration -> m (s, Declaration)) ->
330+ (s -> Expr -> m (s, Expr)) ->
331+ (s -> Binder -> m (s, Binder)) ->
332+ (s -> CaseAlternative -> m (s, CaseAlternative)) ->
333+ (s -> DoNotationElement -> m (s, DoNotationElement)) ->
334+ ( Declaration -> m Declaration
335+ , Expr -> m Expr
336+ , Binder -> m Binder
337+ , CaseAlternative -> m CaseAlternative
338+ , DoNotationElement -> m DoNotationElement)
339+everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j'' s0)
340+ where
341+ f'' s = uncurry f' <=< f s
342+
343+ f' s (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> mapM (f'' s) ds
344+ f' s (ValueDeclaration name nameKind bs val) = ValueDeclaration name nameKind <$> mapM (h'' s) bs <*> eitherM (mapM (pairM (g'' s) (g'' s))) (g'' s) val
345+ f' s (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> mapM (thirdM (g'' s)) ds
346+ f' s (TypeClassDeclaration name args implies ds) = TypeClassDeclaration name args implies <$> mapM (f'' s) ds
347+ f' s (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> traverseTypeInstanceBody (mapM (f'' s)) ds
348+ f' s (PositionedDeclaration pos com d1) = PositionedDeclaration pos com <$> f'' s d1
349+ f' _ other = return other
350+
351+ g'' s = uncurry g' <=< g s
352+
353+ g' s (UnaryMinus v) = UnaryMinus <$> g'' s v
354+ g' s (BinaryNoParens op v1 v2) = BinaryNoParens <$> g'' s op <*> g'' s v1 <*> g'' s v2
355+ g' s (Parens v) = Parens <$> g'' s v
356+ g' s (OperatorSection op (Left v)) = OperatorSection <$> g'' s op <*> (Left <$> g'' s v)
357+ g' s (OperatorSection op (Right v)) = OperatorSection <$> g'' s op <*> (Right <$> g'' s v)
358+ g' s (ArrayLiteral vs) = ArrayLiteral <$> mapM (g'' s) vs
359+ g' s (ObjectLiteral vs) = ObjectLiteral <$> mapM (sndM (g'' s)) vs
360+ g' s (ObjectConstructor vs) = ObjectConstructor <$> mapM (sndM $ maybeM (g'' s)) vs
361+ g' s (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> g'' s v
362+ g' s (Accessor prop v) = Accessor prop <$> g'' s v
363+ g' s (ObjectUpdate obj vs) = ObjectUpdate <$> g'' s obj <*> mapM (sndM (g'' s)) vs
364+ g' s (ObjectUpdater obj vs) = ObjectUpdater <$> maybeM (g'' s) obj <*> mapM (sndM $ maybeM (g'' s)) vs
365+ g' s (Abs name v) = Abs name <$> g'' s v
366+ g' s (App v1 v2) = App <$> g'' s v1 <*> g'' s v2
367+ g' s (IfThenElse v1 v2 v3) = IfThenElse <$> g'' s v1 <*> g'' s v2 <*> g'' s v3
368+ g' s (Case vs alts) = Case <$> mapM (g'' s) vs <*> mapM (i'' s) alts
369+ g' s (TypedValue check v ty) = TypedValue check <$> g'' s v <*> pure ty
370+ g' s (Let ds v) = Let <$> mapM (f'' s) ds <*> g'' s v
371+ g' s (Do es) = Do <$> mapM (j'' s) es
372+ g' s (PositionedValue pos com v) = PositionedValue pos com <$> g'' s v
373+ g' _ other = return other
374+
375+ h'' s = uncurry h' <=< h s
376+
377+ h' s (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> mapM (h'' s) bs
378+ h' s (ObjectBinder bs) = ObjectBinder <$> mapM (sndM (h'' s)) bs
379+ h' s (ArrayBinder bs) = ArrayBinder <$> mapM (h'' s) bs
380+ h' s (NamedBinder name b) = NamedBinder name <$> h'' s b
381+ h' s (PositionedBinder pos com b) = PositionedBinder pos com <$> h'' s b
382+ h' _ other = return other
383+
384+ i'' s = uncurry i' <=< i s
385+
386+ i' s (CaseAlternative bs val) = CaseAlternative <$> mapM (h'' s) bs <*> eitherM (mapM (pairM (g'' s) (g'' s))) (g'' s) val
387+
388+ j'' s = uncurry j' <=< j s
389+
390+ j' s (DoNotationValue v) = DoNotationValue <$> g'' s v
391+ j' s (DoNotationBind b v) = DoNotationBind <$> h'' s b <*> g'' s v
392+ j' s (DoNotationLet ds) = DoNotationLet <$> mapM (f'' s) ds
393+ j' s (PositionedDoNotationElement pos com e1) = PositionedDoNotationElement pos com <$> j'' s e1
394+
395+accumTypes :: (Monoid r) => (Type -> r) -> (Declaration -> r, Expr -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r)
396+accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)
397+ where
398+ forDecls (DataDeclaration _ _ _ dctors) = mconcat (concatMap (map f . snd) dctors)
399+ forDecls (ExternDeclaration _ ty) = f ty
400+ forDecls (TypeClassDeclaration _ _ implies _) = mconcat (concatMap (map f . snd) implies)
401+ forDecls (TypeInstanceDeclaration _ cs _ tys _) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)
402+ forDecls (TypeSynonymDeclaration _ _ ty) = f ty
403+ forDecls (TypeDeclaration _ ty) = f ty
404+ forDecls _ = mempty
405+
406+ forValues (TypeClassDictionary (_, cs) _) = mconcat (map f cs)
407+ forValues (SuperClassDictionary _ tys) = mconcat (map f tys)
408+ forValues (TypedValue _ _ ty) = f ty
409+ forValues _ = mempty
src/Language/PureScript/Bundle.hsnew file+552
@@ -0,0 +1,552 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : psc-bundle
4+-- Copyright : (c) Phil Freeman 2015
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- | Bundles compiled PureScript modules for the browser.
12+--
13+-- This module takes as input the individual generated modules from 'Language.PureScript.Make' and
14+-- performs dead code elimination, filters empty modules,
15+-- and generates the final Javascript bundle.
16+-----------------------------------------------------------------------------
17+
18+{-# LANGUAGE PatternGuards #-}
19+{-# LANGUAGE FlexibleContexts #-}
20+{-# LANGUAGE ScopedTypeVariables #-}
21+{-# LANGUAGE TupleSections #-}
22+{-# LANGUAGE RecordWildCards #-}
23+{-# LANGUAGE CPP #-}
24+
25+module Language.PureScript.Bundle (
26+ bundle
27+ , ModuleIdentifier(..)
28+ , moduleName
29+ , ModuleType(..)
30+ , ErrorMessage(..)
31+ , printErrorMessage
32+) where
33+
34+import Data.List (nub)
35+import Data.Maybe (mapMaybe, catMaybes)
36+import Data.Generics (everything, everywhere, mkQ, mkT)
37+import Data.Graph
38+import Data.Version (showVersion)
39+
40+import qualified Data.Set as S
41+
42+#if __GLASGOW_HASKELL__ < 710
43+import Control.Applicative
44+#endif
45+import Control.Monad
46+import Control.Monad.Error.Class
47+import Language.JavaScript.Parser
48+
49+import qualified Paths_purescript as Paths
50+
51+-- | The type of error messages. We separate generation and rendering of errors using a data
52+-- type, in case we need to match on error types later.
53+data ErrorMessage
54+ = UnsupportedModulePath String
55+ | InvalidTopLevel
56+ | UnableToParseModule String
57+ | UnsupportedExport
58+ | ErrorInModule ModuleIdentifier ErrorMessage
59+ deriving (Show, Read)
60+
61+-- | Modules are either "regular modules" (i.e. those generated by psc) or foreign modules.
62+data ModuleType
63+ = Regular
64+ | Foreign
65+ deriving (Show, Read, Eq, Ord)
66+
67+showModuleType :: ModuleType -> String
68+showModuleType Regular = "Regular"
69+showModuleType Foreign = "Foreign"
70+
71+-- | A module is identified by its module name and its type.
72+data ModuleIdentifier = ModuleIdentifier String ModuleType deriving (Show, Read, Eq, Ord)
73+
74+moduleName :: ModuleIdentifier -> String
75+moduleName (ModuleIdentifier name _) = name
76+
77+-- | A piece of code is identified by its module and its name. These keys are used to label vertices
78+-- in the dependency graph.
79+type Key = (ModuleIdentifier, String)
80+
81+-- | An export is either a "regular export", which exports a name from the regular module we are in,
82+-- or a reexport of a declaration in the corresponding foreign module.
83+--
84+-- Regular exports are labelled, since they might re-export an operator with another name.
85+data ExportType
86+ = RegularExport String
87+ | ForeignReexport
88+ deriving (Show, Read, Eq, Ord)
89+
90+-- | There are four types of module element we are interested in:
91+--
92+-- 1) Require statements
93+-- 2) Member declarations
94+-- 3) Export lists
95+-- 4) Everything else
96+--
97+-- Each is labelled with the original AST node which generated it, so that we can dump it back
98+-- into the output during codegen.
99+data ModuleElement
100+ = Require JSNode String ModuleIdentifier
101+ | Member JSNode Bool String [JSNode] [Key]
102+ | ExportsList [(ExportType, String, JSNode, [Key])]
103+ | Other JSNode
104+ deriving (Show, Read)
105+
106+-- | A module is just a list of elements of the types listed above.
107+data Module = Module ModuleIdentifier [ModuleElement] deriving (Show, Read)
108+
109+-- | Prepare an error message for consumption by humans.
110+printErrorMessage :: ErrorMessage -> [String]
111+printErrorMessage (UnsupportedModulePath s) =
112+ [ "A CommonJS module has an unsupported name (" ++ show s ++ ")."
113+ , "The following file names are supported:"
114+ , " 1) index.js (psc native modules)"
115+ , " 2) foreign.js (psc foreign modules)"
116+ ]
117+printErrorMessage InvalidTopLevel =
118+ [ "Expected a list of source elements at the top level." ]
119+printErrorMessage (UnableToParseModule err) =
120+ [ "The module could not be parsed:"
121+ , err
122+ ]
123+printErrorMessage UnsupportedExport =
124+ [ "An export was unsupported. Exports can be defined in one of two ways: "
125+ , " 1) exports.name = ..."
126+ , " 2) exports = { ... }"
127+ ]
128+printErrorMessage (ErrorInModule mid e) =
129+ ("Error in module " ++ displayIdentifier mid ++ ":")
130+ : ""
131+ : map (" " ++) (printErrorMessage e)
132+ where
133+ displayIdentifier (ModuleIdentifier name ty) =
134+ name ++ " (" ++ showModuleType ty ++ ")"
135+
136+-- | Unpack the node inside a JSNode. This is useful when pattern matching.
137+node :: JSNode -> Node
138+node (NN n) = n
139+node (NT n _ _) = n
140+
141+-- | Calculate the ModuleIdentifier which a require(...) statement imports.
142+checkImportPath :: String -> ModuleIdentifier -> S.Set String -> Maybe ModuleIdentifier
143+checkImportPath "./foreign" m _ =
144+ Just (ModuleIdentifier (moduleName m) Foreign)
145+checkImportPath name _ names
146+ | name `S.member` names = Just (ModuleIdentifier name Regular)
147+checkImportPath _ _ _ = Nothing
148+
149+-- | Compute the dependencies of all elements in a module, and add them to the tree.
150+--
151+-- Members and exports can have dependencies. A dependency is of one of the following forms:
152+--
153+-- 1) module.name or member["name"]
154+--
155+-- where module was imported using
156+--
157+-- var module = require("Module.Name");
158+--
159+-- 2) name
160+--
161+-- where name is the name of a member defined in the current module.
162+withDeps :: Module -> Module
163+withDeps (Module modulePath es) = Module modulePath (map expandDeps es)
164+ where
165+ -- | Collects all modules which are imported, so that we can identify dependencies of the first type.
166+ imports :: [(String, ModuleIdentifier)]
167+ imports = mapMaybe toImport es
168+ where
169+ toImport :: ModuleElement -> Maybe (String, ModuleIdentifier)
170+ toImport (Require _ nm mid) = Just (nm, mid)
171+ toImport _ = Nothing
172+
173+ -- | Collects all member names in scope, so that we can identify dependencies of the second type.
174+ boundNames :: [String]
175+ boundNames = mapMaybe toBoundName es
176+ where
177+ toBoundName :: ModuleElement -> Maybe String
178+ toBoundName (Member _ _ nm _ _) = Just nm
179+ toBoundName _ = Nothing
180+
181+ -- | Calculate dependencies and add them to the current element.
182+ expandDeps :: ModuleElement -> ModuleElement
183+ expandDeps (Member n f nm decl _) = Member n f nm decl (nub (concatMap (dependencies modulePath) decl))
184+ expandDeps (ExportsList exps) = ExportsList (map expand exps)
185+ where
186+ expand (ty, nm, n1, _) = (ty, nm, n1, nub (dependencies modulePath n1))
187+ expandDeps other = other
188+
189+ dependencies :: ModuleIdentifier -> JSNode -> [(ModuleIdentifier, String)]
190+ dependencies m = everything (++) (mkQ [] toReference)
191+ where
192+ toReference :: Node -> [(ModuleIdentifier, String)]
193+ toReference (JSMemberDot [ mn ] _ nm)
194+ | JSIdentifier mn' <- node mn
195+ , JSIdentifier nm' <- node nm
196+ , Just mid <- lookup mn' imports
197+ = [(mid, nm')]
198+ toReference (JSMemberSquare [ mn ] _ nm _)
199+ | JSIdentifier mn' <- node mn
200+ , JSExpression [ s ] <- node nm
201+ , JSStringLiteral _ nm' <- node s
202+ , Just mid <- lookup mn' imports
203+ = [(mid, nm')]
204+ toReference (JSIdentifier nm)
205+ | nm `elem` boundNames
206+ = [(m, nm)]
207+ toReference _ = []
208+
209+-- | Attempt to create a Module from a Javascript AST.
210+--
211+-- Each type of module element is matched using pattern guards, and everything else is bundled into the
212+-- Other constructor.
213+toModule :: forall m. (Applicative m, MonadError ErrorMessage m) => S.Set String -> ModuleIdentifier -> JSNode -> m Module
214+toModule mids mid top
215+ | JSSourceElementsTop ns <- node top = Module mid <$> mapM toModuleElement ns
216+ | otherwise = err InvalidTopLevel
217+ where
218+ err = throwError . ErrorInModule mid
219+
220+ toModuleElement :: JSNode -> m ModuleElement
221+ toModuleElement n
222+ | JSVariables var [ varIntro ] _ <- node n
223+ , JSLiteral "var" <- node var
224+ , JSVarDecl impN [ eq, req, impP ] <- node varIntro
225+ , JSIdentifier importName <- node impN
226+ , JSLiteral "=" <- node eq
227+ , JSIdentifier "require" <- node req
228+ , JSArguments _ [ impS ] _ <- node impP
229+ , JSStringLiteral _ importPath <- node impS
230+ , Just importPath' <- checkImportPath importPath mid mids
231+ = pure (Require n importName importPath')
232+ toModuleElement n
233+ | JSVariables var [ varIntro ] _ <- node n
234+ , JSLiteral "var" <- node var
235+ , JSVarDecl declN (eq : decl) <- node varIntro
236+ , JSIdentifier name <- node declN
237+ , JSLiteral "=" <- node eq
238+ = pure (Member n False name decl [])
239+ toModuleElement n
240+ | JSExpression (e : op : decl) <- node n
241+ , Just name <- accessor (node e)
242+ , JSOperator eq <- node op
243+ , JSLiteral "=" <- node eq
244+ = pure (Member n True name decl [])
245+ where
246+ accessor :: Node -> Maybe String
247+ accessor (JSMemberDot [ exports ] _ nm)
248+ | JSIdentifier "exports" <- node exports
249+ , JSIdentifier name <- node nm
250+ = Just name
251+ accessor (JSMemberSquare [ exports ] _ nm _)
252+ | JSIdentifier "exports" <- node exports
253+ , JSExpression [e] <- node nm
254+ , JSStringLiteral _ name <- node e
255+ = Just name
256+ accessor _ = Nothing
257+ toModuleElement n
258+ | JSExpression (mnExp : op : obj: _) <- node n
259+ , JSMemberDot [ mn ] _ e <- node mnExp
260+ , JSIdentifier "module" <- node mn
261+ , JSIdentifier "exports" <- node e
262+ , JSOperator eq <- node op
263+ , JSLiteral "=" <- node eq
264+ , JSObjectLiteral _ props _ <- node obj
265+ = ExportsList <$> mapM toExport (filter (not . isSeparator) (map node props))
266+ where
267+ toExport :: Node -> m (ExportType, String, JSNode, [Key])
268+ toExport (JSPropertyNameandValue name _ [val] ) =
269+ (,,val,[]) <$> exportType (node val)
270+ <*> extractLabel (node name)
271+ toExport _ = err UnsupportedExport
272+
273+ exportType :: Node -> m ExportType
274+ exportType (JSMemberDot [f] _ _)
275+ | JSIdentifier "$foreign" <- node f
276+ = pure ForeignReexport
277+ exportType (JSMemberSquare [f] _ _ _)
278+ | JSIdentifier "$foreign" <- node f
279+ = pure ForeignReexport
280+ exportType (JSIdentifier s) = pure (RegularExport s)
281+ exportType _ = err UnsupportedExport
282+
283+ extractLabel :: Node -> m String
284+ extractLabel (JSStringLiteral _ nm) = pure nm
285+ extractLabel (JSIdentifier nm) = pure nm
286+ extractLabel _ = err UnsupportedExport
287+
288+ isSeparator :: Node -> Bool
289+ isSeparator (JSLiteral ",") = True
290+ isSeparator _ = False
291+ toModuleElement other = pure (Other other)
292+
293+-- | Eliminate unused code based on the specified entry point set.
294+compile :: [Module] -> [ModuleIdentifier] -> [Module]
295+compile modules [] = modules
296+compile modules entryPoints = filteredModules
297+ where
298+ (graph, _, vertexFor) = graphFromEdges verts
299+
300+ -- | The vertex set
301+ verts :: [(ModuleElement, Key, [Key])]
302+ verts = do
303+ Module mid els <- modules
304+ concatMap (toVertices mid) els
305+ where
306+ -- | Create a set of vertices for a module element.
307+ --
308+ -- Some special cases worth commenting on:
309+ --
310+ -- 1) Regular exports which simply export their own name do not count as dependencies.
311+ -- Regular exports which rename and reexport an operator do count, however.
312+ --
313+ -- 2) Require statements don't contribute towards dependencies, since they effectively get
314+ -- inlined wherever they are used inside other module elements.
315+ toVertices :: ModuleIdentifier -> ModuleElement -> [(ModuleElement, Key, [Key])]
316+ toVertices p m@(Member _ _ nm _ deps) = [(m, (p, nm), deps)]
317+ toVertices p m@(ExportsList exps) = mapMaybe toVertex exps
318+ where
319+ toVertex (ForeignReexport, nm, _, ks) = Just (m, (p, nm), ks)
320+ toVertex (RegularExport nm, nm1, _, ks) | nm /= nm1 = Just (m, (p, nm1), ks)
321+ toVertex _ = Nothing
322+ toVertices _ _ = []
323+
324+ -- | The set of vertices whose connected components we are interested in keeping.
325+ entryPointVertices :: [Vertex]
326+ entryPointVertices = catMaybes $ do
327+ (_, k@(mid, _), _) <- verts
328+ guard $ mid `elem` entryPoints
329+ return (vertexFor k)
330+
331+ -- | The set of vertices reachable from an entry point
332+ reachableSet :: S.Set Vertex
333+ reachableSet = S.fromList (concatMap (reachable graph) entryPointVertices)
334+
335+ filteredModules :: [Module]
336+ filteredModules = map filterUsed modules
337+ where
338+ filterUsed :: Module -> Module
339+ filterUsed (Module mid ds) = Module mid (map filterExports (go ds))
340+ where
341+ go :: [ModuleElement] -> [ModuleElement]
342+ go [] = []
343+ go (d : Other semi : rest)
344+ | JSLiteral ";" <- node semi
345+ , not (isDeclUsed d)
346+ = go rest
347+ go (d : rest)
348+ | not (isDeclUsed d) = go rest
349+ | otherwise = d : go rest
350+
351+ -- | Filter out the exports for members which aren't used.
352+ filterExports :: ModuleElement -> ModuleElement
353+ filterExports (ExportsList exps) = ExportsList (filter (\(_, nm, _, _) -> isKeyUsed (mid, nm)) exps)
354+ filterExports me = me
355+
356+ isDeclUsed :: ModuleElement -> Bool
357+ isDeclUsed (Member _ _ nm _ _) = isKeyUsed (mid, nm)
358+ isDeclUsed _ = True
359+
360+ isKeyUsed :: Key -> Bool
361+ isKeyUsed k
362+ | Just me <- vertexFor k = me `S.member` reachableSet
363+ | otherwise = False
364+
365+-- | Topologically sort the module dependency graph, so that when we generate code, modules can be
366+-- defined in the right order.
367+sortModules :: [Module] -> [Module]
368+sortModules modules = map (\v -> case nodeFor v of (n, _, _) -> n) (reverse (topSort graph))
369+ where
370+ (graph, nodeFor, _) = graphFromEdges $ do
371+ m@(Module mid els) <- modules
372+ return (m, mid, mapMaybe getKey els)
373+
374+ getKey :: ModuleElement -> Maybe ModuleIdentifier
375+ getKey (Require _ _ mi) = Just mi
376+ getKey _ = Nothing
377+
378+-- | A module is empty if it contains no exported members (in other words,
379+-- if the only things left after dead code elimination are module imports and
380+-- "other" foreign code).
381+--
382+-- If a module is empty, we don't want to generate code for it.
383+isModuleEmpty :: Module -> Bool
384+isModuleEmpty (Module _ els) = all isElementEmpty els
385+ where
386+ isElementEmpty :: ModuleElement -> Bool
387+ isElementEmpty (ExportsList exps) = null exps
388+ isElementEmpty (Require _ _ _) = True
389+ isElementEmpty (Other _) = True
390+ isElementEmpty _ = False
391+
392+-- | Generate code for a set of modules, including a call to main().
393+--
394+-- Modules get defined on the global PS object, as follows:
395+--
396+-- var PS = { };
397+-- (function(exports) {
398+-- ...
399+-- })(PS["Module.Name"] = PS["Module.Name"] || {});
400+--
401+-- In particular, a module and its foreign imports share the same namespace inside PS.
402+-- This saves us from having to generate unique names for a module and its foreign imports,
403+-- and is safe since a module shares a namespace with its foreign imports in PureScript as well
404+-- (so there is no way to have overlaps in code generated by psc).
405+codeGen :: Maybe String -- ^ main module
406+ -> String -- ^ namespace
407+ -> [Module] -- ^ input modules
408+ -> String
409+codeGen optionsMainModule optionsNamespace ms = renderToString (NN (JSSourceElementsTop (prelude ++ concatMap moduleToJS ms ++ maybe [] runMain optionsMainModule)))
410+ where
411+ moduleToJS :: Module -> [JSNode]
412+ moduleToJS (Module mn ds) = wrap (moduleName mn) (indent (concatMap declToJS ds))
413+ where
414+ declToJS :: ModuleElement -> [JSNode]
415+ declToJS (Member n _ _ _ _) = [n]
416+ declToJS (Other n) = [n]
417+ declToJS (Require _ nm req) =
418+ [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n " ])
419+ [ NN (JSVarDecl (sp (JSIdentifier nm))
420+ [ sp (JSLiteral "=")
421+ , moduleReference sp (moduleName req)
422+ ])
423+ ]
424+ (nt (JSLiteral ";"))) ]
425+ declToJS (ExportsList exps) = map toExport exps
426+
427+ where
428+ toExport :: (ExportType, String, JSNode, [Key]) -> JSNode
429+ toExport (_, nm, val, _) =
430+ NN (JSExpression [ NN (JSMemberSquare [ NT (JSIdentifier "exports") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n " ] ]
431+ (nt (JSLiteral "["))
432+ (NN (JSExpression [ nt (JSStringLiteral '"' nm) ]))
433+ (nt (JSLiteral "]")))
434+ , NN (JSOperator (sp (JSLiteral "=")))
435+ , reindent val
436+ , nt (JSLiteral ";")
437+ ])
438+
439+ reindent :: JSNode -> JSNode
440+ reindent (NT n _ _) = sp n
441+ reindent nn = nn
442+
443+ indent :: [JSNode] -> [JSNode]
444+ indent = everywhere (mkT squash)
445+ where
446+ squash (NT n pos ann) = NT n (keepCol pos) (map splat ann)
447+ squash nn = nn
448+
449+ splat (CommentA pos s) = CommentA (keepCol pos) s
450+ splat (WhiteSpace pos w) = WhiteSpace (keepCol pos) w
451+ splat ann = ann
452+
453+ keepCol (TokenPn _ _ c) = TokenPn 0 0 (c + 2)
454+
455+ prelude :: [JSNode]
456+ prelude =
457+ [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ CommentA tokenPosnEmpty ("// Generated by psc-bundle " ++ showVersion Paths.version)
458+ , WhiteSpace tokenPosnEmpty "\n"
459+ ])
460+ [ NN (JSVarDecl (sp (JSIdentifier optionsNamespace))
461+ [ sp (JSLiteral "=")
462+ , NN (JSObjectLiteral (sp (JSLiteral "{"))
463+ []
464+ (sp (JSLiteral "}")))
465+ ])
466+ ]
467+ (nt (JSLiteral ";")))
468+ , lf
469+ ]
470+
471+ moduleReference :: (Node -> JSNode) -> String -> JSNode
472+ moduleReference f mn =
473+ NN (JSMemberSquare [ f (JSIdentifier optionsNamespace) ]
474+ (nt (JSLiteral "["))
475+ (NN (JSExpression [ nt (JSStringLiteral '"' mn) ]))
476+ (nt (JSLiteral "]")))
477+
478+ wrap :: String -> [JSNode] -> [JSNode]
479+ wrap mn ds =
480+ [ NN (JSExpression [ NN (JSExpressionParen (nt (JSLiteral "("))
481+ (NN (JSExpression [ NN (JSFunctionExpression (nt (JSLiteral "function"))
482+ []
483+ (nt (JSLiteral "(") ) [nt (JSIdentifier "exports")] (nt (JSLiteral ")"))
484+ (NN (JSBlock [sp (JSLiteral "{")]
485+ (lf : ds)
486+ [nl (JSLiteral "}")])))]))
487+ (nt (JSLiteral ")")))
488+ , NN (JSArguments (nt (JSLiteral "("))
489+ [ NN (JSExpression [ moduleReference nt mn
490+ , NN (JSOperator (sp (JSLiteral "=")))
491+ , NN (JSExpressionBinary "||"
492+ [ moduleReference sp mn ]
493+ (sp (JSLiteral "||"))
494+ [ emptyObj ])
495+ ])
496+ ]
497+ (nt (JSLiteral ")")))
498+ ])
499+ , nt (JSLiteral ";")
500+ , lf
501+ ]
502+ where
503+ emptyObj = NN (JSObjectLiteral (sp (JSLiteral "{")) [] (nt (JSLiteral "}")))
504+
505+ runMain :: String -> [JSNode]
506+ runMain mn =
507+ [ NN (JSExpression [ NN (JSMemberDot [ NN (JSMemberSquare [ nl (JSIdentifier optionsNamespace) ]
508+ (nt (JSLiteral "["))
509+ (NN (JSExpression [ nt (JSStringLiteral '"' mn) ]))
510+ (nt (JSLiteral "]")))
511+ ]
512+ (nt (JSLiteral "."))
513+ (nt (JSIdentifier "main")))
514+ , NN (JSArguments (nt (JSLiteral "(")) [] (nt (JSLiteral ")")))
515+ ])
516+ , nt (JSLiteral ";")
517+ ]
518+
519+ nt :: Node -> JSNode
520+ nt n = NT n tokenPosnEmpty []
521+
522+ lf :: JSNode
523+ lf = NT (JSLiteral "") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]
524+
525+ sp :: Node -> JSNode
526+ sp n = NT n tokenPosnEmpty [ WhiteSpace tokenPosnEmpty " " ]
527+
528+ nl :: Node -> JSNode
529+ nl n = NT n tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]
530+
531+-- | The bundling function.
532+-- This function performs dead code elimination, filters empty modules
533+-- and generates and prints the final Javascript bundle.
534+bundle :: forall m. (Applicative m, MonadError ErrorMessage m)
535+ => [(ModuleIdentifier, String)] -- ^ The input modules. Each module should be javascript rendered from 'Language.PureScript.Make' or @psc@.
536+ -> [ModuleIdentifier] -- ^ Entry points. These module identifiers are used as the roots for dead-code elimination
537+ -> Maybe String -- ^ An optional main module.
538+ -> String -- ^ The namespace (e.g. PS).
539+ -> m String
540+bundle inputStrs entryPoints mainModule namespace = do
541+ input <- forM inputStrs $ \(ident, js) -> do
542+ ast <- either (throwError . ErrorInModule ident . UnableToParseModule) pure $ parse js (moduleName ident)
543+ return (ident, ast)
544+
545+ let mids = S.fromList (map (moduleName . fst) input)
546+
547+ modules <- mapM (fmap withDeps . uncurry (toModule mids)) input
548+
549+ let compiled = compile modules entryPoints
550+ sorted = sortModules (filter (not . isModuleEmpty) compiled)
551+
552+ return (codeGen mainModule namespace sorted)
src/Language/PureScript/CodeGen.hs−5
@@ -13,13 +13,8 @@
13--
13--
14-- [@Language.PureScript.CodeGen.JS@] Code generator for Javascript
14-- [@Language.PureScript.CodeGen.JS@] Code generator for Javascript
15--
15--
16−-- [@Language.PureScript.CodeGen.Externs@] Code generator for extern (foreign import) files
17−--
18−-- [@Language.PureScript.CodeGen.Optimize@] Optimization passes for generated Javascript
19−--
20-----------------------------------------------------------------------------
16-----------------------------------------------------------------------------
21
17
22module Language.PureScript.CodeGen (module C) where
18module Language.PureScript.CodeGen (module C) where
23
19
24import Language.PureScript.CodeGen.JS as C
20import Language.PureScript.CodeGen.JS as C
25−import Language.PureScript.CodeGen.Externs as C
src/Language/PureScript/CodeGen/Externs.hsdeleted−100
@@ -1,100 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.CodeGen.Externs
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−-- This module generates code for \"externs\" files, i.e. files containing only foreign import declarations.
13−--
14−-----------------------------------------------------------------------------
15−
16−module Language.PureScript.CodeGen.Externs (
17− moduleToPs
18−) where
19−
20−import Data.Maybe (fromMaybe, mapMaybe)
21−import Data.List (intercalate, find)
22−
23−import qualified Data.Map as M
24−
25−import Control.Monad.Writer
26−
27−import Language.PureScript.CodeGen.Common
28−import Language.PureScript.TypeClassDictionaries
29−import Language.PureScript.Declarations
30−import Language.PureScript.Pretty
31−import Language.PureScript.Names
32−import Language.PureScript.Environment
33−
34−-- |
35−-- Generate foreign imports for all declarations in a module
36−--
37−moduleToPs :: Module -> Environment -> String
38−moduleToPs (Module _ _ Nothing) _ = error "Module exports were not elaborated in moduleToPs"
39−moduleToPs (Module moduleName ds (Just exts)) env = intercalate "\n" . execWriter $ do
40− tell [ "module " ++ runModuleName moduleName ++ " where"]
41− mapM_ declToPs ds
42− mapM_ exportToPs exts
43− where
44−
45− declToPs :: Declaration -> Writer [String] ()
46− declToPs (ImportDeclaration mn _ _) = tell ["import " ++ show mn ++ " ()"]
47− declToPs (FixityDeclaration (Fixity assoc prec) ident) =
48− tell [ unwords [ show assoc, show prec, ident ] ]
49− declToPs (PositionedDeclaration _ d) = declToPs d
50− declToPs _ = return ()
51−
52− exportToPs :: DeclarationRef -> Writer [String] ()
53− exportToPs (PositionedDeclarationRef _ r) = exportToPs r
54− exportToPs (TypeRef pn dctors) = do
55− case Qualified (Just moduleName) pn `M.lookup` types env of
56− Nothing -> error $ show pn ++ " has no kind in exportToPs"
57− Just (kind, ExternData) ->
58− tell ["foreign import data " ++ show pn ++ " :: " ++ prettyPrintKind kind]
59− Just (_, DataType args tys) -> do
60− let dctors' = fromMaybe (map fst tys) dctors
61− printDctor dctor = case dctor `lookup` tys of
62− Nothing -> Nothing
63− Just tyArgs -> Just $ show dctor ++ " " ++ unwords (map prettyPrintTypeAtom tyArgs)
64− let dtype = if length dctors' == 1 && isNewtypeConstructor env (Qualified (Just moduleName) $ head dctors')
65− then "newtype"
66− else "data"
67− tell [dtype ++ " " ++ show pn ++ " " ++ unwords args ++ (if null dctors' then "" else " = " ++ intercalate " | " (mapMaybe printDctor dctors'))]
68− Just (_, TypeSynonym) ->
69− case Qualified (Just moduleName) pn `M.lookup` typeSynonyms env of
70− Nothing -> error $ show pn ++ " has no type synonym info in exportToPs"
71− Just (args, synTy) ->
72− tell ["type " ++ show pn ++ " " ++ unwords args ++ " = " ++ prettyPrintType synTy]
73− _ -> error "Invalid input in exportToPs"
74−
75− exportToPs (ValueRef ident) =
76− case (moduleName, ident) `M.lookup` names env of
77− Nothing -> error $ show ident ++ " has no type in exportToPs"
78− Just (ty, nameKind, _) | nameKind == Value || nameKind == Extern ForeignImport || nameKind == Extern InlineJavascript ->
79− tell ["foreign import " ++ show ident ++ " :: " ++ prettyPrintType ty]
80− _ -> return ()
81− exportToPs (TypeClassRef className) =
82− case Qualified (Just moduleName) className `M.lookup` typeClasses env of
83− Nothing -> error $ show className ++ " has no type class definition in exportToPs"
84− Just (args, members, implies) -> do
85− let impliesString = if null implies then "" else "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map prettyPrintTypeAtom tys')) implies) ++ ") <= "
86− tell ["class " ++ impliesString ++ show className ++ " " ++ unwords args ++ " where"]
87− forM_ (filter (isValueExported . fst) members) $ \(member ,ty) ->
88− tell [ " " ++ show member ++ " :: " ++ prettyPrintType ty ]
89−
90− exportToPs (TypeInstanceRef ident) = do
91− let TypeClassDictionaryInScope { tcdClassName = className, tcdInstanceTypes = tys, tcdDependencies = deps} =
92− fromMaybe (error $ "Type class instance has no dictionary in exportToPs") . find ((== Qualified (Just moduleName) ident) . tcdName) $ M.elems $ typeClassDictionaries env
93− let constraintsText = case fromMaybe [] deps of
94− [] -> ""
95− cs -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map prettyPrintTypeAtom tys')) cs) ++ ") => "
96− tell ["foreign import instance " ++ show ident ++ " :: " ++ constraintsText ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys)]
97−
98− isValueExported :: Ident -> Bool
99− isValueExported ident = ValueRef ident `elem` exts
100−
src/Language/PureScript/CodeGen/JS.hs+315−361
@@ -13,396 +13,350 @@
13--
13--
14-----------------------------------------------------------------------------
14-----------------------------------------------------------------------------
15
15
16−{-# LANGUAGE DoAndIfThenElse #-}
16+{-# LANGUAGE GADTs #-}
17+{-# LANGUAGE ViewPatterns #-}
18+{-# LANGUAGE FlexibleContexts #-}
19+{-# LANGUAGE ScopedTypeVariables #-}
20+{-# LANGUAGE CPP #-}
17
21
18−module Language.PureScript.CodeGen.JS (
22+module Language.PureScript.CodeGen.JS
19− module AST,
23+ ( module AST
20− ModuleType(..),
24+ , module Common
21− declToJs,
22− moduleToJs,
25+ , moduleToJs
23− identNeedsEscaping
26+ , mainCall
24−) where
27+ ) where
25
28
26−import Data.Maybe (catMaybes, fromJust)
29+import Data.List ((\\), delete, intersect)
27−import Data.Function (on)
30+import qualified Data.Traversable as T (traverse)
28−import Data.List (nub, (\\), delete, sortBy)
29
31
30−import Control.Monad (replicateM, forM)
32+#if __GLASGOW_HASKELL__ < 710
31import Control.Applicative
33import Control.Applicative
34+#endif
35+import Control.Arrow ((&&&))
36+import Control.Monad (replicateM, forM)
37+import Control.Monad.Reader (MonadReader, asks)
38+import Control.Monad.Supply.Class
32
39
40+import Language.PureScript.AST.SourcePos
41+import Language.PureScript.CodeGen.JS.AST as AST
42+import Language.PureScript.CodeGen.JS.Common as Common
43+import Language.PureScript.CoreFn
33import Language.PureScript.Names
44import Language.PureScript.Names
34−import Language.PureScript.Declarations
45+import Language.PureScript.CodeGen.JS.Optimizer
35import Language.PureScript.Options
46import Language.PureScript.Options
36−import Language.PureScript.CodeGen.JS.AST as AST
37−import Language.PureScript.Types
38−import Language.PureScript.Optimizer
39−import Language.PureScript.CodeGen.Common
40−import Language.PureScript.Environment
41−import Language.PureScript.Supply
42import Language.PureScript.Traversals (sndM)
47import Language.PureScript.Traversals (sndM)
43import qualified Language.PureScript.Constants as C
48import qualified Language.PureScript.Constants as C
44
49
45−-- |
50+import System.FilePath.Posix ((</>))
46−-- Different types of modules which are supported
47−--
48−data ModuleType = CommonJS | Globals
49
51
50-- |
52-- |
51-- Generate code in the simplified Javascript intermediate representation for all declarations in a
53-- Generate code in the simplified Javascript intermediate representation for all declarations in a
52-- module.
54-- module.
53--
55--
54−moduleToJs :: (Functor m, Applicative m, Monad m) => ModuleType -> Options -> Module -> Environment -> SupplyT m [JS]
56+moduleToJs :: forall m. (Applicative m, Monad m, MonadReader Options m, MonadSupply m)
57+ => Module Ann -> Maybe JS -> m [JS]
55−moduleToJs mt opts (Module name decls (Just exps)) env = do
58+moduleToJs (Module coms mn imps exps foreigns decls) foreign_ = do
56− let jsImports = map (importToJs mt opts) . delete (ModuleName [ProperName C.prim]) . (\\ [name]) . nub $ concatMap imports decls
59+ jsImports <- T.traverse importToJs . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ imps
57− jsDecls <- mapM (\decl -> declToJs opts name decl env) decls
60+ jsDecls <- mapM bindToJs decls
58− let optimized = concat $ map (map $ optimize opts) $ catMaybes jsDecls
61+ optimized <- T.traverse (T.traverse optimize) jsDecls
59− let isModuleEmpty = null optimized
62+ comments <- not <$> asks optionsNoComments
60− let moduleBody = JSStringLiteral "use strict" : jsImports ++ optimized
63+ let strict = JSStringLiteral "use strict"
61− let moduleExports = JSObjectLiteral $ concatMap exportToJs exps
64+ let header = if comments && not (null coms) then JSComment coms strict else strict
62− return $ case mt of
65+ let foreign' = [JSVariableIntroduction "$foreign" foreign_ | not $ null foreigns || foreign_ == Nothing]
66+ let moduleBody = header : foreign' ++ jsImports ++ concat optimized
67+ let foreignExps = exps `intersect` (fst `map` foreigns)
68+ let standardExps = exps \\ foreignExps
69+ let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) standardExps
70+ ++ map (runIdent &&& foreignIdent) foreignExps
63− CommonJS -> moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) moduleExports]
71+ return $ moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) exps']
64− Globals | not isModuleEmpty ->
65− [ JSVariableIntroduction (fromJust (optionsBrowserNamespace opts))
66− (Just (JSBinary Or (JSVar (fromJust (optionsBrowserNamespace opts))) (JSObjectLiteral [])) )
67− , JSAssignment (JSAccessor (moduleNameToJs name) (JSVar (fromJust (optionsBrowserNamespace opts))))
68− (JSApp (JSFunction Nothing [] (JSBlock (moduleBody ++ [JSReturn moduleExports]))) [])
69− ]
70− _ -> []
71−moduleToJs _ _ _ _ = error "Exports should have been elaborated in name desugaring"
72
72
73−importToJs :: ModuleType -> Options -> ModuleName -> JS
74−importToJs mt opts mn = JSVariableIntroduction (moduleNameToJs mn) (Just moduleBody)
75 where
73 where
76− moduleBody = case mt of
77− CommonJS -> JSApp (JSVar "require") [JSStringLiteral (runModuleName mn)]
78− Globals -> JSAccessor (moduleNameToJs mn) (JSVar (fromJust (optionsBrowserNamespace opts)))
79
74
80−imports :: Declaration -> [ModuleName]
75+ -- |
81−imports (ImportDeclaration mn _ _) = [mn]
76+ -- Generates Javascript code for a module import.
82−imports other =
77+ --
83− let (f, _, _, _, _) = everythingOnValues (++) (const []) collectV collectB (const []) (const [])
78+ importToJs :: ModuleName -> m JS
84− in f other
79+ importToJs mn' = do
85− where
80+ path <- asks optionsRequirePath
86− collectV :: Expr -> [ModuleName]
81+ let moduleBody = JSApp (JSVar "require") [JSStringLiteral (maybe id (</>) path $ runModuleName mn')]
87− collectV (Var (Qualified (Just mn) _)) = [mn]
82+ return $ JSVariableIntroduction (moduleNameToJs mn') (Just moduleBody)
88− collectV (Constructor (Qualified (Just mn) _)) = [mn]
89− collectV (TypeClassDictionaryConstructorApp (Qualified (Just mn) _) _) = [mn]
90− collectV _ = []
91− collectB :: Binder -> [ModuleName]
92− collectB (ConstructorBinder (Qualified (Just mn) _) _) = [mn]
93− collectB _ = []
94
83
95−-- |
84+ -- |
96−-- Generate code in the simplified Javascript intermediate representation for a declaration
85+ -- Generate code in the simplified Javascript intermediate representation for a declaration
97−--
86+ --
98−declToJs :: (Functor m, Applicative m, Monad m) => Options -> ModuleName -> Declaration -> Environment -> SupplyT m (Maybe [JS])
87+ bindToJs :: Bind Ann -> m [JS]
99−declToJs opts mp (ValueDeclaration ident _ _ _ val) e = do
88+ bindToJs (NonRec ident val) = return <$> nonRecToJS ident val
100− js <- valueToJs opts mp e val
89+ bindToJs (Rec vals) = forM vals (uncurry nonRecToJS)
101− return $ Just [JSVariableIntroduction (identToJs ident) (Just js)]
90+
102−declToJs opts mp (BindingGroupDeclaration vals) e = do
91+ -- |
103− jss <- flip mapM vals $ \(ident, _, val) -> do
92+ -- Generate code in the simplified Javascript intermediate representation for a single non-recursive
93+ -- declaration.
94+ --
95+ -- The main purpose of this function is to handle code generation for comments.
96+ --
97+ nonRecToJS :: Ident -> Expr Ann -> m JS
98+ nonRecToJS i e@(extractAnn -> (_, com, _, _)) | not (null com) = do
99+ withoutComment <- asks optionsNoComments
100+ if withoutComment
101+ then nonRecToJS i (modifyAnn removeComments e)
102+ else JSComment com <$> nonRecToJS i (modifyAnn removeComments e)
103+ nonRecToJS ident val = do
104− js <- valueToJs opts mp e val
104+ js <- valueToJs val
105 return $ JSVariableIntroduction (identToJs ident) (Just js)
105 return $ JSVariableIntroduction (identToJs ident) (Just js)
106− return $ Just jss
107−declToJs _ _ (DataDeclaration Newtype _ _ [((ProperName ctor), _)]) _ =
108− return $ Just $ [JSVariableIntroduction ctor (Just $
109− JSObjectLiteral [("create",
110− JSFunction Nothing ["value"]
111− (JSBlock [JSReturn $ JSVar "value"]))])]
112−declToJs _ _ (DataDeclaration Newtype _ _ _) _ =
113− error "newtype has multiple constructors"
114−declToJs _ mp (DataDeclaration Data _ _ ctors) e = do
115− return $ Just $ flip concatMap ctors $ \(pn@(ProperName ctor), tys) ->
116− let propName = if isNullaryConstructor e (Qualified (Just mp) pn) then "value" else "create"
117− in [ makeConstructor ctor (length tys)
118− , JSAssignment (JSAccessor propName (JSVar ctor)) (go pn 0 (length tys) [])
119− ]
120− where
121− makeConstructor :: String -> Int -> JS
122− makeConstructor ctorName n =
123− let
124− args = [ "value" ++ show index | index <- [0..n-1] ]
125− body = [ JSAssignment (JSAccessor arg (JSVar "this")) (JSVar arg) | arg <- args ]
126− in JSFunction (Just ctorName) args (JSBlock body)
127− go :: ProperName -> Int -> Int -> [JS] -> JS
128− go pn _ 0 values = JSUnary JSNew $ JSApp (JSVar $ runProperName pn) (reverse values)
129− go pn index n values =
130− JSFunction Nothing ["value" ++ show index]
131− (JSBlock [JSReturn (go pn (index + 1) (n - 1) (JSVar ("value" ++ show index) : values))])
132−declToJs opts mp (DataBindingGroupDeclaration ds) e = do
133− jss <- mapM (\decl -> declToJs opts mp decl e) ds
134− return $ Just $ concat $ catMaybes jss
135−declToJs _ _ (TypeClassDeclaration name _ supers members) _ =
136− return $ Just $ [
137− JSFunction (Just $ runProperName name) (identToJs `map` args)
138− (JSBlock $ assn `map` args)]
139− where
140− assn :: Ident -> JS
141− assn arg = JSAssignment (accessor arg (JSVar "this")) (var arg)
142− args :: [Ident]
143− args = sortBy (compare `on` runIdent) $ memberNames ++ superNames
144− memberNames :: [Ident]
145− memberNames = memberToName `map` members
146− superNames :: [Ident]
147− superNames = [ toSuperName superclass index
148− | (index, (superclass, _)) <- zip [0..] supers
149− ]
150− toSuperName :: Qualified ProperName -> Integer -> Ident
151− toSuperName pn index = Ident $ C.__superclass_ ++ show pn ++ "_" ++ show index
152− memberToName :: Declaration -> Ident
153− memberToName (TypeDeclaration ident _) = ident
154− memberToName (PositionedDeclaration _ d) = memberToName d
155− memberToName _ = error "Invalid declaration in type class definition"
156−declToJs _ _ (ExternDeclaration _ _ (Just js) _) _ = return $ Just [js]
157−declToJs opts mp (PositionedDeclaration _ d) e = declToJs opts mp d e
158−declToJs _ _ _ _ = return Nothing
159
106
160−-- |
107+ -- |
161−-- Generate key//value pairs for an object literal exporting values from a module.
108+ -- Generate code in the simplified Javascript intermediate representation for a variable based on a
109+ -- PureScript identifier.
162−--
110+ --
163−exportToJs :: DeclarationRef -> [(String, JS)]
111+ var :: Ident -> JS
164−exportToJs (TypeRef _ (Just dctors)) = map ((\n -> (n, var (Ident n))) . runProperName) dctors
112+ var = JSVar . identToJs
165−exportToJs (ValueRef name) = [(runIdent name, var name)]
166−exportToJs (TypeInstanceRef name) = [(runIdent name, var name)]
167−exportToJs (TypeClassRef name) = [(runProperName name, var $ Ident $ runProperName name)]
168−exportToJs _ = []
169
113
170−-- |
114+ -- |
171−-- Generate code in the simplified Javascript intermediate representation for a variable based on a
115+ -- Generate code in the simplified Javascript intermediate representation for an accessor based on
172−-- PureScript identifier.
116+ -- a PureScript identifier. If the name is not valid in Javascript (symbol based, reserved name) an
173−--
117+ -- indexer is returned.
118+ --
174−var :: Ident -> JS
119+ accessor :: Ident -> JS -> JS
175−var = JSVar . identToJs
120+ accessor (Ident prop) = accessorString prop
121+ accessor (Op op) = JSIndexer (JSStringLiteral op)
176
122
177−-- |
123+ accessorString :: String -> JS -> JS
178−-- Generate code in the simplified Javascript intermediate representation for an accessor based on
179−-- a PureScript identifier. If the name is not valid in Javascript (symbol based, reserved name) an
180−-- indexer is returned.
181−--
182−accessor :: Ident -> JS -> JS
183−accessor (Ident prop) = accessorString prop
184−accessor (Op op) = JSIndexer (JSStringLiteral op)
124+ accessorString prop | identNeedsEscaping prop = JSIndexer (JSStringLiteral prop)
125+ | otherwise = JSAccessor prop
185
126
186−accessorString :: String -> JS -> JS
127+ -- |
187−accessorString prop | identNeedsEscaping prop = JSIndexer (JSStringLiteral prop)
128+ -- Generate code in the simplified Javascript intermediate representation for a value or expression.
188− | otherwise = JSAccessor prop
129+ --
130+ valueToJs :: Expr Ann -> m JS
131+ valueToJs (Literal _ l) =
132+ literalToValueJS l
133+ valueToJs (Var (_, _, _, Just (IsConstructor _ [])) name) =
134+ return $ JSAccessor "value" $ qualifiedToJS id name
135+ valueToJs (Var (_, _, _, Just (IsConstructor _ _)) name) =
136+ return $ JSAccessor "create" $ qualifiedToJS id name
137+ valueToJs (Accessor _ prop val) =
138+ accessorString prop <$> valueToJs val
139+ valueToJs (ObjectUpdate _ o ps) = do
140+ obj <- valueToJs o
141+ sts <- mapM (sndM valueToJs) ps
142+ extendObj obj sts
143+ valueToJs e@(Abs (_, _, _, Just IsTypeClassConstructor) _ _) =
144+ let args = unAbs e
145+ in return $ JSFunction Nothing (map identToJs args) (JSBlock $ map assign args)
146+ where
147+ unAbs :: Expr Ann -> [Ident]
148+ unAbs (Abs _ arg val) = arg : unAbs val
149+ unAbs _ = []
150+ assign :: Ident -> JS
151+ assign name = JSAssignment (accessorString (runIdent name) (JSVar "this"))
152+ (var name)
153+ valueToJs (Abs _ arg val) = do
154+ ret <- valueToJs val
155+ return $ JSFunction Nothing [identToJs arg] (JSBlock [JSReturn ret])
156+ valueToJs e@App{} = do
157+ let (f, args) = unApp e []
158+ args' <- mapM valueToJs args
159+ case f of
160+ Var (_, _, _, Just IsNewtype) _ -> return (head args')
161+ Var (_, _, _, Just (IsConstructor _ fields)) name | length args == length fields ->
162+ return $ JSUnary JSNew $ JSApp (qualifiedToJS id name) args'
163+ Var (_, _, _, Just IsTypeClassConstructor) name ->
164+ return $ JSUnary JSNew $ JSApp (qualifiedToJS id name) args'
165+ _ -> flip (foldl (\fn a -> JSApp fn [a])) args' <$> valueToJs f
166+ where
167+ unApp :: Expr Ann -> [Expr Ann] -> (Expr Ann, [Expr Ann])
168+ unApp (App _ val arg) args = unApp val (arg : args)
169+ unApp other args = (other, args)
170+ valueToJs (Var (_, _, _, Just IsForeign) qi@(Qualified (Just mn') ident)) =
171+ return $ if mn' == mn
172+ then foreignIdent ident
173+ else varToJs qi
174+ valueToJs (Var (_, _, _, Just IsForeign) ident) =
175+ error $ "Encountered an unqualified reference to a foreign ident " ++ showQualified showIdent ident
176+ valueToJs (Var _ ident) =
177+ return $ varToJs ident
178+ valueToJs (Case (maybeSpan, _, _, _) values binders) = do
179+ vals <- mapM valueToJs values
180+ bindersToJs maybeSpan binders vals
181+ valueToJs (Let _ ds val) = do
182+ ds' <- concat <$> mapM bindToJs ds
183+ ret <- valueToJs val
184+ return $ JSApp (JSFunction Nothing [] (JSBlock (ds' ++ [JSReturn ret]))) []
185+ valueToJs (Constructor (_, _, _, Just IsNewtype) _ (ProperName ctor) _) =
186+ return $ JSVariableIntroduction ctor (Just $
187+ JSObjectLiteral [("create",
188+ JSFunction Nothing ["value"]
189+ (JSBlock [JSReturn $ JSVar "value"]))])
190+ valueToJs (Constructor _ _ (ProperName ctor) []) =
191+ return $ iife ctor [ JSFunction (Just ctor) [] (JSBlock [])
192+ , JSAssignment (JSAccessor "value" (JSVar ctor))
193+ (JSUnary JSNew $ JSApp (JSVar ctor) []) ]
194+ valueToJs (Constructor _ _ (ProperName ctor) fields) =
195+ let constructor =
196+ let body = [ JSAssignment (JSAccessor (identToJs f) (JSVar "this")) (var f) | f <- fields ]
197+ in JSFunction (Just ctor) (identToJs `map` fields) (JSBlock body)
198+ createFn =
199+ let body = JSUnary JSNew $ JSApp (JSVar ctor) (var `map` fields)
200+ in foldr (\f inner -> JSFunction Nothing [identToJs f] (JSBlock [JSReturn inner])) body fields
201+ in return $ iife ctor [ constructor
202+ , JSAssignment (JSAccessor "create" (JSVar ctor)) createFn
203+ ]
189
204
190−-- |
205+ iife :: String -> [JS] -> JS
191−-- Generate code in the simplified Javascript intermediate representation for a value or expression.
192−--
193−valueToJs :: (Functor m, Applicative m, Monad m) => Options -> ModuleName -> Environment -> Expr -> SupplyT m JS
194−valueToJs _ _ _ (NumericLiteral n) = return $ JSNumericLiteral n
195−valueToJs _ _ _ (StringLiteral s) = return $ JSStringLiteral s
196−valueToJs _ _ _ (BooleanLiteral b) = return $ JSBooleanLiteral b
197−valueToJs opts m e (ArrayLiteral xs) = JSArrayLiteral <$> mapM (valueToJs opts m e) xs
198−valueToJs opts m e (ObjectLiteral ps) = JSObjectLiteral <$> mapM (sndM (valueToJs opts m e)) ps
199−valueToJs opts m e (TypeClassDictionaryConstructorApp name (TypedValue _ (ObjectLiteral ps) _)) =
200− JSUnary JSNew . JSApp (qualifiedToJS m (Ident . runProperName) name) <$> mapM (valueToJs opts m e . snd) (sortBy (compare `on` fst) ps)
201−valueToJs _ _ _ TypeClassDictionaryConstructorApp{} =
202− error "TypeClassDictionaryConstructorApp did not contain object literal"
203−valueToJs opts m e (ObjectUpdate o ps) = do
204− obj <- valueToJs opts m e o
205− sts <- mapM (sndM (valueToJs opts m e)) ps
206− extendObj obj sts
207−valueToJs _ m e (Constructor name) =
208− let propName = if isNullaryConstructor e name then "value" else "create"
209− in return $ JSAccessor propName $ qualifiedToJS m (Ident . runProperName) name
210−valueToJs opts m e (Case values binders) = do
211− vals <- mapM (valueToJs opts m e) values
212− bindersToJs opts m e binders vals
213−valueToJs opts m e (IfThenElse cond th el) = JSConditional <$> valueToJs opts m e cond <*> valueToJs opts m e th <*> valueToJs opts m e el
214−valueToJs opts m e (Accessor prop val) = accessorString prop <$> valueToJs opts m e val
215−valueToJs opts m e v@App{} = do
216− let (f, args) = unApp v []
217− args' <- mapM (valueToJs opts m e) args
218− case f of
219− Constructor name | isNewtypeConstructor e name && length args == 1 -> return (head args')
220− Constructor name | getConstructorArity e name == length args ->
221− return $ JSUnary JSNew $ JSApp (qualifiedToJS m (Ident . runProperName) name) args'
222− _ -> flip (foldl (\fn a -> JSApp fn [a])) args' <$> valueToJs opts m e f
223− where
224− unApp :: Expr -> [Expr] -> (Expr, [Expr])
225− unApp (App val arg) args = unApp val (arg : args)
226− unApp (PositionedValue _ val) args = unApp val args
227− unApp (TypedValue _ val _) args = unApp val args
228− unApp other args = (other, args)
229−valueToJs opts m e (Let ds val) = do
230− decls <- concat . catMaybes <$> mapM (flip (declToJs opts m) e) ds
231− ret <- valueToJs opts m e val
232− return $ JSApp (JSFunction Nothing [] (JSBlock (decls ++ [JSReturn ret]))) []
206+ iife v exprs = JSApp (JSFunction Nothing [] (JSBlock $ exprs ++ [JSReturn $ JSVar v])) []
233−valueToJs opts m e (Abs (Left arg) val) = do
234− ret <- valueToJs opts m e val
235− return $ JSFunction Nothing [identToJs arg] (JSBlock [JSReturn ret])
236−valueToJs opts m e (TypedValue _ (Abs (Left arg) val) ty) | optionsPerformRuntimeTypeChecks opts = do
237− let arg' = identToJs arg
238− ret <- valueToJs opts m e val
239− return $ JSFunction Nothing [arg'] (JSBlock $ runtimeTypeChecks arg' ty ++ [JSReturn ret])
240−valueToJs _ m _ (Var ident) = return $ varToJs m ident
241−valueToJs opts m e (TypedValue _ val _) = valueToJs opts m e val
242−valueToJs opts m e (PositionedValue _ val) = valueToJs opts m e val
243−valueToJs _ _ _ (TypeClassDictionary _ _ _) = error "Type class dictionary was not replaced"
244−valueToJs _ _ _ _ = error "Invalid argument to valueToJs"
245
207
246−-- |
208+ literalToValueJS :: Literal (Expr Ann) -> m JS
247−-- Shallow copy an object.
209+ literalToValueJS (NumericLiteral n) = return $ JSNumericLiteral n
248−--
210+ literalToValueJS (StringLiteral s) = return $ JSStringLiteral s
249−extendObj :: (Functor m, Applicative m, Monad m) => JS -> [(String, JS)] -> SupplyT m JS
211+ literalToValueJS (CharLiteral c) = return $ JSStringLiteral [c]
250−extendObj obj sts = do
212+ literalToValueJS (BooleanLiteral b) = return $ JSBooleanLiteral b
251− newObj <- freshName
213+ literalToValueJS (ArrayLiteral xs) = JSArrayLiteral <$> mapM valueToJs xs
252− key <- freshName
214+ literalToValueJS (ObjectLiteral ps) = JSObjectLiteral <$> mapM (sndM valueToJs) ps
253− let
254− jsKey = JSVar key
255− jsNewObj = JSVar newObj
256− block = JSBlock (objAssign:copy:extend ++ [JSReturn jsNewObj])
257− objAssign = JSVariableIntroduction newObj (Just $ JSObjectLiteral [])
258− copy = JSForIn key obj $ JSBlock [JSIfElse cond assign Nothing]
259− cond = JSApp (JSAccessor "hasOwnProperty" obj) [jsKey]
260− assign = JSBlock [JSAssignment (JSIndexer jsKey jsNewObj) (JSIndexer jsKey obj)]
261− stToAssign (s, js) = JSAssignment (JSAccessor s jsNewObj) js
262− extend = map stToAssign sts
263− return $ JSApp (JSFunction Nothing [] block) []
264
215
265−-- |
216+ -- |
266−-- Generate code in the simplified Javascript intermediate representation for runtime type checks.
217+ -- Shallow copy an object.
267−--
218+ --
268−runtimeTypeChecks :: String -> Type -> [JS]
219+ extendObj :: JS -> [(String, JS)] -> m JS
269−runtimeTypeChecks arg ty =
220+ extendObj obj sts = do
270− let
221+ newObj <- freshName
271− argTy = getFunctionArgumentType ty
222+ key <- freshName
272− in
273− maybe [] (argumentCheck (JSVar arg)) argTy
274− where
275− getFunctionArgumentType :: Type -> Maybe Type
276− getFunctionArgumentType (TypeApp (TypeApp t funArg) _) | t == tyFunction = Just funArg
277− getFunctionArgumentType (ForAll _ ty' _) = getFunctionArgumentType ty'
278− getFunctionArgumentType _ = Nothing
279− argumentCheck :: JS -> Type -> [JS]
280− argumentCheck val t | t == tyNumber = [typeCheck val "number"]
281− argumentCheck val t | t == tyString = [typeCheck val "string"]
282− argumentCheck val t | t == tyBoolean = [typeCheck val "boolean"]
283− argumentCheck val (TypeApp t _) | t == tyArray = [arrayCheck val]
284− argumentCheck val (TypeApp t row) | t == tyObject =
285 let
223 let
286− (pairs, _) = rowToList row
224+ jsKey = JSVar key
287− in
225+ jsNewObj = JSVar newObj
288− typeCheck val "object" : concatMap (\(prop, ty') -> argumentCheck (accessorString prop val) ty') pairs
226+ block = JSBlock (objAssign:copy:extend ++ [JSReturn jsNewObj])
289− argumentCheck val (TypeApp (TypeApp t _) _) | t == tyFunction = [typeCheck val "function"]
227+ objAssign = JSVariableIntroduction newObj (Just $ JSObjectLiteral [])
290− argumentCheck val (ForAll _ ty' _) = argumentCheck val ty'
228+ copy = JSForIn key obj $ JSBlock [JSIfElse cond assign Nothing]
291− argumentCheck _ _ = []
229+ cond = JSApp (JSAccessor "hasOwnProperty" obj) [jsKey]
292− typeCheck :: JS -> String -> JS
230+ assign = JSBlock [JSAssignment (JSIndexer jsKey jsNewObj) (JSIndexer jsKey obj)]
293− typeCheck js ty' = JSIfElse (JSBinary NotEqualTo (JSTypeOf js) (JSStringLiteral ty')) (JSBlock [JSThrow (JSStringLiteral $ ty' ++ " expected")]) Nothing
231+ stToAssign (s, js) = JSAssignment (JSAccessor s jsNewObj) js
294− arrayCheck :: JS -> JS
232+ extend = map stToAssign sts
295− arrayCheck js = JSIfElse (JSUnary Not (JSApp (JSAccessor "isArray" (JSVar "Array")) [js])) (JSBlock [JSThrow (JSStringLiteral "Array expected")]) Nothing
233+ return $ JSApp (JSFunction Nothing [] block) []
296
234
297−-- |
235+ -- |
298−-- Generate code in the simplified Javascript intermediate representation for a reference to a
236+ -- Generate code in the simplified Javascript intermediate representation for a reference to a
299−-- variable.
237+ -- variable.
300−--
238+ --
301−varToJs :: ModuleName -> Qualified Ident -> JS
239+ varToJs :: Qualified Ident -> JS
302−varToJs _ (Qualified Nothing ident) = var ident
240+ varToJs (Qualified Nothing ident) = var ident
303−varToJs m qual = qualifiedToJS m id qual
241+ varToJs qual = qualifiedToJS id qual
304
242
305−-- |
243+ -- |
306−-- Generate code in the simplified Javascript intermediate representation for a reference to a
244+ -- Generate code in the simplified Javascript intermediate representation for a reference to a
307−-- variable that may have a qualified name.
245+ -- variable that may have a qualified name.
308−--
246+ --
309−qualifiedToJS :: ModuleName -> (a -> Ident) -> Qualified a -> JS
247+ qualifiedToJS :: (a -> Ident) -> Qualified a -> JS
248+ qualifiedToJS f (Qualified (Just (ModuleName [ProperName mn'])) a) | mn' == C.prim = JSVar . runIdent $ f a
310−qualifiedToJS m f (Qualified (Just m') a) | m /= m' = accessor (f a) (JSVar (moduleNameToJs m'))
249+ qualifiedToJS f (Qualified (Just mn') a) | mn /= mn' = accessor (f a) (JSVar (moduleNameToJs mn'))
311−qualifiedToJS _ f (Qualified _ a) = JSVar $ identToJs (f a)
250+ qualifiedToJS f (Qualified _ a) = JSVar $ identToJs (f a)
312
251
313−-- |
252+ foreignIdent :: Ident -> JS
314−-- Generate code in the simplified Javascript intermediate representation for pattern match binders
253+ foreignIdent ident = accessorString (runIdent ident) (JSVar "$foreign")
315−-- and guards.
316−--
317−bindersToJs :: (Functor m, Applicative m, Monad m) => Options -> ModuleName -> Environment -> [CaseAlternative] -> [JS] -> SupplyT m JS
318−bindersToJs opts m e binders vals = do
319− valNames <- replicateM (length vals) freshName
320− let assignments = zipWith JSVariableIntroduction valNames (map Just vals)
321− jss <- forM binders $ \(CaseAlternative bs grd result) -> do
322− ret <- valueToJs opts m e result
323− go valNames [JSReturn ret] bs grd
324− return $ JSApp (JSFunction Nothing [] (JSBlock (assignments ++ concat jss ++ [JSThrow $ JSUnary JSNew $ JSApp (JSVar "Error") $ [JSStringLiteral "Failed pattern match"]])))
325− []
326− where
327− go :: (Functor m, Applicative m, Monad m) => [String] -> [JS] -> [Binder] -> Maybe Guard -> SupplyT m [JS]
328− go _ done [] Nothing = return done
329− go _ done [] (Just cond) = do
330− cond' <- valueToJs opts m e cond
331− return [JSIfElse cond' (JSBlock done) Nothing]
332− go (v:vs) done' (b:bs) grd = do
333− done'' <- go vs done' bs grd
334− binderToJs m e v done'' b
335− go _ _ _ _ = error "Invalid arguments to bindersToJs"
336
254
337−-- |
255+ -- |
338−-- Generate code in the simplified Javascript intermediate representation for a pattern match
256+ -- Generate code in the simplified Javascript intermediate representation for pattern match binders
339−-- binder.
257+ -- and guards.
340−--
258+ --
341−binderToJs :: (Functor m, Applicative m, Monad m) => ModuleName -> Environment -> String -> [JS] -> Binder -> SupplyT m [JS]
259+ bindersToJs :: Maybe SourceSpan -> [CaseAlternative Ann] -> [JS] -> m JS
260+ bindersToJs maybeSpan binders vals = do
261+ valNames <- replicateM (length vals) freshName
262+ let assignments = zipWith JSVariableIntroduction valNames (map Just vals)
263+ jss <- forM binders $ \(CaseAlternative bs result) -> do
264+ ret <- guardsToJs result
265+ go valNames ret bs
266+ return $ JSApp (JSFunction Nothing [] (JSBlock (assignments ++ concat jss ++ [JSThrow $ failedPatternError valNames])))
267+ []
268+ where
269+ go :: [String] -> [JS] -> [Binder Ann] -> m [JS]
270+ go _ done [] = return done
271+ go (v:vs) done' (b:bs) = do
272+ done'' <- go vs done' bs
273+ binderToJs v done'' b
274+ go _ _ _ = error "Invalid arguments to bindersToJs"
275+
276+ failedPatternError :: [String] -> JS
277+ failedPatternError names = JSUnary JSNew $ JSApp (JSVar "Error") [JSBinary Add (JSStringLiteral errorMessage) (JSArrayLiteral $ zipWith valueError names vals)]
278+
279+ errorMessage :: String
280+ errorMessage = "Failed pattern match" ++ maybe "" (((" at " ++ runModuleName mn ++ " ") ++) . displayStartEndPos) maybeSpan ++ ": "
281+
282+ valueError :: String -> JS -> JS
283+ valueError _ l@(JSNumericLiteral _) = l
284+ valueError _ l@(JSStringLiteral _) = l
285+ valueError _ l@(JSBooleanLiteral _) = l
286+ valueError s _ = JSAccessor "name" . JSAccessor "constructor" $ JSVar s
287+
288+ guardsToJs :: Either [(Guard Ann, Expr Ann)] (Expr Ann) -> m [JS]
289+ guardsToJs (Left gs) = forM gs $ \(cond, val) -> do
290+ cond' <- valueToJs cond
291+ done <- valueToJs val
292+ return $ JSIfElse cond' (JSBlock [JSReturn done]) Nothing
293+ guardsToJs (Right v) = return . JSReturn <$> valueToJs v
294+
295+ -- |
296+ -- Generate code in the simplified Javascript intermediate representation for a pattern match
297+ -- binder.
298+ --
299+ binderToJs :: String -> [JS] -> Binder Ann -> m [JS]
342−binderToJs _ _ _ done NullBinder = return done
300+ binderToJs _ done (NullBinder{}) = return done
343−binderToJs _ _ varName done (StringBinder str) =
344− return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSStringLiteral str)) (JSBlock done) Nothing]
345−binderToJs _ _ varName done (NumberBinder num) =
301+ binderToJs varName done (LiteralBinder _ l) =
346− return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSNumericLiteral num)) (JSBlock done) Nothing]
302+ literalToBinderJS varName done l
347−binderToJs _ _ varName done (BooleanBinder True) =
348− return [JSIfElse (JSVar varName) (JSBlock done) Nothing]
349−binderToJs _ _ varName done (BooleanBinder False) =
350− return [JSIfElse (JSUnary Not (JSVar varName)) (JSBlock done) Nothing]
351−binderToJs _ _ varName done (VarBinder ident) =
303+ binderToJs varName done (VarBinder _ ident) =
352− return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : done)
304+ return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : done)
305+ binderToJs varName done (ConstructorBinder (_, _, _, Just IsNewtype) _ _ [b]) =
306+ binderToJs varName done b
353−binderToJs m e varName done (ConstructorBinder ctor bs) | isNewtypeConstructor e ctor =
307+ binderToJs varName done (ConstructorBinder (_, _, _, Just (IsConstructor ctorType fields)) _ ctor bs) = do
308+ js <- go (zip fields bs) done
354− case bs of
309+ return $ case ctorType of
355− [b] -> binderToJs m e varName done b
310+ ProductType -> js
356− _ -> error "binder for newtype constructor should have a single argument"
311+ SumType ->
357−binderToJs m e varName done (ConstructorBinder ctor bs) = do
358− js <- go 0 done bs
359− if isOnlyConstructor e ctor
360− then
361− return js
362− else
363− return [JSIfElse (JSInstanceOf (JSVar varName) (qualifiedToJS m (Ident . runProperName) ctor))
312+ [JSIfElse (JSInstanceOf (JSVar varName) (qualifiedToJS (Ident . runProperName) ctor))
364− (JSBlock js)
313+ (JSBlock js)
365− Nothing]
314+ Nothing]
366− where
315+ where
367− go :: (Functor m, Applicative m, Monad m) => Integer -> [JS] -> [Binder] -> SupplyT m [JS]
316+ go :: [(Ident, Binder Ann)] -> [JS] -> m [JS]
368− go _ done' [] = return done'
317+ go [] done' = return done'
369− go index done' (binder:bs') = do
318+ go ((field, binder) : remain) done' = do
370− argVar <- freshName
319+ argVar <- freshName
371− done'' <- go (index + 1) done' bs'
320+ done'' <- go remain done'
372− js <- binderToJs m e argVar done'' binder
321+ js <- binderToJs argVar done'' binder
373− return (JSVariableIntroduction argVar (Just (JSAccessor ("value" ++ show index) (JSVar varName))) : js)
322+ return (JSVariableIntroduction argVar (Just (JSAccessor (identToJs field) (JSVar varName))) : js)
374−binderToJs m e varName done (ObjectBinder bs) = go done bs
323+ binderToJs _ _ ConstructorBinder{} =
375− where
324+ error "binderToJs: Invalid ConstructorBinder in binderToJs"
325+ binderToJs varName done (NamedBinder _ ident binder) = do
326+ js <- binderToJs varName done binder
327+ return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : js)
328+
329+ literalToBinderJS :: String -> [JS] -> Literal (Binder Ann) -> m [JS]
330+ literalToBinderJS varName done (NumericLiteral num) =
331+ return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSNumericLiteral num)) (JSBlock done) Nothing]
332+ literalToBinderJS varName done (CharLiteral c) =
333+ return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSStringLiteral [c])) (JSBlock done) Nothing]
334+ literalToBinderJS varName done (StringLiteral str) =
335+ return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSStringLiteral str)) (JSBlock done) Nothing]
336+ literalToBinderJS varName done (BooleanLiteral True) =
337+ return [JSIfElse (JSVar varName) (JSBlock done) Nothing]
338+ literalToBinderJS varName done (BooleanLiteral False) =
339+ return [JSIfElse (JSUnary Not (JSVar varName)) (JSBlock done) Nothing]
340+ literalToBinderJS varName done (ObjectLiteral bs) = go done bs
341+ where
376− go :: (Functor m, Applicative m, Monad m) => [JS] -> [(String, Binder)] -> SupplyT m [JS]
342+ go :: [JS] -> [(String, Binder Ann)] -> m [JS]
377− go done' [] = return done'
343+ go done' [] = return done'
378− go done' ((prop, binder):bs') = do
344+ go done' ((prop, binder):bs') = do
379− propVar <- freshName
345+ propVar <- freshName
380− done'' <- go done' bs'
346+ done'' <- go done' bs'
381− js <- binderToJs m e propVar done'' binder
347+ js <- binderToJs propVar done'' binder
382− return (JSVariableIntroduction propVar (Just (accessorString prop (JSVar varName))) : js)
348+ return (JSVariableIntroduction propVar (Just (accessorString prop (JSVar varName))) : js)
383−binderToJs m e varName done (ArrayBinder bs) = do
349+ literalToBinderJS varName done (ArrayLiteral bs) = do
384− js <- go done 0 bs
350+ js <- go done 0 bs
385− return [JSIfElse (JSBinary EqualTo (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]
351+ return [JSIfElse (JSBinary EqualTo (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left (fromIntegral $ length bs)))) (JSBlock js) Nothing]
386− where
352+ where
387− go :: (Functor m, Applicative m, Monad m) => [JS] -> Integer -> [Binder] -> SupplyT m [JS]
353+ go :: [JS] -> Integer -> [Binder Ann] -> m [JS]
388− go done' _ [] = return done'
354+ go done' _ [] = return done'
389− go done' index (binder:bs') = do
355+ go done' index (binder:bs') = do
390− elVar <- freshName
356+ elVar <- freshName
391− done'' <- go done' (index + 1) bs'
357+ done'' <- go done' (index + 1) bs'
392− js <- binderToJs m e elVar done'' binder
358+ js <- binderToJs elVar done'' binder
393− return (JSVariableIntroduction elVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : js)
359+ return (JSVariableIntroduction elVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : js)
394−binderToJs m e varName done (ConsBinder headBinder tailBinder) = do
360+
395− headVar <- freshName
361+mainCall :: ModuleName -> String -> JS
396− tailVar <- freshName
362+mainCall mmi ns = JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar ns))) []
397− js1 <- binderToJs m e headVar done headBinder
398− js2 <- binderToJs m e tailVar js1 tailBinder
399− return [JSIfElse (JSBinary GreaterThan (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left 0))) (JSBlock
400− ( JSVariableIntroduction headVar (Just (JSIndexer (JSNumericLiteral (Left 0)) (JSVar varName))) :
401− JSVariableIntroduction tailVar (Just (JSApp (JSAccessor "slice" (JSVar varName)) [JSNumericLiteral (Left 1)])) :
402− js2
403− )) Nothing]
404−binderToJs m e varName done (NamedBinder ident binder) = do
405− js <- binderToJs m e varName done binder
406− return (JSVariableIntroduction (identToJs ident) (Just (JSVar varName)) : js)
407−binderToJs m e varName done (PositionedBinder _ binder) =
408− binderToJs m e varName done binder
src/Language/PureScript/CodeGen/JS/AST.hs+47−26
@@ -14,10 +14,21 @@
14-----------------------------------------------------------------------------
14-----------------------------------------------------------------------------
15
15
16{-# LANGUAGE DeriveDataTypeable #-}
16{-# LANGUAGE DeriveDataTypeable #-}
17+{-# LANGUAGE CPP #-}
17
18
18module Language.PureScript.CodeGen.JS.AST where
19module Language.PureScript.CodeGen.JS.AST where
19
20
21+#if __GLASGOW_HASKELL__ < 710
22+import Control.Applicative (Applicative, (<$>), (<*>))
23+#endif
24+import Control.Monad.Identity
20import Data.Data
25import Data.Data
26+#if __GLASGOW_HASKELL__ < 710
27+import Data.Traversable (traverse)
28+#endif
29+
30+import Language.PureScript.Comments
31+import Language.PureScript.Traversals
21
32
22-- |
33-- |
23-- Built-in unary operators
34-- Built-in unary operators
@@ -42,7 +53,7 @@ data UnaryOperator
42 -- |
53 -- |
43 -- Constructor
54 -- Constructor
44 --
55 --
45− | JSNew deriving (Show, Eq, Data, Typeable)
56+ | JSNew deriving (Show, Read, Eq, Data, Typeable)
46
57
47-- |
58-- |
48-- Built-in binary operators
59-- Built-in binary operators
@@ -123,7 +134,7 @@ data BinaryOperator
123 -- |
134 -- |
124 -- Bitwise right shift with zero-fill
135 -- Bitwise right shift with zero-fill
125 --
136 --
126− | ZeroFillShiftRight deriving (Show, Eq, Data, Typeable)
137+ | ZeroFillShiftRight deriving (Show, Read, Eq, Data, Typeable)
127
138
128-- |
139-- |
129-- Data type for simplified Javascript expressions
140-- Data type for simplified Javascript expressions
@@ -240,7 +251,11 @@ data JS
240 -- |
251 -- |
241 -- Raw Javascript (generated when parsing fails for an inline foreign import declaration)
252 -- Raw Javascript (generated when parsing fails for an inline foreign import declaration)
242 --
253 --
254+ | JSRaw String
255+ -- |
256+ -- Commented Javascript
257+ --
243− | JSRaw String deriving (Show, Eq, Data, Typeable)
258+ | JSComment [Comment] JS deriving (Show, Read, Eq, Data, Typeable)
244
259
245--
260--
246-- Traversals
261-- Traversals
@@ -271,33 +286,38 @@ everywhereOnJS f = go
271 go (JSTypeOf js) = f (JSTypeOf (go js))
286 go (JSTypeOf js) = f (JSTypeOf (go js))
272 go (JSLabel name js) = f (JSLabel name (go js))
287 go (JSLabel name js) = f (JSLabel name (go js))
273 go (JSInstanceOf j1 j2) = f (JSInstanceOf (go j1) (go j2))
288 go (JSInstanceOf j1 j2) = f (JSInstanceOf (go j1) (go j2))
289+ go (JSComment com j) = f (JSComment com (go j))
274 go other = f other
290 go other = f other
275
291
276everywhereOnJSTopDown :: (JS -> JS) -> JS -> JS
292everywhereOnJSTopDown :: (JS -> JS) -> JS -> JS
277−everywhereOnJSTopDown f = go . f
293+everywhereOnJSTopDown f = runIdentity . everywhereOnJSTopDownM (Identity . f)
294+
295+everywhereOnJSTopDownM :: (Applicative m, Monad m) => (JS -> m JS) -> JS -> m JS
296+everywhereOnJSTopDownM f = f >=> go
278 where
297 where
279− go :: JS -> JS
298+ f' = f >=> go
280− go (JSUnary op j) = JSUnary op (go (f j))
299+ go (JSUnary op j) = JSUnary op <$> f' j
281− go (JSBinary op j1 j2) = JSBinary op (go (f j1)) (go (f j2))
300+ go (JSBinary op j1 j2) = JSBinary op <$> f' j1 <*> f' j2
282− go (JSArrayLiteral js) = JSArrayLiteral (map (go . f) js)
301+ go (JSArrayLiteral js) = JSArrayLiteral <$> traverse f' js
283− go (JSIndexer j1 j2) = JSIndexer (go (f j1)) (go (f j2))
302+ go (JSIndexer j1 j2) = JSIndexer <$> f' j1 <*> f' j2
284− go (JSObjectLiteral js) = JSObjectLiteral (map (fmap (go . f)) js)
303+ go (JSObjectLiteral js) = JSObjectLiteral <$> traverse (sndM f') js
285− go (JSAccessor prop j) = JSAccessor prop (go (f j))
304+ go (JSAccessor prop j) = JSAccessor prop <$> f' j
286− go (JSFunction name args j) = JSFunction name args (go (f j))
305+ go (JSFunction name args j) = JSFunction name args <$> f' j
287− go (JSApp j js) = JSApp (go (f j)) (map (go . f) js)
306+ go (JSApp j js) = JSApp <$> f' j <*> traverse f' js
288− go (JSConditional j1 j2 j3) = JSConditional (go (f j1)) (go (f j2)) (go (f j3))
307+ go (JSConditional j1 j2 j3) = JSConditional <$> f' j1 <*> f' j2 <*> f' j3
289− go (JSBlock js) = JSBlock (map (go . f) js)
308+ go (JSBlock js) = JSBlock <$> traverse f' js
290− go (JSVariableIntroduction name j) = JSVariableIntroduction name (fmap (go . f) j)
309+ go (JSVariableIntroduction name j) = JSVariableIntroduction name <$> traverse f' j
291− go (JSAssignment j1 j2) = JSAssignment (go (f j1)) (go (f j2))
310+ go (JSAssignment j1 j2) = JSAssignment <$> f' j1 <*> f' j2
292− go (JSWhile j1 j2) = JSWhile (go (f j1)) (go (f j2))
311+ go (JSWhile j1 j2) = JSWhile <$> f' j1 <*> f' j2
293− go (JSFor name j1 j2 j3) = JSFor name (go (f j1)) (go (f j2)) (go (f j3))
312+ go (JSFor name j1 j2 j3) = JSFor name <$> f' j1 <*> f' j2 <*> f' j3
294− go (JSForIn name j1 j2) = JSForIn name (go (f j1)) (go (f j2))
313+ go (JSForIn name j1 j2) = JSForIn name <$> f' j1 <*> f' j2
295− go (JSIfElse j1 j2 j3) = JSIfElse (go (f j1)) (go (f j2)) (fmap (go . f) j3)
314+ go (JSIfElse j1 j2 j3) = JSIfElse <$> f' j1 <*> f' j2 <*> traverse f' j3
296− go (JSReturn j) = JSReturn (go (f j))
315+ go (JSReturn j) = JSReturn <$> f' j
297− go (JSThrow j) = JSThrow (go (f j))
316+ go (JSThrow j) = JSThrow <$> f' j
298− go (JSTypeOf j) = JSTypeOf (go (f j))
317+ go (JSTypeOf j) = JSTypeOf <$> f' j
299− go (JSLabel name j) = JSLabel name (go (f j))
318+ go (JSLabel name j) = JSLabel name <$> f' j
300− go (JSInstanceOf j1 j2) = JSInstanceOf (go (f j1)) (go (f j2))
319+ go (JSInstanceOf j1 j2) = JSInstanceOf <$> f' j1 <*> f' j2
320+ go (JSComment com j) = JSComment com <$> f' j
301 go other = f other
321 go other = f other
302
322
303everythingOnJS :: (r -> r -> r) -> (JS -> r) -> JS -> r
323everythingOnJS :: (r -> r -> r) -> (JS -> r) -> JS -> r
@@ -325,4 +345,5 @@ everythingOnJS (<>) f = go
325 go j@(JSTypeOf j1) = f j <> go j1
345 go j@(JSTypeOf j1) = f j <> go j1
326 go j@(JSLabel _ j1) = f j <> go j1
346 go j@(JSLabel _ j1) = f j <> go j1
327 go j@(JSInstanceOf j1 j2) = f j <> go j1 <> go j2
347 go j@(JSInstanceOf j1 j2) = f j <> go j1 <> go j2
348+ go j@(JSComment _ j1) = f j <> go j1
328 go other = f other
349 go other = f other
src/Language/PureScript/CodeGen/Common.hs → src/Language/PureScript/CodeGen/JS/Common.hsrenamed+41−53
@@ -13,18 +13,12 @@
13--
13--
14-----------------------------------------------------------------------------
14-----------------------------------------------------------------------------
15
15
16−module Language.PureScript.CodeGen.Common where
16+module Language.PureScript.CodeGen.JS.Common where
17
17
18import Data.Char
18import Data.Char
19import Data.List (intercalate)
19import Data.List (intercalate)
20−import Data.Maybe (fromMaybe)
21−import Data.Function (on)
22−
23−import qualified Data.Map as M
24
20
25import Language.PureScript.Names
21import Language.PureScript.Names
26−import Language.PureScript.Environment
27−import Language.PureScript.Types
28
22
29-- |
23-- |
30-- Convert an Ident into a valid Javascript identifier:
24-- Convert an Ident into a valid Javascript identifier:
@@ -141,53 +135,47 @@ nameIsJsReserved name =
141 , "volatile"
135 , "volatile"
142 , "while"
136 , "while"
143 , "with"
137 , "with"
144− , "yield" ]
138+ , "yield" ] || properNameIsJsReserved name
145
139
146moduleNameToJs :: ModuleName -> String
140moduleNameToJs :: ModuleName -> String
141+moduleNameToJs (ModuleName pns) =
147−moduleNameToJs (ModuleName pns) = intercalate "_" (runProperName `map` pns)
142+ let name = intercalate "_" (runProperName `map` pns)
148−
143+ in if properNameIsJsReserved name then "$$" ++ name else name
149−-- |
150−-- Finds the value stored for a data constructor in the current environment.
151−-- This is a partial function, but if an invalid type has reached this far then
152−-- something has gone wrong in typechecking.
153−--
154−lookupConstructor :: Environment -> Qualified ProperName -> (DataDeclType, ProperName, Type)
155−lookupConstructor e ctor = fromMaybe (error "Data constructor not found") $ ctor `M.lookup` dataConstructors e
156−
157−-- |
158−-- Checks whether a data constructor is the only constructor for that type, used
159−-- to simplify the check when generating code for binders.
160−--
161−isOnlyConstructor :: Environment -> Qualified ProperName -> Bool
162−isOnlyConstructor e ctor = numConstructors (ctor, lookupConstructor e ctor) == 1
163− where
164− numConstructors :: (Qualified ProperName, (DataDeclType, ProperName, Type)) -> Int
165− numConstructors ty = length $ filter (((==) `on` typeConstructor) ty) $ M.toList $ dataConstructors e
166− typeConstructor :: (Qualified ProperName, (DataDeclType, ProperName, Type)) -> (ModuleName, ProperName)
167− typeConstructor (Qualified (Just moduleName) _, (_, tyCtor, _)) = (moduleName, tyCtor)
168− typeConstructor _ = error "Invalid argument to isOnlyConstructor"
169
144
170-- |
145-- |
171−-- Checks whether a data constructor is for a newtype.
146+-- Checks whether a proper name is reserved in Javascript.
172−--
147+--
173−isNewtypeConstructor :: Environment -> Qualified ProperName -> Bool
148+properNameIsJsReserved :: String -> Bool
174−isNewtypeConstructor e ctor = case lookupConstructor e ctor of
149+properNameIsJsReserved name =
175− (Newtype, _, _) -> True
150+ name `elem` [ "Infinity"
176− (Data, _, _) -> False
151+ , "NaN"
177−
152+ , "Object"
178−-- |
153+ , "Function"
179−-- Checks the number of arguments a data constructor accepts.
154+ , "Boolean"
180−--
155+ , "Error"
181−getConstructorArity :: Environment -> Qualified ProperName -> Int
156+ , "EvalError"
182−getConstructorArity e = go . (\(_, _, ctors) -> ctors) . lookupConstructor e
157+ , "InternalError"
183− where
158+ , "RangeError"
184− go :: Type -> Int
159+ , "ReferenceError"
185− go (TypeApp (TypeApp f _) t) | f == tyFunction = go t + 1
160+ , "SyntaxError"
186− go (ForAll _ ty _) = go ty
161+ , "TypeError"
187− go _ = 0
162+ , "URIError"
188−
163+ , "Number"
189−-- |
164+ , "Math"
190−-- Checks whether a data constructor has no arguments, for example, `Nothing`.
165+ , "Date"
191−--
166+ , "String"
192−isNullaryConstructor :: Environment -> Qualified ProperName -> Bool
167+ , "RegExp"
193−isNullaryConstructor e = (== 0) . getConstructorArity e
168+ , "Array"
169+ , "Int8Array"
170+ , "Uint8Array"
171+ , "Uint8ClampedArray"
172+ , "Int16Array"
173+ , "Uint16Array"
174+ , "Int32Array"
175+ , "Uint32Array"
176+ , "Float32Array"
177+ , "Float64Array"
178+ , "ArrayBuffer"
179+ , "DataView"
180+ , "JSON"
181+ , "Intl" ]
src/Language/PureScript/CodeGen/JS/Optimizer.hsnew file+92
@@ -0,0 +1,92 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.CodeGen.JS.Optimizer
4+-- Copyright : (c) Phil Freeman 2013
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+-- This module optimizes code in the simplified-Javascript intermediate representation.
13+--
14+-- The following optimizations are supported:
15+--
16+-- * Collapsing nested blocks
17+--
18+-- * Tail call elimination
19+--
20+-- * Inlining of (>>=) and ret for the Eff monad
21+--
22+-- * Removal of unnecessary thunks
23+--
24+-- * Eta conversion
25+--
26+-- * Inlining variables
27+--
28+-- * Inline Prelude.($), Prelude.(#), Prelude.(++), Prelude.(!!)
29+--
30+-- * Inlining primitive Javascript operators
31+--
32+-----------------------------------------------------------------------------
33+
34+{-# LANGUAGE FlexibleContexts #-}
35+{-# LANGUAGE CPP #-}
36+
37+module Language.PureScript.CodeGen.JS.Optimizer (
38+ optimize
39+) where
40+
41+#if __GLASGOW_HASKELL__ < 710
42+import Control.Applicative (Applicative)
43+#endif
44+import Control.Monad.Reader (MonadReader, ask, asks)
45+import Control.Monad.Supply.Class (MonadSupply)
46+
47+import Language.PureScript.CodeGen.JS.AST
48+import Language.PureScript.Options
49+import qualified Language.PureScript.Constants as C
50+
51+import Language.PureScript.CodeGen.JS.Optimizer.Common
52+import Language.PureScript.CodeGen.JS.Optimizer.TCO
53+import Language.PureScript.CodeGen.JS.Optimizer.MagicDo
54+import Language.PureScript.CodeGen.JS.Optimizer.Inliner
55+import Language.PureScript.CodeGen.JS.Optimizer.Unused
56+import Language.PureScript.CodeGen.JS.Optimizer.Blocks
57+
58+-- |
59+-- Apply a series of optimizer passes to simplified Javascript code
60+--
61+optimize :: (Monad m, MonadReader Options m, Applicative m, MonadSupply m) => JS -> m JS
62+optimize js = do
63+ noOpt <- asks optionsNoOptimizations
64+ if noOpt then return js else optimize' js
65+
66+optimize' :: (Monad m, MonadReader Options m, Applicative m, MonadSupply m) => JS -> m JS
67+optimize' js = do
68+ opts <- ask
69+ untilFixedPoint (inlineFnComposition . applyAll
70+ [ collapseNestedBlocks
71+ , collapseNestedIfs
72+ , tco opts
73+ , magicDo opts
74+ , removeCodeAfterReturnStatements
75+ , removeUnusedArg
76+ , removeUndefinedApp
77+ , unThunk
78+ , etaConvert
79+ , evaluateIifes
80+ , inlineVariables
81+ , inlineValues
82+ , inlineOperator (C.prelude, (C.$)) $ \f x -> JSApp f [x]
83+ , inlineOperator (C.prelude, (C.#)) $ \x f -> JSApp f [x]
84+ , inlineOperator (C.dataArrayUnsafe, C.unsafeIndex) $ flip JSIndexer
85+ , inlineCommonOperators ]) js
86+
87+untilFixedPoint :: (Monad m, Eq a) => (a -> m a) -> a -> m a
88+untilFixedPoint f = go
89+ where
90+ go a = do
91+ a' <- f a
92+ if a' == a then return a' else go a'
src/Language/PureScript/Optimizer/Blocks.hs → src/Language/PureScript/CodeGen/JS/Optimizer/Blocks.hsrenamed+2−2
@@ -1,6 +1,6 @@
1-----------------------------------------------------------------------------
1-----------------------------------------------------------------------------
2--
2--
3−-- Module : Language.PureScript.Optimizer.Blocks
3+-- Module : Language.PureScript.CodeGen.JS.Optimizer.Blocks
4-- Copyright : (c) Phil Freeman 2013-14
4-- Copyright : (c) Phil Freeman 2013-14
5-- License : MIT
5-- License : MIT
6--
6--
@@ -13,7 +13,7 @@
13--
13--
14-----------------------------------------------------------------------------
14-----------------------------------------------------------------------------
15
15
16−module Language.PureScript.Optimizer.Blocks
16+module Language.PureScript.CodeGen.JS.Optimizer.Blocks
17 ( collapseNestedBlocks
17 ( collapseNestedBlocks
18 , collapseNestedIfs
18 , collapseNestedIfs
19 ) where
19 ) where
src/Language/PureScript/Optimizer/Common.hs → src/Language/PureScript/CodeGen/JS/Optimizer/Common.hsrenamed+2−2
@@ -1,6 +1,6 @@
1-----------------------------------------------------------------------------
1-----------------------------------------------------------------------------
2--
2--
3−-- Module : Language.PureScript.Optimizer.Common
3+-- Module : Language.PureScript.CodeGen.JS.Optimizer.Common
4-- Copyright : (c) Phil Freeman 2013-14
4-- Copyright : (c) Phil Freeman 2013-14
5-- License : MIT
5-- License : MIT
6--
6--
@@ -13,7 +13,7 @@
13--
13--
14-----------------------------------------------------------------------------
14-----------------------------------------------------------------------------
15
15
16−module Language.PureScript.Optimizer.Common where
16+module Language.PureScript.CodeGen.JS.Optimizer.Common where
17
17
18import Data.Maybe (fromMaybe)
18import Data.Maybe (fromMaybe)
19
19
src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hsnew file+318
@@ -0,0 +1,318 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.CodeGen.JS.Optimizer.Inliner
4+-- Copyright : (c) Phil Freeman 2013-14
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+-- This module provides basic inlining capabilities
13+--
14+-----------------------------------------------------------------------------
15+
16+{-# LANGUAGE CPP #-}
17+
18+module Language.PureScript.CodeGen.JS.Optimizer.Inliner (
19+ inlineVariables,
20+ inlineValues,
21+ inlineOperator,
22+ inlineCommonOperators,
23+ inlineFnComposition,
24+ etaConvert,
25+ unThunk,
26+ evaluateIifes
27+) where
28+
29+#if __GLASGOW_HASKELL__ < 710
30+import Control.Applicative (Applicative)
31+#endif
32+import Control.Monad.Supply.Class (MonadSupply, freshName)
33+import Data.Maybe (fromMaybe)
34+
35+import Language.PureScript.CodeGen.JS.AST
36+import Language.PureScript.CodeGen.JS.Common
37+import Language.PureScript.Names
38+import Language.PureScript.CodeGen.JS.Optimizer.Common
39+import qualified Language.PureScript.Constants as C
40+
41+-- TODO: Potential bug:
42+-- Shouldn't just inline this case: { var x = 0; x.toFixed(10); }
43+-- Needs to be: { 0..toFixed(10); }
44+-- Probably needs to be fixed in pretty-printer instead.
45+shouldInline :: JS -> Bool
46+shouldInline (JSVar _) = True
47+shouldInline (JSNumericLiteral _) = True
48+shouldInline (JSStringLiteral _) = True
49+shouldInline (JSBooleanLiteral _) = True
50+shouldInline (JSAccessor _ val) = shouldInline val
51+shouldInline (JSIndexer index val) = shouldInline index && shouldInline val
52+shouldInline _ = False
53+
54+etaConvert :: JS -> JS
55+etaConvert = everywhereOnJS convert
56+ where
57+ convert :: JS -> JS
58+ convert (JSBlock [JSReturn (JSApp (JSFunction Nothing idents block@(JSBlock body)) args)])
59+ | all shouldInline args &&
60+ not (any (`isRebound` block) (map JSVar idents)) &&
61+ not (any (`isRebound` block) args)
62+ = JSBlock (map (replaceIdents (zip idents args)) body)
63+ convert (JSFunction Nothing [] (JSBlock [JSReturn (JSApp fn [])])) = fn
64+ convert js = js
65+
66+unThunk :: JS -> JS
67+unThunk = everywhereOnJS convert
68+ where
69+ convert :: JS -> JS
70+ convert (JSBlock []) = JSBlock []
71+ convert (JSBlock jss) =
72+ case last jss of
73+ JSReturn (JSApp (JSFunction Nothing [] (JSBlock body)) []) -> JSBlock $ init jss ++ body
74+ _ -> JSBlock jss
75+ convert js = js
76+
77+evaluateIifes :: JS -> JS
78+evaluateIifes = everywhereOnJS convert
79+ where
80+ convert :: JS -> JS
81+ convert (JSApp (JSFunction Nothing [] (JSBlock [JSReturn ret])) []) = ret
82+ convert js = js
83+
84+inlineVariables :: JS -> JS
85+inlineVariables = everywhereOnJS $ removeFromBlock go
86+ where
87+ go :: [JS] -> [JS]
88+ go [] = []
89+ go (JSVariableIntroduction var (Just js) : sts)
90+ | shouldInline js && not (any (isReassigned var) sts) && not (any (isRebound js) sts) && not (any (isUpdated var) sts) =
91+ go (map (replaceIdent var js) sts)
92+ go (s:sts) = s : go sts
93+
94+inlineValues :: JS -> JS
95+inlineValues = everywhereOnJS convert
96+ where
97+ convert :: JS -> JS
98+ convert (JSApp fn [dict]) | isDict semiringNumber dict && isFn fnZero fn = JSNumericLiteral (Left 0)
99+ | isDict semiringNumber dict && isFn fnOne fn = JSNumericLiteral (Left 1)
100+ | isDict semiringInt dict && isFn fnZero fn = JSNumericLiteral (Left 0)
101+ | isDict semiringInt dict && isFn fnOne fn = JSNumericLiteral (Left 1)
102+ | isDict boundedBoolean dict && isFn fnBottom fn = JSBooleanLiteral False
103+ | isDict boundedBoolean dict && isFn fnTop fn = JSBooleanLiteral True
104+ convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y])
105+ | isDict semiringInt dict && isFn fnAdd fn = JSBinary BitwiseOr (JSBinary Add x y) (JSNumericLiteral (Left 0))
106+ | isDict semiringInt dict && isFn fnMultiply fn = JSBinary BitwiseOr (JSBinary Multiply x y) (JSNumericLiteral (Left 0))
107+ | isDict moduloSemiringInt dict && isFn fnDivide fn = JSBinary BitwiseOr (JSBinary Divide x y) (JSNumericLiteral (Left 0))
108+ | isDict ringInt dict && isFn fnSubtract fn = JSBinary BitwiseOr (JSBinary Subtract x y) (JSNumericLiteral (Left 0))
109+ convert other = other
110+ fnZero = (C.prelude, C.zero)
111+ fnOne = (C.prelude, C.one)
112+ fnBottom = (C.prelude, C.bottom)
113+ fnTop = (C.prelude, C.top)
114+ fnAdd = (C.prelude, (C.+))
115+ fnDivide = (C.prelude, (C./))
116+ fnMultiply = (C.prelude, (C.*))
117+ fnSubtract = (C.prelude, (C.-))
118+
119+inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS
120+inlineOperator (m, op) f = everywhereOnJS convert
121+ where
122+ convert :: JS -> JS
123+ convert (JSApp (JSApp op' [x]) [y]) | isOp op' = f x y
124+ convert other = other
125+ isOp (JSAccessor longForm (JSVar m')) = m == m' && longForm == identToJs (Op op)
126+ isOp (JSIndexer (JSStringLiteral op') (JSVar m')) = m == m' && op == op'
127+ isOp _ = False
128+
129+inlineCommonOperators :: JS -> JS
130+inlineCommonOperators = applyAll $
131+ [ binary semiringNumber (C.+) Add
132+ , binary semiringNumber (C.*) Multiply
133+
134+ , binary ringNumber (C.-) Subtract
135+ , unary ringNumber C.negate Negate
136+ , binary ringInt (C.-) Subtract
137+ , unary ringInt C.negate Negate
138+
139+ , binary moduloSemiringNumber (C./) Divide
140+ , binary moduloSemiringInt C.mod Modulus
141+
142+ , binary eqNumber (C.==) EqualTo
143+ , binary eqNumber (C./=) NotEqualTo
144+ , binary eqInt (C.==) EqualTo
145+ , binary eqInt (C./=) NotEqualTo
146+ , binary eqString (C.==) EqualTo
147+ , binary eqString (C./=) NotEqualTo
148+ , binary eqBoolean (C.==) EqualTo
149+ , binary eqBoolean (C./=) NotEqualTo
150+
151+ , binary ordNumber (C.<) LessThan
152+ , binary ordNumber (C.>) GreaterThan
153+ , binary ordNumber (C.<=) LessThanOrEqualTo
154+ , binary ordNumber (C.>=) GreaterThanOrEqualTo
155+ , binary ordInt (C.<) LessThan
156+ , binary ordInt (C.>) GreaterThan
157+ , binary ordInt (C.<=) LessThanOrEqualTo
158+ , binary ordInt (C.>=) GreaterThanOrEqualTo
159+
160+ , binary semigroupString (C.<>) Add
161+ , binary semigroupString (C.++) Add
162+
163+ , binary booleanAlgebraBoolean (C.&&) And
164+ , binary booleanAlgebraBoolean (C.||) Or
165+ , binaryFunction booleanAlgebraBoolean C.conj And
166+ , binaryFunction booleanAlgebraBoolean C.disj Or
167+ , unary booleanAlgebraBoolean C.not Not
168+
169+ , binary' C.dataIntBits (C..|.) BitwiseOr
170+ , binary' C.dataIntBits (C..&.) BitwiseAnd
171+ , binary' C.dataIntBits (C..^.) BitwiseXor
172+ , binary' C.dataIntBits C.shl ShiftLeft
173+ , binary' C.dataIntBits C.shr ShiftRight
174+ , binary' C.dataIntBits C.zshr ZeroFillShiftRight
175+ , unary' C.dataIntBits C.complement BitwiseNot
176+ ] ++
177+ [ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]
178+ where
179+ binary :: (String, String) -> String -> BinaryOperator -> JS -> JS
180+ binary dict opString op = everywhereOnJS convert
181+ where
182+ convert :: JS -> JS
183+ convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isDict dict dict' && isPreludeFn opString fn = JSBinary op x y
184+ convert other = other
185+ binary' :: String -> String -> BinaryOperator -> JS -> JS
186+ binary' moduleName opString op = everywhereOnJS convert
187+ where
188+ convert :: JS -> JS
189+ convert (JSApp (JSApp fn [x]) [y]) | isFn (moduleName, opString) fn = JSBinary op x y
190+ convert other = other
191+ binaryFunction :: (String, String) -> String -> BinaryOperator -> JS -> JS
192+ binaryFunction dict fnName op = everywhereOnJS convert
193+ where
194+ convert :: JS -> JS
195+ convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isPreludeFn fnName fn && isDict dict dict' = JSBinary op x y
196+ convert other = other
197+ unary :: (String, String) -> String -> UnaryOperator -> JS -> JS
198+ unary dict fnName op = everywhereOnJS convert
199+ where
200+ convert :: JS -> JS
201+ convert (JSApp (JSApp fn [dict']) [x]) | isPreludeFn fnName fn && isDict dict dict' = JSUnary op x
202+ convert other = other
203+ unary' :: String -> String -> UnaryOperator -> JS -> JS
204+ unary' moduleName fnName op = everywhereOnJS convert
205+ where
206+ convert :: JS -> JS
207+ convert (JSApp fn [x]) | isFn (moduleName, fnName) fn = JSUnary op x
208+ convert other = other
209+ mkFn :: Int -> JS -> JS
210+ mkFn 0 = everywhereOnJS convert
211+ where
212+ convert :: JS -> JS
213+ convert (JSApp mkFnN [JSFunction Nothing [_] (JSBlock js)]) | isNFn C.mkFn 0 mkFnN =
214+ JSFunction Nothing [] (JSBlock js)
215+ convert other = other
216+ mkFn n = everywhereOnJS convert
217+ where
218+ convert :: JS -> JS
219+ convert orig@(JSApp mkFnN [fn]) | isNFn C.mkFn n mkFnN =
220+ case collectArgs n [] fn of
221+ Just (args, js) -> JSFunction Nothing args (JSBlock js)
222+ Nothing -> orig
223+ convert other = other
224+ collectArgs :: Int -> [String] -> JS -> Maybe ([String], [JS])
225+ collectArgs 1 acc (JSFunction Nothing [oneArg] (JSBlock js)) | length acc == n - 1 = Just (reverse (oneArg : acc), js)
226+ collectArgs m acc (JSFunction Nothing [oneArg] (JSBlock [JSReturn ret])) = collectArgs (m - 1) (oneArg : acc) ret
227+ collectArgs _ _ _ = Nothing
228+
229+ isNFn :: String -> Int -> JS -> Bool
230+ isNFn prefix n (JSVar name) = name == (prefix ++ show n)
231+ isNFn prefix n (JSAccessor name (JSVar dataFunction)) | dataFunction == C.dataFunction = name == (prefix ++ show n)
232+ isNFn _ _ _ = False
233+
234+ runFn :: Int -> JS -> JS
235+ runFn n = everywhereOnJS convert
236+ where
237+ convert :: JS -> JS
238+ convert js = fromMaybe js $ go n [] js
239+
240+ go :: Int -> [JS] -> JS -> Maybe JS
241+ go 0 acc (JSApp runFnN [fn]) | isNFn C.runFn n runFnN && length acc == n = Just (JSApp fn acc)
242+ go m acc (JSApp lhs [arg]) = go (m - 1) (arg : acc) lhs
243+ go _ _ _ = Nothing
244+
245+-- (f <<< g $ x) = f (g x)
246+-- (f <<< g) = \x -> f (g x)
247+inlineFnComposition :: (Applicative m, MonadSupply m) => JS -> m JS
248+inlineFnComposition = everywhereOnJSTopDownM convert
249+ where
250+ convert :: (MonadSupply m) => JS -> m JS
251+ convert (JSApp (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) [z]) | isFnCompose dict' fn =
252+ return $ JSApp x [JSApp y [z]]
253+ convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isFnCompose dict' fn = do
254+ arg <- freshName
255+ return $ JSFunction Nothing [arg] (JSBlock [JSReturn $ JSApp x [JSApp y [JSVar arg]]])
256+ convert other = return other
257+ isFnCompose :: JS -> JS -> Bool
258+ isFnCompose dict' fn = isDict semigroupoidFn dict' && (isPreludeFn (C.<<<) fn || isPreludeFn (C.compose) fn)
259+
260+isDict :: (String, String) -> JS -> Bool
261+isDict (moduleName, dictName) (JSAccessor x (JSVar y)) = x == dictName && y == moduleName
262+isDict _ _ = False
263+
264+isFn :: (String, String) -> JS -> Bool
265+isFn (moduleName, fnName) (JSAccessor x (JSVar y)) = x == fnName && y == moduleName
266+isFn (moduleName, fnName) (JSIndexer (JSStringLiteral x) (JSVar y)) = x == fnName && y == moduleName
267+isFn _ _ = False
268+
269+isPreludeFn :: String -> JS -> Bool
270+isPreludeFn fnName = isFn (C.prelude, fnName)
271+
272+semiringNumber :: (String, String)
273+semiringNumber = (C.prelude, C.semiringNumber)
274+
275+semiringInt :: (String, String)
276+semiringInt = (C.prelude, C.semiringInt)
277+
278+ringNumber :: (String, String)
279+ringNumber = (C.prelude, C.ringNumber)
280+
281+ringInt :: (String, String)
282+ringInt = (C.prelude, C.ringInt)
283+
284+moduloSemiringNumber :: (String, String)
285+moduloSemiringNumber = (C.prelude, C.moduloSemiringNumber)
286+
287+moduloSemiringInt :: (String, String)
288+moduloSemiringInt = (C.prelude, C.moduloSemiringInt)
289+
290+eqNumber :: (String, String)
291+eqNumber = (C.prelude, C.eqNumber)
292+
293+eqInt :: (String, String)
294+eqInt = (C.prelude, C.eqInt)
295+
296+eqString :: (String, String)
297+eqString = (C.prelude, C.eqNumber)
298+
299+eqBoolean :: (String, String)
300+eqBoolean = (C.prelude, C.eqNumber)
301+
302+ordNumber :: (String, String)
303+ordNumber = (C.prelude, C.ordNumber)
304+
305+ordInt :: (String, String)
306+ordInt = (C.prelude, C.ordInt)
307+
308+semigroupString :: (String, String)
309+semigroupString = (C.prelude, C.semigroupString)
310+
311+boundedBoolean :: (String, String)
312+boundedBoolean = (C.prelude, C.boundedBoolean)
313+
314+booleanAlgebraBoolean :: (String, String)
315+booleanAlgebraBoolean = (C.prelude, C.booleanAlgebraBoolean)
316+
317+semigroupoidFn :: (String, String)
318+semigroupoidFn = (C.prelude, C.semigroupoidFn)
src/Language/PureScript/Optimizer/MagicDo.hs → src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hsrenamed+23−24
@@ -1,6 +1,6 @@
1-----------------------------------------------------------------------------
1-----------------------------------------------------------------------------
2--
2--
3−-- Module : Language.PureScript.Optimizer.MagicDo
3+-- Module : Language.PureScript.CodeGen.JS.Optimizer.MagicDo
4-- Copyright : (c) Phil Freeman 2013-14
4-- Copyright : (c) Phil Freeman 2013-14
5-- License : MIT
5-- License : MIT
6--
6--
@@ -14,18 +14,17 @@
14--
14--
15-----------------------------------------------------------------------------
15-----------------------------------------------------------------------------
16
16
17−module Language.PureScript.Optimizer.MagicDo (
17+module Language.PureScript.CodeGen.JS.Optimizer.MagicDo (
18 magicDo
18 magicDo
19) where
19) where
20
20
21import Data.List (nub)
21import Data.List (nub)
22import Data.Maybe (fromJust, isJust)
22import Data.Maybe (fromJust, isJust)
23
23
24−import Language.PureScript.Options
25import Language.PureScript.CodeGen.JS.AST
24import Language.PureScript.CodeGen.JS.AST
26−import Language.PureScript.CodeGen.Common (identToJs)
25+import Language.PureScript.CodeGen.JS.Common
27import Language.PureScript.Names
26import Language.PureScript.Names
28−
27+import Language.PureScript.Options
29import qualified Language.PureScript.Constants as C
28import qualified Language.PureScript.Constants as C
30
29
31magicDo :: Options -> JS -> JS
30magicDo :: Options -> JS -> JS
@@ -60,19 +59,17 @@ magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert
60 -- Desugar pure
59 -- Desugar pure
61 convert (JSApp (JSApp pure' [val]) []) | isPure pure' = val
60 convert (JSApp (JSApp pure' [val]) []) | isPure pure' = val
62 -- Desugar >>
61 -- Desugar >>
63− convert (JSApp (JSApp bind [m]) [JSFunction Nothing ["_"] (JSBlock js)]) | isBind bind && isJSReturn (last js) =
62+ convert (JSApp (JSApp bind [m]) [JSFunction Nothing [] (JSBlock js)]) | isBind bind =
64− let JSReturn ret = last js in
65− JSFunction (Just fnName) [] $ JSBlock (JSApp m [] : init js ++ [JSReturn (JSApp ret [])] )
63+ JSFunction (Just fnName) [] $ JSBlock (JSApp m [] : map applyReturns js )
66 -- Desugar >>=
64 -- Desugar >>=
67− convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock js)]) | isBind bind && isJSReturn (last js) =
65+ convert (JSApp (JSApp bind [m]) [JSFunction Nothing [arg] (JSBlock js)]) | isBind bind =
68− let JSReturn ret = last js in
69− JSFunction (Just fnName) [] $ JSBlock (JSVariableIntroduction arg (Just (JSApp m [])) : init js ++ [JSReturn (JSApp ret [])] )
66+ JSFunction (Just fnName) [] $ JSBlock (JSVariableIntroduction arg (Just (JSApp m [])) : map applyReturns js)
70 -- Desugar untilE
67 -- Desugar untilE
71 convert (JSApp (JSApp f [arg]) []) | isEffFunc C.untilE f =
68 convert (JSApp (JSApp f [arg]) []) | isEffFunc C.untilE f =
72− JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSUnary Not (JSApp arg [])) (JSBlock []), JSReturn (JSObjectLiteral []) ])) []
69+ JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSUnary Not (JSApp arg [])) (JSBlock []), JSReturn $ JSObjectLiteral []])) []
73 -- Desugar whileE
70 -- Desugar whileE
74 convert (JSApp (JSApp (JSApp f [arg1]) [arg2]) []) | isEffFunc C.whileE f =
71 convert (JSApp (JSApp (JSApp f [arg1]) [arg2]) []) | isEffFunc C.whileE f =
75− JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSApp arg1 []) (JSBlock [ JSApp arg2 [] ]), JSReturn (JSObjectLiteral []) ])) []
72+ JSApp (JSFunction Nothing [] (JSBlock [ JSWhile (JSApp arg1 []) (JSBlock [ JSApp arg2 [] ]), JSReturn $ JSObjectLiteral []])) []
76 convert other = other
73 convert other = other
77 -- Check if an expression represents a monomorphic call to >>= for the Eff monad
74 -- Check if an expression represents a monomorphic call to >>= for the Eff monad
78 isBind (JSApp bindPoly [effDict]) | isBindPoly bindPoly && isEffDict C.bindEffDictionary effDict = True
75 isBind (JSApp bindPoly [effDict]) | isBindPoly bindPoly && isEffDict C.bindEffDictionary effDict = True
@@ -84,8 +81,8 @@ magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert
84 isPure (JSApp purePoly [effDict]) | isPurePoly purePoly && isEffDict C.applicativeEffDictionary effDict = True
81 isPure (JSApp purePoly [effDict]) | isPurePoly purePoly && isEffDict C.applicativeEffDictionary effDict = True
85 isPure _ = False
82 isPure _ = False
86 -- Check if an expression represents the polymorphic >>= function
83 -- Check if an expression represents the polymorphic >>= function
87− isBindPoly (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && prop == identToJs (Op (C.>>=))
84+ isBindPoly (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && (prop `elem` map identToJs [Ident C.bind, Op (C.>>=)])
88− isBindPoly (JSIndexer (JSStringLiteral bind) (JSVar prelude)) = prelude == C.prelude && bind == (C.>>=)
85+ isBindPoly (JSIndexer (JSStringLiteral bind) (JSVar prelude)) = prelude == C.prelude && (bind `elem` [C.bind, (C.>>=)])
89 isBindPoly _ = False
86 isBindPoly _ = False
90 -- Check if an expression represents the polymorphic return function
87 -- Check if an expression represents the polymorphic return function
91 isRetPoly (JSAccessor returnEscaped (JSVar prelude)) = prelude == C.prelude && returnEscaped == C.returnEscaped
88 isRetPoly (JSAccessor returnEscaped (JSVar prelude)) = prelude == C.prelude && returnEscaped == C.returnEscaped
@@ -99,16 +96,22 @@ magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert
99 isEffFunc name (JSAccessor name' (JSVar eff)) = eff == C.eff && name == name'
96 isEffFunc name (JSAccessor name' (JSVar eff)) = eff == C.eff && name == name'
100 isEffFunc _ _ = False
97 isEffFunc _ _ = False
101 -- Check if an expression represents the Monad Eff dictionary
98 -- Check if an expression represents the Monad Eff dictionary
102− isEffDict name (JSApp (JSVar ident) [JSObjectLiteral []]) | ident == name = True
99+ isEffDict name (JSVar ident) | ident == name = True
103− isEffDict name (JSApp (JSAccessor prop (JSVar eff)) [JSObjectLiteral []]) = eff == C.eff && prop == name
100+ isEffDict name (JSAccessor prop (JSVar eff)) = eff == C.eff && prop == name
104 isEffDict _ _ = False
101 isEffDict _ _ = False
105 -- Remove __do function applications which remain after desugaring
102 -- Remove __do function applications which remain after desugaring
106 undo :: JS -> JS
103 undo :: JS -> JS
107 undo (JSReturn (JSApp (JSFunction (Just ident) [] body) [])) | ident == fnName = body
104 undo (JSReturn (JSApp (JSFunction (Just ident) [] body) [])) | ident == fnName = body
108 undo other = other
105 undo other = other
109
106
110− isJSReturn (JSReturn _) = True
107+ applyReturns :: JS -> JS
111− isJSReturn _ = False
108+ applyReturns (JSReturn ret) = JSReturn (JSApp ret [])
109+ applyReturns (JSBlock jss) = JSBlock (map applyReturns jss)
110+ applyReturns (JSWhile cond js) = JSWhile cond (applyReturns js)
111+ applyReturns (JSFor v lo hi js) = JSFor v lo hi (applyReturns js)
112+ applyReturns (JSForIn v xs js) = JSForIn v xs (applyReturns js)
113+ applyReturns (JSIfElse cond t f) = JSIfElse cond (applyReturns t) (applyReturns `fmap` f)
114+ applyReturns other = other
112
115
113-- |
116-- |
114-- Inline functions in the ST module
117-- Inline functions in the ST module
@@ -119,7 +122,7 @@ inlineST = everywhereOnJS convertBlock
119 -- Look for runST blocks and inline the STRefs there.
122 -- Look for runST blocks and inline the STRefs there.
120 -- If all STRefs are used in the scope of the same runST, only using { read, write, modify }STRef then
123 -- If all STRefs are used in the scope of the same runST, only using { read, write, modify }STRef then
121 -- we can be more aggressive about inlining, and actually turn STRefs into local variables.
124 -- we can be more aggressive about inlining, and actually turn STRefs into local variables.
122− convertBlock (JSApp f [arg]) | isSTFunc C.runST f || isSTFunc C.runSTArray f =
125+ convertBlock (JSApp f [arg]) | isSTFunc C.runST f =
123 let refs = nub . findSTRefsIn $ arg
126 let refs = nub . findSTRefsIn $ arg
124 usages = findAllSTUsagesIn arg
127 usages = findAllSTUsagesIn arg
125 allUsagesAreLocalVars = all (\u -> let v = toVar u in isJust v && fromJust v `elem` refs) usages
128 allUsagesAreLocalVars = all (\u -> let v = toVar u in isJust v && fromJust v `elem` refs) usages
@@ -137,10 +140,6 @@ inlineST = everywhereOnJS convertBlock
137 if agg then JSAssignment ref arg else JSAssignment (JSAccessor C.stRefValue ref) arg
140 if agg then JSAssignment ref arg else JSAssignment (JSAccessor C.stRefValue ref) arg
138 convert agg (JSApp (JSApp (JSApp f [ref]) [func]) []) | isSTFunc C.modifySTRef f =
141 convert agg (JSApp (JSApp (JSApp f [ref]) [func]) []) | isSTFunc C.modifySTRef f =
139 if agg then JSAssignment ref (JSApp func [ref]) else JSAssignment (JSAccessor C.stRefValue ref) (JSApp func [JSAccessor C.stRefValue ref])
142 if agg then JSAssignment ref (JSApp func [ref]) else JSAssignment (JSAccessor C.stRefValue ref) (JSApp func [JSAccessor C.stRefValue ref])
140− convert _ (JSApp (JSApp (JSApp f [arr]) [i]) []) | isSTFunc C.peekSTArray f =
141− JSIndexer i arr
142− convert _ (JSApp (JSApp (JSApp (JSApp f [arr]) [i]) [val]) []) | isSTFunc C.pokeSTArray f =
143− JSAssignment (JSIndexer i arr) val
144 convert _ other = other
143 convert _ other = other
145 -- Check if an expression represents a function in the ST module
144 -- Check if an expression represents a function in the ST module
146 isSTFunc name (JSAccessor name' (JSVar st)) = st == C.st && name == name'
145 isSTFunc name (JSAccessor name' (JSVar st)) = st == C.st && name == name'
src/Language/PureScript/Optimizer/TCO.hs → src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hsrenamed+32−7
@@ -1,6 +1,6 @@
1-----------------------------------------------------------------------------
1-----------------------------------------------------------------------------
2--
2--
3−-- Module : Language.PureScript.Optimizer.TCO
3+-- Module : Language.PureScript.CodeGen.JS.Optimizer.TCO
4-- Copyright : (c) Phil Freeman 2013-14
4-- Copyright : (c) Phil Freeman 2013-14
5-- License : MIT
5-- License : MIT
6--
6--
@@ -13,7 +13,9 @@
13--
13--
14-----------------------------------------------------------------------------
14-----------------------------------------------------------------------------
15
15
16−module Language.PureScript.Optimizer.TCO (tco) where
16+module Language.PureScript.CodeGen.JS.Optimizer.TCO (tco) where
17+
18+import Data.Monoid
17
19
18import Language.PureScript.Options
20import Language.PureScript.Options
19import Language.PureScript.CodeGen.JS.AST
21import Language.PureScript.CodeGen.JS.AST
@@ -30,10 +32,13 @@ tco' = everywhereOnJS convert
30 where
32 where
31 tcoLabel :: String
33 tcoLabel :: String
32 tcoLabel = "tco"
34 tcoLabel = "tco"
35+
33 tcoVar :: String -> String
36 tcoVar :: String -> String
34 tcoVar arg = "__tco_" ++ arg
37 tcoVar arg = "__tco_" ++ arg
38+
35 copyVar :: String -> String
39 copyVar :: String -> String
36 copyVar arg = "__copy_" ++ arg
40 copyVar arg = "__copy_" ++ arg
41+
37 convert :: JS -> JS
42 convert :: JS -> JS
38 convert js@(JSVariableIntroduction name (Just fn@JSFunction {})) =
43 convert js@(JSVariableIntroduction name (Just fn@JSFunction {})) =
39 let
44 let
@@ -46,6 +51,7 @@ tco' = everywhereOnJS convert
46 JSVariableIntroduction name (Just (replace (toLoop name allArgs body')))
51 JSVariableIntroduction name (Just (replace (toLoop name allArgs body')))
47 | otherwise -> js
52 | otherwise -> js
48 convert js = js
53 convert js = js
54+
49 collectAllFunctionArgs :: [[String]] -> (JS -> JS) -> JS -> ([[String]], JS, JS -> JS)
55 collectAllFunctionArgs :: [[String]] -> (JS -> JS) -> JS -> ([[String]], JS, JS -> JS)
50 collectAllFunctionArgs allArgs f (JSFunction ident args (JSBlock (body@(JSReturn _):_))) =
56 collectAllFunctionArgs allArgs f (JSFunction ident args (JSBlock (body@(JSReturn _):_))) =
51 collectAllFunctionArgs (args : allArgs) (\b -> f (JSFunction ident (map copyVar args) (JSBlock [b]))) body
57 collectAllFunctionArgs (args : allArgs) (\b -> f (JSFunction ident (map copyVar args) (JSBlock [b]))) body
@@ -56,25 +62,35 @@ tco' = everywhereOnJS convert
56 collectAllFunctionArgs allArgs f (JSReturn (JSFunction ident args body@(JSBlock _))) =
62 collectAllFunctionArgs allArgs f (JSReturn (JSFunction ident args body@(JSBlock _))) =
57 (args : allArgs, body, f . JSReturn . JSFunction ident (map copyVar args))
63 (args : allArgs, body, f . JSReturn . JSFunction ident (map copyVar args))
58 collectAllFunctionArgs allArgs f body = (allArgs, body, f)
64 collectAllFunctionArgs allArgs f body = (allArgs, body, f)
65+
59 isTailCall :: String -> JS -> Bool
66 isTailCall :: String -> JS -> Bool
60 isTailCall ident js =
67 isTailCall ident js =
61 let
68 let
62 numSelfCalls = everythingOnJS (+) countSelfCalls js
69 numSelfCalls = everythingOnJS (+) countSelfCalls js
63 numSelfCallsInTailPosition = everythingOnJS (+) countSelfCallsInTailPosition js
70 numSelfCallsInTailPosition = everythingOnJS (+) countSelfCallsInTailPosition js
64 numSelfCallsUnderFunctions = everythingOnJS (+) countSelfCallsUnderFunctions js
71 numSelfCallsUnderFunctions = everythingOnJS (+) countSelfCallsUnderFunctions js
72+ numSelfCallWithFnArgs = everythingOnJS (+) countSelfCallsWithFnArgs js
65 in
73 in
66 numSelfCalls > 0
74 numSelfCalls > 0
67 && numSelfCalls == numSelfCallsInTailPosition
75 && numSelfCalls == numSelfCallsInTailPosition
68 && numSelfCallsUnderFunctions == 0
76 && numSelfCallsUnderFunctions == 0
77+ && numSelfCallWithFnArgs == 0
69 where
78 where
70 countSelfCalls :: JS -> Int
79 countSelfCalls :: JS -> Int
71 countSelfCalls (JSApp (JSVar ident') _) | ident == ident' = 1
80 countSelfCalls (JSApp (JSVar ident') _) | ident == ident' = 1
72 countSelfCalls _ = 0
81 countSelfCalls _ = 0
82+
73 countSelfCallsInTailPosition :: JS -> Int
83 countSelfCallsInTailPosition :: JS -> Int
74 countSelfCallsInTailPosition (JSReturn ret) | isSelfCall ident ret = 1
84 countSelfCallsInTailPosition (JSReturn ret) | isSelfCall ident ret = 1
75 countSelfCallsInTailPosition _ = 0
85 countSelfCallsInTailPosition _ = 0
86+
87+ countSelfCallsUnderFunctions :: JS -> Int
76 countSelfCallsUnderFunctions (JSFunction _ _ js') = everythingOnJS (+) countSelfCalls js'
88 countSelfCallsUnderFunctions (JSFunction _ _ js') = everythingOnJS (+) countSelfCalls js'
77 countSelfCallsUnderFunctions _ = 0
89 countSelfCallsUnderFunctions _ = 0
90+
91+ countSelfCallsWithFnArgs :: JS -> Int
92+ countSelfCallsWithFnArgs ret = if isSelfCallWithFnArgs ident ret [] then 1 else 0
93+
78 toLoop :: String -> [String] -> JS -> JS
94 toLoop :: String -> [String] -> JS -> JS
79 toLoop ident allArgs js = JSBlock $
95 toLoop ident allArgs js = JSBlock $
80 map (\arg -> JSVariableIntroduction arg (Just (JSVar (copyVar arg)))) allArgs ++
96 map (\arg -> JSVariableIntroduction arg (Just (JSVar (copyVar arg)))) allArgs ++
@@ -94,10 +110,19 @@ tco' = everywhereOnJS convert
94 collectSelfCallArgs :: [[JS]] -> JS -> [[JS]]
110 collectSelfCallArgs :: [[JS]] -> JS -> [[JS]]
95 collectSelfCallArgs allArgumentValues (JSApp fn args') = collectSelfCallArgs (args' : allArgumentValues) fn
111 collectSelfCallArgs allArgumentValues (JSApp fn args') = collectSelfCallArgs (args' : allArgumentValues) fn
96 collectSelfCallArgs allArgumentValues _ = allArgumentValues
112 collectSelfCallArgs allArgumentValues _ = allArgumentValues
113+
97 isSelfCall :: String -> JS -> Bool
114 isSelfCall :: String -> JS -> Bool
98− isSelfCall ident (JSApp (JSVar ident') args) | ident == ident' && not (any isFunction args) = True
115+ isSelfCall ident (JSApp (JSVar ident') _) = ident == ident'
99− isSelfCall ident (JSApp fn args) | not (any isFunction args) = isSelfCall ident fn
116+ isSelfCall ident (JSApp fn _) = isSelfCall ident fn
100 isSelfCall _ _ = False
117 isSelfCall _ _ = False
101− isFunction :: JS -> Bool
118+
119+ isSelfCallWithFnArgs :: String -> JS -> [JS] -> Bool
120+ isSelfCallWithFnArgs ident (JSVar ident') args | ident == ident' && any hasFunction args = True
121+ isSelfCallWithFnArgs ident (JSApp fn args) acc = isSelfCallWithFnArgs ident fn (args ++ acc)
122+ isSelfCallWithFnArgs _ _ _ = False
123+
124+ hasFunction :: JS -> Bool
125+ hasFunction = getAny . everythingOnJS mappend (Any . isFunction)
126+ where
102− isFunction (JSFunction _ _ _) = True
127+ isFunction (JSFunction _ _ _) = True
103− isFunction _ = False
128+ isFunction _ = False
src/Language/PureScript/Optimizer/Unused.hs → src/Language/PureScript/CodeGen/JS/Optimizer/Unused.hsrenamed+21−5
@@ -1,6 +1,6 @@
1-----------------------------------------------------------------------------
1-----------------------------------------------------------------------------
2--
2--
3−-- Module : Language.PureScript.Optimizer.Unused
3+-- Module : Language.PureScript.CodeGen.JS.Optimizer.Unused
4-- Copyright : (c) Phil Freeman 2013-14
4-- Copyright : (c) Phil Freeman 2013-14
5-- License : MIT
5-- License : MIT
6--
6--
@@ -13,12 +13,16 @@
13--
13--
14-----------------------------------------------------------------------------
14-----------------------------------------------------------------------------
15
15
16−module Language.PureScript.Optimizer.Unused (
16+module Language.PureScript.CodeGen.JS.Optimizer.Unused
17− removeCodeAfterReturnStatements
17+ ( removeCodeAfterReturnStatements
18+ , removeUnusedArg
19+ , removeUndefinedApp
18−) where
20+ ) where
19
21
20import Language.PureScript.CodeGen.JS.AST
22import Language.PureScript.CodeGen.JS.AST
21−import Language.PureScript.Optimizer.Common
23+import Language.PureScript.CodeGen.JS.Optimizer.Common
24+
25+import qualified Language.PureScript.Constants as C
22
26
23removeCodeAfterReturnStatements :: JS -> JS
27removeCodeAfterReturnStatements :: JS -> JS
24removeCodeAfterReturnStatements = everywhereOnJS (removeFromBlock go)
28removeCodeAfterReturnStatements = everywhereOnJS (removeFromBlock go)
@@ -28,3 +32,15 @@ removeCodeAfterReturnStatements = everywhereOnJS (removeFromBlock go)
28 | otherwise = let (body, ret : _) = span (not . isJSReturn) jss in body ++ [ret]
32 | otherwise = let (body, ret : _) = span (not . isJSReturn) jss in body ++ [ret]
29 isJSReturn (JSReturn _) = True
33 isJSReturn (JSReturn _) = True
30 isJSReturn _ = False
34 isJSReturn _ = False
35+
36+removeUnusedArg :: JS -> JS
37+removeUnusedArg = everywhereOnJS convert
38+ where
39+ convert (JSFunction name [arg] body) | arg == C.__unused = JSFunction name [] body
40+ convert js = js
41+
42+removeUndefinedApp :: JS -> JS
43+removeUndefinedApp = everywhereOnJS convert
44+ where
45+ convert (JSApp fn [JSVar arg]) | arg == C.undefined = JSApp fn []
46+ convert js = js
src/Language/PureScript/Comments.hsnew file+29
@@ -0,0 +1,29 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.Parser.Comments
4+-- Copyright : (c) Phil Freeman 2015
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+-- Defines the types of source code comments
13+--
14+-----------------------------------------------------------------------------
15+
16+{-# LANGUAGE DeriveDataTypeable #-}
17+{-# LANGUAGE TemplateHaskell #-}
18+
19+module Language.PureScript.Comments where
20+
21+import Data.Aeson.TH
22+import qualified Data.Data as D
23+
24+data Comment
25+ = LineComment String
26+ | BlockComment String
27+ deriving (Show, Read, Eq, Ord, D.Data, D.Typeable)
28+
29+$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''Comment)
src/Language/PureScript/Constants.hs+103−33
@@ -15,7 +15,7 @@
15
15
16module Language.PureScript.Constants where
16module Language.PureScript.Constants where
17
17
18−-- Prelude Operators
18+-- Operators
19
19
20($) :: String
20($) :: String
21($) = "$"
21($) = "$"
@@ -65,29 +65,50 @@ module Language.PureScript.Constants where
65(/=) :: String
65(/=) :: String
66(/=) = "/="
66(/=) = "/="
67
67
68−(&) :: String
69−(&) = "&"
70−
71−bar :: String
72−bar = "|"
73−
74−(^) :: String
75−(^) = "^"
76−
77(&&) :: String
68(&&) :: String
78(&&) = "&&"
69(&&) = "&&"
79
70
80(||) :: String
71(||) :: String
81(||) = "||"
72(||) = "||"
82
73
74+bind :: String
75+bind = "bind"
76+
83unsafeIndex :: String
77unsafeIndex :: String
84unsafeIndex = "unsafeIndex"
78unsafeIndex = "unsafeIndex"
85
79
80+(.|.) :: String
81+(.|.) = ".|."
82+
83+(.&.) :: String
84+(.&.) = ".&."
85+
86+(.^.) :: String
87+(.^.) = ".^."
88+
89+(<<<) :: String
90+(<<<) = "<<<"
91+
92+compose :: String
93+compose = "compose"
94+
86−-- Prelude Operator Functions
95+-- Functions
87
96
88negate :: String
97negate :: String
89negate = "negate"
98negate = "negate"
90
99
100+not :: String
101+not = "not"
102+
103+conj :: String
104+conj = "conj"
105+
106+disj :: String
107+disj = "disj"
108+
109+mod :: String
110+mod = "mod"
111+
91shl :: String
112shl :: String
92shl = "shl"
113shl = "shl"
93
114
@@ -100,11 +121,20 @@ zshr = "zshr"
100complement :: String
121complement :: String
101complement = "complement"
122complement = "complement"
102
123
103−not :: String
104−not = "not"
105−
106-- Prelude Values
124-- Prelude Values
107
125
126+zero :: String
127+zero = "zero"
128+
129+one :: String
130+one = "one"
131+
132+bottom :: String
133+bottom = "bottom"
134+
135+top :: String
136+top = "top"
137+
108return :: String
138return :: String
109return = "return"
139return = "return"
110
140
@@ -123,9 +153,6 @@ whileE = "whileE"
123runST :: String
153runST :: String
124runST = "runST"
154runST = "runST"
125
155
126−runSTArray :: String
127−runSTArray = "runSTArray"
128−
129stRefValue :: String
156stRefValue :: String
130stRefValue = "value"
157stRefValue = "value"
131
158
@@ -141,18 +168,20 @@ writeSTRef = "writeSTRef"
141modifySTRef :: String
168modifySTRef :: String
142modifySTRef = "modifySTRef"
169modifySTRef = "modifySTRef"
143
170
144−peekSTArray :: String
145−peekSTArray = "peekSTArray"
146−
147−pokeSTArray :: String
148−pokeSTArray = "pokeSTArray"
149−
150mkFn :: String
171mkFn :: String
151mkFn = "mkFn"
172mkFn = "mkFn"
152
173
153runFn :: String
174runFn :: String
154runFn = "runFn"
175runFn = "runFn"
155
176
177+unit :: String
178+unit = "unit"
179+
180+-- Prim values
181+
182+undefined :: String
183+undefined = "undefined"
184+
156-- Type Class Dictionary Names
185-- Type Class Dictionary Names
157
186
158monadEffDictionary :: String
187monadEffDictionary :: String
@@ -164,32 +193,67 @@ applicativeEffDictionary = "applicativeEff"
164bindEffDictionary :: String
193bindEffDictionary :: String
165bindEffDictionary = "bindEff"
194bindEffDictionary = "bindEff"
166
195
167−numNumber :: String
196+semiringNumber :: String
168−numNumber = "numNumber"
197+semiringNumber = "semiringNumber"
198+
199+semiringInt :: String
200+semiringInt = "semiringInt"
201+
202+ringNumber :: String
203+ringNumber = "ringNumber"
204+
205+ringInt :: String
206+ringInt = "ringInt"
207+
208+moduloSemiringNumber :: String
209+moduloSemiringNumber = "moduloSemiringNumber"
210+
211+moduloSemiringInt :: String
212+moduloSemiringInt = "moduloSemiringInt"
169
213
170ordNumber :: String
214ordNumber :: String
171ordNumber = "ordNumber"
215ordNumber = "ordNumber"
172
216
217+ordInt :: String
218+ordInt = "ordInt"
219+
173eqNumber :: String
220eqNumber :: String
174eqNumber = "eqNumber"
221eqNumber = "eqNumber"
175
222
223+eqInt :: String
224+eqInt = "eqInt"
225+
176eqString :: String
226eqString :: String
177eqString = "eqString"
227eqString = "eqString"
178
228
179eqBoolean :: String
229eqBoolean :: String
180eqBoolean = "eqBoolean"
230eqBoolean = "eqBoolean"
181
231
182−bitsNumber :: String
232+boundedBoolean :: String
183−bitsNumber = "bitsNumber"
233+boundedBoolean = "boundedBoolean"
184
234
185−boolLikeBoolean :: String
235+booleanAlgebraBoolean :: String
186−boolLikeBoolean = "boolLikeBoolean"
236+booleanAlgebraBoolean = "booleanAlgebraBoolean"
187
237
188semigroupString :: String
238semigroupString :: String
189semigroupString = "semigroupString"
239semigroupString = "semigroupString"
190
240
191−semigroupoidArr :: String
241+semigroupoidFn :: String
192−semigroupoidArr = "semigroupoidArr"
242+semigroupoidFn = "semigroupoidFn"
243+
244+-- Generic Deriving
245+
246+generic :: String
247+generic = "Generic"
248+
249+toSpine :: String
250+toSpine = "toSpine"
251+
252+fromSpine :: String
253+fromSpine = "fromSpine"
254+
255+toSignature :: String
256+toSignature = "toSignature"
193
257
194-- Main module
258-- Main module
195
259
@@ -201,6 +265,9 @@ main = "main"
201__superclass_ :: String
265__superclass_ :: String
202__superclass_ = "__superclass_"
266__superclass_ = "__superclass_"
203
267
268+__unused :: String
269+__unused = "__unused"
270+
204-- Modules
271-- Modules
205
272
206prim :: String
273prim :: String
@@ -209,8 +276,8 @@ prim = "Prim"
209prelude :: String
276prelude :: String
210prelude = "Prelude"
277prelude = "Prelude"
211
278
212−preludeUnsafe :: String
279+dataArrayUnsafe :: String
213−preludeUnsafe = "Prelude_Unsafe"
280+dataArrayUnsafe = "Data_Array_Unsafe"
214
281
215eff :: String
282eff :: String
216eff = "Control_Monad_Eff"
283eff = "Control_Monad_Eff"
@@ -220,3 +287,6 @@ st = "Control_Monad_ST"
220
287
221dataFunction :: String
288dataFunction :: String
222dataFunction = "Data_Function"
289dataFunction = "Data_Function"
290+
291+dataIntBits :: String
292+dataIntBits = "Data_Int_Bits"
src/Language/PureScript/CoreFn.hsnew file+26
@@ -0,0 +1,26 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.CoreFn
4+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- | The core functional representation
12+--
13+-----------------------------------------------------------------------------
14+
15+module Language.PureScript.CoreFn (
16+ module C
17+) where
18+
19+import Language.PureScript.CoreFn.Ann as C
20+import Language.PureScript.CoreFn.Binders as C
21+import Language.PureScript.CoreFn.Desugar as C
22+import Language.PureScript.CoreFn.Expr as C
23+import Language.PureScript.CoreFn.Literals as C
24+import Language.PureScript.CoreFn.Meta as C
25+import Language.PureScript.CoreFn.Module as C
26+import Language.PureScript.CoreFn.Traversals as C
src/Language/PureScript/CoreFn/Ann.hsnew file+37
@@ -0,0 +1,37 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.CoreFn.Ann
4+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- | Type alias for basic annotations
12+--
13+-----------------------------------------------------------------------------
14+
15+module Language.PureScript.CoreFn.Ann where
16+
17+import Language.PureScript.AST.SourcePos
18+import Language.PureScript.CoreFn.Meta
19+import Language.PureScript.Types
20+import Language.PureScript.Comments
21+
22+-- |
23+-- Type alias for basic annotations
24+--
25+type Ann = (Maybe SourceSpan, [Comment], Maybe Type, Maybe Meta)
26+
27+-- |
28+-- Initial annotation with no metadata
29+--
30+nullAnn :: Ann
31+nullAnn = (Nothing, [], Nothing, Nothing)
32+
33+-- |
34+-- Remove the comments from an annotation
35+--
36+removeComments :: Ann -> Ann
37+removeComments (ss, _, ty, meta) = (ss, [], ty, meta)
src/Language/PureScript/CoreFn/Binders.hsnew file+48
@@ -0,0 +1,48 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.CoreFn.Binders
4+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- | The core functional representation for binders
12+--
13+-----------------------------------------------------------------------------
14+
15+{-# LANGUAGE DeriveDataTypeable #-}
16+{-# LANGUAGE DeriveFunctor #-}
17+
18+module Language.PureScript.CoreFn.Binders where
19+
20+import qualified Data.Data as D
21+
22+import Language.PureScript.CoreFn.Literals
23+import Language.PureScript.Names
24+
25+-- |
26+-- Data type for binders
27+--
28+data Binder a
29+ -- |
30+ -- Wildcard binder
31+ --
32+ = NullBinder a
33+ -- |
34+ -- A binder which matches a literal value
35+ --
36+ | LiteralBinder a (Literal (Binder a))
37+ -- |
38+ -- A binder which binds an identifier
39+ --
40+ | VarBinder a Ident
41+ -- |
42+ -- A binder which matches a data constructor (type name, constructor name, binders)
43+ --
44+ | ConstructorBinder a (Qualified ProperName) (Qualified ProperName) [Binder a]
45+ -- |
46+ -- A binder which binds its input to an identifier
47+ --
48+ | NamedBinder a Ident (Binder a) deriving (Show, Read, D.Data, D.Typeable, Functor)
src/Language/PureScript/CoreFn/Desugar.hsnew file+263
@@ -0,0 +1,263 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.CoreFn.Desugar
4+-- Copyright : (c) 2013-15 Phil Freeman, (c) 2014-15 Gary Burgess
5+-- License : MIT (http://opensource.org/licenses/MIT)
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- | The AST -> CoreFn desugaring step
12+--
13+-----------------------------------------------------------------------------
14+
15+module Language.PureScript.CoreFn.Desugar (moduleToCoreFn) where
16+
17+import Data.Function (on)
18+import Data.List (sort, sortBy, nub)
19+import Data.Maybe (mapMaybe)
20+import qualified Data.Map as M
21+
22+import Control.Arrow (second, (***))
23+
24+import Language.PureScript.AST.SourcePos
25+import Language.PureScript.AST.Traversals
26+import Language.PureScript.CoreFn.Ann
27+import Language.PureScript.CoreFn.Binders
28+import Language.PureScript.CoreFn.Expr
29+import Language.PureScript.CoreFn.Literals
30+import Language.PureScript.CoreFn.Meta
31+import Language.PureScript.CoreFn.Module
32+import Language.PureScript.Environment
33+import Language.PureScript.Names
34+import Language.PureScript.Sugar.TypeClasses (typeClassMemberName, superClassDictionaryNames)
35+import Language.PureScript.Types
36+import Language.PureScript.Comments
37+import qualified Language.PureScript.AST as A
38+
39+-- |
40+-- Desugars a module from AST to CoreFn representation.
41+--
42+moduleToCoreFn :: Environment -> A.Module -> Module Ann
43+moduleToCoreFn _ (A.Module _ _ _ _ Nothing) =
44+ error "Module exports were not elaborated before moduleToCoreFn"
45+moduleToCoreFn env (A.Module _ coms mn decls (Just exps)) =
46+ let imports = nub $ mapMaybe importToCoreFn decls ++ findQualModules decls
47+ exps' = nub $ concatMap exportToCoreFn exps
48+ externs = nub $ mapMaybe externToCoreFn decls
49+ decls' = concatMap (declToCoreFn Nothing []) decls
50+ in Module coms mn imports exps' externs decls'
51+
52+ where
53+
54+ -- |
55+ -- Desugars member declarations from AST to CoreFn representation.
56+ --
57+ declToCoreFn :: Maybe SourceSpan -> [Comment] -> A.Declaration -> [Bind Ann]
58+ declToCoreFn ss com (A.DataDeclaration Newtype _ _ [(ctor, _)]) =
59+ [NonRec (properToIdent ctor) $
60+ Abs (ss, com, Nothing, Just IsNewtype) (Ident "x") (Var nullAnn $ Qualified Nothing (Ident "x"))]
61+ declToCoreFn _ _ d@(A.DataDeclaration Newtype _ _ _) =
62+ error $ "Found newtype with multiple constructors: " ++ show d
63+ declToCoreFn ss com (A.DataDeclaration Data tyName _ ctors) =
64+ flip map ctors $ \(ctor, _) ->
65+ let (_, _, _, fields) = lookupConstructor env (Qualified (Just mn) ctor)
66+ in NonRec (properToIdent ctor) $ Constructor (ss, com, Nothing, Nothing) tyName ctor fields
67+ declToCoreFn ss _ (A.DataBindingGroupDeclaration ds) = concatMap (declToCoreFn ss []) ds
68+ declToCoreFn ss com (A.ValueDeclaration name _ _ (Right e)) =
69+ [NonRec name (exprToCoreFn ss com Nothing e)]
70+ declToCoreFn ss _ (A.BindingGroupDeclaration ds) =
71+ [Rec $ map (\(name, _, e) -> (name, exprToCoreFn ss [] Nothing e)) ds]
72+ declToCoreFn ss com (A.TypeClassDeclaration name _ supers members) =
73+ [NonRec (properToIdent name) $ mkTypeClassConstructor ss com supers members]
74+ declToCoreFn _ com (A.PositionedDeclaration ss com1 d) =
75+ declToCoreFn (Just ss) (com ++ com1) d
76+ declToCoreFn _ _ _ = []
77+
78+ -- |
79+ -- Desugars expressions from AST to CoreFn representation.
80+ --
81+ exprToCoreFn :: Maybe SourceSpan -> [Comment] -> Maybe Type -> A.Expr -> Expr Ann
82+ exprToCoreFn ss com ty (A.NumericLiteral v) =
83+ Literal (ss, com, ty, Nothing) (NumericLiteral v)
84+ exprToCoreFn ss com ty (A.StringLiteral v) =
85+ Literal (ss, com, ty, Nothing) (StringLiteral v)
86+ exprToCoreFn ss com ty (A.CharLiteral v) =
87+ Literal (ss, com, ty, Nothing) (CharLiteral v)
88+ exprToCoreFn ss com ty (A.BooleanLiteral v) =
89+ Literal (ss, com, ty, Nothing) (BooleanLiteral v)
90+ exprToCoreFn ss com ty (A.ArrayLiteral vs) =
91+ Literal (ss, com, ty, Nothing) (ArrayLiteral $ map (exprToCoreFn ss [] Nothing) vs)
92+ exprToCoreFn ss com ty (A.ObjectLiteral vs) =
93+ Literal (ss, com, ty, Nothing) (ObjectLiteral $ map (second (exprToCoreFn ss [] Nothing)) vs)
94+ exprToCoreFn ss com ty (A.Accessor name v) =
95+ Accessor (ss, com, ty, Nothing) name (exprToCoreFn ss [] Nothing v)
96+ exprToCoreFn ss com ty (A.ObjectUpdate obj vs) =
97+ ObjectUpdate (ss, com, ty, Nothing) (exprToCoreFn ss [] Nothing obj) $ map (second (exprToCoreFn ss [] Nothing)) vs
98+ exprToCoreFn ss com ty (A.Abs (Left name) v) =
99+ Abs (ss, com, ty, Nothing) name (exprToCoreFn ss [] Nothing v)
100+ exprToCoreFn _ _ _ (A.Abs _ _) =
101+ error "Abs with Binder argument was not desugared before exprToCoreFn mn"
102+ exprToCoreFn ss com ty (A.App v1 v2) =
103+ App (ss, com, ty, Nothing) (exprToCoreFn ss [] Nothing v1) (exprToCoreFn ss [] Nothing v2)
104+ exprToCoreFn ss com ty (A.Var ident) =
105+ Var (ss, com, ty, getValueMeta ident) ident
106+ exprToCoreFn ss com ty (A.IfThenElse v1 v2 v3) =
107+ Case (ss, com, ty, Nothing) [exprToCoreFn ss [] Nothing v1]
108+ [ CaseAlternative [LiteralBinder nullAnn $ BooleanLiteral True]
109+ (Right $ exprToCoreFn Nothing [] Nothing v2)
110+ , CaseAlternative [LiteralBinder nullAnn $ BooleanLiteral False]
111+ (Right $ exprToCoreFn Nothing [] Nothing v3) ]
112+ exprToCoreFn ss com ty (A.Constructor name) =
113+ Var (ss, com, ty, Just $ getConstructorMeta name) $ fmap properToIdent name
114+ exprToCoreFn ss com ty (A.Case vs alts) =
115+ Case (ss, com, ty, Nothing) (map (exprToCoreFn ss [] Nothing) vs) (map (altToCoreFn ss) alts)
116+ exprToCoreFn ss com _ (A.TypedValue _ v ty) =
117+ exprToCoreFn ss com (Just ty) v
118+ exprToCoreFn ss com ty (A.Let ds v) =
119+ Let (ss, com, ty, Nothing) (concatMap (declToCoreFn ss []) ds) (exprToCoreFn ss [] Nothing v)
120+ exprToCoreFn ss com _ (A.TypeClassDictionaryConstructorApp name (A.TypedValue _ (A.ObjectLiteral vs) _)) =
121+ let args = map (exprToCoreFn ss [] Nothing . snd) $ sortBy (compare `on` fst) vs
122+ ctor = Var (ss, [], Nothing, Just IsTypeClassConstructor) (fmap properToIdent name)
123+ in foldl (App (ss, com, Nothing, Nothing)) ctor args
124+ exprToCoreFn ss com ty (A.TypeClassDictionaryAccessor _ ident) =
125+ Abs (ss, com, ty, Nothing) (Ident "dict")
126+ (Accessor nullAnn (runIdent ident) (Var nullAnn $ Qualified Nothing (Ident "dict")))
127+ exprToCoreFn _ com ty (A.PositionedValue ss com1 v) =
128+ exprToCoreFn (Just ss) (com ++ com1) ty v
129+ exprToCoreFn _ _ _ e =
130+ error $ "Unexpected value in exprToCoreFn mn: " ++ show e
131+
132+ -- |
133+ -- Desugars case alternatives from AST to CoreFn representation.
134+ --
135+ altToCoreFn :: Maybe SourceSpan -> A.CaseAlternative -> CaseAlternative Ann
136+ altToCoreFn ss (A.CaseAlternative bs vs) = CaseAlternative (map (binderToCoreFn ss []) bs) (go vs)
137+ where
138+ go :: Either [(A.Guard, A.Expr)] A.Expr -> Either [(Guard Ann, Expr Ann)] (Expr Ann)
139+ go (Left ges) = Left $ map (exprToCoreFn ss [] Nothing *** exprToCoreFn ss [] Nothing) ges
140+ go (Right e) = Right (exprToCoreFn ss [] Nothing e)
141+
142+ -- |
143+ -- Desugars case binders from AST to CoreFn representation.
144+ --
145+ binderToCoreFn :: Maybe SourceSpan -> [Comment] -> A.Binder -> Binder Ann
146+ binderToCoreFn ss com (A.NullBinder) =
147+ NullBinder (ss, com, Nothing, Nothing)
148+ binderToCoreFn ss com (A.BooleanBinder b) =
149+ LiteralBinder (ss, com, Nothing, Nothing) (BooleanLiteral b)
150+ binderToCoreFn ss com (A.StringBinder s) =
151+ LiteralBinder (ss, com, Nothing, Nothing) (StringLiteral s)
152+ binderToCoreFn ss com (A.CharBinder c) =
153+ LiteralBinder (ss, com, Nothing, Nothing) (CharLiteral c)
154+ binderToCoreFn ss com (A.NumberBinder n) =
155+ LiteralBinder (ss, com, Nothing, Nothing) (NumericLiteral n)
156+ binderToCoreFn ss com (A.VarBinder name) =
157+ VarBinder (ss, com, Nothing, Nothing) name
158+ binderToCoreFn ss com (A.ConstructorBinder dctor@(Qualified mn' _) bs) =
159+ let (_, tctor, _, _) = lookupConstructor env dctor
160+ in ConstructorBinder (ss, com, Nothing, Just $ getConstructorMeta dctor) (Qualified mn' tctor) dctor (map (binderToCoreFn ss []) bs)
161+ binderToCoreFn ss com (A.ObjectBinder bs) =
162+ LiteralBinder (ss, com, Nothing, Nothing) (ObjectLiteral $ map (second (binderToCoreFn ss [])) bs)
163+ binderToCoreFn ss com (A.ArrayBinder bs) =
164+ LiteralBinder (ss, com, Nothing, Nothing) (ArrayLiteral $ map (binderToCoreFn ss []) bs)
165+ binderToCoreFn ss com (A.NamedBinder name b) =
166+ NamedBinder (ss, com, Nothing, Nothing) name (binderToCoreFn ss [] b)
167+ binderToCoreFn _ com (A.PositionedBinder ss com1 b) =
168+ binderToCoreFn (Just ss) (com ++ com1) b
169+
170+ -- |
171+ -- Gets metadata for values.
172+ --
173+ getValueMeta :: Qualified Ident -> Maybe Meta
174+ getValueMeta name =
175+ case lookupValue env name of
176+ Just (_, External, _) -> Just IsForeign
177+ _ -> Nothing
178+
179+ -- |
180+ -- Gets metadata for data constructors.
181+ --
182+ getConstructorMeta :: Qualified ProperName -> Meta
183+ getConstructorMeta ctor =
184+ case lookupConstructor env ctor of
185+ (Newtype, _, _, _) -> IsNewtype
186+ dc@(Data, _, _, fields) ->
187+ let constructorType = if numConstructors (ctor, dc) == 1 then ProductType else SumType
188+ in IsConstructor constructorType fields
189+ where
190+ numConstructors :: (Qualified ProperName, (DataDeclType, ProperName, Type, [Ident])) -> Int
191+ numConstructors ty = length $ filter (((==) `on` typeConstructor) ty) $ M.toList $ dataConstructors env
192+ typeConstructor :: (Qualified ProperName, (DataDeclType, ProperName, Type, [Ident])) -> (ModuleName, ProperName)
193+ typeConstructor (Qualified (Just mn') _, (_, tyCtor, _, _)) = (mn', tyCtor)
194+ typeConstructor _ = error "Invalid argument to typeConstructor"
195+
196+-- |
197+-- Find module names from qualified references to values. This is used to
198+-- ensure instances are imported from any module that is referenced by the
199+-- current module, not just from those that are imported explicitly (#667).
200+--
201+findQualModules :: [A.Declaration] -> [ModuleName]
202+findQualModules decls =
203+ let (f, _, _, _, _) = everythingOnValues (++) (const []) fqValues fqBinders (const []) (const [])
204+ in f `concatMap` decls
205+ where
206+ fqValues :: A.Expr -> [ModuleName]
207+ fqValues (A.Var (Qualified (Just mn) _)) = [mn]
208+ fqValues (A.Constructor (Qualified (Just mn) _)) = [mn]
209+ fqValues _ = []
210+
211+ fqBinders :: A.Binder -> [ModuleName]
212+ fqBinders (A.ConstructorBinder (Qualified (Just mn) _) _) = [mn]
213+ fqBinders _ = []
214+
215+-- |
216+-- Desugars import declarations from AST to CoreFn representation.
217+--
218+importToCoreFn :: A.Declaration -> Maybe ModuleName
219+importToCoreFn (A.ImportDeclaration name _ _) = Just name
220+importToCoreFn (A.PositionedDeclaration _ _ d) = importToCoreFn d
221+importToCoreFn _ = Nothing
222+
223+-- |
224+-- Desugars foreign declarations from AST to CoreFn representation.
225+--
226+externToCoreFn :: A.Declaration -> Maybe ForeignDecl
227+externToCoreFn (A.ExternDeclaration name ty) = Just (name, ty)
228+externToCoreFn (A.PositionedDeclaration _ _ d) = externToCoreFn d
229+externToCoreFn _ = Nothing
230+
231+-- |
232+-- Desugars export declarations references from AST to CoreFn representation.
233+-- CoreFn modules only export values, so all data constructors, class
234+-- constructor, instances and values are flattened into one list.
235+--
236+exportToCoreFn :: A.DeclarationRef -> [Ident]
237+exportToCoreFn (A.TypeRef _ (Just dctors)) = map properToIdent dctors
238+exportToCoreFn (A.ValueRef name) = [name]
239+exportToCoreFn (A.TypeClassRef name) = [properToIdent name]
240+exportToCoreFn (A.TypeInstanceRef name) = [name]
241+exportToCoreFn (A.PositionedDeclarationRef _ _ d) = exportToCoreFn d
242+exportToCoreFn _ = []
243+
244+-- |
245+-- Makes a typeclass dictionary constructor function. The returned expression
246+-- is a function that accepts the superclass instances and member
247+-- implementations and returns a record for the instance dictionary.
248+--
249+mkTypeClassConstructor :: Maybe SourceSpan -> [Comment] -> [Constraint] -> [A.Declaration] -> Expr Ann
250+mkTypeClassConstructor ss com [] [] = Literal (ss, com, Nothing, Just IsTypeClassConstructor) (ObjectLiteral [])
251+mkTypeClassConstructor ss com supers members =
252+ let args@(a:as) = sort $ map typeClassMemberName members ++ superClassDictionaryNames supers
253+ props = [ (arg, Var nullAnn $ Qualified Nothing (Ident arg)) | arg <- args ]
254+ dict = Literal nullAnn (ObjectLiteral props)
255+ in Abs (ss, com, Nothing, Just IsTypeClassConstructor)
256+ (Ident a)
257+ (foldr (Abs nullAnn . Ident) dict as)
258+
259+-- |
260+-- Converts a ProperName to an Ident.
261+--
262+properToIdent :: ProperName -> Ident
263+properToIdent = Ident . runProperName
src/Language/PureScript/CoreFn/Expr.hsnew file+134
@@ -0,0 +1,134 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.CoreFn.Expr
4+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- | The core functional representation
12+--
13+-----------------------------------------------------------------------------
14+
15+{-# LANGUAGE DeriveDataTypeable #-}
16+{-# LANGUAGE DeriveFunctor #-}
17+
18+module Language.PureScript.CoreFn.Expr where
19+
20+import Control.Arrow ((***))
21+
22+import qualified Data.Data as D
23+
24+import Language.PureScript.CoreFn.Binders
25+import Language.PureScript.CoreFn.Literals
26+import Language.PureScript.Names
27+
28+-- |
29+-- Data type for expressions and terms
30+--
31+data Expr a
32+ -- |
33+ -- A literal value
34+ --
35+ = Literal a (Literal (Expr a))
36+ -- |
37+ -- A data constructor (type name, constructor name, field names)
38+ --
39+ | Constructor a ProperName ProperName [Ident]
40+ -- |
41+ -- A record property accessor
42+ --
43+ | Accessor a String (Expr a)
44+ -- |
45+ -- Partial record update
46+ --
47+ | ObjectUpdate a (Expr a) [(String, Expr a)]
48+ -- |
49+ -- Function introduction
50+ --
51+ | Abs a Ident (Expr a)
52+ -- |
53+ -- Function application
54+ --
55+ | App a (Expr a) (Expr a)
56+ -- |
57+ -- Variable
58+ --
59+ | Var a (Qualified Ident)
60+ -- |
61+ -- A case expression
62+ --
63+ | Case a [Expr a] [CaseAlternative a]
64+ -- |
65+ -- A let binding
66+ --
67+ | Let a [Bind a] (Expr a) deriving (Show, Read, D.Data, D.Typeable, Functor)
68+
69+-- |
70+-- A let or module binding.
71+--
72+data Bind a
73+ -- |
74+ -- Non-recursive binding for a single value
75+ --
76+ = NonRec Ident (Expr a)
77+ -- |
78+ -- Mutually recursive binding group for several values
79+ --
80+ | Rec [(Ident, Expr a)] deriving (Show, Read, D.Data, D.Typeable, Functor)
81+
82+-- |
83+-- A guard is just a boolean-valued expression that appears alongside a set of binders
84+--
85+type Guard a = Expr a
86+
87+-- |
88+-- An alternative in a case statement
89+--
90+data CaseAlternative a = CaseAlternative
91+ { -- |
92+ -- A collection of binders with which to match the inputs
93+ --
94+ caseAlternativeBinders :: [Binder a]
95+ -- |
96+ -- The result expression or a collect of guarded expressions
97+ --
98+ , caseAlternativeResult :: Either [(Guard a, Expr a)] (Expr a)
99+ } deriving (Show, Read, D.Data, D.Typeable)
100+
101+instance Functor CaseAlternative where
102+
103+ fmap f (CaseAlternative cabs car) = CaseAlternative
104+ (fmap (fmap f) $ cabs)
105+ (either (Left . fmap (fmap f *** fmap f)) (Right . fmap f) car)
106+
107+-- |
108+-- Extract the annotation from a term
109+--
110+extractAnn :: Expr a -> a
111+extractAnn (Literal a _) = a
112+extractAnn (Constructor a _ _ _) = a
113+extractAnn (Accessor a _ _) = a
114+extractAnn (ObjectUpdate a _ _) = a
115+extractAnn (Abs a _ _) = a
116+extractAnn (App a _ _) = a
117+extractAnn (Var a _) = a
118+extractAnn (Case a _ _) = a
119+extractAnn (Let a _ _) = a
120+
121+
122+-- |
123+-- Modify the annotation on a term
124+--
125+modifyAnn :: (a -> a) -> Expr a -> Expr a
126+modifyAnn f (Literal a b) = Literal (f a) b
127+modifyAnn f (Constructor a b c d) = Constructor (f a) b c d
128+modifyAnn f (Accessor a b c) = Accessor (f a) b c
129+modifyAnn f (ObjectUpdate a b c) = ObjectUpdate (f a) b c
130+modifyAnn f (Abs a b c) = Abs (f a) b c
131+modifyAnn f (App a b c) = App (f a) b c
132+modifyAnn f (Var a b) = Var (f a) b
133+modifyAnn f (Case a b c) = Case (f a) b c
134+modifyAnn f (Let a b c) = Let (f a) b c
src/Language/PureScript/CoreFn/Literals.hsnew file+50
@@ -0,0 +1,50 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.CoreFn.Literals
4+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- | The core functional representation for literal values.
12+--
13+-----------------------------------------------------------------------------
14+
15+{-# LANGUAGE DeriveDataTypeable #-}
16+{-# LANGUAGE DeriveFunctor #-}
17+
18+module Language.PureScript.CoreFn.Literals where
19+
20+import qualified Data.Data as D
21+
22+-- |
23+-- Data type for literal values. Parameterised so it can be used for Exprs and
24+-- Binders.
25+--
26+data Literal a
27+ -- |
28+ -- A numeric literal
29+ --
30+ = NumericLiteral (Either Integer Double)
31+ -- |
32+ -- A string literal
33+ --
34+ | StringLiteral String
35+ -- |
36+ -- A character literal
37+ --
38+ | CharLiteral Char
39+ -- |
40+ -- A boolean literal
41+ --
42+ | BooleanLiteral Bool
43+ -- |
44+ -- An array literal
45+ --
46+ | ArrayLiteral [a]
47+ -- |
48+ -- An object literal
49+ --
50+ | ObjectLiteral [(String, a)] deriving (Show, Read, D.Data, D.Typeable, Functor)
src/Language/PureScript/CoreFn/Meta.hsnew file+55
@@ -0,0 +1,55 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.CoreFn.Meta
4+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- | Metadata annotations for core functional representation
12+--
13+-----------------------------------------------------------------------------
14+
15+{-# LANGUAGE DeriveDataTypeable #-}
16+
17+module Language.PureScript.CoreFn.Meta where
18+
19+import qualified Data.Data as D
20+
21+import Language.PureScript.Names
22+
23+-- |
24+-- Metadata annotations
25+--
26+data Meta
27+ -- |
28+ -- The contained value is a data constructor
29+ --
30+ = IsConstructor ConstructorType [Ident]
31+ -- |
32+ -- The contained value is a newtype
33+ --
34+ | IsNewtype
35+ -- |
36+ -- The contained value is a typeclass dictionary constructor
37+ --
38+ | IsTypeClassConstructor
39+ -- |
40+ -- The contained reference is for a foreign member
41+ --
42+ | IsForeign deriving (Show, Read, D.Data, D.Typeable)
43+
44+-- |
45+-- Data constructor metadata
46+--
47+data ConstructorType
48+ -- |
49+ -- The constructor is for a type with a single construcor
50+ --
51+ = ProductType
52+ -- |
53+ -- The constructor is for a type with multiple construcors
54+ --
55+ | SumType deriving (Show, Read, D.Data, D.Typeable)
src/Language/PureScript/CoreFn/Module.hsnew file+31
@@ -0,0 +1,31 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.CoreFn.Module
4+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- | The CoreFn module representation
12+--
13+-----------------------------------------------------------------------------
14+
15+module Language.PureScript.CoreFn.Module where
16+
17+import Language.PureScript.Comments
18+import Language.PureScript.CoreFn.Expr
19+import Language.PureScript.Names
20+import Language.PureScript.Types
21+
22+data Module a = Module
23+ { moduleComments :: [Comment]
24+ , moduleName :: ModuleName
25+ , moduleImports :: [ModuleName]
26+ , moduleExports :: [Ident]
27+ , moduleForeign :: [ForeignDecl]
28+ , moduleDecls :: [Bind a]
29+ } deriving (Show, Read)
30+
31+type ForeignDecl = (Ident, Type)
src/Language/PureScript/CoreFn/Traversals.hsnew file+85
@@ -0,0 +1,85 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.CoreFn.Traversals
4+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- | CoreFn traversal helpers
12+--
13+-----------------------------------------------------------------------------
14+
15+module Language.PureScript.CoreFn.Traversals where
16+
17+import Control.Arrow (second, (***), (+++))
18+
19+import Language.PureScript.CoreFn.Binders
20+import Language.PureScript.CoreFn.Expr
21+import Language.PureScript.CoreFn.Literals
22+
23+everywhereOnValues :: (Bind a -> Bind a) ->
24+ (Expr a -> Expr a) ->
25+ (Binder a -> Binder a) ->
26+ (Bind a -> Bind a, Expr a -> Expr a, Binder a -> Binder a)
27+everywhereOnValues f g h = (f', g', h')
28+ where
29+ f' (NonRec name e) = f (NonRec name (g' e))
30+ f' (Rec es) = f (Rec (map (second g') es))
31+
32+ g' (Literal ann e) = g (Literal ann (handleLiteral g' e))
33+ g' (Accessor ann prop e) = g (Accessor ann prop (g' e))
34+ g' (ObjectUpdate ann obj vs) = g (ObjectUpdate ann (g' obj) (map (fmap g') vs))
35+ g' (Abs ann name e) = g (Abs ann name (g' e))
36+ g' (App ann v1 v2) = g (App ann (g' v1) (g' v2))
37+ g' (Case ann vs alts) = g (Case ann (map g' vs) (map handleCaseAlternative alts))
38+ g' (Let ann ds e) = g (Let ann (map f' ds) (g' e))
39+ g' e = g e
40+
41+ h' (LiteralBinder a b) = h (LiteralBinder a (handleLiteral h' b))
42+ h' (NamedBinder a name b) = h (NamedBinder a name (h' b))
43+ h' b = h b
44+
45+ handleCaseAlternative ca =
46+ ca { caseAlternativeBinders = map h' (caseAlternativeBinders ca)
47+ , caseAlternativeResult = (map (g' *** g') +++ g') (caseAlternativeResult ca)
48+ }
49+
50+ handleLiteral :: (a -> a) -> Literal a -> Literal a
51+ handleLiteral i (ArrayLiteral ls) = ArrayLiteral (map i ls)
52+ handleLiteral i (ObjectLiteral ls) = ObjectLiteral (map (fmap i) ls)
53+ handleLiteral _ other = other
54+
55+everythingOnValues :: (r -> r -> r) ->
56+ (Bind a -> r) ->
57+ (Expr a -> r) ->
58+ (Binder a -> r) ->
59+ (CaseAlternative a -> r) ->
60+ (Bind a -> r, Expr a -> r, Binder a -> r, CaseAlternative a -> r)
61+everythingOnValues (<>) f g h i = (f', g', h', i')
62+ where
63+ f' b@(NonRec _ e) = f b <> g' e
64+ f' b@(Rec es) = foldl (<>) (f b) (map (g' . snd) es)
65+
66+ g' v@(Literal _ l) = foldl (<>) (g v) (map g' (extractLiteral l))
67+ g' v@(Accessor _ _ e1) = g v <> g' e1
68+ g' v@(ObjectUpdate _ obj vs) = foldl (<>) (g v <> g' obj) (map (g' . snd) vs)
69+ g' v@(Abs _ _ e1) = g v <> g' e1
70+ g' v@(App _ e1 e2) = g v <> g' e1 <> g' e2
71+ g' v@(Case _ vs alts) = foldl (<>) (foldl (<>) (g v) (map g' vs)) (map i' alts)
72+ g' v@(Let _ ds e1) = foldl (<>) (g v) (map f' ds) <> g' e1
73+ g' v = g v
74+
75+ h' b@(LiteralBinder _ l) = foldl (<>) (h b) (map h' (extractLiteral l))
76+ h' b@(ConstructorBinder _ _ _ bs) = foldl (<>) (h b) (map h' bs)
77+ h' b@(NamedBinder _ _ b1) = h b <> h' b1
78+ h' b = h b
79+
80+ i' ca@(CaseAlternative bs (Right val)) = foldl (<>) (i ca) (map h' bs) <> g' val
81+ i' ca@(CaseAlternative bs (Left gs)) = foldl (<>) (i ca) (map h' bs ++ concatMap (\(grd, val) -> [g' grd, g' val]) gs)
82+
83+ extractLiteral (ArrayLiteral xs) = xs
84+ extractLiteral (ObjectLiteral xs) = map snd xs
85+ extractLiteral _ = []
src/Language/PureScript/DeadCodeElimination.hsdeleted−113
@@ -1,113 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.DeadCodeElimination
4−-- Copyright : (c) 2014 Phil Freeman
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- |
12−--
13−-----------------------------------------------------------------------------
14−
15−module Language.PureScript.DeadCodeElimination (
16− eliminateDeadCode
17−) where
18−
19−import Data.List
20−import Data.Graph
21−import Data.Maybe (mapMaybe)
22−
23−import Language.PureScript.Names
24−import Language.PureScript.Declarations
25−
26−-- |
27−-- Eliminate all declarations which are not a transitive dependency of the entry point module
28−--
29−eliminateDeadCode :: [ModuleName] -> [Module] -> [Module]
30−eliminateDeadCode entryPoints ms = map go ms
31− where
32− go (Module moduleName ds (Just exps)) = Module moduleName ds' (Just exps')
33− where
34− ds' = filter (isUsed moduleName graph vertexFor entryPointVertices) ds
35− exps' = mapMaybe (filterExport ds') exps
36− go _ = error "Exports should have been elaborated in name desugaring"
37− declarations = concatMap declarationsByModule ms
38− (graph, _, vertexFor) = graphFromEdges $ map (\(key, deps) -> (key, key, deps)) declarations
39− entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((mn, _), _) -> mn `elem` entryPoints) $ declarations
40−
41− filterExport :: [Declaration] -> DeclarationRef -> Maybe DeclarationRef
42− filterExport decls r@(TypeRef name _) | (any $ typeOrClassExists name) decls = Just r
43− filterExport decls r@(TypeClassRef name) | (any $ typeOrClassExists name) decls = Just r
44− filterExport decls r@(ValueRef name) | (any $ valueExists name) decls = Just r
45− filterExport decls r@(TypeInstanceRef name) | (any $ valueExists name) decls = Just r
46− filterExport _ _ = Nothing
47−
48− valueExists :: Ident -> Declaration -> Bool
49− valueExists name (ValueDeclaration name' _ _ _ _) = name == name'
50− valueExists name (ExternDeclaration _ name' _ _) = name == name'
51− valueExists name (BindingGroupDeclaration decls) = any (\(name', _, _) -> name == name') decls
52− valueExists name (PositionedDeclaration _ d) = valueExists name d
53− valueExists _ _ = False
54−
55− typeOrClassExists :: ProperName -> Declaration -> Bool
56− typeOrClassExists name (DataDeclaration _ name' _ _) = name == name'
57− typeOrClassExists name (TypeClassDeclaration name' _ _ _) = name == name'
58− typeOrClassExists name (DataBindingGroupDeclaration decls) = any (typeOrClassExists name) decls
59− typeOrClassExists name (PositionedDeclaration _ d) = typeOrClassExists name d
60− typeOrClassExists _ _ = False
61−
62−type Key = (ModuleName, Either Ident ProperName)
63−
64−declarationsByModule :: Module -> [(Key, [Key])]
65−declarationsByModule (Module moduleName ds _) = concatMap go ds
66− where
67− go :: Declaration -> [(Key, [Key])]
68− go d@(ValueDeclaration name _ _ _ _) = [((moduleName, Left name), dependencies moduleName d)]
69− go (DataDeclaration _ _ _ dctors) = map (\(name, _) -> ((moduleName, Right name), [])) dctors
70− go (ExternDeclaration _ name _ _) = [((moduleName, Left name), [])]
71− go d@(BindingGroupDeclaration names') = map (\(name, _, _) -> ((moduleName, Left name), dependencies moduleName d)) names'
72− go (DataBindingGroupDeclaration ds') = concatMap go ds'
73− go (TypeClassDeclaration name _ _ _) = [((moduleName, Right name), [])]
74− go (PositionedDeclaration _ d) = go d
75− go _ = []
76−
77−dependencies :: ModuleName -> Declaration -> [Key]
78−dependencies moduleName =
79− let (f, _, _, _, _) = everythingOnValues (++) (const []) values (const []) (const []) (const [])
80− in nub . f
81− where
82− values :: Expr -> [Key]
83− values (Var ident) = let (mn, name) = qualify moduleName ident in [(mn, Left name)]
84− values (Constructor (Qualified (Just mn) name)) = [(mn, Right name)]
85− values (Constructor (Qualified Nothing _)) = error "Found unqualified data constructor"
86− values (TypeClassDictionaryConstructorApp (Qualified (Just mn) name) _) = [(mn, Right name)]
87− values (TypeClassDictionaryConstructorApp (Qualified Nothing _) _) = error "Found unqualified class dictionary constructor"
88− values _ = []
89−
90−isUsed :: ModuleName -> Graph -> (Key -> Maybe Vertex) -> [Vertex] -> Declaration -> Bool
91−isUsed moduleName graph vertexFor entryPointVertices (ValueDeclaration name _ _ _ _) =
92− let Just v' = vertexFor (moduleName, Left name)
93− in any (\v -> path graph v v') entryPointVertices
94−isUsed moduleName graph vertexFor entryPointVertices (FixityDeclaration _ name) =
95− let Just v' = vertexFor (moduleName, Left $ Op name)
96− in any (\v -> path graph v v') entryPointVertices
97−isUsed moduleName graph vertexFor entryPointVertices (DataDeclaration _ _ _ dctors) =
98− any (\(pn, _) -> let Just v' = vertexFor (moduleName, Right pn)
99− in any (\v -> path graph v v') entryPointVertices) dctors
100−isUsed moduleName graph vertexFor entryPointVertices (ExternDeclaration _ name _ _) =
101− let Just v' = vertexFor (moduleName, Left name)
102− in any (\v -> path graph v v') entryPointVertices
103−isUsed moduleName graph vertexFor entryPointVertices (BindingGroupDeclaration ds) =
104− any (\(name, _, _) -> let Just v' = vertexFor (moduleName, Left name)
105− in any (\v -> path graph v v') entryPointVertices) ds
106−isUsed moduleName graph vertexFor entryPointVertices (DataBindingGroupDeclaration ds) =
107− any (isUsed moduleName graph vertexFor entryPointVertices) ds
108−isUsed moduleName graph vertexFor entryPointVertices (TypeClassDeclaration name _ _ _) =
109− let Just v' = vertexFor (moduleName, Right name)
110− in any (\v -> path graph v v') entryPointVertices
111−isUsed moduleName graph vertexFor entryPointVertices (PositionedDeclaration _ d) =
112− isUsed moduleName graph vertexFor entryPointVertices d
113−isUsed _ _ _ _ _ = True
src/Language/PureScript/Declarations.hsdeleted−853
@@ -1,853 +0,0 @@
1−-----------------------------------------------------------------------------
2−--
3−-- Module : Language.PureScript.Declarations
4−-- Copyright : (c) Phil Freeman 2013
5−-- License : MIT
6−--
7−-- Maintainer : Phil Freeman <paf31@cantab.net>
8−-- Stability : experimental
9−-- Portability :
10−--
11−-- | Data types for modules and declarations
12−--
13−-----------------------------------------------------------------------------
14−
15−{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}
16−
17−module Language.PureScript.Declarations where
18−
19−import Data.Monoid (Monoid(..), mconcat)
20−
21−import qualified Data.Data as D
22−
23−import Control.Applicative
24−import Control.Monad
25−
26−import Language.PureScript.Types
27−import Language.PureScript.Names
28−import Language.PureScript.Kinds
29−import Language.PureScript.TypeClassDictionaries
30−import Language.PureScript.CodeGen.JS.AST
31−import Language.PureScript.Environment
32−import Language.PureScript.Traversals
33−
34−-- |
35−-- A precedence level for an infix operator
36−--
37−type Precedence = Integer
38−
39−-- |
40−-- Associativity for infix operators
41−--
42−data Associativity = Infixl | Infixr | Infix deriving (D.Data, D.Typeable)
43−
44−instance Show Associativity where
45− show Infixl = "infixl"
46− show Infixr = "infixr"
47− show Infix = "infix"
48−
49−-- |
50−-- Source position information
51−--
52−data SourcePos = SourcePos
53− { -- |
54− -- Source name
55− --
56− sourceName :: String
57− -- |
58− -- Line number
59− --
60− , sourcePosLine :: Int
61− -- |
62− -- Column number
63− --
64− , sourcePosColumn :: Int
65− } deriving (D.Data, D.Typeable)
66−
67−instance Show SourcePos where
68− show sp = (sourceName sp) ++ " line " ++ show (sourcePosLine sp) ++ ", column " ++ show (sourcePosColumn sp)
69−
70−-- |
71−-- Fixity data for infix operators
72−--
73−data Fixity = Fixity Associativity Precedence deriving (Show, D.Data, D.Typeable)
74−
75−-- |
76−-- A module declaration, consisting of a module name, a list of declarations, and a list of the
77−-- declarations that are explicitly exported. If the export list is Nothing, everything is exported.
78−--
79−data Module = Module ModuleName [Declaration] (Maybe [DeclarationRef]) deriving (Show, D.Data, D.Typeable)
80−
81−-- |
82−-- An item in a list of explicit imports or exports
83−--
84−data DeclarationRef
85− -- |
86− -- A type constructor with data constructors
87− --
88− = TypeRef ProperName (Maybe [ProperName])
89− -- |
90− -- A value
91− --
92− | ValueRef Ident
93− -- |
94− -- A type class
95− --
96− | TypeClassRef ProperName
97− -- |
98− -- A type class instance, created during typeclass desugaring (name, class name, instance types)
99− --
100− | TypeInstanceRef Ident
101− -- |
102− -- A declaration reference with source position information
103− --
104− | PositionedDeclarationRef SourcePos DeclarationRef
105− deriving (Show, D.Data, D.Typeable)
106−
107−instance Eq DeclarationRef where
108− (TypeRef name dctors) == (TypeRef name' dctors') = name == name' && dctors == dctors'
109− (ValueRef name) == (ValueRef name') = name == name'
110− (TypeClassRef name) == (TypeClassRef name') = name == name'
111− (TypeInstanceRef name) == (TypeInstanceRef name') = name == name'
112− (PositionedDeclarationRef _ r) == r' = r == r'
113− r == (PositionedDeclarationRef _ r') = r == r'
114− _ == _ = False
115−
116−-- |
117−-- The data type which specifies type of import declaration
118−--
119−data ImportDeclarationType
120− -- |
121− -- Unqualified import
122− --
123− = Unqualified
124− -- |
125− -- Qualified import with a list of references to import
126− --
127− | Qualifying [DeclarationRef]
128− -- |
129− -- Import with hiding clause with a list of references to hide
130− --
131− | Hiding [DeclarationRef]
132− deriving (Show, D.Data, D.Typeable)
133−
134−-- |
135−-- The data type of declarations
136−--
137−data Declaration
138− -- |
139− -- A data type declaration (data or newtype, name, arguments, data constructors)
140− --
141− = DataDeclaration DataDeclType ProperName [String] [(ProperName, [Type])]
142− -- |
143− -- A minimal mutually recursive set of data type declarations
144− --
145− | DataBindingGroupDeclaration [Declaration]
146− -- |
147− -- A type synonym declaration (name, arguments, type)
148− --
149− | TypeSynonymDeclaration ProperName [String] Type
150− -- |
151− -- A type declaration for a value (name, ty)
152− --
153− | TypeDeclaration Ident Type
154− -- |
155− -- A value declaration (name, top-level binders, optional guard, value)
156− --
157− | ValueDeclaration Ident NameKind [Binder] (Maybe Guard) Expr
158− -- |
159− -- A minimal mutually recursive set of value declarations
160− --
161− | BindingGroupDeclaration [(Ident, NameKind, Expr)]
162− -- |
163− -- A foreign import declaration (type, name, optional inline Javascript, type)
164− --
165− | ExternDeclaration ForeignImportType Ident (Maybe JS) Type
166− -- |
167− -- A data type foreign import (name, kind)
168− --
169− | ExternDataDeclaration ProperName Kind
170− -- |
171− -- A type class instance foreign import
172− --
173− | ExternInstanceDeclaration Ident [(Qualified ProperName, [Type])] (Qualified ProperName) [Type]
174− -- |
175− -- A fixity declaration (fixity data, operator name)
176− --
177− | FixityDeclaration Fixity String
178− -- |
179− -- A module import (module name, optional set of identifiers to import,
180− -- optional set of identifiers to hide, optional "qualified as" name)
181− --
182− | ImportDeclaration ModuleName ImportDeclarationType (Maybe ModuleName)
183− -- |
184− -- A type class declaration (name, argument, implies, member declarations)
185− --
186− | TypeClassDeclaration ProperName [String] [(Qualified ProperName, [Type])] [Declaration]
187− -- |
188− -- A type instance declaration (name, dependencies, class name, instance types, member
189− -- declarations)
190− --
191− | TypeInstanceDeclaration Ident [(Qualified ProperName, [Type])] (Qualified ProperName) [Type] [Declaration]
192− -- |
193− -- A declaration with source position information
194− --
195− | PositionedDeclaration SourcePos Declaration
196− deriving (Show, D.Data, D.Typeable)
197−
198−-- |
199−-- Test if a declaration is a value declaration
200−--
201−isValueDecl :: Declaration -> Bool
202−isValueDecl ValueDeclaration{} = True
203−isValueDecl (PositionedDeclaration _ d) = isValueDecl d
204−isValueDecl _ = False
205−
206−-- |
207−-- Test if a declaration is a data type or type synonym declaration
208−--
209−isDataDecl :: Declaration -> Bool
210−isDataDecl DataDeclaration{} = True
211−isDataDecl TypeSynonymDeclaration{} = True
212−isDataDecl (PositionedDeclaration _ d) = isDataDecl d
213−isDataDecl _ = False
214−
215−-- |
216−-- Test if a declaration is a module import
217−--
218−isImportDecl :: Declaration -> Bool
219−isImportDecl ImportDeclaration{} = True
220−isImportDecl (PositionedDeclaration _ d) = isImportDecl d
221−isImportDecl _ = False
222−
223−-- |
224−-- Test if a declaration is a data type foreign import
225−--
226−isExternDataDecl :: Declaration -> Bool
227−isExternDataDecl ExternDataDeclaration{} = True
228−isExternDataDecl (PositionedDeclaration _ d) = isExternDataDecl d
229−isExternDataDecl _ = False
230−
231−-- |
232−-- Test if a declaration is a type class instance foreign import
233−--
234−isExternInstanceDecl :: Declaration -> Bool
235−isExternInstanceDecl ExternInstanceDeclaration{} = True
236−isExternInstanceDecl (PositionedDeclaration _ d) = isExternInstanceDecl d
237−isExternInstanceDecl _ = False
238−
239−-- |
240−-- Test if a declaration is a fixity declaration
241−--
242−isFixityDecl :: Declaration -> Bool
243−isFixityDecl FixityDeclaration{} = True
244−isFixityDecl (PositionedDeclaration _ d) = isFixityDecl d
245−isFixityDecl _ = False
246−
247−-- |
248−-- Test if a declaration is a foreign import
249−--
250−isExternDecl :: Declaration -> Bool
251−isExternDecl ExternDeclaration{} = True
252−isExternDecl (PositionedDeclaration _ d) = isExternDecl d
253−isExternDecl _ = False
254−
255−-- |
256−-- Test if a declaration is a type class or instance declaration
257−--
258−isTypeClassDeclaration :: Declaration -> Bool
259−isTypeClassDeclaration TypeClassDeclaration{} = True
260−isTypeClassDeclaration TypeInstanceDeclaration{} = True
261−isTypeClassDeclaration (PositionedDeclaration _ d) = isTypeClassDeclaration d
262−isTypeClassDeclaration _ = False
263−
264−-- |
265−-- A guard is just a boolean-valued expression that appears alongside a set of binders
266−--
267−type Guard = Expr
268−
269−-- |
270−-- Data type for expressions and terms
271−--
272−data Expr
273− -- |
274− -- A numeric literal
275− --
276− = NumericLiteral (Either Integer Double)
277− -- |
278− -- A string literal
279− --
280− | StringLiteral String
281− -- |
282− -- A boolean literal
283− --
284− | BooleanLiteral Bool
285− -- |
286− -- A prefix -, will be desugared
287− --
288− | UnaryMinus Expr
289− -- |
290− -- Binary operator application. During the rebracketing phase of desugaring, this data constructor
291− -- will be removed.
292− --
293− | BinaryNoParens (Qualified Ident) Expr Expr
294− -- |
295− -- Explicit parentheses. During the rebracketing phase of desugaring, this data constructor
296− -- will be removed.
297− --
298− | Parens Expr
299− -- |
300− -- An array literal
301− --
302− | ArrayLiteral [Expr]
303− -- |
304− -- An object literal
305− --
306− | ObjectLiteral [(String, Expr)]
307− -- |
308− -- An record property accessor expression
309− --
310− | Accessor String Expr
311− -- |
312− -- Partial record update
313− --
314− | ObjectUpdate Expr [(String, Expr)]
315− -- |
316− -- Function introduction
317− --
318− | Abs (Either Ident Binder) Expr
319− -- |
320− -- Function application
321− --
322− | App Expr Expr
323− -- |
324− -- Variable
325− --
326− | Var (Qualified Ident)
327− -- |
328− -- Conditional (if-then-else expression)
329− --
330− | IfThenElse Expr Expr Expr
331− -- |
332− -- A data constructor
333− --
334− | Constructor (Qualified ProperName)
335− -- |
336− -- A case expression. During the case expansion phase of desugaring, top-level binders will get
337− -- desugared into case expressions, hence the need for guards and multiple binders per branch here.
338− --
339− | Case [Expr] [CaseAlternative]
340− -- |
341− -- A value with a type annotation
342− --
343− | TypedValue Bool Expr Type
344− -- |
345− -- A let binding
346− --
347− | Let [Declaration] Expr
348− -- |
349− -- A do-notation block
350− --
351− | Do [DoNotationElement]
352− -- |
353− -- An application of a typeclass dictionary constructor. The value should be
354− -- an ObjectLiteral.
355− --
356− | TypeClassDictionaryConstructorApp (Qualified ProperName) Expr
357− -- |
358− -- A placeholder for a type class dictionary to be inserted later. At the end of type checking, these
359− -- placeholders will be replaced with actual expressions representing type classes dictionaries which
360− -- can be evaluated at runtime. The constructor arguments represent (in order): whether or not to look
361− -- at superclass implementations when searching for a dictionary, the type class name and
362− -- instance type, and the type class dictionaries in scope.
363− --
364− | TypeClassDictionary Bool (Qualified ProperName, [Type]) [TypeClassDictionaryInScope]
365− -- |
366− -- A placeholder for a superclass dictionary to be turned into a TypeClassDictionary during typechecking
367− --
368− | SuperClassDictionary (Qualified ProperName) [Type]
369− -- |
370− -- A value with source position information
371− --
372− | PositionedValue SourcePos Expr deriving (Show, D.Data, D.Typeable)
373−
374−-- |
375−-- An alternative in a case statement
376−--
377−data CaseAlternative = CaseAlternative
378− { -- |
379− -- A collection of binders with which to match the inputs
380− --
381− caseAlternativeBinders :: [Binder]
382− -- |
383− -- An optional guard
384− --
385− , caseAlternativeGuard :: Maybe Guard
386− -- |
387− -- The result expression
388− --
389− , caseAlternativeResult :: Expr
390− } deriving (Show, D.Data, D.Typeable)
391−
392−-- |
393−-- Find the original dictionary which a type class dictionary in scope refers to
394−--
395−canonicalizeDictionary :: TypeClassDictionaryInScope -> Qualified Ident
396−canonicalizeDictionary (TypeClassDictionaryInScope { tcdType = TCDRegular, tcdName = nm }) = nm
397−canonicalizeDictionary (TypeClassDictionaryInScope { tcdType = TCDAlias nm }) = nm
398−
399−-- |
400−-- A statement in a do-notation block
401−--
402−data DoNotationElement
403− -- |
404− -- A monadic value without a binder
405− --
406− = DoNotationValue Expr
407− -- |
408− -- A monadic value with a binder
409− --
410− | DoNotationBind Binder Expr
411− -- |
412− -- A let statement, i.e. a pure value with a binder
413− --
414− | DoNotationLet [Declaration]
415− -- |
416− -- A do notation element with source position information
417− --
418− | PositionedDoNotationElement SourcePos DoNotationElement deriving (Show, D.Data, D.Typeable)
419−
420−-- |
421−-- Data type for binders
422−--
423−data Binder
424− -- |
425− -- Wildcard binder
426− --
427− = NullBinder
428− -- |
429− -- A binder which matches a boolean literal
430− --
431− | BooleanBinder Bool
432− -- |
433− -- A binder which matches a string literal
434− --
435− | StringBinder String
436− -- |
437− -- A binder which matches a numeric literal
438− --
439− | NumberBinder (Either Integer Double)
440− -- |
441− -- A binder which binds an identifier
442− --
443− | VarBinder Ident
444− -- |
445− -- A binder which matches a data constructor
446− --
447− | ConstructorBinder (Qualified ProperName) [Binder]
448− -- |
449− -- A binder which matches a record and binds its properties
450− --
451− | ObjectBinder [(String, Binder)]
452− -- |
453− -- A binder which matches an array and binds its elements
454− --
455− | ArrayBinder [Binder]
456− -- |
457− -- A binder which matches an array and binds its head and tail
458− --
459− | ConsBinder Binder Binder
460− -- |
461− -- A binder which binds its input to an identifier
462− --
463− | NamedBinder Ident Binder
464− -- |
465− -- A binder with source position information
466− --
467− | PositionedBinder SourcePos Binder
468− -- |
469− -- A binder with a type annotation
470− --
471− | TypedBinder Type Binder deriving (Show, D.Data, D.Typeable)
472−
473−-- |
474−-- Collect all names introduced in binders in an expression
475−--
476−binderNames :: Binder -> [Ident]
477−binderNames = go []
478− where
479− go ns (VarBinder name) = name : ns
480− go ns (ConstructorBinder _ bs) = foldl go ns bs
481− go ns (ObjectBinder bs) = foldl go ns (map snd bs)
482− go ns (ArrayBinder bs) = foldl go ns bs
483− go ns (ConsBinder b1 b2) = go (go ns b1) b2
484− go ns (NamedBinder name b) = go (name : ns) b
485− go ns (PositionedBinder _ b) = go ns b
486− go ns _ = ns
487−
488−--
489−-- Traversals
490−--
491−
492−everywhereOnValues :: (Declaration -> Declaration) ->
493− (Expr -> Expr) ->
494− (Binder -> Binder) ->
495− (Declaration -> Declaration, Expr -> Expr, Binder -> Binder)
496−everywhereOnValues f g h = (f', g', h')
497− where
498− f' :: Declaration -> Declaration
499− f' (DataBindingGroupDeclaration ds) = f (DataBindingGroupDeclaration (map f' ds))
500− f' (ValueDeclaration name nameKind bs grd val) = f (ValueDeclaration name nameKind (map h' bs) (fmap g' grd) (g' val))
501− f' (BindingGroupDeclaration ds) = f (BindingGroupDeclaration (map (\(name, nameKind, val) -> (name, nameKind, g' val)) ds))
502− f' (TypeClassDeclaration name args implies ds) = f (TypeClassDeclaration name args implies (map f' ds))
503− f' (TypeInstanceDeclaration name cs className args ds) = f (TypeInstanceDeclaration name cs className args (map f' ds))
504− f' (PositionedDeclaration pos d) = f (PositionedDeclaration pos (f' d))
505− f' other = f other
506−
507− g' :: Expr -> Expr
508− g' (UnaryMinus v) = g (UnaryMinus (g' v))
509− g' (BinaryNoParens op v1 v2) = g (BinaryNoParens op (g' v1) (g' v2))
510− g' (Parens v) = g (Parens (g' v))
511− g' (ArrayLiteral vs) = g (ArrayLiteral (map g' vs))
512− g' (ObjectLiteral vs) = g (ObjectLiteral (map (fmap g') vs))
513− g' (TypeClassDictionaryConstructorApp name v) = g (TypeClassDictionaryConstructorApp name (g' v))
514− g' (Accessor prop v) = g (Accessor prop (g' v))
515− g' (ObjectUpdate obj vs) = g (ObjectUpdate (g' obj) (map (fmap g') vs))
516− g' (Abs name v) = g (Abs name (g' v))
517− g' (App v1 v2) = g (App (g' v1) (g' v2))
518− g' (IfThenElse v1 v2 v3) = g (IfThenElse (g' v1) (g' v2) (g' v3))
519− g' (Case vs alts) = g (Case (map g' vs) (map handleCaseAlternative alts))
520− g' (TypedValue check v ty) = g (TypedValue check (g' v) ty)
521− g' (Let ds v) = g (Let (map f' ds) (g' v))
522− g' (Do es) = g (Do (map handleDoNotationElement es))
523− g' (PositionedValue pos v) = g (PositionedValue pos (g' v))
524− g' other = g other
525−
526− h' :: Binder -> Binder
527− h' (ConstructorBinder ctor bs) = h (ConstructorBinder ctor (map h' bs))
528− h' (ObjectBinder bs) = h (ObjectBinder (map (fmap h') bs))
529− h' (ArrayBinder bs) = h (ArrayBinder (map h' bs))
530− h' (ConsBinder b1 b2) = h (ConsBinder (h' b1) (h' b2))
531− h' (NamedBinder name b) = h (NamedBinder name (h' b))
532− h' (PositionedBinder pos b) = h (PositionedBinder pos (h' b))
533− h' other = h other
534−
535− handleCaseAlternative :: CaseAlternative -> CaseAlternative
536− handleCaseAlternative ca =
537− ca { caseAlternativeBinders = map h' (caseAlternativeBinders ca)
538− , caseAlternativeGuard = fmap g' (caseAlternativeGuard ca)
539− , caseAlternativeResult = g' (caseAlternativeResult ca)
540− }
541−
542− handleDoNotationElement :: DoNotationElement -> DoNotationElement
543− handleDoNotationElement (DoNotationValue v) = DoNotationValue (g' v)
544− handleDoNotationElement (DoNotationBind b v) = DoNotationBind (h' b) (g' v)
545− handleDoNotationElement (DoNotationLet ds) = DoNotationLet (map f' ds)
546− handleDoNotationElement (PositionedDoNotationElement pos e) = PositionedDoNotationElement pos (handleDoNotationElement e)
547−
548−
549−everywhereOnValuesTopDownM :: (Functor m, Applicative m, Monad m) =>
550− (Declaration -> m Declaration) ->
551− (Expr -> m Expr) ->
552− (Binder -> m Binder) ->
553− (Declaration -> m Declaration, Expr -> m Expr, Binder -> m Binder)
554−everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)
555− where
556− f' (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> mapM (f' <=< f) ds
557− f' (ValueDeclaration name nameKind bs grd val) = ValueDeclaration name nameKind <$> mapM (h' <=< h) bs <*> maybeM (g' <=< g) grd <*> (g val >>= g')
558− f' (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> mapM (\(name, nameKind, val) -> (,,) name nameKind <$> (g val >>= g')) ds
559− f' (TypeClassDeclaration name args implies ds) = TypeClassDeclaration name args implies <$> mapM (f' <=< f) ds
560− f' (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> mapM (f' <=< f) ds
561− f' (PositionedDeclaration pos d) = PositionedDeclaration pos <$> (f d >>= f')
562− f' other = f other
563−
564− g' (UnaryMinus v) = UnaryMinus <$> (g v >>= g')
565− g' (BinaryNoParens op v1 v2) = BinaryNoParens op <$> (g v1 >>= g') <*> (g v2 >>= g')
566− g' (Parens v) = Parens <$> (g v >>= g')
567− g' (ArrayLiteral vs) = ArrayLiteral <$> mapM (g' <=< g) vs
568− g' (ObjectLiteral vs) = ObjectLiteral <$> mapM (sndM (g' <=< g)) vs
569− g' (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> (g v >>= g')
570− g' (Accessor prop v) = Accessor prop <$> (g v >>= g')
571− g' (ObjectUpdate obj vs) = ObjectUpdate <$> (g obj >>= g') <*> mapM (sndM (g' <=< g)) vs
572− g' (Abs name v) = Abs name <$> (g v >>= g')
573− g' (App v1 v2) = App <$> (g v1 >>= g') <*> (g v2 >>= g')
574− g' (IfThenElse v1 v2 v3) = IfThenElse <$> (g v1 >>= g') <*> (g v2 >>= g') <*> (g v3 >>= g')
575− g' (Case vs alts) = Case <$> mapM (g' <=< g) vs <*> mapM handleCaseAlternative alts
576− g' (TypedValue check v ty) = TypedValue check <$> (g v >>= g') <*> pure ty
577− g' (Let ds v) = Let <$> mapM (f' <=< f) ds <*> (g v >>= g')
578− g' (Do es) = Do <$> mapM handleDoNotationElement es
579− g' (PositionedValue pos v) = PositionedValue pos <$> (g v >>= g')
580− g' other = g other
581−
582− h' (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> mapM (h' <=< h) bs
583− h' (ObjectBinder bs) = ObjectBinder <$> mapM (sndM (h' <=< h)) bs
584− h' (ArrayBinder bs) = ArrayBinder <$> mapM (h' <=< h) bs
585− h' (ConsBinder b1 b2) = ConsBinder <$> (h b1 >>= h') <*> (h b2 >>= h')
586− h' (NamedBinder name b) = NamedBinder name <$> (h b >>= h')
587− h' (PositionedBinder pos b) = PositionedBinder pos <$> (h b >>= h')
588− h' other = h other
589−
590− handleCaseAlternative (CaseAlternative bs grd val) = CaseAlternative <$> mapM (h' <=< h) bs
591− <*> maybeM (g' <=< g) grd
592− <*> (g' <=< g) val
593−
594− handleDoNotationElement (DoNotationValue v) = DoNotationValue <$> (g' <=< g) v
595− handleDoNotationElement (DoNotationBind b v) = DoNotationBind <$> (h' <=< h) b <*> (g' <=< g) v
596− handleDoNotationElement (DoNotationLet ds) = DoNotationLet <$> mapM (f' <=< f) ds
597− handleDoNotationElement (PositionedDoNotationElement pos e) = PositionedDoNotationElement pos <$> handleDoNotationElement e
598−
599−everywhereOnValuesM :: (Functor m, Applicative m, Monad m) =>
600− (Declaration -> m Declaration) ->
601− (Expr -> m Expr) ->
602− (Binder -> m Binder) ->
603− (Declaration -> m Declaration, Expr -> m Expr, Binder -> m Binder)
604−everywhereOnValuesM f g h = (f' <=< f, g' <=< g, h' <=< h)
605− where
606− f' (DataBindingGroupDeclaration ds) = (DataBindingGroupDeclaration <$> mapM f' ds) >>= f
607− f' (ValueDeclaration name nameKind bs grd val) = (ValueDeclaration name nameKind <$> mapM h' bs <*> maybeM g' grd <*> g' val) >>= f
608− f' (BindingGroupDeclaration ds) = (BindingGroupDeclaration <$> mapM (\(name, nameKind, val) -> (,,) name nameKind <$> g' val) ds) >>= f
609− f' (TypeClassDeclaration name args implies ds) = (TypeClassDeclaration name args implies <$> mapM f' ds) >>= f
610− f' (TypeInstanceDeclaration name cs className args ds) = (TypeInstanceDeclaration name cs className args <$> mapM f' ds) >>= f
611− f' (PositionedDeclaration pos d) = (PositionedDeclaration pos <$> f' d) >>= f
612− f' other = f other
613−
614− g' (UnaryMinus v) = (UnaryMinus <$> g' v) >>= g
615− g' (BinaryNoParens op v1 v2) = (BinaryNoParens op <$> (g' v1) <*> (g' v2)) >>= g
616− g' (Parens v) = (Parens <$> g' v) >>= g
617− g' (ArrayLiteral vs) = (ArrayLiteral <$> mapM g' vs) >>= g
618− g' (ObjectLiteral vs) = (ObjectLiteral <$> mapM (sndM g') vs) >>= g
619− g' (TypeClassDictionaryConstructorApp name v) = (TypeClassDictionaryConstructorApp name <$> g' v) >>= g
620− g' (Accessor prop v) = (Accessor prop <$> g' v) >>= g
621− g' (ObjectUpdate obj vs) = (ObjectUpdate <$> g' obj <*> mapM (sndM g') vs) >>= g
622− g' (Abs name v) = (Abs name <$> g' v) >>= g
623− g' (App v1 v2) = (App <$> g' v1 <*> g' v2) >>= g
624− g' (IfThenElse v1 v2 v3) = (IfThenElse <$> g' v1 <*> g' v2 <*> g' v3) >>= g
625− g' (Case vs alts) = (Case <$> mapM g' vs <*> mapM handleCaseAlternative alts) >>= g
626− g' (TypedValue check v ty) = (TypedValue check <$> g' v <*> pure ty) >>= g
627− g' (Let ds v) = (Let <$> mapM f' ds <*> g' v) >>= g
628− g' (Do es) = (Do <$> mapM handleDoNotationElement es) >>= g
629− g' (PositionedValue pos v) = (PositionedValue pos <$> g' v) >>= g
630− g' other = g other
631−
632− h' (ConstructorBinder ctor bs) = (ConstructorBinder ctor <$> mapM h' bs) >>= h
633− h' (ObjectBinder bs) = (ObjectBinder <$> mapM (sndM h') bs) >>= h
634− h' (ArrayBinder bs) = (ArrayBinder <$> mapM h' bs) >>= h
635− h' (ConsBinder b1 b2) = (ConsBinder <$> h' b1 <*> h' b2) >>= h
636− h' (NamedBinder name b) = (NamedBinder name <$> h' b) >>= h
637− h' (PositionedBinder pos b) = (PositionedBinder pos <$> h' b) >>= h
638− h' other = h other
639−
640− handleCaseAlternative (CaseAlternative bs grd val) = CaseAlternative <$> mapM h' bs
641− <*> maybeM g' grd
642− <*> g' val
643−
644− handleDoNotationElement (DoNotationValue v) = DoNotationValue <$> g' v
645− handleDoNotationElement (DoNotationBind b v) = DoNotationBind <$> h' b <*> g' v
646− handleDoNotationElement (DoNotationLet ds) = DoNotationLet <$> mapM f' ds
647− handleDoNotationElement (PositionedDoNotationElement pos e) = PositionedDoNotationElement pos <$> handleDoNotationElement e
648−
649−everythingOnValues :: (r -> r -> r) ->
650− (Declaration -> r) ->
651− (Expr -> r) ->
652− (Binder -> r) ->
653− (CaseAlternative -> r) ->
654− (DoNotationElement -> r) ->
655− (Declaration -> r, Expr -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r)
656−everythingOnValues (<>) f g h i j = (f', g', h', i', j')
657− where
658− f' d@(DataBindingGroupDeclaration ds) = foldl (<>) (f d) (map f' ds)
659− f' d@(ValueDeclaration _ _ bs Nothing val) = foldl (<>) (f d) (map h' bs) <> g' val
660− f' d@(ValueDeclaration _ _ bs (Just grd) val) = foldl (<>) (f d) (map h' bs) <> g' grd <> g' val
661− f' d@(BindingGroupDeclaration ds) = foldl (<>) (f d) (map (\(_, _, val) -> g' val) ds)
662− f' d@(TypeClassDeclaration _ _ _ ds) = foldl (<>) (f d) (map f' ds)
663− f' d@(TypeInstanceDeclaration _ _ _ _ ds) = foldl (<>) (f d) (map f' ds)
664− f' d@(PositionedDeclaration _ d1) = f d <> f' d1
665− f' d = f d
666−
667− g' v@(UnaryMinus v1) = g v <> g' v1
668− g' v@(BinaryNoParens _ v1 v2) = g v <> g' v1 <> g' v2
669− g' v@(Parens v1) = g v <> g' v1
670− g' v@(ArrayLiteral vs) = foldl (<>) (g v) (map g' vs)
671− g' v@(ObjectLiteral vs) = foldl (<>) (g v) (map (g' . snd) vs)
672− g' v@(TypeClassDictionaryConstructorApp _ v1) = g v <> g' v1
673− g' v@(Accessor _ v1) = g v <> g' v1
674− g' v@(ObjectUpdate obj vs) = foldl (<>) (g v <> g' obj) (map (g' . snd) vs)
675− g' v@(Abs _ v1) = g v <> g' v1
676− g' v@(App v1 v2) = g v <> g' v1 <> g' v2
677− g' v@(IfThenElse v1 v2 v3) = g v <> g' v1 <> g' v2 <> g' v3
678− g' v@(Case vs alts) = foldl (<>) (foldl (<>) (g v) (map g' vs)) (map i' alts)
679− g' v@(TypedValue _ v1 _) = g v <> g' v1
680− g' v@(Let ds v1) = (foldl (<>) (g v) (map f' ds)) <> g' v1
681− g' v@(Do es) = foldl (<>) (g v) (map j' es)
682− g' v@(PositionedValue _ v1) = g v <> g' v1
683− g' v = g v
684−
685− h' b@(ConstructorBinder _ bs) = foldl (<>) (h b) (map h' bs)
686− h' b@(ObjectBinder bs) = foldl (<>) (h b) (map (h' . snd) bs)
687− h' b@(ArrayBinder bs) = foldl (<>) (h b) (map h' bs)
688− h' b@(ConsBinder b1 b2) = h b <> h' b1 <> h' b2
689− h' b@(NamedBinder _ b1) = h b <> h' b1
690− h' b@(PositionedBinder _ b1) = h b <> h' b1
691− h' b = h b
692−
693− i' ca = case caseAlternativeGuard ca of
694− Nothing -> foldl (<>) (i ca) (map h' (caseAlternativeBinders ca)) <> g' (caseAlternativeResult ca)
695− Just grd -> foldl (<>) (i ca) (map h' (caseAlternativeBinders ca)) <> g' grd <> g' (caseAlternativeResult ca)
696−
697− j' e@(DoNotationValue v) = j e <> g' v
698− j' e@(DoNotationBind b v) = j e <> h' b <> g' v
699− j' e@(DoNotationLet ds) = foldl (<>) (j e) (map f' ds)
700− j' e@(PositionedDoNotationElement _ e1) = j e <> j' e1
701−
702−everythingWithContextOnValues ::
703− s ->
704− r ->
705− (r -> r -> r) ->
706− (s -> Declaration -> (s, r)) ->
707− (s -> Expr -> (s, r)) ->
708− (s -> Binder -> (s, r)) ->
709− (s -> CaseAlternative -> (s, r)) ->
710− (s -> DoNotationElement -> (s, r)) ->
711− ( Declaration -> r
712− , Expr -> r
713− , Binder -> r
714− , CaseAlternative -> r
715− , DoNotationElement -> r)
716−everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j'' s0)
717− where
718− f'' s d = let (s', r) = f s d in r <> f' s' d
719−
720− f' s (DataBindingGroupDeclaration ds) = foldl (<>) r0 (map (f'' s) ds)
721− f' s (ValueDeclaration _ _ bs Nothing val) = foldl (<>) r0 (map (h'' s) bs) <> (g'' s) val
722− f' s (ValueDeclaration _ _ bs (Just grd) val) = foldl (<>) r0 (map (h'' s) bs) <> (g'' s) grd <> (g'' s) val
723− f' s (BindingGroupDeclaration ds) = foldl (<>) r0 (map (\(_, _, val) -> (g'' s) val) ds)
724− f' s (TypeClassDeclaration _ _ _ ds) = foldl (<>) r0 (map (f'' s) ds)
725− f' s (TypeInstanceDeclaration _ _ _ _ ds) = foldl (<>) r0 (map (f'' s) ds)
726− f' s (PositionedDeclaration _ d1) = (f'' s) d1
727− f' _ _ = r0
728−
729− g'' s v = let (s', r) = g s v in r <> g' s' v
730−
731− g' s (UnaryMinus v1) = (g'' s) v1
732− g' s (BinaryNoParens _ v1 v2) = (g'' s) v1 <> (g'' s) v2
733− g' s (Parens v1) = (g'' s) v1
734− g' s (ArrayLiteral vs) = foldl (<>) r0 (map (g'' s) vs)
735− g' s (ObjectLiteral vs) = foldl (<>) r0 (map (g'' s . snd) vs)
736− g' s (TypeClassDictionaryConstructorApp _ v1) = (g'' s) v1
737− g' s (Accessor _ v1) = (g'' s) v1
738− g' s (ObjectUpdate obj vs) = foldl (<>) ((g'' s) obj) (map (g'' s . snd) vs)
739− g' s (Abs _ v1) = (g'' s) v1
740− g' s (App v1 v2) = (g'' s) v1 <> (g'' s) v2
741− g' s (IfThenElse v1 v2 v3) = (g'' s) v1 <> (g'' s) v2 <> (g'' s) v3
742− g' s (Case vs alts) = foldl (<>) (foldl (<>) r0 (map (g'' s) vs)) (map (i'' s) alts)
743− g' s (TypedValue _ v1 _) = (g'' s) v1
744− g' s (Let ds v1) = (foldl (<>) r0 (map (f'' s) ds)) <> (g'' s) v1
745− g' s (Do es) = foldl (<>) r0 (map (j'' s) es)
746− g' s (PositionedValue _ v1) = (g'' s) v1
747− g' _ _ = r0
748−
749− h'' s b = let (s', r) = h s b in r <> h' s' b
750−
751− h' s (ConstructorBinder _ bs) = foldl (<>) r0 (map (h'' s) bs)
752− h' s (ObjectBinder bs) = foldl (<>) r0 (map (h'' s . snd) bs)
753− h' s (ArrayBinder bs) = foldl (<>) r0 (map (h'' s) bs)
754− h' s (ConsBinder b1 b2) = (h'' s) b1 <> (h'' s) b2
755− h' s (NamedBinder _ b1) = (h'' s) b1
756− h' s (PositionedBinder _ b1) = (h'' s) b1
757− h' _ _ = r0
758−
759− i'' s ca = let (s', r) = i s ca in r <> i' s' ca
760−
761− i' s (CaseAlternative bs Nothing val) = foldl (<>) r0 (map (h'' s) bs) <> (g'' s) val
762− i' s (CaseAlternative bs (Just grd) val) = foldl (<>) r0 (map (h'' s) bs) <> (g'' s) grd <> (g'' s) val
763−
764− j'' s e = let (s', r) = j s e in r <> j' s' e
765−
766− j' s (DoNotationValue v) = (g'' s) v
767− j' s (DoNotationBind b v) = (h'' s) b <> (g'' s) v
768− j' s (DoNotationLet ds) = foldl (<>) r0 (map (f'' s) ds)
769− j' s (PositionedDoNotationElement _ e1) = (j'' s) e1
770−
771−everywhereWithContextOnValuesM :: (Functor m, Applicative m, Monad m) =>
772− s ->
773− (s -> Declaration -> m (s, Declaration)) ->
774− (s -> Expr -> m (s, Expr)) ->
775− (s -> Binder -> m (s, Binder)) ->
776− (s -> CaseAlternative -> m (s, CaseAlternative)) ->
777− (s -> DoNotationElement -> m (s, DoNotationElement)) ->
778− ( Declaration -> m Declaration
779− , Expr -> m Expr
780− , Binder -> m Binder
781− , CaseAlternative -> m CaseAlternative
782− , DoNotationElement -> m DoNotationElement)
783−everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j'' s0)
784− where
785− f'' s = uncurry f' <=< f s
786−
787− f' s (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> mapM (f'' s) ds
788− f' s (ValueDeclaration name nameKind bs grd val) = ValueDeclaration name nameKind <$> mapM (h'' s) bs <*> maybeM (g'' s) grd <*> g'' s val
789− f' s (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> mapM (thirdM (g'' s)) ds
790− f' s (TypeClassDeclaration name args implies ds) = TypeClassDeclaration name args implies <$> mapM (f'' s) ds
791− f' s (TypeInstanceDeclaration name cs className args ds) = TypeInstanceDeclaration name cs className args <$> mapM (f'' s) ds
792− f' s (PositionedDeclaration pos d1) = PositionedDeclaration pos <$> f'' s d1
793− f' _ other = return other
794−
795− g'' s = uncurry g' <=< g s
796−
797− g' s (UnaryMinus v) = UnaryMinus <$> g'' s v
798− g' s (BinaryNoParens op v1 v2) = BinaryNoParens op <$> g'' s v1 <*> g'' s v2
799− g' s (Parens v) = Parens <$> g'' s v
800− g' s (ArrayLiteral vs) = ArrayLiteral <$> mapM (g'' s) vs
801− g' s (ObjectLiteral vs) = ObjectLiteral <$> mapM (sndM (g'' s)) vs
802− g' s (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> (g'' s) v
803− g' s (Accessor prop v) = Accessor prop <$> g'' s v
804− g' s (ObjectUpdate obj vs) = ObjectUpdate <$> g'' s obj <*> mapM (sndM (g'' s)) vs
805− g' s (Abs name v) = Abs name <$> g'' s v
806− g' s (App v1 v2) = App <$> g'' s v1 <*> g'' s v2
807− g' s (IfThenElse v1 v2 v3) = IfThenElse <$> g'' s v1 <*> g'' s v2 <*> g'' s v3
808− g' s (Case vs alts) = Case <$> mapM (g'' s) vs <*> mapM (i'' s) alts
809− g' s (TypedValue check v ty) = TypedValue check <$> g'' s v <*> pure ty
810− g' s (Let ds v) = Let <$> mapM (f'' s) ds <*> g'' s v
811− g' s (Do es) = Do <$> mapM (j'' s) es
812− g' s (PositionedValue pos v) = PositionedValue pos <$> g'' s v
813− g' _ other = return other
814−
815− h'' s = uncurry h' <=< h s
816−
817− h' s (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> mapM (h'' s) bs
818− h' s (ObjectBinder bs) = ObjectBinder <$> mapM (sndM (h'' s)) bs
819− h' s (ArrayBinder bs) = ArrayBinder <$> mapM (h'' s) bs
820− h' s (ConsBinder b1 b2) = ConsBinder <$> h'' s b1 <*> h'' s b2
821− h' s (NamedBinder name b) = NamedBinder name <$> h'' s b
822− h' s (PositionedBinder pos b) = PositionedBinder pos <$> h'' s b
823− h' _ other = return other
824−
825− i'' s = uncurry i' <=< i s
826−
827− i' s (CaseAlternative bs grd val) = CaseAlternative <$> mapM (h'' s) bs <*> maybeM (g'' s) grd <*> g'' s val
828−
829− j'' s = uncurry j' <=< j s
830−
831− j' s (DoNotationValue v) = DoNotationValue <$> g'' s v
832− j' s (DoNotationBind b v) = DoNotationBind <$> h'' s b <*> g'' s v
833− j' s (DoNotationLet ds) = DoNotationLet <$> mapM (f'' s) ds
834− j' s (PositionedDoNotationElement pos e1) = PositionedDoNotationElement pos <$> j'' s e1
835−
836−accumTypes :: (Monoid r) => (Type -> r) -> (Declaration -> r, Expr -> r, Binder -> r, CaseAlternative -> r, DoNotationElement -> r)
837−accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)
838− where
839− forDecls (DataDeclaration _ _ _ dctors) = mconcat (concatMap (map f . snd) dctors)
840− forDecls (ExternDeclaration _ _ _ ty) = f ty
841− forDecls (ExternInstanceDeclaration _ cs _ tys) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)
842− forDecls (TypeClassDeclaration _ _ implies _) = mconcat (concatMap (map f . snd) implies)
843− forDecls (TypeInstanceDeclaration _ cs _ tys _) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)
844− forDecls (TypeSynonymDeclaration _ _ ty) = f ty
845− forDecls (TypeDeclaration _ ty) = f ty
846− forDecls _ = mempty
847−
848− forValues (TypeClassDictionary _ (_, cs) _) = mconcat (map f cs)
849− forValues (SuperClassDictionary _ tys) = mconcat (map f tys)
850− forValues (TypedValue _ _ ty) = f ty
851− forValues _ = mempty
852−
853−
src/Language/PureScript/Docs.hsnew file+14
@@ -0,0 +1,14 @@
1+
2+-- | Data types and functions for rendering generated documentation from
3+-- PureScript code, in a variety of formats.
4+
5+module Language.PureScript.Docs (
6+ module Docs
7+) where
8+
9+import Language.PureScript.Docs.Types as Docs
10+import Language.PureScript.Docs.RenderedCode.Types as Docs
11+import Language.PureScript.Docs.RenderedCode.Render as Docs
12+import Language.PureScript.Docs.Convert as Docs
13+import Language.PureScript.Docs.Render as Docs
14+import Language.PureScript.Docs.ParseAndDesugar as Docs
src/Language/PureScript/Docs/AsMarkdown.hsnew file+124
@@ -0,0 +1,124 @@
1+{-# LANGUAGE RecordWildCards #-}
2+
3+module Language.PureScript.Docs.AsMarkdown (
4+ renderModulesAsMarkdown
5+) where
6+
7+import Control.Monad.Writer hiding (First)
8+import Data.Foldable (for_)
9+import Data.List (partition)
10+
11+import qualified Language.PureScript as P
12+
13+import Language.PureScript.Docs.Types
14+import Language.PureScript.Docs.RenderedCode
15+import qualified Language.PureScript.Docs.Convert as Convert
16+import qualified Language.PureScript.Docs.Render as Render
17+
18+-- |
19+-- Take a list of modules and render them all in order, returning a single
20+-- Markdown-formatted String.
21+--
22+renderModulesAsMarkdown :: [P.Module] -> String
23+renderModulesAsMarkdown =
24+ runDocs . modulesAsMarkdown . map Convert.convertModule
25+
26+modulesAsMarkdown :: [Module] -> Docs
27+modulesAsMarkdown = mapM_ moduleAsMarkdown
28+
29+moduleAsMarkdown :: Module -> Docs
30+moduleAsMarkdown Module{..} = do
31+ headerLevel 2 $ "Module " ++ modName
32+ spacer
33+ for_ modComments tell'
34+ mapM_ declAsMarkdown modDeclarations
35+ spacer
36+
37+declAsMarkdown :: Declaration -> Docs
38+declAsMarkdown decl@Declaration{..} = do
39+ headerLevel 4 (ticks declTitle)
40+ spacer
41+
42+ let (instances, children) = partition (isChildInstance . cdeclInfo) declChildren
43+ fencedBlock $ do
44+ tell' (codeToString $ Render.renderDeclaration decl)
45+ zipWithM_ (\f c -> tell' (childToString f c)) (First : repeat NotFirst) children
46+ spacer
47+
48+ for_ declFixity (\fixity -> fixityAsMarkdown fixity >> spacer)
49+
50+ for_ declComments tell'
51+
52+ unless (null instances) $ do
53+ headerLevel 5 "Instances"
54+ fencedBlock $ mapM_ (tell' . childToString NotFirst) instances
55+ spacer
56+
57+ where
58+ isChildInstance (ChildInstance _ _) = True
59+ isChildInstance _ = False
60+
61+codeToString :: RenderedCode -> String
62+codeToString = outputWith elemAsMarkdown
63+ where
64+ elemAsMarkdown (Syntax x) = x
65+ elemAsMarkdown (Ident x) = x
66+ elemAsMarkdown (Ctor x _) = x
67+ elemAsMarkdown (Kind x) = x
68+ elemAsMarkdown (Keyword x) = x
69+ elemAsMarkdown Space = " "
70+
71+fixityAsMarkdown :: P.Fixity -> Docs
72+fixityAsMarkdown (P.Fixity associativity precedence) =
73+ tell' $ concat [ "_"
74+ , associativityStr
75+ , " / precedence "
76+ , show precedence
77+ , "_"
78+ ]
79+ where
80+ associativityStr = case associativity of
81+ P.Infixl -> "left-associative"
82+ P.Infixr -> "right-associative"
83+ P.Infix -> "non-associative"
84+
85+childToString :: First -> ChildDeclaration -> String
86+childToString f decl@ChildDeclaration{..} =
87+ case cdeclInfo of
88+ ChildDataConstructor _ ->
89+ let c = if f == First then "=" else "|"
90+ in " " ++ c ++ " " ++ str
91+ ChildTypeClassMember _ ->
92+ " " ++ str
93+ ChildInstance _ _ ->
94+ str
95+ where
96+ str = codeToString $ Render.renderChildDeclaration decl
97+
98+data First
99+ = First
100+ | NotFirst
101+ deriving (Show, Read, Eq, Ord)
102+
103+type Docs = Writer [String] ()
104+
105+runDocs :: Docs -> String
106+runDocs = unlines . execWriter
107+
108+tell' :: String -> Docs
109+tell' = tell . (:[])
110+
111+spacer :: Docs
112+spacer = tell' ""
113+
114+headerLevel :: Int -> String -> Docs
115+headerLevel level hdr = tell' (replicate level '#' ++ ' ' : hdr)
116+
117+fencedBlock :: Docs -> Docs
118+fencedBlock inner = do
119+ tell' "``` purescript"
120+ inner
121+ tell' "```"
122+
123+ticks :: String -> String
124+ticks = ("`" ++) . (++ "`")
src/Language/PureScript/Docs/Convert.hsnew file+227

This diff is too big to show here.

src/Language/PureScript/Docs/ParseAndDesugar.hsnew file+146

This diff is too big to show here.

src/Language/PureScript/Docs/Render.hsnew file+127

This diff is too big to show here.

src/Language/PureScript/Docs/RenderedCode.hsnew file+11

This diff is too big to show here.

src/Language/PureScript/Docs/RenderedCode/Render.hsnew file+184

This diff is too big to show here.

src/Language/PureScript/Docs/RenderedCode/Types.hsnew file+194

This diff is too big to show here.

src/Language/PureScript/Docs/Types.hsnew file+513

This diff is too big to show here.

src/Language/PureScript/Docs/Utils/MonoidExtras.hsnew file+9

This diff is too big to show here.

src/Language/PureScript/Environment.hs+101−50

This diff is too big to show here.

src/Language/PureScript/Errors.hs+914−61

This diff is too big to show here.

src/Language/PureScript/Externs.hsnew file+216

This diff is too big to show here.

src/Language/PureScript/Kinds.hs+16−1

This diff is too big to show here.

src/Language/PureScript/Linter.hsnew file+118

This diff is too big to show here.

src/Language/PureScript/Linter/Exhaustive.hsnew file+282

This diff is too big to show here.

src/Language/PureScript/Make.hsnew file+324

This diff is too big to show here.

src/Language/PureScript/ModuleDependencies.hs+12−11

This diff is too big to show here.

src/Language/PureScript/Names.hs+47−16

This diff is too big to show here.

src/Language/PureScript/Optimizer.hsdeleted−74

This diff is too big to show here.

src/Language/PureScript/Optimizer/Inliner.hsdeleted−193

This diff is too big to show here.

src/Language/PureScript/Options.hs+9−30

This diff is too big to show here.

src/Language/PureScript/Parser.hs+2

This diff is too big to show here.

src/Language/PureScript/Parser/Common.hs+34−274

This diff is too big to show here.

src/Language/PureScript/Parser/Declarations.hs+304−178

This diff is too big to show here.

src/Language/PureScript/Parser/JS.hsnew file+62

This diff is too big to show here.

src/Language/PureScript/Parser/Kinds.hs+13−9

This diff is too big to show here.

src/Language/PureScript/Parser/Lexer.hsnew file+520

This diff is too big to show here.

src/Language/PureScript/Parser/Types.hs+59−38

This diff is too big to show here.

src/Language/PureScript/Pretty/Common.hs+3−3

This diff is too big to show here.

src/Language/PureScript/Pretty/JS.hs+73−30

This diff is too big to show here.

src/Language/PureScript/Pretty/Types.hs+15−7

This diff is too big to show here.

src/Language/PureScript/Pretty/Values.hs+90−99

This diff is too big to show here.

src/Language/PureScript/Publish.hsnew file+366

This diff is too big to show here.

src/Language/PureScript/Publish/BoxesHelpers.hsnew file+38

This diff is too big to show here.

src/Language/PureScript/Publish/ErrorsWarnings.hsnew file+396

This diff is too big to show here.

src/Language/PureScript/Publish/Utils.hsnew file+38

This diff is too big to show here.

src/Language/PureScript/Renamer.hs+79−85

This diff is too big to show here.

src/Language/PureScript/Sugar.hs+41−21

This diff is too big to show here.

src/Language/PureScript/Sugar/BindingGroups.hs+114−55

This diff is too big to show here.

src/Language/PureScript/Sugar/CaseDeclarations.hs+120−51

This diff is too big to show here.

src/Language/PureScript/Sugar/DoNotation.hs+26−23

This diff is too big to show here.

src/Language/PureScript/Sugar/Names.hs+207−429

This diff is too big to show here.

src/Language/PureScript/Sugar/Names/Env.hsnew file+191

This diff is too big to show here.

src/Language/PureScript/Sugar/Names/Exports.hsnew file+236

This diff is too big to show here.

src/Language/PureScript/Sugar/Names/Imports.hsnew file+210

This diff is too big to show here.

src/Language/PureScript/Sugar/ObjectWildcards.hsnew file+68

This diff is too big to show here.

src/Language/PureScript/Sugar/Operators.hs+63−38

This diff is too big to show here.

src/Language/PureScript/Sugar/TypeClasses.hs+122−90

This diff is too big to show here.

src/Language/PureScript/Sugar/TypeClasses/Deriving.hsnew file+232

This diff is too big to show here.

src/Language/PureScript/Sugar/TypeDeclarations.hs+28−22

This diff is too big to show here.

src/Language/PureScript/Traversals.hs+11

This diff is too big to show here.

src/Language/PureScript/TypeChecker.hs+242−120

This diff is too big to show here.

src/Language/PureScript/TypeChecker/Entailment.hsnew file+188

This diff is too big to show here.

src/Language/PureScript/TypeChecker/Kinds.hs+106−68

This diff is too big to show here.

src/Language/PureScript/TypeChecker/Monad.hs+87−44

This diff is too big to show here.

src/Language/PureScript/TypeChecker/Rows.hsnew file+67

This diff is too big to show here.

src/Language/PureScript/TypeChecker/Skolems.hsnew file+118

This diff is too big to show here.

src/Language/PureScript/TypeChecker/Subsumption.hsnew file+96

This diff is too big to show here.

src/Language/PureScript/TypeChecker/Synonyms.hs+75−20

This diff is too big to show here.

src/Language/PureScript/TypeChecker/Types.hs+277−675

This diff is too big to show here.

src/Language/PureScript/TypeChecker/Unify.hsnew file+209

This diff is too big to show here.

src/Language/PureScript/TypeClassDictionaries.hs+24−24

This diff is too big to show here.

src/Language/PureScript/Types.hs+85−32

This diff is too big to show here.

stack-lts-2.yamlnew file+9

This diff is too big to show here.

stack-lts-3.yamlnew file+5

This diff is too big to show here.

stack-nightly.yamlnew file+5

This diff is too big to show here.

stack.yamlnew file+1

This diff is too big to show here.

tests/Main.hs+189−72

This diff is too big to show here.

tests/common/TestsSetup.hsnew file+48

This diff is too big to show here.

tests/support/.gitignorenew file+2

This diff is too big to show here.

tests/support/bower.jsonnew file+11

This diff is too big to show here.

tests/support/package.jsonnew file+7

This diff is too big to show here.

tests/support/setup-win.cmdnew file+3

This diff is too big to show here.

tests/support/setup.jsnew file+22

This diff is too big to show here.

travis/after.shnew file+25

This diff is too big to show here.

travis/configure.shnew file+17

This diff is too big to show here.

travis/test-install.shnew file+18

This diff is too big to show here.