summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPhilFreeman <>2015-06-30 01:42:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2015-06-30 01:42:00 (GMT)
commite2d6ce02076b1c8f647b25efe19b89f61e02bbaf (patch)
treeb49066c9978408370e829708ce43b327c12f5a09
parent0ead6173f8d2b592406633546f30530ae0d93aff (diff)
version 0.7.0.00.7.0.0
-rw-r--r--LICENSE1579
-rw-r--r--examples/failing/365.purs13
-rw-r--r--examples/failing/438.purs11
-rw-r--r--examples/failing/ArrayType.purs1
-rw-r--r--examples/failing/Arrays.purs4
-rw-r--r--examples/failing/CaseDoesNotMatchAllConstructorArgs.purs14
-rw-r--r--examples/failing/Do.purs2
-rw-r--r--examples/failing/DuplicateDeclarationsInLet.purs2
-rw-r--r--examples/failing/DuplicateProperties1.purs6
-rw-r--r--examples/failing/DuplicateProperties2.purs6
-rw-r--r--examples/failing/DuplicateTypeVars.purs2
-rw-r--r--examples/failing/Foldable.purs14
-rw-r--r--examples/failing/InstanceExport.purs2
-rw-r--r--examples/failing/KindError.purs4
-rw-r--r--examples/failing/LeadingZeros1.purs5
-rw-r--r--examples/failing/LeadingZeros2.purs5
-rw-r--r--examples/failing/Let.purs2
-rw-r--r--examples/failing/MPTCs.purs2
-rw-r--r--examples/failing/MissingClassExport.purs6
-rw-r--r--examples/failing/MissingClassMemberExport.purs6
-rw-r--r--examples/failing/MultipleErrors.purs2
-rw-r--r--examples/failing/MultipleErrors2.purs2
-rw-r--r--examples/failing/MutRec.purs2
-rw-r--r--examples/failing/MutRec2.purs2
-rw-r--r--examples/failing/NewtypeMultiArgs.purs2
-rw-r--r--examples/failing/NewtypeMultiCtor.purs2
-rw-r--r--examples/failing/NoOverlap.purs2
-rw-r--r--examples/failing/NullaryAbs.purs4
-rw-r--r--examples/failing/Object.purs2
-rw-r--r--examples/failing/OverlappingArguments.purs2
-rw-r--r--examples/failing/OverlappingBinders.purs6
-rw-r--r--examples/failing/OverlappingInstances.purs2
-rw-r--r--examples/failing/OverlappingInstances2.purs2
-rw-r--r--examples/failing/OverlappingVars.purs2
-rw-r--r--examples/failing/Rank2Types.purs6
-rw-r--r--examples/failing/Reserved.purs2
-rw-r--r--examples/failing/RowConstructors1.purs8
-rw-r--r--examples/failing/RowConstructors2.purs8
-rw-r--r--examples/failing/RowConstructors3.purs8
-rw-r--r--examples/failing/SkolemEscape.purs6
-rw-r--r--examples/failing/Superclasses1.purs2
-rw-r--r--examples/failing/Superclasses2.purs2
-rw-r--r--examples/failing/Superclasses3.purs2
-rw-r--r--examples/failing/Superclasses4.purs2
-rw-r--r--examples/failing/TopLevelCaseNoArgs.purs9
-rw-r--r--examples/failing/TypeClassInstances.purs2
-rw-r--r--examples/failing/TypeError.purs4
-rw-r--r--examples/failing/TypeSynonyms.purs4
-rw-r--r--examples/failing/TypeSynonyms2.purs2
-rw-r--r--examples/failing/TypeSynonyms3.purs2
-rw-r--r--examples/failing/TypeSynonyms4.purs2
-rw-r--r--examples/failing/TypeSynonyms5.purs5
-rw-r--r--examples/failing/TypeWildcards1.purs2
-rw-r--r--examples/failing/TypeWildcards2.purs2
-rw-r--r--examples/failing/TypeWildcards3.purs2
-rw-r--r--examples/failing/UnderscoreModuleName.purs2
-rw-r--r--examples/failing/UnifyInTypeInstanceLookup.purs2
-rw-r--r--examples/failing/UnknownType.purs2
-rw-r--r--examples/passing/652.purs2
-rw-r--r--examples/passing/810.purs2
-rw-r--r--examples/passing/ArrayType.purs4
-rw-r--r--examples/passing/Arrays.purs24
-rw-r--r--examples/passing/Auto.purs16
-rw-r--r--examples/passing/AutoPrelude.purs7
-rw-r--r--examples/passing/AutoPrelude2.purs1
-rw-r--r--examples/passing/BindersInFunctions.purs16
-rw-r--r--examples/passing/BindingGroups.purs6
-rw-r--r--examples/passing/BlockString.purs10
-rw-r--r--examples/passing/CaseInDo.purs11
-rw-r--r--examples/passing/CaseStatement.purs2
-rw-r--r--examples/passing/CheckFunction.purs4
-rw-r--r--examples/passing/CheckSynonymBug.purs15
-rw-r--r--examples/passing/CheckTypeClass.purs20
-rw-r--r--examples/passing/Church.purs20
-rw-r--r--examples/passing/Collatz.purs10
-rw-r--r--examples/passing/Comparisons.purs20
-rw-r--r--examples/passing/Conditional.purs8
-rw-r--r--examples/passing/Console.purs6
-rw-r--r--examples/passing/DataAndType.purs2
-rw-r--r--examples/passing/DeepArrayBinder.purs21
-rw-r--r--examples/passing/DeepCase.purs7
-rw-r--r--examples/passing/Do.purs26
-rw-r--r--examples/passing/Eff.purs8
-rw-r--r--examples/passing/EmptyDataDecls.purs19
-rw-r--r--examples/passing/EmptyRow.purs2
-rw-r--r--examples/passing/EmptyTypeClass.purs4
-rw-r--r--examples/passing/EqOrd.purs4
-rw-r--r--examples/passing/ExtendedInfixOperators.purs16
-rw-r--r--examples/passing/ExternData.purs13
-rw-r--r--examples/passing/ExternRaw.purs26
-rw-r--r--examples/passing/FFI.purs13
-rw-r--r--examples/passing/Fib.purs6
-rw-r--r--examples/passing/FinalTagless.purs2
-rw-r--r--examples/passing/ForeignInstance.purs20
-rw-r--r--examples/passing/FunctionScope.purs24
-rw-r--r--examples/passing/Functions.purs14
-rw-r--r--examples/passing/Functions2.purs24
-rw-r--r--examples/passing/Guards.purs42
-rw-r--r--examples/passing/HoistError.purs17
-rw-r--r--examples/passing/IfThenElseMaybe.purs2
-rw-r--r--examples/passing/ImplicitEmptyImport.purs2
-rw-r--r--examples/passing/ImportHiding.purs2
-rw-r--r--examples/passing/InferRecFunWithConstrainedArgument.purs6
-rw-r--r--examples/passing/InstanceBeforeClass.purs4
-rw-r--r--examples/passing/IntAndChar.purs18
-rw-r--r--examples/passing/JSReserved.purs12
-rw-r--r--examples/passing/KindedType.purs8
-rw-r--r--examples/passing/Let.purs45
-rw-r--r--examples/passing/Let2.purs17
-rw-r--r--examples/passing/LetInInstance.purs2
-rw-r--r--examples/passing/LiberalTypeSynonyms.purs2
-rw-r--r--examples/passing/Match.purs8
-rw-r--r--examples/passing/ModuleExport.purs9
-rw-r--r--examples/passing/ModuleExportDupes.purs19
-rw-r--r--examples/passing/ModuleExportExcluded.purs14
-rw-r--r--examples/passing/ModuleExportHiding.purs11
-rw-r--r--examples/passing/ModuleExportQualified.purs9
-rw-r--r--examples/passing/ModuleExportSelf.purs14
-rw-r--r--examples/passing/Monad.purs42
-rw-r--r--examples/passing/MonadState.purs2
-rw-r--r--examples/passing/MultiArgFunctions.purs29
-rw-r--r--examples/passing/MultipleConstructorArgs.purs21
-rw-r--r--examples/passing/MutRec.purs20
-rw-r--r--examples/passing/MutRec2.purs2
-rw-r--r--examples/passing/MutRec3.purs2
-rw-r--r--examples/passing/NamedPatterns.purs10
-rw-r--r--examples/passing/NegativeBinder.purs4
-rw-r--r--examples/passing/Nested.purs8
-rw-r--r--examples/passing/NestedTypeSynonyms.purs12
-rw-r--r--examples/passing/NestedWhere.purs4
-rw-r--r--examples/passing/Newtype.purs5
-rw-r--r--examples/passing/NewtypeEff.purs3
-rw-r--r--examples/passing/NewtypeWithRecordUpdate.purs7
-rw-r--r--examples/passing/ObjectGetter.purs4
-rw-r--r--examples/passing/ObjectSynonym.purs4
-rw-r--r--examples/passing/ObjectUpdate.purs24
-rw-r--r--examples/passing/ObjectUpdate2.purs5
-rw-r--r--examples/passing/ObjectUpdater.purs31
-rw-r--r--examples/passing/ObjectWildcards.purs25
-rw-r--r--examples/passing/Objects.purs40
-rw-r--r--examples/passing/OneConstructor.purs2
-rw-r--r--examples/passing/OperatorAssociativity.purs67
-rw-r--r--examples/passing/OperatorInlining.purs47
-rw-r--r--examples/passing/OperatorSections.purs22
-rw-r--r--examples/passing/Operators.purs139
-rw-r--r--examples/passing/OptimizerBug.purs2
-rw-r--r--examples/passing/PartialFunction.purs19
-rw-r--r--examples/passing/Patterns.purs36
-rw-r--r--examples/passing/Person.purs19
-rw-r--r--examples/passing/Rank2Data.purs36
-rw-r--r--examples/passing/Rank2Object.purs3
-rw-r--r--examples/passing/Rank2TypeSynonym.purs3
-rw-r--r--examples/passing/Rank2Types.purs12
-rw-r--r--examples/passing/RebindableSyntax.purs39
-rw-r--r--examples/passing/Recursion.purs12
-rw-r--r--examples/passing/ReservedWords.purs16
-rw-r--r--examples/passing/RowConstructors.purs42
-rw-r--r--examples/passing/RowPolyInstanceContext.purs2
-rw-r--r--examples/passing/RowSynonyms.purs46
-rw-r--r--examples/passing/RuntimeScopeIssue.purs10
-rw-r--r--examples/passing/ScopedTypeVariables.purs6
-rw-r--r--examples/passing/Sequence.purs11
-rw-r--r--examples/passing/SequenceDesugared.purs41
-rw-r--r--examples/passing/ShadowedRename.purs15
-rw-r--r--examples/passing/ShadowedTCO.purs4
-rw-r--r--examples/passing/ShadowedTCOLet.purs6
-rw-r--r--examples/passing/SignedNumericLiterals.purs22
-rw-r--r--examples/passing/Superclasses1.purs6
-rw-r--r--examples/passing/Superclasses2.purs13
-rw-r--r--examples/passing/Superclasses3.purs6
-rw-r--r--examples/passing/TCOCase.purs8
-rw-r--r--examples/passing/TailCall.purs12
-rw-r--r--examples/passing/Tick.purs2
-rw-r--r--examples/passing/TopLevelCase.purs22
-rw-r--r--examples/passing/TypeClassImport.purs18
-rw-r--r--examples/passing/TypeClassMemberOrderChange.purs2
-rw-r--r--examples/passing/TypeClasses.purs14
-rw-r--r--examples/passing/TypeClassesWithOverlappingTypeVariables.purs12
-rw-r--r--examples/passing/TypeDecl.purs14
-rw-r--r--examples/passing/TypeSynonymInData.purs4
-rw-r--r--examples/passing/TypeSynonyms.purs38
-rw-r--r--examples/passing/TypeWildcards.purs4
-rw-r--r--examples/passing/TypeWildcardsRecordExtension.purs2
-rw-r--r--examples/passing/TypedWhere.purs16
-rw-r--r--examples/passing/UnderscoreIdent.purs2
-rw-r--r--examples/passing/UnknownInTypeClassLookup.purs4
-rw-r--r--examples/passing/Where.purs28
-rw-r--r--examples/passing/iota.purs8
-rw-r--r--examples/passing/s.purs6
-rw-r--r--hierarchy/Main.hs19
-rw-r--r--prelude/prelude.purs1478
-rw-r--r--psc-bundle/Main.hs621
-rw-r--r--psc-docs/Main.hs368
-rw-r--r--psc-docs/Tags.hs2
-rw-r--r--psc-make/Main.hs177
-rw-r--r--psc-publish/BoxesHelpers.hs38
-rw-r--r--psc-publish/ErrorsWarnings.hs359
-rw-r--r--psc-publish/Main.hs286
-rw-r--r--psc-publish/Utils.hs22
-rw-r--r--psc/Main.hs237
-rw-r--r--psc/Make.hs140
-rw-r--r--psci/Commands.hs78
-rw-r--r--psci/Completion.hs224
-rw-r--r--psci/Directive.hs128
-rw-r--r--psci/IO.hs21
-rw-r--r--psci/Main.hs702
-rw-r--r--psci/Make.hs127
-rw-r--r--psci/PSCi.hs569
-rw-r--r--psci/Parser.hs83
-rw-r--r--psci/Types.hs181
-rw-r--r--psci/main/Main.hs6
-rw-r--r--psci/tests/Main.hs150
-rw-r--r--purescript.cabal122
-rw-r--r--src/Control/Monad/Supply.hs4
-rw-r--r--src/Control/Monad/Unify.hs2
-rw-r--r--src/Language/PureScript.hs213
-rw-r--r--src/Language/PureScript/AST.hs1
-rw-r--r--src/Language/PureScript/AST/Binders.hs9
-rw-r--r--src/Language/PureScript/AST/Declarations.hs64
-rw-r--r--src/Language/PureScript/AST/Exported.hs136
-rw-r--r--src/Language/PureScript/AST/Operators.hs16
-rw-r--r--src/Language/PureScript/AST/SourcePos.hs32
-rw-r--r--src/Language/PureScript/AST/Traversals.hs8
-rw-r--r--src/Language/PureScript/CodeGen/Externs.hs27
-rw-r--r--src/Language/PureScript/CodeGen/JS.hs108
-rw-r--r--src/Language/PureScript/CodeGen/JS/AST.hs54
-rw-r--r--src/Language/PureScript/CodeGen/JS/Optimizer.hs17
-rw-r--r--src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs218
-rw-r--r--src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs6
-rw-r--r--src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs37
-rw-r--r--src/Language/PureScript/Constants.hs86
-rw-r--r--src/Language/PureScript/CoreFn/Desugar.hs24
-rw-r--r--src/Language/PureScript/CoreFn/Literals.hs4
-rw-r--r--src/Language/PureScript/CoreFn/Meta.hs6
-rw-r--r--src/Language/PureScript/CoreFn/Module.hs3
-rw-r--r--src/Language/PureScript/DeadCodeElimination.hs102
-rw-r--r--src/Language/PureScript/Docs.hs14
-rw-r--r--src/Language/PureScript/Docs/AsMarkdown.hs124
-rw-r--r--src/Language/PureScript/Docs/Convert.hs228
-rw-r--r--src/Language/PureScript/Docs/ParseAndDesugar.hs120
-rw-r--r--src/Language/PureScript/Docs/Render.hs127
-rw-r--r--src/Language/PureScript/Docs/RenderedCode.hs11
-rw-r--r--src/Language/PureScript/Docs/RenderedCode/Render.hs179
-rw-r--r--src/Language/PureScript/Docs/RenderedCode/Types.hs191
-rw-r--r--src/Language/PureScript/Docs/Types.hs472
-rw-r--r--src/Language/PureScript/Docs/Utils/MonoidExtras.hs9
-rw-r--r--src/Language/PureScript/Environment.hs85
-rw-r--r--src/Language/PureScript/Errors.hs819
-rw-r--r--src/Language/PureScript/Kinds.hs14
-rw-r--r--src/Language/PureScript/Linter.hs82
-rw-r--r--src/Language/PureScript/ModuleDependencies.hs9
-rw-r--r--src/Language/PureScript/Names.hs19
-rw-r--r--src/Language/PureScript/Options.hs55
-rw-r--r--src/Language/PureScript/Parser.hs1
-rw-r--r--src/Language/PureScript/Parser/Common.hs5
-rw-r--r--src/Language/PureScript/Parser/Declarations.hs77
-rw-r--r--src/Language/PureScript/Parser/JS.hs59
-rw-r--r--src/Language/PureScript/Parser/Lexer.hs28
-rw-r--r--src/Language/PureScript/Parser/Types.hs13
-rw-r--r--src/Language/PureScript/Pretty/Types.hs4
-rw-r--r--src/Language/PureScript/Pretty/Values.hs22
-rw-r--r--src/Language/PureScript/Renamer.hs20
-rw-r--r--src/Language/PureScript/Sugar.hs2
-rw-r--r--src/Language/PureScript/Sugar/BindingGroups.hs3
-rw-r--r--src/Language/PureScript/Sugar/CaseDeclarations.hs59
-rw-r--r--src/Language/PureScript/Sugar/DoNotation.hs11
-rw-r--r--src/Language/PureScript/Sugar/Names.hs102
-rw-r--r--src/Language/PureScript/Sugar/ObjectWildcards.hs2
-rw-r--r--src/Language/PureScript/Sugar/Operators.hs2
-rw-r--r--src/Language/PureScript/Sugar/TypeClasses.hs10
-rw-r--r--src/Language/PureScript/Sugar/TypeDeclarations.hs3
-rw-r--r--src/Language/PureScript/TypeChecker.hs26
-rw-r--r--src/Language/PureScript/TypeChecker/Entailment.hs86
-rw-r--r--src/Language/PureScript/TypeChecker/Kinds.hs3
-rw-r--r--src/Language/PureScript/TypeChecker/Monad.hs81
-rw-r--r--src/Language/PureScript/TypeChecker/Rows.hs3
-rw-r--r--src/Language/PureScript/TypeChecker/Skolems.hs4
-rw-r--r--src/Language/PureScript/TypeChecker/Subsumption.hs3
-rw-r--r--src/Language/PureScript/TypeChecker/Synonyms.hs32
-rw-r--r--src/Language/PureScript/TypeChecker/Types.hs55
-rw-r--r--src/Language/PureScript/TypeChecker/Unify.hs5
-rw-r--r--src/Language/PureScript/Types.hs19
-rw-r--r--tests/Main.hs204
283 files changed, 9307 insertions, 5260 deletions
diff --git a/LICENSE b/LICENSE
index c7a284a..8135c95 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,6 +1,7 @@
The MIT License (MIT)
-Copyright (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
+Copyright (c) 2013-15 Phil Freeman, (c) 2014-2015 Gary Burgess, and other
+contributors
Permission is hereby granted, free of charge, to any person obtaining a copy of
this software and associated documentation files (the "Software"), to deal in
@@ -21,65 +22,387 @@ CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
PureScript uses the following Haskell library packages. Their license files follow.
+ Glob
+ HUnit
+ aeson
+ aeson-better-errors
+ ansi-terminal
+ ansi-wl-pprint
+ array
+ attoparsec
base
+ blaze-builder
+ bower-json
+ boxes
+ bytestring
containers
+ deepseq
directory
- file-embed
+ dlist
filepath
+ ghc-prim
+ hashable
haskeline
- monad-unify
+ integer-gmp
+ language-javascript
mtl
+ nats
+ old-locale
optparse-applicative
parsec
pattern-arrows
+ pretty
+ primitive
process
+ rts
+ safe
+ scientific
+ semigroups
+ split
+ syb
+ template-haskell
+ terminfo
+ text
time
transformers
+ transformers-compat
+ unix
unordered-containers
utf8-string
- split
- boxes
+ vector
+ void
-base LICENSE file:
+Glob LICENSE file:
- This library (libraries/base) is derived from code from several
- sources:
+ The code in Glob is released under the license below. Copyrights to parts of
+ the code are held by whoever wrote the code in question: see CREDITS.txt for a
+ list of authors.
+
+ Copyright (c) 2008-2012 <authors>
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ * Neither the name of the project nor the names of its contributors may be
+ used to endorse or promote products derived from this software without
+ specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+
+HUnit LICENSE file:
+
+ HUnit is Copyright (c) Dean Herington, 2002, all rights reserved,
+ and is distributed as free software under the following license.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+
+ - Redistributions of source code must retain the above copyright
+ notice, this list of conditions, and the following disclaimer.
+
+ - Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions, and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+ - The names of the copyright holders may not be used to endorse or
+ promote products derived from this software without specific prior
+ written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "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 HOLDERS 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.
+
+aeson LICENSE file:
+
+ Copyright (c) 2011, MailRank, Inc.
+
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+
+ 1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ 2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+ 3. Neither the name of the author nor the names of his contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE 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 AUTHORS 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.
+
+aeson-better-errors LICENSE file:
+
+ Copyright (c) 2015 Harry Garrood
+
+ Permission is hereby granted, free of charge, to any person obtaining
+ a copy of this software and associated documentation files (the
+ "Software"), to deal in the Software without restriction, including
+ without limitation the rights to use, copy, modify, merge, publish,
+ distribute, sublicense, and/or sell copies of the Software, and to
+ permit persons to whom the Software is furnished to do so, subject to
+ the following conditions:
+
+ The above copyright notice and this permission notice shall be included
+ in all copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+ IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+ CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+ TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+ SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+ansi-terminal LICENSE file:
+
+ Copyright (c) 2008, Maximilian Bolingbroke
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without modification, are permitted
+ provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice, this list of
+ conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright notice, this list of
+ conditions and the following disclaimer in the documentation and/or other materials
+ provided with the distribution.
+ * Neither the name of Maximilian Bolingbroke nor the names of other contributors may be used to
+ endorse or promote products derived from this software without specific prior written permission.
+
+ 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.
+
+ansi-wl-pprint LICENSE file:
+
+ Copyright 2008, Daan Leijen and Max Bolingbroke. All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are
+ met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in
+ the documentation and/or other materials provided with the
+ distribution.
+
+ This software is provided by the copyright holders "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 holders 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.
+
+array LICENSE file:
+ This library (libraries/base) is derived from code from several
+ sources:
+
* Code from the GHC project which is largely (c) The University of
Glasgow, and distributable under a BSD-style license (see below),
-
+
* Code from the Haskell 98 Report which is (c) Simon Peyton Jones
and freely redistributable (but see the full license for
restrictions).
-
+
* Code from the Haskell Foreign Function Interface specification,
which is (c) Manuel M. T. Chakravarty and freely redistributable
(but see the full license for restrictions).
-
+
The full text of these licenses is reproduced below. All of the
licenses are BSD-style or compatible.
-
+
-----------------------------------------------------------------------------
-
+
The Glasgow Haskell Compiler License
+
+ Copyright 2004, The University Court of the University of Glasgow.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ - Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+
+ - Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+ - Neither name of the University nor the names of its contributors may be
+ used to endorse or promote products derived from this software without
+ specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+ GLASGOW AND THE 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
+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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.
+
+ -----------------------------------------------------------------------------
+
+ Code derived from the document "Report on the Programming Language
+ Haskell 98", is distributed under the following license:
+
+ Copyright (c) 2002 Simon Peyton Jones
+
+ The authors intend this Report to belong to the entire Haskell
+ community, and so we grant permission to copy and distribute it for
+ any purpose, provided that it is reproduced in its entirety,
+ including this Notice. Modified versions of this Report may also be
+ copied and distributed for any purpose, provided that the modified
+ version is clearly presented as such, and that it does not claim to
+ be a definition of the Haskell 98 Language.
+
+ -----------------------------------------------------------------------------
+
+ Code derived from the document "The Haskell 98 Foreign Function
+ Interface, An Addendum to the Haskell 98 Report" is distributed under
+ the following license:
+
+ Copyright (c) 2002 Manuel M. T. Chakravarty
+
+ The authors intend this Report to belong to the entire Haskell
+ community, and so we grant permission to copy and distribute it for
+ any purpose, provided that it is reproduced in its entirety,
+ including this Notice. Modified versions of this Report may also be
+ copied and distributed for any purpose, provided that the modified
+ version is clearly presented as such, and that it does not claim to
+ be a definition of the Haskell 98 Foreign Function Interface.
+
+ -----------------------------------------------------------------------------
- Copyright 2004, The University Court of the University of Glasgow.
+attoparsec LICENSE file:
+
+ Copyright (c) Lennart Kolmodin
+
All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+
+ 1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ 2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+ 3. Neither the name of the author nor the names of his contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE 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 AUTHORS 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.
+base LICENSE file:
+
+ This library (libraries/base) is derived from code from several
+ sources:
+
+ * Code from the GHC project which is largely (c) The University of
+ Glasgow, and distributable under a BSD-style license (see below),
+
+ * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
+ and freely redistributable (but see the full license for
+ restrictions).
+
+ * Code from the Haskell Foreign Function Interface specification,
+ which is (c) Manuel M. T. Chakravarty and freely redistributable
+ (but see the full license for restrictions).
+
+ The full text of these licenses is reproduced below. All of the
+ licenses are BSD-style or compatible.
+
+ -----------------------------------------------------------------------------
+
+ The Glasgow Haskell Compiler License
+
+ Copyright 2004, The University Court of the University of Glasgow.
+ All rights reserved.
+
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
-
+
- Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
-
+
- Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
-
+
- Neither name of the University nor the names of its contributors may be
used to endorse or promote products derived from this software without
- specific prior written permission.
-
+ specific prior written permission.
+
THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
@@ -92,14 +415,14 @@ base LICENSE file:
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.
-
+
-----------------------------------------------------------------------------
-
+
Code derived from the document "Report on the Programming Language
Haskell 98", is distributed under the following license:
-
+
Copyright (c) 2002 Simon Peyton Jones
-
+
The authors intend this Report to belong to the entire Haskell
community, and so we grant permission to copy and distribute it for
any purpose, provided that it is reproduced in its entirety,
@@ -107,15 +430,15 @@ base LICENSE file:
copied and distributed for any purpose, provided that the modified
version is clearly presented as such, and that it does not claim to
be a definition of the Haskell 98 Language.
-
+
-----------------------------------------------------------------------------
-
+
Code derived from the document "The Haskell 98 Foreign Function
Interface, An Addendum to the Haskell 98 Report" is distributed under
the following license:
-
+
Copyright (c) 2002 Manuel M. T. Chakravarty
-
+
The authors intend this Report to belong to the entire Haskell
community, and so we grant permission to copy and distribute it for
any purpose, provided that it is reproduced in its entirety,
@@ -123,30 +446,189 @@ base LICENSE file:
copied and distributed for any purpose, provided that the modified
version is clearly presented as such, and that it does not claim to
be a definition of the Haskell 98 Foreign Function Interface.
-
+
-----------------------------------------------------------------------------
+blaze-builder LICENSE file:
+
+ Copyright Jasper Van der Jeugt 2010, Simon Meier 2010 & 2011
+
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Jasper Van der Jeugt nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+ 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.
+
+bower-json LICENSE file:
+
+ Copyright (c) 2015 Harry Garrood
+
+ Permission is hereby granted, free of charge, to any person obtaining
+ a copy of this software and associated documentation files (the
+ "Software"), to deal in the Software without restriction, including
+ without limitation the rights to use, copy, modify, merge, publish,
+ distribute, sublicense, and/or sell copies of the Software, and to
+ permit persons to whom the Software is furnished to do so, subject to
+ the following conditions:
+
+ The above copyright notice and this permission notice shall be included
+ in all copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+ IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+ CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+ TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+ SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+boxes LICENSE file:
+
+ Copyright (c) Brent Yorgey 2008
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+ 1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ 2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ 3. Neither the name of the author nor the names of other contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ All other rights are reserved.
+
+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+
+bytestring LICENSE file:
+
+ Copyright (c) Don Stewart 2005-2009
+ (c) Duncan Coutts 2006-2015
+ (c) David Roundy 2003-2005
+ (c) Simon Meier 2010-2011
+
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+ 1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ 2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ 3. Neither the name of the author nor the names of his contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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.
+
containers LICENSE file:
The Glasgow Haskell Compiler License
-
+
Copyright 2004, The University Court of the University of Glasgow.
All rights reserved.
-
+
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
-
+
- Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
-
+
- Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
-
+
- Neither name of the University nor the names of its contributors may be
used to endorse or promote products derived from this software without
specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+ GLASGOW AND THE 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
+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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.
+
+deepseq LICENSE file:
+ This library (deepseq) is derived from code from the GHC project which
+ is largely (c) The University of Glasgow, and distributable under a
+ BSD-style license (see below).
+
+ -----------------------------------------------------------------------------
+
+ The Glasgow Haskell Compiler License
+
+ Copyright 2001-2009, The University Court of the University of Glasgow.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ - Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+
+ - Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+ - Neither name of the University nor the names of its contributors may be
+ used to endorse or promote products derived from this software without
+ specific prior written permission.
+
THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
@@ -159,43 +641,45 @@ containers LICENSE file:
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.
+
+ -----------------------------------------------------------------------------
directory LICENSE file:
This library (libraries/base) is derived from code from two
- sources:
-
+ sources:
+
* Code from the GHC project which is largely (c) The University of
Glasgow, and distributable under a BSD-style license (see below),
-
+
* Code from the Haskell 98 Report which is (c) Simon Peyton Jones
and freely redistributable (but see the full license for
restrictions).
-
+
The full text of these licenses is reproduced below. Both of the
licenses are BSD-style or compatible.
-
+
-----------------------------------------------------------------------------
-
+
The Glasgow Haskell Compiler License
-
- Copyright 2004, The University Court of the University of Glasgow.
+
+ Copyright 2004, The University Court of the University of Glasgow.
All rights reserved.
-
+
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
-
+
- Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
-
+
- Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
-
+
- Neither name of the University nor the names of its contributors may be
used to endorse or promote products derived from this software without
- specific prior written permission.
-
+ specific prior written permission.
+
THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
@@ -208,14 +692,14 @@ directory LICENSE file:
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.
-
+
-----------------------------------------------------------------------------
-
+
Code derived from the document "Report on the Programming Language
Haskell 98", is distributed under the following license:
-
+
Copyright (c) 2002 Simon Peyton Jones
-
+
The authors intend this Report to belong to the entire Haskell
community, and so we grant permission to copy and distribute it for
any purpose, provided that it is reproduced in its entirety,
@@ -223,58 +707,162 @@ directory LICENSE file:
copied and distributed for any purpose, provided that the modified
version is clearly presented as such, and that it does not claim to
be a definition of the Haskell 98 Language.
-
+
-----------------------------------------------------------------------------
-file-embed LICENSE file:
-
- The following license covers this documentation, and the source code, except
- where otherwise indicated.
-
- Copyright 2008, Michael Snoyman. All rights reserved.
+dlist LICENSE file:
+ Copyright (c) 2006-2009 Don Stewart, 2013-2014 Sean Leather
+
+ All rights reserved.
+
Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright notice, this
- list of conditions and the following disclaimer.
-
- * Redistributions in binary form must reproduce the above copyright notice,
- this list of conditions and the following disclaimer in the documentation
- and/or other materials provided with the distribution.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "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 HOLDERS 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.
+ modification, are permitted provided that the following conditions are
+ met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Don Stewart nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+ 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.
filepath LICENSE file:
- Copyright Neil Mitchell 2005-2007.
+ Copyright Neil Mitchell 2005-2015.
All rights reserved.
-
+
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
-
+
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
-
+
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
-
+
* Neither the name of Neil Mitchell nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
+
+ 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.
+ghc-prim LICENSE file:
+
+ This library (libraries/ghc-prim) is derived from code from several
+ sources:
+
+ * Code from the GHC project which is largely (c) The University of
+ Glasgow, and distributable under a BSD-style license (see below),
+
+ * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
+ and freely redistributable (but see the full license for
+ restrictions).
+
+ The full text of these licenses is reproduced below. All of the
+ licenses are BSD-style or compatible.
+
+ -----------------------------------------------------------------------------
+
+ The Glasgow Haskell Compiler License
+
+ Copyright 2004, The University Court of the University of Glasgow.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ - Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+
+ - Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+ - Neither name of the University nor the names of its contributors may be
+ used to endorse or promote products derived from this software without
+ specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+ GLASGOW AND THE 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
+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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.
+
+ -----------------------------------------------------------------------------
+
+ Code derived from the document "Report on the Programming Language
+ Haskell 98", is distributed under the following license:
+
+ Copyright (c) 2002 Simon Peyton Jones
+
+ The authors intend this Report to belong to the entire Haskell
+ community, and so we grant permission to copy and distribute it for
+ any purpose, provided that it is reproduced in its entirety,
+ including this Notice. Modified versions of this Report may also be
+ copied and distributed for any purpose, provided that the modified
+ version is clearly presented as such, and that it does not claim to
+ be a definition of the Haskell 98 Language.
+
+
+hashable LICENSE file:
+
+ Copyright Milan Straka 2010
+
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Milan Straka nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
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
@@ -291,17 +879,17 @@ haskeline LICENSE file:
Copyright 2007-2009, Judah Jacobson.
All Rights Reserved.
-
+
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
-
+
- Redistribution of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
-
+
- Redistribution in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
-
+
THIS SOFTWARE IS PROVIDED BY THE AUTHOR 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
@@ -313,50 +901,175 @@ haskeline LICENSE file:
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.
-monad-unify LICENSE file:
+integer-gmp LICENSE file:
- The MIT License (MIT)
-
- Copyright (c) 2013 Phil Freeman
-
- Permission is hereby granted, free of charge, to any person obtaining a copy of
- this software and associated documentation files (the "Software"), to deal in
- the Software without restriction, including without limitation the rights to
- use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
- the Software, and to permit persons to whom the Software is furnished to do so,
- subject to the following conditions:
+ Copyright (c) 2014, Herbert Valerio Riedel
+
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Herbert Valerio Riedel nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+ 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.
- The above copyright notice and this permission notice shall be included in all
- copies or substantial portions of the Software.
+language-javascript LICENSE file:
- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
- FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
- COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
- IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
- CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Copyright (c)2010, Alan Zimmerman
+
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Alan Zimmerman nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+ 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.
mtl LICENSE file:
The Glasgow Haskell Compiler License
-
+
Copyright 2004, The University Court of the University of Glasgow.
All rights reserved.
-
+
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
-
+
- Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
-
+
- Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
-
+
- Neither name of the University nor the names of its contributors may be
used to endorse or promote products derived from this software without
specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+ GLASGOW AND THE 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
+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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.
+
+nats LICENSE file:
+
+ Copyright 2011-2014 Edward Kmett
+
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+
+ 1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ 2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+ 3. Neither the name of the author nor the names of his contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+old-locale LICENSE file:
+
+ This library (libraries/base) is derived from code from two
+ sources:
+
+ * Code from the GHC project which is largely (c) The University of
+ Glasgow, and distributable under a BSD-style license (see below),
+
+ * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
+ and freely redistributable (but see the full license for
+ restrictions).
+
+ The full text of these licenses is reproduced below. Both of the
+ licenses are BSD-style or compatible.
+
+ -----------------------------------------------------------------------------
+
+ The Glasgow Haskell Compiler License
+
+ Copyright 2004, The University Court of the University of Glasgow.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ - Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+
+ - Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+ - Neither name of the University nor the names of its contributors may be
+ used to endorse or promote products derived from this software without
+ specific prior written permission.
+
THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
@@ -369,28 +1082,45 @@ mtl LICENSE file:
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.
+
+ -----------------------------------------------------------------------------
+
+ Code derived from the document "Report on the Programming Language
+ Haskell 98", is distributed under the following license:
+
+ Copyright (c) 2002 Simon Peyton Jones
+
+ The authors intend this Report to belong to the entire Haskell
+ community, and so we grant permission to copy and distribute it for
+ any purpose, provided that it is reproduced in its entirety,
+ including this Notice. Modified versions of this Report may also be
+ copied and distributed for any purpose, provided that the modified
+ version is clearly presented as such, and that it does not claim to
+ be a definition of the Haskell 98 Language.
+
+ -----------------------------------------------------------------------------
optparse-applicative LICENSE file:
Copyright (c) 2012, Paolo Capriotti
-
+
All rights reserved.
-
+
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
-
+
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
-
+
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
-
+
* Neither the name of Paolo Capriotti nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
-
+
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
@@ -406,16 +1136,16 @@ optparse-applicative LICENSE file:
parsec LICENSE file:
Copyright 1999-2000, Daan Leijen; 2007, Paolo Martini. All rights reserved.
-
+
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
-
+
* Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
-
+
This software is provided by the copyright holders "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
@@ -430,19 +1160,19 @@ parsec LICENSE file:
pattern-arrows LICENSE file:
The MIT License (MIT)
-
+
Copyright (c) 2013 Phil Freeman
-
+
Permission is hereby granted, free of charge, to any person obtaining a copy of
this software and associated documentation files (the "Software"), to deal in
the Software without restriction, including without limitation the rights to
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
the Software, and to permit persons to whom the Software is furnished to do so,
subject to the following conditions:
-
+
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
-
+
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
@@ -450,42 +1180,117 @@ pattern-arrows LICENSE file:
IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+pretty LICENSE file:
+
+ This library (libraries/pretty) is derived from code from
+ the GHC project which is largely (c) The University of
+ Glasgow, and distributable under a BSD-style license (see below).
+
+ -----------------------------------------------------------------------------
+
+ The Glasgow Haskell Compiler License
+
+ Copyright 2004, The University Court of the University of Glasgow.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ - Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+
+ - Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+ - Neither name of the University nor the names of its contributors may be
+ used to endorse or promote products derived from this software without
+ specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+ GLASGOW AND THE 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
+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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.
+
+ -----------------------------------------------------------------------------
+
+primitive LICENSE file:
+
+ Copyright (c) 2008-2009, Roman Leshchinskiy
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ - Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+
+ - Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+ - Neither name of the University nor the names of its contributors may be
+ used to endorse or promote products derived from this software without
+ specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+ GLASGOW AND THE 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
+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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.
+
+
process LICENSE file:
This library (libraries/process) is derived from code from two
- sources:
-
+ sources:
+
* Code from the GHC project which is largely (c) The University of
Glasgow, and distributable under a BSD-style license (see below),
-
+
* Code from the Haskell 98 Report which is (c) Simon Peyton Jones
and freely redistributable (but see the full license for
restrictions).
-
+
The full text of these licenses is reproduced below. Both of the
licenses are BSD-style or compatible.
-
+
-----------------------------------------------------------------------------
-
+
The Glasgow Haskell Compiler License
-
- Copyright 2004, The University Court of the University of Glasgow.
+
+ Copyright 2004, The University Court of the University of Glasgow.
All rights reserved.
-
+
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
-
+
- Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
-
+
- Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
-
+
- Neither name of the University nor the names of its contributors may be
used to endorse or promote products derived from this software without
- specific prior written permission.
-
+ specific prior written permission.
+
THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
@@ -498,14 +1303,14 @@ process LICENSE file:
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.
-
+
-----------------------------------------------------------------------------
-
+
Code derived from the document "Report on the Programming Language
Haskell 98", is distributed under the following license:
-
+
Copyright (c) 2002 Simon Peyton Jones
-
+
The authors intend this Report to belong to the entire Haskell
community, and so we grant permission to copy and distribute it for
any purpose, provided that it is reproduced in its entirety,
@@ -513,43 +1318,416 @@ process LICENSE file:
copied and distributed for any purpose, provided that the modified
version is clearly presented as such, and that it does not claim to
be a definition of the Haskell 98 Language.
-
+
-----------------------------------------------------------------------------
+rts LICENSE file:
+
+ Package not found: No such package in package index
+
+safe LICENSE file:
+
+ Copyright Neil Mitchell 2007-2015.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are
+ met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Neil Mitchell nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+ 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.
+
+scientific LICENSE file:
+
+ Copyright (c) 2013, Bas van Dijk
+
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Bas van Dijk nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+ 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.
+
+semigroups LICENSE file:
+
+ Copyright 2011-2015 Edward Kmett
+
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+
+ 1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ 2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+
+split LICENSE file:
+
+ Copyright (c) 2008 Brent Yorgey, Louis Wasserman
+
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+ 1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+ 2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+ 3. Neither the name of the author nor the names of other contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+
+syb LICENSE file:
+
+ This library (libraries/syb) is derived from code from several
+ sources:
+
+ * Code from the GHC project which is largely (c) The University of
+ Glasgow, and distributable under a BSD-style license (see below),
+
+ * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
+ and freely redistributable (but see the full license for
+ restrictions).
+
+ * Code from the Haskell Foreign Function Interface specification,
+ which is (c) Manuel M. T. Chakravarty and freely redistributable
+ (but see the full license for restrictions).
+
+ The full text of these licenses is reproduced below. All of the
+ licenses are BSD-style or compatible.
+
+ -----------------------------------------------------------------------------
+
+ The Glasgow Haskell Compiler License
+
+ Copyright 2004, The University Court of the University of Glasgow.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ - Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+
+ - Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+ - Neither name of the University nor the names of its contributors may be
+ used to endorse or promote products derived from this software without
+ specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+ GLASGOW AND THE 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
+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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.
+
+ -----------------------------------------------------------------------------
+
+ Code derived from the document "Report on the Programming Language
+ Haskell 98", is distributed under the following license:
+
+ Copyright (c) 2002 Simon Peyton Jones
+
+ The authors intend this Report to belong to the entire Haskell
+ community, and so we grant permission to copy and distribute it for
+ any purpose, provided that it is reproduced in its entirety,
+ including this Notice. Modified versions of this Report may also be
+ copied and distributed for any purpose, provided that the modified
+ version is clearly presented as such, and that it does not claim to
+ be a definition of the Haskell 98 Language.
+
+ -----------------------------------------------------------------------------
+
+ Code derived from the document "The Haskell 98 Foreign Function
+ Interface, An Addendum to the Haskell 98 Report" is distributed under
+ the following license:
+
+ Copyright (c) 2002 Manuel M. T. Chakravarty
+
+ The authors intend this Report to belong to the entire Haskell
+ community, and so we grant permission to copy and distribute it for
+ any purpose, provided that it is reproduced in its entirety,
+ including this Notice. Modified versions of this Report may also be
+ copied and distributed for any purpose, provided that the modified
+ version is clearly presented as such, and that it does not claim to
+ be a definition of the Haskell 98 Foreign Function Interface.
+
+ -----------------------------------------------------------------------------
+
+template-haskell LICENSE file:
+
+
+ The Glasgow Haskell Compiler License
+
+ Copyright 2002-2007, The University Court of the University of Glasgow.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ - Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+
+ - Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+ - Neither name of the University nor the names of its contributors may be
+ used to endorse or promote products derived from this software without
+ specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+ GLASGOW AND THE 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
+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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.
+
+
+terminfo LICENSE file:
+
+ Copyright 2007, Judah Jacobson.
+ All Rights Reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ - Redistribution of source code must retain the above copyright notice,
+ this list of conditions and the following disclamer.
+
+ - Redistribution in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclamer in the documentation
+ and/or other materials provided with the distribution.
+
+ THIS SOFTWARE IS PROVIDED BY THE AUTHOR 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 AUTHOR OR THE 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.
+
+text LICENSE file:
+
+ Copyright (c) 2008-2009, Tom Harper
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ 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.
+
time LICENSE file:
TimeLib is Copyright (c) Ashley Yakeley, 2004-2014. All rights reserved.
Certain sections are Copyright 2004, The University Court of the University of Glasgow. All rights reserved.
-
+
Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
-
+
- Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
-
+
- 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.
-
+
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.
transformers LICENSE file:
The Glasgow Haskell Compiler License
-
+
Copyright 2004, The University Court of the University of Glasgow.
All rights reserved.
-
+
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
-
+
- Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
-
+
- Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
-
+
- Neither name of the University nor the names of its contributors may be
used to endorse or promote products derived from this software without
specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+ GLASGOW AND THE 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
+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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.
+
+transformers-compat LICENSE file:
+
+ Copyright 2012 Edward Kmett
+
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+
+ 1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ 2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+ 3. Neither the name of the author nor the names of his contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+unix LICENSE file:
+
+ The Glasgow Haskell Compiler License
+
+ Copyright 2004, The University Court of the University of Glasgow.
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions are met:
+
+ - Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+
+ - Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+ - Neither name of the University nor the names of its contributors may be
+ used to endorse or promote products derived from this software without
+ specific prior written permission.
+
THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
@@ -566,24 +1744,24 @@ transformers LICENSE file:
unordered-containers LICENSE file:
Copyright (c) 2010, Johan Tibell
-
+
All rights reserved.
-
+
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
-
+
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
-
+
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
-
+
* Neither the name of Johan Tibell nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
-
+
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
@@ -623,62 +1801,69 @@ utf8-string LICENSE file:
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-split LICENSE file:
-
- Copyright (c) 2008 Brent Yorgey, Louis Wasserman
+vector LICENSE file:
+ Copyright (c) 2008-2012, Roman Leshchinskiy
All rights reserved.
-
+
Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions
- are met:
- 1. Redistributions of source code must retain the above copyright
- notice, this list of conditions and the following disclaimer.
- 2. Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
- 3. Neither the name of the author nor the names of other contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS OR CONTRIBUTORS BE LIABLE
+ modification, are permitted provided that the following conditions are met:
+
+ - Redistributions of source code must retain the above copyright notice,
+ this list of conditions and the following disclaimer.
+
+ - Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+ - Neither name of the University nor the names of its contributors may be
+ used to endorse or promote products derived from this software without
+ specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
+ GLASGOW AND THE 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
+ UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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
+ 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.
-
-boxes LICENSE file:
+ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+ DAMAGE.
+
- Copyright (c) Brent Yorgey 2008
+void LICENSE file:
+ Copyright 2013 Edward Kmett
+
+ All rights reserved.
+
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
+
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
+
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
- 3. Neither the name of the author nor the names of other contributors
+
+ 3. Neither the name of the author nor the names of his contributors
may be used to endorse or promote products derived from this software
without specific prior written permission.
-
- All other rights are reserved.
-
- THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS OR CONTRIBUTORS BE LIABLE
- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+
+ THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
+ 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.
+
diff --git a/examples/failing/365.purs b/examples/failing/365.purs
new file mode 100644
index 0000000..248003b
--- /dev/null
+++ b/examples/failing/365.purs
@@ -0,0 +1,13 @@
+module Main where
+
+import Prelude
+
+class C a where
+ f :: a -> a
+ g :: a -> a
+
+instance cS :: C String where
+ f s = s
+ g = f
+
+main = g "Done"
diff --git a/examples/failing/438.purs b/examples/failing/438.purs
new file mode 100644
index 0000000..f5e8f02
--- /dev/null
+++ b/examples/failing/438.purs
@@ -0,0 +1,11 @@
+module Main where
+
+import Prelude
+
+data Fix f = In (f (Fix f))
+
+instance eqFix :: (Eq (f (Fix f))) => Eq (Fix f) where
+ (==) (In f) (In g) = f == g
+ (/=) a b = not (a == b)
+
+example = In [] == In []
diff --git a/examples/failing/ArrayType.purs b/examples/failing/ArrayType.purs
index 75d4893..88888aa 100644
--- a/examples/failing/ArrayType.purs
+++ b/examples/failing/ArrayType.purs
@@ -1,5 +1,6 @@
module Main where
+import Prelude
import Debug.Trace
bar :: Number -> Number -> Number
diff --git a/examples/failing/Arrays.purs b/examples/failing/Arrays.purs
index eb5abba..d4ed307 100644
--- a/examples/failing/Arrays.purs
+++ b/examples/failing/Arrays.purs
@@ -1,5 +1,5 @@
module Main where
- import Prelude
+import Prelude
- test = \arr -> arr !! (0 !! 0)
+test = \arr -> arr !! (0 !! 0)
diff --git a/examples/failing/CaseDoesNotMatchAllConstructorArgs.purs b/examples/failing/CaseDoesNotMatchAllConstructorArgs.purs
new file mode 100644
index 0000000..0e02b37
--- /dev/null
+++ b/examples/failing/CaseDoesNotMatchAllConstructorArgs.purs
@@ -0,0 +1,14 @@
+module Main where
+
+import Prelude
+
+data Person = Person String Int
+
+data TwoPeople = Two Person Person
+
+getName p = case p of
+ (Two (Person n) (Person n2 a2)) -> n
+ _ -> "Unknown"
+
+
+name = getName (Two (Person "Jimmy" 20) (Person "" 1))
diff --git a/examples/failing/Do.purs b/examples/failing/Do.purs
index fae1630..face15e 100644
--- a/examples/failing/Do.purs
+++ b/examples/failing/Do.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
test1 = do let x = 1
test2 y = do x <- y
diff --git a/examples/failing/DuplicateDeclarationsInLet.purs b/examples/failing/DuplicateDeclarationsInLet.purs
index a1dd634..9230d3a 100644
--- a/examples/failing/DuplicateDeclarationsInLet.purs
+++ b/examples/failing/DuplicateDeclarationsInLet.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
foo = a
where
a :: Number
diff --git a/examples/failing/DuplicateProperties1.purs b/examples/failing/DuplicateProperties1.purs
index 1d7fbb8..7298bd7 100644
--- a/examples/failing/DuplicateProperties1.purs
+++ b/examples/failing/DuplicateProperties1.purs
@@ -1,9 +1,11 @@
module DuplicateProperties where
+import Prelude
+
foreign import data Test :: # * -> *
-foreign import subtractX "" :: forall r. Test (x :: Unit | r) -> Test r
+foreign import subtractX :: forall r. Test (x :: Unit | r) -> Test r
-foreign import hasX "" :: Test (x :: Unit, y :: Unit)
+foreign import hasX :: Test (x :: Unit, y :: Unit)
baz = subtractX (subtractX hasX)
diff --git a/examples/failing/DuplicateProperties2.purs b/examples/failing/DuplicateProperties2.purs
index 1b1f612..aa0e63c 100644
--- a/examples/failing/DuplicateProperties2.purs
+++ b/examples/failing/DuplicateProperties2.purs
@@ -1,9 +1,11 @@
module DuplicateProperties where
+import Prelude
+
foreign import data Test :: # * -> *
-foreign import subtractX "" :: forall r. Test (x :: Unit | r) -> Test r
+foreign import subtractX :: forall r. Test (x :: Unit | r) -> Test r
-foreign import hasX "" :: forall r. Test (x :: Unit, y :: Unit | r)
+foreign import hasX :: forall r. Test (x :: Unit, y :: Unit | r)
baz = subtractX (subtractX hasX)
diff --git a/examples/failing/DuplicateTypeVars.purs b/examples/failing/DuplicateTypeVars.purs
index 15340f0..85a638c 100644
--- a/examples/failing/DuplicateTypeVars.purs
+++ b/examples/failing/DuplicateTypeVars.purs
@@ -1,3 +1,5 @@
module Main where
+import Prelude
+
type Foo a a = a
diff --git a/examples/failing/Foldable.purs b/examples/failing/Foldable.purs
index abd73d9..c589cce 100644
--- a/examples/failing/Foldable.purs
+++ b/examples/failing/Foldable.purs
@@ -1,12 +1,16 @@
module Main where
+import Prelude
+
class Foldable f where
fold :: forall a b. (a -> b -> b) -> b -> f a -> b
size :: forall a. f a -> Number
-instance foldableArray :: Foldable [] where
- fold _ z [] = z
- fold f z (x:xs) = x `f` (fold f z xs)
- size = fold (const ((+) 1)) 0
+data L a = C a (L a) | N
+
+instance foldableL :: Foldable L where
+ fold _ z N = z
+ fold f z (C x xs) = x `f` (fold f z xs)
+ size = fold (const ((+) 1.0)) 0.0
-x = size [1,2,3]
+x = size (C 1 (C 2 (C 3 N)))
diff --git a/examples/failing/InstanceExport.purs b/examples/failing/InstanceExport.purs
index 597e07b..fca062c 100644
--- a/examples/failing/InstanceExport.purs
+++ b/examples/failing/InstanceExport.purs
@@ -1,5 +1,7 @@
module InstanceExport (S(..), f) where
+import Prelude
+
newtype S = S String
class F a where
diff --git a/examples/failing/KindError.purs b/examples/failing/KindError.purs
index f550505..ae6a728 100644
--- a/examples/failing/KindError.purs
+++ b/examples/failing/KindError.purs
@@ -1,3 +1,5 @@
module Main where
- data KindError f a = One f | Two (f a)
+import Prelude
+
+data KindError f a = One f | Two (f a)
diff --git a/examples/failing/LeadingZeros1.purs b/examples/failing/LeadingZeros1.purs
new file mode 100644
index 0000000..9c6967a
--- /dev/null
+++ b/examples/failing/LeadingZeros1.purs
@@ -0,0 +1,5 @@
+module Main where
+
+import Prelude
+
+x = 01
diff --git a/examples/failing/LeadingZeros2.purs b/examples/failing/LeadingZeros2.purs
new file mode 100644
index 0000000..4602707
--- /dev/null
+++ b/examples/failing/LeadingZeros2.purs
@@ -0,0 +1,5 @@
+module Main where
+
+import Prelude
+
+x = 00.1
diff --git a/examples/failing/Let.purs b/examples/failing/Let.purs
index 06e0748..db26dbf 100644
--- a/examples/failing/Let.purs
+++ b/examples/failing/Let.purs
@@ -1,3 +1,5 @@
module Main where
+import Prelude
+
test = let x = x in x
diff --git a/examples/failing/MPTCs.purs b/examples/failing/MPTCs.purs
index 3d1dbe4..935bbf3 100644
--- a/examples/failing/MPTCs.purs
+++ b/examples/failing/MPTCs.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
class Foo a where
f :: a -> a
diff --git a/examples/failing/MissingClassExport.purs b/examples/failing/MissingClassExport.purs
index c1676fa..4b3b8a0 100644
--- a/examples/failing/MissingClassExport.purs
+++ b/examples/failing/MissingClassExport.purs
@@ -1,4 +1,6 @@
module Test (bar) where
- class Foo a where
- bar :: a -> a
+import Prelude
+
+class Foo a where
+ bar :: a -> a
diff --git a/examples/failing/MissingClassMemberExport.purs b/examples/failing/MissingClassMemberExport.purs
index 9f8712e..e865694 100644
--- a/examples/failing/MissingClassMemberExport.purs
+++ b/examples/failing/MissingClassMemberExport.purs
@@ -1,4 +1,6 @@
module Test (Foo) where
- class Foo a where
- bar :: a -> a
+import Prelude
+
+class Foo a where
+ bar :: a -> a
diff --git a/examples/failing/MultipleErrors.purs b/examples/failing/MultipleErrors.purs
index 27db822..da04702 100644
--- a/examples/failing/MultipleErrors.purs
+++ b/examples/failing/MultipleErrors.purs
@@ -1,5 +1,7 @@
module MultipleErrors where
+import Prelude
+
foo :: Number -> Number
foo 0 = "Test"
foo n = bar (n - 1)
diff --git a/examples/failing/MultipleErrors2.purs b/examples/failing/MultipleErrors2.purs
index f4f4a98..37fe9d7 100644
--- a/examples/failing/MultipleErrors2.purs
+++ b/examples/failing/MultipleErrors2.purs
@@ -1,5 +1,7 @@
module MultipleErrors2 where
+import Prelude
+
foo = itDoesntExist
bar = neitherDoesThis
diff --git a/examples/failing/MutRec.purs b/examples/failing/MutRec.purs
index 48757eb..219eb6f 100644
--- a/examples/failing/MutRec.purs
+++ b/examples/failing/MutRec.purs
@@ -1,5 +1,7 @@
module MutRec where
+import Prelude
+
x = y
y = x
diff --git a/examples/failing/MutRec2.purs b/examples/failing/MutRec2.purs
index 52dd5b3..3fb84eb 100644
--- a/examples/failing/MutRec2.purs
+++ b/examples/failing/MutRec2.purs
@@ -1,3 +1,5 @@
module Main where
+import Prelude
+
x = x
diff --git a/examples/failing/NewtypeMultiArgs.purs b/examples/failing/NewtypeMultiArgs.purs
index d658755..805a784 100644
--- a/examples/failing/NewtypeMultiArgs.purs
+++ b/examples/failing/NewtypeMultiArgs.purs
@@ -1,3 +1,5 @@
module Main where
+import Prelude
+
newtype Thing = Thing String Boolean
diff --git a/examples/failing/NewtypeMultiCtor.purs b/examples/failing/NewtypeMultiCtor.purs
index 89a9184..158f38c 100644
--- a/examples/failing/NewtypeMultiCtor.purs
+++ b/examples/failing/NewtypeMultiCtor.purs
@@ -1,3 +1,5 @@
module Main where
+import Prelude
+
newtype Thing = Thing String | Other
diff --git a/examples/failing/NoOverlap.purs b/examples/failing/NoOverlap.purs
index 23b2897..abf8620 100644
--- a/examples/failing/NoOverlap.purs
+++ b/examples/failing/NoOverlap.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
data Foo = Foo
instance showFoo1 :: Show Foo where
diff --git a/examples/failing/NullaryAbs.purs b/examples/failing/NullaryAbs.purs
index 72ac0fe..8ad6f88 100644
--- a/examples/failing/NullaryAbs.purs
+++ b/examples/failing/NullaryAbs.purs
@@ -1,3 +1,5 @@
module Main where
- func = \ -> "no"
+import Prelude
+
+func = \ -> "no"
diff --git a/examples/failing/Object.purs b/examples/failing/Object.purs
index 7df3309..9a66afb 100644
--- a/examples/failing/Object.purs
+++ b/examples/failing/Object.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
test o = o.foo
test1 = test {}
diff --git a/examples/failing/OverlappingArguments.purs b/examples/failing/OverlappingArguments.purs
index 5fb0dbe..7b2347c 100644
--- a/examples/failing/OverlappingArguments.purs
+++ b/examples/failing/OverlappingArguments.purs
@@ -1,3 +1,5 @@
module OverlappingArguments where
+import Prelude
+
f x x = x
diff --git a/examples/failing/OverlappingBinders.purs b/examples/failing/OverlappingBinders.purs
index 4ab37d4..9c879fe 100644
--- a/examples/failing/OverlappingBinders.purs
+++ b/examples/failing/OverlappingBinders.purs
@@ -1,4 +1,8 @@
module OverlappingBinders where
+import Prelude
+
+data S a = S a (S a)
+
f x = case x of
- (y:y@(z:zs)) -> y
+ (S y (S y@(S z zs))) -> y
diff --git a/examples/failing/OverlappingInstances.purs b/examples/failing/OverlappingInstances.purs
index 54e6b85..aad48b0 100644
--- a/examples/failing/OverlappingInstances.purs
+++ b/examples/failing/OverlappingInstances.purs
@@ -1,5 +1,7 @@
module OverlappingInstances where
+import Prelude
+
data A = A
instance showA1 :: Show A where
diff --git a/examples/failing/OverlappingInstances2.purs b/examples/failing/OverlappingInstances2.purs
index 555b2ed..bf971ee 100644
--- a/examples/failing/OverlappingInstances2.purs
+++ b/examples/failing/OverlappingInstances2.purs
@@ -1,5 +1,7 @@
module OverlappingInstances where
+import Prelude
+
data A = A | B
instance eqA1 :: Eq A where
diff --git a/examples/failing/OverlappingVars.purs b/examples/failing/OverlappingVars.purs
index a6c83ea..1d9f118 100644
--- a/examples/failing/OverlappingVars.purs
+++ b/examples/failing/OverlappingVars.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
class OverlappingVars a where
f :: a -> a
diff --git a/examples/failing/Rank2Types.purs b/examples/failing/Rank2Types.purs
index 11e69f2..61c0442 100644
--- a/examples/failing/Rank2Types.purs
+++ b/examples/failing/Rank2Types.purs
@@ -1,7 +1,7 @@
module Main where
- import Prelude
+import Prelude
- foreign import test :: (forall a. a -> a) -> Number
+foreign import test :: (forall a. a -> a) -> Number
- test1 = test (\n -> n + 1)
+test1 = test (\n -> n + 1)
diff --git a/examples/failing/Reserved.purs b/examples/failing/Reserved.purs
index 2a14304..5edd95a 100644
--- a/examples/failing/Reserved.purs
+++ b/examples/failing/Reserved.purs
@@ -1,4 +1,6 @@
module Main where
+import Prelude
+
(<) :: Number -> Number -> Number
(<) a b = !(a >= b)
diff --git a/examples/failing/RowConstructors1.purs b/examples/failing/RowConstructors1.purs
new file mode 100644
index 0000000..ca260db
--- /dev/null
+++ b/examples/failing/RowConstructors1.purs
@@ -0,0 +1,8 @@
+module Main where
+
+import Prelude
+
+data Foo = Bar
+type Baz = { | Foo }
+
+main = Debug.Trace.trace "Done"
diff --git a/examples/failing/RowConstructors2.purs b/examples/failing/RowConstructors2.purs
new file mode 100644
index 0000000..d763d6e
--- /dev/null
+++ b/examples/failing/RowConstructors2.purs
@@ -0,0 +1,8 @@
+module Main where
+
+import Prelude
+
+type Foo r = (x :: Number | r)
+type Bar = { | Foo }
+
+main = Debug.Trace.trace "Done"
diff --git a/examples/failing/RowConstructors3.purs b/examples/failing/RowConstructors3.purs
new file mode 100644
index 0000000..d5ad0b1
--- /dev/null
+++ b/examples/failing/RowConstructors3.purs
@@ -0,0 +1,8 @@
+module Main where
+
+import Prelude
+
+type Foo = { x :: Number }
+type Bar = { | Foo }
+
+main = Debug.Trace.trace "Done"
diff --git a/examples/failing/SkolemEscape.purs b/examples/failing/SkolemEscape.purs
index f7acaa4..f083c73 100644
--- a/examples/failing/SkolemEscape.purs
+++ b/examples/failing/SkolemEscape.purs
@@ -1,5 +1,7 @@
module Main where
- foreign import foo :: (forall a. a -> a) -> Number
+import Prelude
- test = \x -> foo x
+foreign import foo :: (forall a. a -> a) -> Number
+
+test = \x -> foo x
diff --git a/examples/failing/Superclasses1.purs b/examples/failing/Superclasses1.purs
index 571ef30..af98520 100644
--- a/examples/failing/Superclasses1.purs
+++ b/examples/failing/Superclasses1.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
class Su a where
su :: a -> a
diff --git a/examples/failing/Superclasses2.purs b/examples/failing/Superclasses2.purs
index 93e1205..13e9d56 100644
--- a/examples/failing/Superclasses2.purs
+++ b/examples/failing/Superclasses2.purs
@@ -1,5 +1,7 @@
module CycleInSuperclasses where
+import Prelude
+
class (Foo a) <= Bar a
class (Bar a) <= Foo a
diff --git a/examples/failing/Superclasses3.purs b/examples/failing/Superclasses3.purs
index 8332b59..f79d89d 100644
--- a/examples/failing/Superclasses3.purs
+++ b/examples/failing/Superclasses3.purs
@@ -1,5 +1,7 @@
module UnknownSuperclassTypeVar where
+import Prelude
+
class Foo a
class (Foo b) <= Bar a
diff --git a/examples/failing/Superclasses4.purs b/examples/failing/Superclasses4.purs
index fba660b..3c7c979 100644
--- a/examples/failing/Superclasses4.purs
+++ b/examples/failing/Superclasses4.purs
@@ -1,5 +1,7 @@
module OverlappingInstances where
+import Prelude
+
class Foo a
instance foo1 :: Foo Number
diff --git a/examples/failing/TopLevelCaseNoArgs.purs b/examples/failing/TopLevelCaseNoArgs.purs
index c8979c4..c0a9f01 100644
--- a/examples/failing/TopLevelCaseNoArgs.purs
+++ b/examples/failing/TopLevelCaseNoArgs.purs
@@ -1,4 +1,7 @@
module Main where
- foo :: Number
- foo = 1
- foo = 2
+
+import Prelude
+
+foo :: Number
+foo = 1
+foo = 2
diff --git a/examples/failing/TypeClassInstances.purs b/examples/failing/TypeClassInstances.purs
index 59bd0ff..ca4021f 100644
--- a/examples/failing/TypeClassInstances.purs
+++ b/examples/failing/TypeClassInstances.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
class A a where
a :: a -> String
b :: a -> Number
diff --git a/examples/failing/TypeError.purs b/examples/failing/TypeError.purs
index a4c7fbc..a9e65b3 100644
--- a/examples/failing/TypeError.purs
+++ b/examples/failing/TypeError.purs
@@ -1,5 +1,5 @@
module Main where
- import Prelude
+import Prelude
- test = 1 ++ "A"
+test = 1 ++ "A"
diff --git a/examples/failing/TypeSynonyms.purs b/examples/failing/TypeSynonyms.purs
index b1016ad..473dc7d 100644
--- a/examples/failing/TypeSynonyms.purs
+++ b/examples/failing/TypeSynonyms.purs
@@ -1,5 +1,7 @@
module Main where
-type T1 = [T2]
+import Prelude
+
+type T1 = Array T2
type T2 = T1
diff --git a/examples/failing/TypeSynonyms2.purs b/examples/failing/TypeSynonyms2.purs
index 5f668f8..36c7950 100644
--- a/examples/failing/TypeSynonyms2.purs
+++ b/examples/failing/TypeSynonyms2.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
class Foo a where
foo :: a -> String
diff --git a/examples/failing/TypeSynonyms3.purs b/examples/failing/TypeSynonyms3.purs
index 5f668f8..36c7950 100644
--- a/examples/failing/TypeSynonyms3.purs
+++ b/examples/failing/TypeSynonyms3.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
class Foo a where
foo :: a -> String
diff --git a/examples/failing/TypeSynonyms4.purs b/examples/failing/TypeSynonyms4.purs
index 42c60a8..af118c4 100644
--- a/examples/failing/TypeSynonyms4.purs
+++ b/examples/failing/TypeSynonyms4.purs
@@ -1,5 +1,7 @@
module TypeSynonyms4 where
+import Prelude
+
type F x y = x -> y
type G x = F x
diff --git a/examples/failing/TypeSynonyms5.purs b/examples/failing/TypeSynonyms5.purs
new file mode 100644
index 0000000..e948d5a
--- /dev/null
+++ b/examples/failing/TypeSynonyms5.purs
@@ -0,0 +1,5 @@
+module Main where
+
+import Prelude
+
+type T = T
diff --git a/examples/failing/TypeWildcards1.purs b/examples/failing/TypeWildcards1.purs
index b367fc6..f231379 100644
--- a/examples/failing/TypeWildcards1.purs
+++ b/examples/failing/TypeWildcards1.purs
@@ -1,4 +1,6 @@
module TypeWildcards where
+import Prelude
+
type Test = _
diff --git a/examples/failing/TypeWildcards2.purs b/examples/failing/TypeWildcards2.purs
index a7546d6..b625b4e 100644
--- a/examples/failing/TypeWildcards2.purs
+++ b/examples/failing/TypeWildcards2.purs
@@ -1,4 +1,6 @@
module TypeWildcards where
+import Prelude
+
data Test = Test _
diff --git a/examples/failing/TypeWildcards3.purs b/examples/failing/TypeWildcards3.purs
index 7922d05..e28abb8 100644
--- a/examples/failing/TypeWildcards3.purs
+++ b/examples/failing/TypeWildcards3.purs
@@ -1,5 +1,7 @@
module TypeWildcards where
+import Prelude
+
data Foo a = Foo
instance showFoo :: Show (Foo _) where
diff --git a/examples/failing/UnderscoreModuleName.purs b/examples/failing/UnderscoreModuleName.purs
index 508e48a..2cc71a5 100644
--- a/examples/failing/UnderscoreModuleName.purs
+++ b/examples/failing/UnderscoreModuleName.purs
@@ -1,3 +1,5 @@
module Bad_Module where
+import Prelude
+
main = Debug.Trace.trace "Done"
diff --git a/examples/failing/UnifyInTypeInstanceLookup.purs b/examples/failing/UnifyInTypeInstanceLookup.purs
index 815312a..93d084c 100644
--- a/examples/failing/UnifyInTypeInstanceLookup.purs
+++ b/examples/failing/UnifyInTypeInstanceLookup.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
data Z = Z
data S n = S n
diff --git a/examples/failing/UnknownType.purs b/examples/failing/UnknownType.purs
index 4d969aa..ab2ea58 100644
--- a/examples/failing/UnknownType.purs
+++ b/examples/failing/UnknownType.purs
@@ -1,4 +1,6 @@
module Main where
+import Prelude
+
test :: Number -> Something
test = {}
diff --git a/examples/passing/652.purs b/examples/passing/652.purs
index 4bfbc52..66443ab 100644
--- a/examples/passing/652.purs
+++ b/examples/passing/652.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
class Foo a b
class Bar a c
diff --git a/examples/passing/810.purs b/examples/passing/810.purs
index d1ba729..2ba3428 100644
--- a/examples/passing/810.purs
+++ b/examples/passing/810.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
data Maybe a = Nothing | Just a
test :: forall a. Maybe a -> Maybe a
diff --git a/examples/passing/ArrayType.purs b/examples/passing/ArrayType.purs
index 8faa88a..eddf257 100644
--- a/examples/passing/ArrayType.purs
+++ b/examples/passing/ArrayType.purs
@@ -1,9 +1,11 @@
module Main where
+import Prelude
+
class Pointed p where
point :: forall a. a -> p a
-instance pointedArray :: Pointed [] where
+instance pointedArray :: Pointed Array where
point a = [a]
main = Debug.Trace.trace "Done"
diff --git a/examples/passing/Arrays.purs b/examples/passing/Arrays.purs
deleted file mode 100644
index 7a7c53b..0000000
--- a/examples/passing/Arrays.purs
+++ /dev/null
@@ -1,24 +0,0 @@
-module Main where
-
-import Prelude.Unsafe (unsafeIndex)
-
-test1 arr = arr `unsafeIndex` 0 + arr `unsafeIndex` 1 + 1
-
-test2 = \arr -> case arr of
- [x, y] -> x + y
- [x] -> x
- [] -> 0
- (x : y : _) -> x + y
-
-data Tree = One Number | Some [Tree]
-
-test3 = \tree sum -> case tree of
- One n -> n
- Some (n1 : n2 : rest) -> test3 n1 sum * 10 + test3 n2 sum * 5 + sum rest
-
-test4 = \arr -> case arr of
- [] -> 0
- [_] -> 0
- x : y : xs -> x * y + test4 xs
-
-main = Debug.Trace.trace "Done"
diff --git a/examples/passing/Auto.purs b/examples/passing/Auto.purs
index 6484551..070d4aa 100644
--- a/examples/passing/Auto.purs
+++ b/examples/passing/Auto.purs
@@ -1,13 +1,15 @@
module Main where
- data Auto s i o = Auto { state :: s, step :: s -> i -> o }
+import Prelude
- type SomeAuto i o = forall r. (forall s. Auto s i o -> r) -> r
+data Auto s i o = Auto { state :: s, step :: s -> i -> o }
- exists :: forall s i o. s -> (s -> i -> o) -> SomeAuto i o
- exists = \state step f -> f (Auto { state: state, step: step })
+type SomeAuto i o = forall r. (forall s. Auto s i o -> r) -> r
- run :: forall i o. SomeAuto i o -> i -> o
- run = \s i -> s (\a -> case a of Auto a -> a.step a.state i)
+exists :: forall s i o. s -> (s -> i -> o) -> SomeAuto i o
+exists = \state step f -> f (Auto { state: state, step: step })
- main = Debug.Trace.trace "Done"
+run :: forall i o. SomeAuto i o -> i -> o
+run = \s i -> s (\a -> case a of Auto a -> a.step a.state i)
+
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/AutoPrelude.purs b/examples/passing/AutoPrelude.purs
index 6f3bdad..1f8bcdf 100644
--- a/examples/passing/AutoPrelude.purs
+++ b/examples/passing/AutoPrelude.purs
@@ -1,8 +1,9 @@
module Main where
+import Prelude
import Debug.Trace
-f x = x * 10
-g y = y - 10
+f x = x * 10.0
+g y = y - 10.0
-main = trace $ show $ (f <<< g) 100
+main = trace $ show $ (f <<< g) 100.0
diff --git a/examples/passing/AutoPrelude2.purs b/examples/passing/AutoPrelude2.purs
index 0bc90bb..4a8c51a 100644
--- a/examples/passing/AutoPrelude2.purs
+++ b/examples/passing/AutoPrelude2.purs
@@ -1,5 +1,6 @@
module Main where
+import Prelude
import qualified Prelude as P
import Debug.Trace
diff --git a/examples/passing/BindersInFunctions.purs b/examples/passing/BindersInFunctions.purs
index 56ee2b4..13acfc5 100644
--- a/examples/passing/BindersInFunctions.purs
+++ b/examples/passing/BindersInFunctions.purs
@@ -1,18 +1,12 @@
module Main where
import Prelude
+import Assert
-tail = \(_:xs) -> xs
-
-foreign import error
- """
- function error(msg) {
- throw msg;
- }
- """ :: forall a. String -> a
+snd = \[_, y] -> y
main =
- let ts = tail [1, 2, 3] in
- if ts == [2, 3]
+ let ts = snd [1.0, 2.0] in
+ if ts == 2.0
then Debug.Trace.trace "Done"
- else error "Incorrect result from 'tails'."
+ else error "Incorrect result from 'snd'."
diff --git a/examples/passing/BindingGroups.purs b/examples/passing/BindingGroups.purs
index dfc30e5..903579d 100644
--- a/examples/passing/BindingGroups.purs
+++ b/examples/passing/BindingGroups.purs
@@ -1,8 +1,10 @@
module Main where
+import Prelude
+
foo = bar
- where bar r = r + 1
+ where bar r = r + 1.0
-r = foo 2
+r = foo 2.0
main = Debug.Trace.trace "Done"
diff --git a/examples/passing/BlockString.purs b/examples/passing/BlockString.purs
index 60accf1..721612c 100644
--- a/examples/passing/BlockString.purs
+++ b/examples/passing/BlockString.purs
@@ -1,12 +1,8 @@
module Main where
-foreign import foo """
- function foo(s) {
- return s;
- }
-""" :: String -> String
+import Prelude
-bar :: String -> String
-bar _ = foo "test"
+foo :: String
+foo = """foo"""
main = Debug.Trace.trace "Done"
diff --git a/examples/passing/CaseInDo.purs b/examples/passing/CaseInDo.purs
index a5a118c..844d025 100644
--- a/examples/passing/CaseInDo.purs
+++ b/examples/passing/CaseInDo.purs
@@ -1,20 +1,19 @@
module Main where
+import Prelude
import Debug.Trace
import Control.Monad.Eff
-foreign import doIt "function doIt() { global.flag = true; }" :: forall eff. Eff eff Unit
-
-foreign import get "function get() { return global.flag; }" :: forall eff. Eff eff Boolean
+doIt :: forall eff. Eff eff Boolean
+doIt = return true
set = do
trace "Testing..."
case 0 of
0 -> doIt
- _ -> return unit
+ _ -> return false
main = do
- set
- b <- get
+ b <- set
case b of
true -> trace "Done"
diff --git a/examples/passing/CaseStatement.purs b/examples/passing/CaseStatement.purs
index 17669c1..74b4b93 100644
--- a/examples/passing/CaseStatement.purs
+++ b/examples/passing/CaseStatement.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
data A = A | B | C
f a _ A = a
diff --git a/examples/passing/CheckFunction.purs b/examples/passing/CheckFunction.purs
index 6a091a9..6504256 100644
--- a/examples/passing/CheckFunction.purs
+++ b/examples/passing/CheckFunction.purs
@@ -1,5 +1,7 @@
module Main where
-test = ((\x -> x+1) >>> (\x -> x*2)) 4
+import Prelude
+
+test = ((\x -> x+1.0) >>> (\x -> x*2.0)) 4.0
main = Debug.Trace.trace "Done"
diff --git a/examples/passing/CheckSynonymBug.purs b/examples/passing/CheckSynonymBug.purs
index bab0b8e..09c6161 100644
--- a/examples/passing/CheckSynonymBug.purs
+++ b/examples/passing/CheckSynonymBug.purs
@@ -1,16 +1,9 @@
module Main where
- import Prelude
+import Prelude
- type Foo a = [a]
+type Foo a = Array a
- foreign import length
- """
- function length(a) {
- return a.length;
- }
- """ :: forall a. [a] -> Number
+foo _ = length ([] :: Foo Number)
- foo _ = length ([] :: Foo Number)
-
- main = Debug.Trace.trace "Done"
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/CheckTypeClass.purs b/examples/passing/CheckTypeClass.purs
index 6f172f9..45f59ad 100644
--- a/examples/passing/CheckTypeClass.purs
+++ b/examples/passing/CheckTypeClass.purs
@@ -1,16 +1,18 @@
module Main where
- data Bar a = Bar
- data Baz
+import Prelude
- class Foo a where
- foo :: Bar a -> Baz
+data Bar a = Bar
+data Baz
- foo_ :: forall a. (Foo a) => a -> Baz
- foo_ x = foo ((mkBar :: forall a. (Foo a) => a -> Bar a) x)
+class Foo a where
+ foo :: Bar a -> Baz
- mkBar :: forall a. a -> Bar a
- mkBar _ = Bar
+foo_ :: forall a. (Foo a) => a -> Baz
+foo_ x = foo ((mkBar :: forall a. (Foo a) => a -> Bar a) x)
- main = Debug.Trace.trace "Done"
+mkBar :: forall a. a -> Bar a
+mkBar _ = Bar
+
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/Church.purs b/examples/passing/Church.purs
index f563992..bda8fb7 100644
--- a/examples/passing/Church.purs
+++ b/examples/passing/Church.purs
@@ -1,18 +1,18 @@
module Main where
- import Prelude ()
+import Prelude ()
- type List a = forall r. r -> (a -> r -> r) -> r
+type List a = forall r. r -> (a -> r -> r) -> r
- empty :: forall a. List a
- empty = \r f -> r
+empty :: forall a. List a
+empty = \r f -> r
- cons :: forall a. a -> List a -> List a
- cons = \a l r f -> f a (l r f)
+cons :: forall a. a -> List a -> List a
+cons = \a l r f -> f a (l r f)
- append :: forall a. List a -> List a -> List a
- append = \l1 l2 r f -> l2 (l1 r f) f
+append :: forall a. List a -> List a -> List a
+append = \l1 l2 r f -> l2 (l1 r f) f
- test = append (cons 1 empty) (cons 2 empty)
+test = append (cons 1 empty) (cons 2 empty)
- main = Debug.Trace.trace "Done"
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/Collatz.purs b/examples/passing/Collatz.purs
index f61a950..37f51e9 100644
--- a/examples/passing/Collatz.purs
+++ b/examples/passing/Collatz.purs
@@ -7,12 +7,12 @@ import Control.Monad.ST
collatz :: Number -> Number
collatz n = runPure (runST (do
r <- newSTRef n
- count <- newSTRef 0
+ count <- newSTRef 0.0
untilE $ do
- modifySTRef count $ (+) 1
+ modifySTRef count $ (+) 1.0
m <- readSTRef r
- writeSTRef r $ if m % 2 == 0 then m / 2 else 3 * m + 1
- return $ m == 1
+ writeSTRef r $ if m % 2.0 == 0.0 then m / 2.0 else 3.0 * m + 1.0
+ return $ m == 1.0
readSTRef count))
-main = Debug.Trace.print $ collatz 1000
+main = Debug.Trace.print $ collatz 1000.0
diff --git a/examples/passing/Comparisons.purs b/examples/passing/Comparisons.purs
index 4fb768d..ab35318 100644
--- a/examples/passing/Comparisons.purs
+++ b/examples/passing/Comparisons.purs
@@ -1,24 +1,14 @@
module Main where
+import Prelude
import Control.Monad.Eff
import Debug.Trace
-
-foreign import data Assert :: !
-
-foreign import assert
- """
- function assert(x) {
- return function() {
- if (!x) throw new Error('assertion failed');
- return {};
- };
- }
- """ :: forall e. Boolean -> Eff (assert :: Assert | e) Unit
+import Assert
main = do
- assert (1 < 2)
- assert (2 == 2)
- assert (3 > 1)
+ assert (1.0 < 2.0)
+ assert (2.0 == 2.0)
+ assert (3.0 > 1.0)
assert ("a" < "b")
assert ("a" == "a")
assert ("z" > "a")
diff --git a/examples/passing/Conditional.purs b/examples/passing/Conditional.purs
index f20768e..6d39f7f 100644
--- a/examples/passing/Conditional.purs
+++ b/examples/passing/Conditional.purs
@@ -1,9 +1,9 @@
module Main where
- import Prelude ()
+import Prelude ()
- fns = \f -> if f true then f else \x -> x
+fns = \f -> if f true then f else \x -> x
- not = \x -> if x then false else true
+not = \x -> if x then false else true
- main = Debug.Trace.trace "Done"
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/Console.purs b/examples/passing/Console.purs
index dfb2d21..e9e5c91 100644
--- a/examples/passing/Console.purs
+++ b/examples/passing/Console.purs
@@ -5,9 +5,9 @@ import Control.Monad.Eff
import Debug.Trace
replicateM_ :: forall m a. (Monad m) => Number -> m a -> m {}
-replicateM_ 0 _ = return {}
+replicateM_ 0.0 _ = return {}
replicateM_ n act = do
act
- replicateM_ (n - 1) act
+ replicateM_ (n - 1.0) act
-main = replicateM_ 10 (trace "Hello World!")
+main = replicateM_ 10.0 (trace "Hello World!")
diff --git a/examples/passing/DataAndType.purs b/examples/passing/DataAndType.purs
index 711082a..d7b0d2f 100644
--- a/examples/passing/DataAndType.purs
+++ b/examples/passing/DataAndType.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
data A = A B
type B = A
diff --git a/examples/passing/DeepArrayBinder.purs b/examples/passing/DeepArrayBinder.purs
index 8ad3253..a5e7476 100644
--- a/examples/passing/DeepArrayBinder.purs
+++ b/examples/passing/DeepArrayBinder.purs
@@ -1,18 +1,15 @@
module Main where
+import Prelude
import Control.Monad.Eff
+import Assert
-match2 :: [Number] -> Number
-match2 (x : y : xs) = x * y + match2 xs
-match2 _ = 0
+data List a = Cons a (List a) | Nil
-foreign import explode
- """
- function explode() {
- throw new Error('Incorrect result');
- }
- """ :: forall eff a. Eff eff a
+match2 :: List Number -> Number
+match2 (Cons x (Cons y xs)) = x * y + match2 xs
+match2 _ = 0.0
-main = case match2 [1, 2, 3, 4, 5, 6, 7, 8, 9] of
- 100 -> Debug.Trace.trace "Done"
- _ -> explode
+main = case 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))))))))) of
+ 100.0 -> Debug.Trace.trace "Done"
+ _ -> error "Incorrect result!"
diff --git a/examples/passing/DeepCase.purs b/examples/passing/DeepCase.purs
index 2e41310..741e09a 100644
--- a/examples/passing/DeepCase.purs
+++ b/examples/passing/DeepCase.purs
@@ -1,5 +1,6 @@
module Main where
+import Prelude
import Debug.Trace
import Control.Monad.Eff
import Control.Monad.ST
@@ -7,8 +8,8 @@ import Control.Monad.ST
f x y =
let
g = case y of
- 0 -> x
- x -> 1 + x * x
+ 0.0 -> x
+ x -> 1.0 + x * x
in g + x + y
-main = print $ f 1 10
+main = print $ f 1.0 10.0
diff --git a/examples/passing/Do.purs b/examples/passing/Do.purs
index a995f36..9e63f9b 100644
--- a/examples/passing/Do.purs
+++ b/examples/passing/Do.purs
@@ -16,8 +16,8 @@ instance applicativeMaybe :: Applicative Maybe where
pure = Just
instance bindMaybe :: Bind Maybe where
- (>>=) Nothing _ = Nothing
- (>>=) (Just a) f = f a
+ bind Nothing _ = Nothing
+ bind (Just a) f = f a
instance monadMaybe :: Prelude.Monad Maybe
@@ -25,26 +25,26 @@ test1 = \_ -> do
Just "abc"
test2 = \_ -> do
- (x : _) <- Just [1, 2, 3]
- (y : _) <- Just [4, 5, 6]
+ x <- Just 1.0
+ y <- Just 2.0
Just (x + y)
test3 = \_ -> do
- Just 1
+ Just 1.0
Nothing :: Maybe Number
- Just 2
+ Just 2.0
test4 mx my = do
x <- mx
y <- my
- Just (x + y + 1)
+ Just (x + y + 1.0)
test5 mx my mz = do
x <- mx
y <- my
let sum = x + y
z <- mz
- Just (z + sum + 1)
+ Just (z + sum + 1.0)
test6 mx = \_ -> do
let
@@ -54,14 +54,14 @@ test6 mx = \_ -> do
test8 = \_ -> do
Just (do
- Just 1)
+ Just 1.0)
-test9 = \_ -> (+) <$> Just 1 <*> Just 2
+test9 = \_ -> (+) <$> Just 1.0 <*> Just 2.0
test10 _ = do
let
- f x = g x * 3
- g x = f x / 2
- Just (f 10)
+ f x = g x * 3.0
+ g x = f x / 2.0
+ Just (f 10.0)
main = Debug.Trace.trace "Done"
diff --git a/examples/passing/Eff.purs b/examples/passing/Eff.purs
index 0fb8494..c269512 100644
--- a/examples/passing/Eff.purs
+++ b/examples/passing/Eff.purs
@@ -10,13 +10,13 @@ test1 = do
trace "Line 2"
test2 = runPure (runST (do
- ref <- newSTRef 0
- modifySTRef ref $ \n -> n + 1
+ ref <- newSTRef 0.0
+ modifySTRef ref $ \n -> n + 1.0
readSTRef ref))
test3 = pureST (do
- ref <- newSTRef 0
- modifySTRef ref $ \n -> n + 1
+ ref <- newSTRef 0.0
+ modifySTRef ref $ \n -> n + 1.0
readSTRef ref)
main = do
diff --git a/examples/passing/EmptyDataDecls.purs b/examples/passing/EmptyDataDecls.purs
index 41a0319..e19cc65 100644
--- a/examples/passing/EmptyDataDecls.purs
+++ b/examples/passing/EmptyDataDecls.purs
@@ -1,34 +1,19 @@
module Main where
import Prelude
+import Assert
data Z
data S n
-data ArrayBox n a = ArrayBox [a]
+data ArrayBox n a = ArrayBox (Array a)
nil :: forall a. ArrayBox Z a
nil = ArrayBox []
-foreign import concat
- """
- function concat(l1) {
- return function(l2) {
- return l1.concat(l2);
- };
- }
- """ :: forall a. [a] -> [a] -> [a]
-
cons' :: forall a n. a -> ArrayBox n a -> ArrayBox (S n) a
cons' x (ArrayBox xs) = ArrayBox $ concat [x] xs
-foreign import error
- """
- function error(msg) {
- throw msg;
- }
- """ :: forall a. String -> a
-
main = case cons' 1 $ cons' 2 $ cons' 3 nil of
ArrayBox [1, 2, 3] -> Debug.Trace.trace "Done"
_ -> error "Failed"
diff --git a/examples/passing/EmptyRow.purs b/examples/passing/EmptyRow.purs
index 1e9bdb9..3b2532d 100644
--- a/examples/passing/EmptyRow.purs
+++ b/examples/passing/EmptyRow.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
data Foo r = Foo { | r }
test :: Foo ()
diff --git a/examples/passing/EmptyTypeClass.purs b/examples/passing/EmptyTypeClass.purs
index 5827c82..08aa4f3 100644
--- a/examples/passing/EmptyTypeClass.purs
+++ b/examples/passing/EmptyTypeClass.purs
@@ -4,8 +4,8 @@ import Prelude
class Partial
-head :: forall a. (Partial) => [a] -> a
-head (x:xs) = x
+head :: forall a. (Partial) => Array a -> a
+head [x] = x
instance allowPartials :: Partial
diff --git a/examples/passing/EqOrd.purs b/examples/passing/EqOrd.purs
index c840058..1c03c70 100644
--- a/examples/passing/EqOrd.purs
+++ b/examples/passing/EqOrd.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
data Pair a b = Pair a b
instance ordPair :: (Ord a, Ord b) => Ord (Pair a b) where
@@ -11,4 +13,4 @@ instance eqPair :: (Eq a, Eq b) => Eq (Pair a b) where
(==) (Pair a1 b1) (Pair a2 b2) = a1 == a2 && b1 == b2
(/=) (Pair a1 b1) (Pair a2 b2) = a1 /= a2 || b1 /= b2
-main = Debug.Trace.print $ Pair 1 2 == Pair 1 2
+main = Debug.Trace.print $ Pair 1.0 2.0 == Pair 1.0 2.0
diff --git a/examples/passing/ExtendedInfixOperators.purs b/examples/passing/ExtendedInfixOperators.purs
index b6ab020..5771b8a 100644
--- a/examples/passing/ExtendedInfixOperators.purs
+++ b/examples/passing/ExtendedInfixOperators.purs
@@ -1,20 +1,14 @@
module Main where
-zipWith :: forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
-zipWith _ [] _ = []
-zipWith _ _ [] = []
-zipWith f (x:xs) (y:ys) = f x y : zipWith f xs ys
-
-test1 = [1, 2, 3] `zipWith (+)` [4, 5, 6]
+import Prelude
comparing :: forall a b. (Ord b) => (a -> b) -> a -> a -> Ordering
comparing f = compare `Data.Function.on` f
-sum [] = 0
-sum (x:xs) = x + sum xs
+null [] = true
+null _ = false
-test2 = [1, 2, 3] `comparing sum` [4, 5, 6]
+test = [1.0, 2.0, 3.0] `comparing null` [4.0, 5.0, 6.0]
main = do
- Debug.Trace.print test1
- Debug.Trace.print test2
+ Debug.Trace.print test
diff --git a/examples/passing/ExternData.purs b/examples/passing/ExternData.purs
deleted file mode 100644
index eb256ed..0000000
--- a/examples/passing/ExternData.purs
+++ /dev/null
@@ -1,13 +0,0 @@
-module Main where
-
- foreign import data IO :: * -> *
-
- foreign import bind "function bind() {}" :: forall a b. IO a -> (a -> IO b) -> IO b
-
- foreign import showMessage "function showMessage() {}" :: String -> IO { }
-
- foreign import prompt "function prompt() {}" :: IO String
-
- test _ = prompt `bind` \s -> showMessage s
-
- main = Debug.Trace.trace "Done"
diff --git a/examples/passing/ExternRaw.purs b/examples/passing/ExternRaw.purs
deleted file mode 100644
index 376c5af..0000000
--- a/examples/passing/ExternRaw.purs
+++ /dev/null
@@ -1,26 +0,0 @@
-module Main where
-
-foreign import first
- """
- function first(xs) {
- return xs[0];
- }
- """ :: forall a. [a] -> a
-
-foreign import loop
- """
- function loop() {
- while (true) {}
- }
- """ :: forall a. a
-
-foreign import concat
- """
- function concat(xs) {
- return function(ys) {
- return xs.concat(ys);
- };
- }
- """ :: forall a. [a] -> [a] -> [a]
-
-main = Debug.Trace.trace "Done"
diff --git a/examples/passing/FFI.purs b/examples/passing/FFI.purs
deleted file mode 100644
index f508cb1..0000000
--- a/examples/passing/FFI.purs
+++ /dev/null
@@ -1,13 +0,0 @@
-module Main where
-
-foreign import foo
- """
- function foo(s) {
- return s;
- }
- """ :: String -> String
-
-bar :: String -> String
-bar _ = foo "test"
-
-main = Debug.Trace.trace "Done"
diff --git a/examples/passing/Fib.purs b/examples/passing/Fib.purs
index 40f5cd9..1f27ecd 100644
--- a/examples/passing/Fib.purs
+++ b/examples/passing/Fib.purs
@@ -5,9 +5,9 @@ import Control.Monad.Eff
import Control.Monad.ST
main = runST (do
- n1 <- newSTRef 1
- n2 <- newSTRef 1
- whileE ((>) 1000 <$> readSTRef n1) $ do
+ n1 <- newSTRef 1.0
+ n2 <- newSTRef 1.0
+ whileE ((>) 1000.0 <$> readSTRef n1) $ do
n1' <- readSTRef n1
n2' <- readSTRef n2
writeSTRef n2 $ n1' + n2'
diff --git a/examples/passing/FinalTagless.purs b/examples/passing/FinalTagless.purs
index 1eb53e0..80edd29 100644
--- a/examples/passing/FinalTagless.purs
+++ b/examples/passing/FinalTagless.purs
@@ -17,6 +17,6 @@ instance exprId :: E Id where
runId (Id a) = a
three :: Expr Number
-three = add (num 1) (num 2)
+three = add (num 1.0) (num 2.0)
main = Debug.Trace.print $ runId three
diff --git a/examples/passing/ForeignInstance.purs b/examples/passing/ForeignInstance.purs
deleted file mode 100644
index 1c32105..0000000
--- a/examples/passing/ForeignInstance.purs
+++ /dev/null
@@ -1,20 +0,0 @@
-module Main where
-
-class Foo a where
- foo :: a -> String
-
-foreign import instance fooArray :: (Foo a) => Foo [a]
-
-foreign import instance fooNumber :: Foo Number
-
-foreign import instance fooString :: Foo String
-
-foreign import fooString "var fooString = {};" :: Unit
-foreign import fooNumber "var fooNumber = {};" :: Unit
-foreign import fooArray "var fooArray = {};" :: Unit
-
-test1 _ = foo [1, 2, 3]
-
-test2 _ = foo "Test"
-
-main = Debug.Trace.trace "Done"
diff --git a/examples/passing/FunctionScope.purs b/examples/passing/FunctionScope.purs
index 12941b5..00f7ee2 100644
--- a/examples/passing/FunctionScope.purs
+++ b/examples/passing/FunctionScope.purs
@@ -1,19 +1,13 @@
module Main where
- import Prelude
+import Prelude
+import Assert
- mkValue :: Number -> Number
- mkValue id = id
+mkValue :: Number -> Number
+mkValue id = id
- foreign import error
- """
- function error(msg) {
- throw msg;
- }
- """ :: forall a. String -> a
-
- main = do
- let value = mkValue 1
- if value == 1
- then Debug.Trace.trace "Done"
- else error "Not done"
+main = do
+ let value = mkValue 1.0
+ if value == 1.0
+ then Debug.Trace.trace "Done"
+ else error "Not done"
diff --git a/examples/passing/Functions.purs b/examples/passing/Functions.purs
index 30c1fa8..d2fcad5 100644
--- a/examples/passing/Functions.purs
+++ b/examples/passing/Functions.purs
@@ -1,15 +1,15 @@
module Main where
- import Prelude
+import Prelude
- test1 = \_ -> 0
+test1 = \_ -> 0.0
- test2 = \a b -> a + b + 1
+test2 = \a b -> a + b + 1.0
- test3 = \a -> a
+test3 = \a -> a
- test4 = \(%%) -> 1 %% 2
+test4 = \(%%) -> 1.0 %% 2.0
- test5 = \(+++) (***) -> 1 +++ 2 *** 3
+test5 = \(+++) (***) -> 1.0 +++ 2.0 *** 3.0
- main = Debug.Trace.trace "Done"
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/Functions2.purs b/examples/passing/Functions2.purs
index b046bae..ef2db66 100644
--- a/examples/passing/Functions2.purs
+++ b/examples/passing/Functions2.purs
@@ -1,19 +1,13 @@
module Main where
- import Prelude
+import Prelude
+import Assert
- test :: forall a b. a -> b -> a
- test = \const _ -> const
+test :: forall a b. a -> b -> a
+test = \const _ -> const
- foreign import error
- """
- function error(msg) {
- throw msg;
- }
- """ :: forall a. String -> a
-
- main = do
- let value = test "Done" {}
- if value == "Done"
- then Debug.Trace.trace "Done"
- else error "Not done"
+main = do
+ let value = test "Done" {}
+ if value == "Done"
+ then Debug.Trace.trace "Done"
+ else error "Not done"
diff --git a/examples/passing/Guards.purs b/examples/passing/Guards.purs
index b883a4e..44234f2 100644
--- a/examples/passing/Guards.purs
+++ b/examples/passing/Guards.purs
@@ -1,29 +1,29 @@
module Main where
- import Prelude
+import Prelude
- collatz = \x -> case x of
- y | y % 2 == 0 -> y / 2
- y -> y * 3 + 1
+collatz = \x -> case x of
+ y | y % 2.0 == 0.0 -> y / 2.0
+ y -> y * 3.0 + 1.0
- -- Guards have access to current scope
- collatz2 = \x y -> case x of
- z | y > 0 -> z / 2
- z -> z * 3 + 1
+-- Guards have access to current scope
+collatz2 = \x y -> case x of
+ z | y > 0.0 -> z / 2.0
+ z -> z * 3.0 + 1.0
- min :: forall a. (Ord a) => a -> a -> a
- min n m | n < m = n
- | otherwise = m
+min :: forall a. (Ord a) => a -> a -> a
+min n m | n < m = n
+ | otherwise = m
- max :: forall a. (Ord a) => a -> a -> a
- max n m = case unit of
- _ | m < n -> n
- | otherwise -> m
+max :: forall a. (Ord a) => a -> a -> a
+max n m = case unit of
+ _ | m < n -> n
+ | otherwise -> m
- testIndentation :: Number -> Number -> Number
- testIndentation x y | x > 0
- = x + y
- | otherwise
- = y - x
+testIndentation :: Number -> Number -> Number
+testIndentation x y | x > 0.0
+ = x + y
+ | otherwise
+ = y - x
- main = Debug.Trace.trace $ min "Done" "ZZZZ"
+main = Debug.Trace.trace $ min "Done" "ZZZZ"
diff --git a/examples/passing/HoistError.purs b/examples/passing/HoistError.purs
index 3b371d9..25f123a 100644
--- a/examples/passing/HoistError.purs
+++ b/examples/passing/HoistError.purs
@@ -1,19 +1,12 @@
module Main where
+import Prelude
import Control.Monad.Eff
import Debug.Trace
-
-foreign import f
- """
- function f(x) {
- return function() {
- if (x !== 0) throw new Error('x is not 0');
- };
- }
- """ :: forall e. Number -> Eff e Number
+import Assert
main = do
- let x = 0
- f x
- let x = 1 + 1
+ let x = 0.0
+ assert $ x == 0.0
+ let x = 1.0 + 1.0
trace "Done"
diff --git a/examples/passing/IfThenElseMaybe.purs b/examples/passing/IfThenElseMaybe.purs
index 91da56d..2419dc7 100644
--- a/examples/passing/IfThenElseMaybe.purs
+++ b/examples/passing/IfThenElseMaybe.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
data Maybe a = Nothing | Just a
test1 = if true then Just 10 else Nothing
diff --git a/examples/passing/ImplicitEmptyImport.purs b/examples/passing/ImplicitEmptyImport.purs
index 3f68a77..3a452d6 100644
--- a/examples/passing/ImplicitEmptyImport.purs
+++ b/examples/passing/ImplicitEmptyImport.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
main = do
Debug.Trace.trace "Hello"
Debug.Trace.trace "Goodbye"
diff --git a/examples/passing/ImportHiding.purs b/examples/passing/ImportHiding.purs
index 3167443..093e206 100644
--- a/examples/passing/ImportHiding.purs
+++ b/examples/passing/ImportHiding.purs
@@ -7,7 +7,7 @@ import Prelude hiding (
Unit(..) -- a constructor
)
-show = 1
+show = 1.0
class Show a where
noshow :: a -> a
diff --git a/examples/passing/InferRecFunWithConstrainedArgument.purs b/examples/passing/InferRecFunWithConstrainedArgument.purs
index 8541d79..e96285d 100644
--- a/examples/passing/InferRecFunWithConstrainedArgument.purs
+++ b/examples/passing/InferRecFunWithConstrainedArgument.purs
@@ -2,7 +2,7 @@ module Main where
import Prelude
-test 100 = 100
-test n = test(1 + n)
+test 100.0 = 100.0
+test n = test(1.0 + n)
-main = Debug.Trace.print $ test 0
+main = Debug.Trace.print $ test 0.0
diff --git a/examples/passing/InstanceBeforeClass.purs b/examples/passing/InstanceBeforeClass.purs
index 837df05..2302f50 100644
--- a/examples/passing/InstanceBeforeClass.purs
+++ b/examples/passing/InstanceBeforeClass.purs
@@ -1,7 +1,9 @@
module Main where
+import Prelude
+
instance fooNumber :: Foo Number where
- foo = 0
+ foo = 0.0
class Foo a where
foo :: a
diff --git a/examples/passing/IntAndChar.purs b/examples/passing/IntAndChar.purs
new file mode 100644
index 0000000..68cf54f
--- /dev/null
+++ b/examples/passing/IntAndChar.purs
@@ -0,0 +1,18 @@
+module Main where
+
+import Prelude
+import Control.Monad.Eff
+import Assert
+
+f 1 = 1
+f _ = 0
+
+g 'a' = 'a'
+g _ = 'b'
+
+main = do
+ assert $ f 1 == 1
+ assert $ f 0 == 0
+ assert $ g 'a' == 'a'
+ assert $ g 'b' == 'b'
+ Debug.Trace.trace "Done"
diff --git a/examples/passing/JSReserved.purs b/examples/passing/JSReserved.purs
index a3b717a..0761059 100644
--- a/examples/passing/JSReserved.purs
+++ b/examples/passing/JSReserved.purs
@@ -1,12 +1,12 @@
module Main where
- import Prelude
+import Prelude
- yield = 0
- member = 1
+yield = 0
+member = 1
- public = \return -> return
+public = \return -> return
- this catch = catch
+this catch = catch
- main = Debug.Trace.trace "Done"
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/KindedType.purs b/examples/passing/KindedType.purs
index 9b16208..70c48df 100644
--- a/examples/passing/KindedType.purs
+++ b/examples/passing/KindedType.purs
@@ -1,10 +1,12 @@
module Main where
+import Prelude
+
type Star2Star f = f :: * -> *
type Star t = t :: *
-test1 :: Star2Star [] String
+test1 :: Star2Star Array String
test1 = ["test"]
f :: Star (String -> String)
@@ -14,12 +16,12 @@ test2 = f "test"
data Proxy (f :: * -> *) = Proxy
-test3 :: Proxy []
+test3 :: Proxy Array
test3 = Proxy
type Test (f :: * -> *) = f String
-test4 :: Test []
+test4 :: Test Array
test4 = ["test"]
class Clazz (a :: *) where
diff --git a/examples/passing/Let.purs b/examples/passing/Let.purs
index b839f1b..560c1cb 100644
--- a/examples/passing/Let.purs
+++ b/examples/passing/Let.purs
@@ -6,59 +6,48 @@ import Control.Monad.ST
test1 x = let
y :: Number
- y = x + 1
+ y = x + 1.0
in y
test2 x y =
- let x' = x + 1 in
- let y' = y + 1 in
+ let x' = x + 1.0 in
+ let y' = y + 1.0 in
x' + y'
test3 = let f x y z = x + y + z in
- f 1 2 3
+ f 1.0 2.0 3.0
test4 = let f x [y, z] = x y z in
- f (+) [1, 2]
+ f (+) [1.0, 2.0]
test5 = let
- f x | x > 0 = g (x / 2) + 1
- f x = 0
- g x = f (x - 1) + 1
- in f 10
-
-test6 = runPure (runST (do
- r <- newSTRef 0
- (let
- go [] = readSTRef r
- go (n : ns) = do
- modifySTRef r ((+) n)
- go ns
- in go [1, 2, 3, 4, 5])
- ))
+ f x | x > 0.0 = g (x / 2.0) + 1.0
+ f x = 0.0
+ g x = f (x - 1.0) + 1.0
+ in f 10.0
test7 = let
f :: forall a. a -> a
f x = x
- in if f true then f 1 else f 2
+ in if f true then f 1.0 else f 2.0
test8 :: Number -> Number
test8 x = let
go y | (x - 0.1 < y * y) && (y * y < x + 0.1) = y
- go y = go $ (y + x / y) / 2
+ go y = go $ (y + x / y) / 2.0
in go x
test10 _ =
let
- f x = g x * 3
- g x = f x / 2
- in f 10
+ f x = g x * 3.0
+ g x = f x / 2.0
+ in f 10.0
main = do
- Debug.Trace.print (test1 1)
- Debug.Trace.print (test2 1 2)
+ Debug.Trace.print (test1 1.0)
+ Debug.Trace.print (test2 1.0 2.0)
Debug.Trace.print test3
Debug.Trace.print test4
Debug.Trace.print test5
- Debug.Trace.print test6
Debug.Trace.print test7
- Debug.Trace.print (test8 100)
+ Debug.Trace.print (test8 100.0)
diff --git a/examples/passing/Let2.purs b/examples/passing/Let2.purs
new file mode 100644
index 0000000..ad112f9
--- /dev/null
+++ b/examples/passing/Let2.purs
@@ -0,0 +1,17 @@
+module Main where
+
+import Prelude
+
+test =
+ let f :: Number -> Boolean
+ f 0.0 = false
+ f n = g (n - 1.0)
+
+ g :: Number -> Boolean
+ g 0.0 = true
+ g n = f (n - 1.0)
+
+ x = f 1.0
+ in not x
+
+main = Debug.Trace.print test
diff --git a/examples/passing/LetInInstance.purs b/examples/passing/LetInInstance.purs
index 40790a9..b72f255 100644
--- a/examples/passing/LetInInstance.purs
+++ b/examples/passing/LetInInstance.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
class Foo a where
foo :: a -> String
diff --git a/examples/passing/LiberalTypeSynonyms.purs b/examples/passing/LiberalTypeSynonyms.purs
index 75242a5..defe959 100644
--- a/examples/passing/LiberalTypeSynonyms.purs
+++ b/examples/passing/LiberalTypeSynonyms.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
type Reader = (->) String
foo :: Reader String
diff --git a/examples/passing/Match.purs b/examples/passing/Match.purs
index 9c446cb..4f6b08e 100644
--- a/examples/passing/Match.purs
+++ b/examples/passing/Match.purs
@@ -1,7 +1,9 @@
module Main where
- data Foo a = Foo
+import Prelude
- foo = \f -> case f of Foo -> "foo"
+data Foo a = Foo
- main = Debug.Trace.trace "Done"
+foo = \f -> case f of Foo -> "foo"
+
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/ModuleExport.purs b/examples/passing/ModuleExport.purs
new file mode 100644
index 0000000..df54e20
--- /dev/null
+++ b/examples/passing/ModuleExport.purs
@@ -0,0 +1,9 @@
+module A (module Prelude) where
+ import Prelude
+
+module Main where
+ import Debug.Trace
+ import A
+
+ main = do
+ print (show 1.0)
diff --git a/examples/passing/ModuleExportDupes.purs b/examples/passing/ModuleExportDupes.purs
new file mode 100644
index 0000000..82d5347
--- /dev/null
+++ b/examples/passing/ModuleExportDupes.purs
@@ -0,0 +1,19 @@
+module A (module Prelude) where
+ import Prelude
+
+module B (module Prelude) where
+ import Prelude
+
+module C (module Prelude, module A) where
+ import Prelude
+ import A
+
+module Main where
+ import Debug.Trace
+ import A
+ import B
+ import C
+ import Prelude
+
+ main = do
+ print (show 1.0)
diff --git a/examples/passing/ModuleExportExcluded.purs b/examples/passing/ModuleExportExcluded.purs
new file mode 100644
index 0000000..18ef141
--- /dev/null
+++ b/examples/passing/ModuleExportExcluded.purs
@@ -0,0 +1,14 @@
+module A (module Prelude, foo) where
+ import Prelude
+
+ foo :: Number -> Number
+ foo _ = 0.0
+
+module Main where
+ import Debug.Trace
+ import A (foo)
+
+ otherwise = false
+
+ main = do
+ print "1.0"
diff --git a/examples/passing/ModuleExportHiding.purs b/examples/passing/ModuleExportHiding.purs
new file mode 100644
index 0000000..4cea222
--- /dev/null
+++ b/examples/passing/ModuleExportHiding.purs
@@ -0,0 +1,11 @@
+module A (module Prelude) where
+ import Prelude
+
+module Main where
+ import Debug.Trace
+ import A hiding (module Prelude)
+
+ otherwise = false
+
+ main = do
+ print "1.0"
diff --git a/examples/passing/ModuleExportQualified.purs b/examples/passing/ModuleExportQualified.purs
new file mode 100644
index 0000000..7a84aec
--- /dev/null
+++ b/examples/passing/ModuleExportQualified.purs
@@ -0,0 +1,9 @@
+module A (module Prelude) where
+ import Prelude
+
+module Main where
+ import Debug.Trace
+ import qualified A as B
+
+ main = do
+ print (B.show 1.0)
diff --git a/examples/passing/ModuleExportSelf.purs b/examples/passing/ModuleExportSelf.purs
new file mode 100644
index 0000000..42399a0
--- /dev/null
+++ b/examples/passing/ModuleExportSelf.purs
@@ -0,0 +1,14 @@
+module A (module A, module Prelude) where
+ import Prelude
+
+ type Foo = Boolean
+
+module Main where
+ import Debug.Trace
+ import A
+
+ bar :: Foo
+ bar = true
+
+ main = do
+ print (show bar)
diff --git a/examples/passing/Monad.purs b/examples/passing/Monad.purs
index dcff2ed..731d7bb 100644
--- a/examples/passing/Monad.purs
+++ b/examples/passing/Monad.purs
@@ -1,32 +1,32 @@
module Main where
- import Prelude ()
+import Prelude ()
- type Monad m = { return :: forall a. a -> m a
- , bind :: forall a b. m a -> (a -> m b) -> m b }
+type Monad m = { return :: forall a. a -> m a
+ , bind :: forall a b. m a -> (a -> m b) -> m b }
- data Id a = Id a
+data Id a = Id a
- id :: Monad Id
- id = { return : Id
- , bind : \ma f -> case ma of Id a -> f a }
+id :: Monad Id
+id = { return : Id
+ , bind : \ma f -> case ma of Id a -> f a }
- data Maybe a = Nothing | Just a
+data Maybe a = Nothing | Just a
- maybe :: Monad Maybe
- maybe = { return : Just
- , bind : \ma f -> case ma of
- Nothing -> Nothing
- Just a -> f a
- }
+maybe :: Monad Maybe
+maybe = { return : Just
+ , bind : \ma f -> case ma of
+ Nothing -> Nothing
+ Just a -> f a
+ }
- test :: forall m. Monad m -> m Number
- test = \m -> m.bind (m.return 1) (\n1 ->
- m.bind (m.return "Test") (\n2 ->
- m.return n1))
+test :: forall m. Monad m -> m Number
+test = \m -> m.bind (m.return 1.0) (\n1 ->
+ m.bind (m.return "Test") (\n2 ->
+ m.return n1))
- test1 = test id
+test1 = test id
- test2 = test maybe
+test2 = test maybe
- main = Debug.Trace.trace "Done"
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/MonadState.purs b/examples/passing/MonadState.purs
index a604c33..4218c88 100644
--- a/examples/passing/MonadState.purs
+++ b/examples/passing/MonadState.purs
@@ -22,7 +22,7 @@ instance applicativeState :: Applicative (State s) where
pure a = State $ \s -> Tuple s a
instance bindState :: Bind (State s) where
- (>>=) f g = State $ \s -> case runState s f of
+ bind f g = State $ \s -> case runState s f of
Tuple s1 a -> runState s1 (g a)
instance monadState :: Monad (State s)
diff --git a/examples/passing/MultiArgFunctions.purs b/examples/passing/MultiArgFunctions.purs
index 7e37721..a15a363 100644
--- a/examples/passing/MultiArgFunctions.purs
+++ b/examples/passing/MultiArgFunctions.purs
@@ -1,5 +1,6 @@
module Main where
+import Prelude
import Data.Function
import Control.Monad.Eff
import Debug.Trace
@@ -7,20 +8,20 @@ import Debug.Trace
f = mkFn2 $ \a b -> runFn2 g a b + runFn2 g b a
g = mkFn2 $ \a b -> case {} of
- _ | a <= 0 || b <= 0 -> b
- _ -> runFn2 f (a - 1) (b - 1)
+ _ | a <= 0.0 || b <= 0.0 -> b
+ _ -> runFn2 f (a - 0.0) (b - 0.0)
main = do
- runFn0 (mkFn0 $ \_ -> trace $ show 0)
- runFn1 (mkFn1 $ \a -> trace $ show a) 1
- runFn2 (mkFn2 $ \a b -> trace $ show [a, b]) 1 2
- runFn3 (mkFn3 $ \a b c -> trace $ show [a, b, c]) 1 2 3
- runFn4 (mkFn4 $ \a b c d -> trace $ show [a, b, c, d]) 1 2 3 4
- runFn5 (mkFn5 $ \a b c d e -> trace $ show [a, b, c, d, e]) 1 2 3 4 5
- runFn6 (mkFn6 $ \a b c d e f -> trace $ show [a, b, c, d, e, f]) 1 2 3 4 5 6
- 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
- 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
- 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
- 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
- print $ runFn2 g 15 12
+ runFn0 (mkFn0 $ \_ -> trace $ show 0.0)
+ runFn1 (mkFn1 $ \a -> trace $ show a) 0.0
+ runFn2 (mkFn2 $ \a b -> trace $ show [a, b]) 0.0 0.0
+ runFn3 (mkFn3 $ \a b c -> trace $ show [a, b, c]) 0.0 0.0 0.0
+ runFn4 (mkFn4 $ \a b c d -> trace $ show [a, b, c, d]) 0.0 0.0 0.0 0.0
+ runFn5 (mkFn5 $ \a b c d e -> trace $ show [a, b, c, d, e]) 0.0 0.0 0.0 0.0 0.0
+ runFn6 (mkFn6 $ \a b c d e f -> trace $ show [a, b, c, d, e, f]) 0.0 0.0 0.0 0.0 0.0 0.0
+ runFn7 (mkFn7 $ \a b c d e f g -> trace $ show [a, b, c, d, e, f, g]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0
+ runFn8 (mkFn8 $ \a b c d e f g h -> trace $ 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
+ runFn9 (mkFn9 $ \a b c d e f g h i -> trace $ 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
+ runFn10 (mkFn10 $ \a b c d e f g h i j-> trace $ 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
+ print $ runFn2 g 0.0 0.0
trace "Done!"
diff --git a/examples/passing/MultipleConstructorArgs.purs b/examples/passing/MultipleConstructorArgs.purs
deleted file mode 100644
index b5b8b17..0000000
--- a/examples/passing/MultipleConstructorArgs.purs
+++ /dev/null
@@ -1,21 +0,0 @@
-module Main where
-
-import Prelude
-import Control.Monad.Eff
-
-data P a b = P a b
-
-runP :: forall a b r. (a -> b -> r) -> P a b -> r
-runP f (P a b) = f a b
-
-idP = runP P
-
-testCase = \p -> case p of
- P (x:xs) (y:ys) -> x + y
- P _ _ -> 0
-
-test1 = testCase (P [1, 2, 3] [4, 5, 6])
-
-main = do
- Debug.Trace.trace (runP (\s n -> s ++ show n) (P "Test" 1))
- Debug.Trace.print test1
diff --git a/examples/passing/MutRec.purs b/examples/passing/MutRec.purs
index c3e48bd..bdf1797 100644
--- a/examples/passing/MutRec.purs
+++ b/examples/passing/MutRec.purs
@@ -1,19 +1,19 @@
module Main where
- import Prelude
+import Prelude
- f 0 = 0
- f x = g x + 1
+f 0.0 = 0.0
+f x = g x + 0.0
- g x = f (x / 2)
+g x = f (x / 0.0)
- data Even = Zero | Even Odd
+data Even = Zero | Even Odd
- data Odd = Odd Even
+data Odd = Odd Even
- evenToNumber Zero = 0
- evenToNumber (Even n) = oddToNumber n + 1
+evenToNumber Zero = 0.0
+evenToNumber (Even n) = oddToNumber n + 0.0
- oddToNumber (Odd n) = evenToNumber n + 1
+oddToNumber (Odd n) = evenToNumber n + 0.0
- main = Debug.Trace.trace "Done"
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/MutRec2.purs b/examples/passing/MutRec2.purs
index 89b90d0..8a98638 100644
--- a/examples/passing/MutRec2.purs
+++ b/examples/passing/MutRec2.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
data A = A B
data B = B A
diff --git a/examples/passing/MutRec3.purs b/examples/passing/MutRec3.purs
index 9500826..1150f4f 100644
--- a/examples/passing/MutRec3.purs
+++ b/examples/passing/MutRec3.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
data A = A B
data B = B A
diff --git a/examples/passing/NamedPatterns.purs b/examples/passing/NamedPatterns.purs
index 6755b40..28dc1c2 100644
--- a/examples/passing/NamedPatterns.purs
+++ b/examples/passing/NamedPatterns.purs
@@ -1,7 +1,9 @@
module Main where
- foo = \x -> case x of
- y@{ foo = "Foo" } -> y
- y -> y
+import Prelude
- main = Debug.Trace.trace "Done"
+foo = \x -> case x of
+ y@{ foo = "Foo" } -> y
+ y -> y
+
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/NegativeBinder.purs b/examples/passing/NegativeBinder.purs
index d5dfe1b..3433f5d 100644
--- a/examples/passing/NegativeBinder.purs
+++ b/examples/passing/NegativeBinder.purs
@@ -1,7 +1,9 @@
module Main where
+import Prelude
+
test :: Number -> Boolean
-test -1 = false
+test -1.0 = false
test _ = true
main = Debug.Trace.trace "Done"
diff --git a/examples/passing/Nested.purs b/examples/passing/Nested.purs
index 0c9244c..5ac3ffc 100644
--- a/examples/passing/Nested.purs
+++ b/examples/passing/Nested.purs
@@ -1,7 +1,9 @@
module Main where
- data Extend r a = Extend { prev :: r a, next :: a }
+import Prelude
- data Matrix r a = Square (r (r a)) | Bigger (Matrix (Extend r) a)
+data Extend r a = Extend { prev :: r a, next :: a }
- main = Debug.Trace.trace "Done"
+data Matrix r a = Square (r (r a)) | Bigger (Matrix (Extend r) a)
+
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/NestedTypeSynonyms.purs b/examples/passing/NestedTypeSynonyms.purs
index 415b2b2..9f9f2d5 100644
--- a/examples/passing/NestedTypeSynonyms.purs
+++ b/examples/passing/NestedTypeSynonyms.purs
@@ -1,11 +1,11 @@
module Main where
- import Prelude
+import Prelude
- type X = String
- type Y = X -> X
+type X = String
+type Y = X -> X
- fn :: Y
- fn a = a
+fn :: Y
+fn a = a
- main = Debug.Trace.print (fn "Done")
+main = Debug.Trace.print (fn "Done")
diff --git a/examples/passing/NestedWhere.purs b/examples/passing/NestedWhere.purs
index e50b5f0..85e3901 100644
--- a/examples/passing/NestedWhere.purs
+++ b/examples/passing/NestedWhere.purs
@@ -1,10 +1,12 @@
module Main where
+import Prelude
+
f x = g x
where
g x = go x
where
- go x = go1 (x - 1)
+ go x = go1 (x - 1.0)
go1 x = go x
main = Debug.Trace.trace "Done"
diff --git a/examples/passing/Newtype.purs b/examples/passing/Newtype.purs
index 2ec371d..e6e310d 100644
--- a/examples/passing/Newtype.purs
+++ b/examples/passing/Newtype.purs
@@ -1,5 +1,6 @@
module Main where
+import Prelude
import Control.Monad.Eff
import Debug.Trace
@@ -17,6 +18,6 @@ apply f x = f x
main = do
print $ Thing "hello"
- print $ Box 42
- print $ apply Box 9000
+ print $ Box 42.0
+ print $ apply Box 9000.0
trace "Done"
diff --git a/examples/passing/NewtypeEff.purs b/examples/passing/NewtypeEff.purs
index 3d520b8..8054d43 100644
--- a/examples/passing/NewtypeEff.purs
+++ b/examples/passing/NewtypeEff.purs
@@ -1,5 +1,6 @@
module Main where
+import Prelude
import Debug.Trace
import Control.Monad.Eff
@@ -18,7 +19,7 @@ instance applicativeT :: Applicative T where
pure t = T (pure t)
instance bindT :: Bind T where
- (>>=) (T t) f = T (t >>= \x -> runT (f x))
+ bind (T t) f = T (t >>= \x -> runT (f x))
instance monadT :: Monad T
diff --git a/examples/passing/NewtypeWithRecordUpdate.purs b/examples/passing/NewtypeWithRecordUpdate.purs
index 5d92b45..4fd81cc 100644
--- a/examples/passing/NewtypeWithRecordUpdate.purs
+++ b/examples/passing/NewtypeWithRecordUpdate.purs
@@ -1,15 +1,16 @@
--- https://github.com/purescript/purescript/issues/812
+-- https://github.com/purescript/purescript/issues/812.0
module Main where
+import Prelude
import Debug.Trace
newtype NewType a = NewType (Object a)
rec1 :: Object (a :: Number, b :: Number, c:: Number)
-rec1 = { a: 0, b: 0, c: 0 }
+rec1 = { a: 0.0, b: 0.0, c: 0.0 }
rec2 :: NewType (a :: Number, b :: Number, c :: Number)
-rec2 = NewType (rec1 { a = 1 })
+rec2 = NewType (rec1 { a = 1.0 })
main = trace "Done"
diff --git a/examples/passing/ObjectGetter.purs b/examples/passing/ObjectGetter.purs
index b786ae0..5224d79 100644
--- a/examples/passing/ObjectGetter.purs
+++ b/examples/passing/ObjectGetter.purs
@@ -1,8 +1,10 @@
module Main where
+import Prelude
+
getX = _.x
-point = { x: 1, y: 0 }
+point = { x: 1.0, y: 0.0 }
main = do
Debug.Trace.print $ getX point
diff --git a/examples/passing/ObjectSynonym.purs b/examples/passing/ObjectSynonym.purs
index 8941b87..f9b60a6 100644
--- a/examples/passing/ObjectSynonym.purs
+++ b/examples/passing/ObjectSynonym.purs
@@ -1,9 +1,11 @@
module Main where
+import Prelude
+
type Inner = Number
inner :: Inner
-inner = 0
+inner = 0.0
type Outer = { inner :: Inner }
diff --git a/examples/passing/ObjectUpdate.purs b/examples/passing/ObjectUpdate.purs
index 6cd2a85..98fc71e 100644
--- a/examples/passing/ObjectUpdate.purs
+++ b/examples/passing/ObjectUpdate.purs
@@ -1,18 +1,20 @@
module Main where
- update1 = \o -> o { foo = "Foo" }
+import Prelude
- update2 :: forall r. { foo :: String | r } -> { foo :: String | r }
- update2 = \o -> o { foo = "Foo" }
+update1 = \o -> o { foo = "Foo" }
- replace = \o -> case o of
- { foo = "Foo" } -> o { foo = "Bar" }
- { foo = "Bar" } -> o { bar = "Baz" }
- o -> o
+update2 :: forall r. { foo :: String | r } -> { foo :: String | r }
+update2 = \o -> o { foo = "Foo" }
- polyUpdate :: forall a r. { foo :: a | r } -> { foo :: String | r }
- polyUpdate = \o -> o { foo = "Foo" }
+replace = \o -> case o of
+ { foo = "Foo" } -> o { foo = "Bar" }
+ { foo = "Bar" } -> o { bar = "Baz" }
+ o -> o
- inferPolyUpdate = \o -> o { foo = "Foo" }
+polyUpdate :: forall a r. { foo :: a | r } -> { foo :: String | r }
+polyUpdate = \o -> o { foo = "Foo" }
- main = Debug.Trace.trace ((update1 {foo: ""}).foo)
+inferPolyUpdate = \o -> o { foo = "Foo" }
+
+main = Debug.Trace.trace ((update1 {foo: ""}).foo)
diff --git a/examples/passing/ObjectUpdate2.purs b/examples/passing/ObjectUpdate2.purs
index cc19b95..610f4a5 100644
--- a/examples/passing/ObjectUpdate2.purs
+++ b/examples/passing/ObjectUpdate2.purs
@@ -1,8 +1,11 @@
module Main where
+import Prelude
+
type X r = { | r }
-foreign import x "var x = {};" :: forall r. X r
+x :: X (baz :: String)
+x = { baz: "baz" }
blah :: forall r. X r -> X r
blah x = x
diff --git a/examples/passing/ObjectUpdater.purs b/examples/passing/ObjectUpdater.purs
index 23f48b4..929416c 100644
--- a/examples/passing/ObjectUpdater.purs
+++ b/examples/passing/ObjectUpdater.purs
@@ -1,20 +1,9 @@
module Main where
+import Prelude
import Control.Monad.Eff
import Debug.Trace
-
-foreign import eqeqeq
- """
- function eqeqeq(x) {
- return function (y) {
- if (x == y) return x;
- throw new Error("Unexpected result: " + x + " /== " + y);
- };
- };
- """ :: forall a. a -> a -> a
-
-(===) = eqeqeq
-infixl 4 ===
+import Assert
getValue :: forall e. Eff (| e) Boolean
getValue = return true
@@ -22,14 +11,14 @@ getValue = return true
main = do
let record = { value: false }
record' <- record { value = _ } <$> getValue
- print $ record'.value === true
+ assert $ record'.value == true
- let point = { x: 1, y: 1 }
- x = 10
- point' = (point { x = _, y = x }) 100
+ let point = { x: 1.0, y: 1.0 }
+ x = 10.0
+ point' = (point { x = _, y = x }) 100.0
- print $ point'.x === 100
- print $ point'.y === 10
+ assert $ point'.x == 100.0
+ assert $ point'.y == 10.0
- let record2 = (_ { x = _ }) { x: 0 } 10
- print $ record2.x === 10
+ let record2 = (_ { x = _ }) { x: 0.0 } 10.0
+ assert $ record2.x == 10.0
diff --git a/examples/passing/ObjectWildcards.purs b/examples/passing/ObjectWildcards.purs
index 0bf221a..eea7236 100644
--- a/examples/passing/ObjectWildcards.purs
+++ b/examples/passing/ObjectWildcards.purs
@@ -1,31 +1,20 @@
module Main where
+import Prelude
import Control.Monad.Eff
import Debug.Trace
+import Assert
mkRecord = { foo: _, bar: _, baz: "baz" }
getValue :: forall e. Eff (| e) Boolean
getValue = return true
-foreign import eqeqeq
- """
- function eqeqeq(x) {
- return function (y) {
- if (x == y) return x;
- throw new Error("Unexpected result: " + x + " /== " + y);
- };
- };
- """ :: forall a. a -> a -> a
-
-(===) = eqeqeq
-infixl 4 ===
-
main = do
obj <- { value: _ } <$> getValue
print obj.value
- let x = 1
- point <- { x: _, y: x } <$> return 2
- print $ point.x === 2
- print $ point.y === 1
- trace (mkRecord 1 "Done!").bar
+ let x = 1.0
+ point <- { x: _, y: x } <$> return 2.0
+ assert $ point.x == 2.0
+ assert $ point.y == 1.0
+ trace (mkRecord 1.0 "Done!").bar
diff --git a/examples/passing/Objects.purs b/examples/passing/Objects.purs
index 8e76f4c..3227c07 100644
--- a/examples/passing/Objects.purs
+++ b/examples/passing/Objects.purs
@@ -1,35 +1,35 @@
module Main where
- import Prelude
+import Prelude
- test = \x -> x.foo + x.bar + 1
+test = \x -> x.foo + x.bar + 1.0
- append = \o -> { foo: o.foo, bar: 1 }
+append = \o -> { foo: o.foo, bar: 1.0 }
- apTest = append({foo : "Foo", baz: "Baz"})
+apTest = append({foo : "Foo", baz: "Baz"})
- f = (\a -> a.b.c) { b: { c: 1, d: "Hello" }, e: "World" }
+f = (\a -> a.b.c) { b: { c: 1.0, d: "Hello" }, e: "World" }
- g = (\a -> a.f { x: 1, y: "y" }) { f: \o -> o.x + 1 }
+g = (\a -> a.f { x: 1.0, y: "y" }) { f: \o -> o.x + 1.0 }
- typed :: { foo :: Number }
- typed = { foo: 0 }
+typed :: { foo :: Number }
+typed = { foo: 0.0 }
- test2 = \x -> x."!@#"
+test2 = \x -> x."!@#"
- test3 = typed."foo"
+test3 = typed."foo"
- test4 = test2 weirdObj
- where
- weirdObj :: { "!@#" :: Number }
- weirdObj = { "!@#": 1 }
+test4 = test2 weirdObj
+ where
+ weirdObj :: { "!@#" :: Number }
+ weirdObj = { "!@#": 1.0 }
- test5 = case { "***": 1 } of
- { "***" = n } -> n
+test5 = case { "***": 1.0 } of
+ { "***" = n } -> n
- test6 = case { "***": 1 } of
- { "***": n } -> n
+test6 = case { "***": 1.0 } of
+ { "***": n } -> n
- test7 {a: snoog , b : blah } = blah
+test7 {a: snoog , b : blah } = blah
- main = Debug.Trace.trace "Done"
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/OneConstructor.purs b/examples/passing/OneConstructor.purs
index e46cf6a..bbbcef5 100644
--- a/examples/passing/OneConstructor.purs
+++ b/examples/passing/OneConstructor.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
data One a = One a
one' (One a) = a
diff --git a/examples/passing/OperatorAssociativity.purs b/examples/passing/OperatorAssociativity.purs
index 9ee7a5d..b73de61 100644
--- a/examples/passing/OperatorAssociativity.purs
+++ b/examples/passing/OperatorAssociativity.purs
@@ -1,58 +1,25 @@
module Main where
+import Prelude
import Control.Monad.Eff
import Debug.Trace
-
-foreign import data Assert :: !
-
-foreign import assert
- """
- function assert(x) {
- return function(desc) {
- return function() {
- if (!x) throw new Error('assertion (' + desc + ') failed');
- return {};
- };
- };
- }
- """ :: forall e. Boolean -> String -> Eff (assert :: Assert | e) Unit
+import Assert
bug :: Number -> Number -> Number
-bug a b = 0 - (a - b)
-
-foreign import explode
- """
- function explode() {
- throw new Error('Assertion failed!');
- }
- """ :: forall eff a. Eff eff a
+bug a b = 0.0 - (a - b)
main = do
- assert (bug 0 2 == 2) "bug 0 2 == 2"
- assert (0 - (0 - 2) == 2) "0 - (0 - 2) == 2"
- assert (0 - (0 + 2) == -2) "0 - (0 + 2) == -2"
-
- assert (6 / (3 * 2) == 1) "6 / (3 * 2) == 1"
- assert ((6 / 3) * 2 == 4) "(6 / 3) * 2 == 4"
-
- assert (6 % (2 * 2) == 2) "6 % (2 * 2) == 2"
- assert ((6 % 2) * 2 == 0) "(6 % 2) * 2 == 0"
-
- assert (4 % (9 / 3) == 1) "4 % (9 / 3) == 1"
- assert ((4 % 9) / 2 == 2) "(4 % 9) / 2 == 2"
-
- assert (not (1 < 0) == true) "not (1 < 0) == true"
- assert (not (complement (1 + 10) == 8) == true) "not (complement (1 + 10) == 8) == true"
- assert (not ((negate 1) < 0) == false) "not ((negate 1) < 0) == false"
-
- assert (negate (1 + 10) == -11) "negate (1 + 10) == -11"
-
- assert (2 * 3 / 4 == 1.5) "2 * 3 / 4 == 1.5"
- assert (1 * 2 * 3 * 4 * 5 / 6 == 20) "1 * 2 * 3 * 4 * 5 / 6 == 20"
- assert (complement (2 / 3 * 4) == -3) "complement (2 / 3 * 4) == -3"
-
- assert (1 + 10 - 5 == 6) "1 + 10 - 5 == 6"
- assert (1 + 10 * 5 == 51) "1 + 10 * 5 == 51"
- assert (10 * 5 - 1 == 49) "10 * 5 - 1 == 49"
-
- trace "Success!"
+ assert (bug 0.0 2.0 == 2.0)
+ assert (0.0 - (0.0 - 2.0) == 2.0)
+ assert (0.0 - (0.0 + 2.0) == -2.0)
+ assert (6.0 / (3.0 * 2.0) == 1.0)
+ assert ((6.0 / 3.0) * 2.0 == 4.0)
+ assert (not (1.0 < 0.0) == true)
+ assert (not ((negate 1.0) < 0.0) == false)
+ assert (negate (1.0 + 10.0) == -11.0)
+ assert (2.0 * 3.0 / 4.0 == 1.5)
+ assert (1.0 * 2.0 * 3.0 * 4.0 * 5.0 / 6.0 == 20.0)
+ assert (1.0 + 10.0 - 5.0 == 6.0)
+ assert (1.0 + 10.0 * 5.0 == 51.0)
+ assert (10.0 * 5.0 - 1.0 == 49.0)
+ trace "Success!"
diff --git a/examples/passing/OperatorInlining.purs b/examples/passing/OperatorInlining.purs
new file mode 100644
index 0000000..83cb24c
--- /dev/null
+++ b/examples/passing/OperatorInlining.purs
@@ -0,0 +1,47 @@
+module Main where
+
+import Prelude
+import Debug.Trace
+
+main = do
+
+ -- semiringNumber
+ print (1.0 + 2.0)
+ print (1.0 * 2.0)
+
+ -- ringNumber
+ print (1.0 - 2.0)
+ print (negate 1.0)
+
+ -- moduleSemiringNumber
+ print (1.0 / 2.0)
+
+ -- ordNumber
+ print (1.0 > 2.0)
+ print (1.0 < 2.0)
+ print (1.0 <= 2.0)
+ print (1.0 >= 2.0)
+ print (1.0 == 2.0)
+
+ -- eqNumber
+ print (1.0 == 2.0)
+ print (1.0 /= 2.0)
+
+ -- eqString
+ print ("foo" == "bar")
+ print ("foo" /= "bar")
+
+ -- eqBoolean
+ print (true == false)
+ print (true /= false)
+
+ -- semigroupString
+ print ("foo" ++ "bar")
+ print ("foo" <> "bar")
+
+ -- latticeBoolean
+ print (top && true)
+ print (bottom || false)
+
+ -- complementedLatticeBoolean
+ print (not true)
diff --git a/examples/passing/OperatorSections.purs b/examples/passing/OperatorSections.purs
index 16a8f9b..1b51c0e 100644
--- a/examples/passing/OperatorSections.purs
+++ b/examples/passing/OperatorSections.purs
@@ -1,21 +1,11 @@
module Main where
-foreign import eqeqeq
- """
- function eqeqeq(x) {
- return function (y) {
- if (x == y) return x;
- throw new Error("Unexpected result: " + x + " /== " + y);
- };
- };
- """ :: forall a. a -> a -> a
-
-(===) = eqeqeq
-infixl 4 ===
+import Prelude
+import Assert
main = do
- Debug.Trace.print $ (/ 2) 4 === 2
- Debug.Trace.print $ (2 /) 4 === 0.5
- Debug.Trace.print $ (`const` 1) 2 === 2
- Debug.Trace.print $ (1 `const`) 2 === 1
+ assert $ (/ 2.0) 4.0 == 2.0
+ assert $ (2.0 /) 4.0 == 0.5
+ assert $ (`const` 1.0) 2.0 == 2.0
+ assert $ (1.0 `const`) 2.0 == 1.0
Debug.Trace.trace "Done!"
diff --git a/examples/passing/Operators.purs b/examples/passing/Operators.purs
index d38f7ed..b8b519f 100644
--- a/examples/passing/Operators.purs
+++ b/examples/passing/Operators.purs
@@ -1,102 +1,99 @@
module Main where
- import Control.Monad.Eff
- import Debug.Trace
+import Prelude
+import Control.Monad.Eff
+import Debug.Trace
- (?!) :: forall a. a -> a -> a
- (?!) x _ = x
+(?!) :: forall a. a -> a -> a
+(?!) x _ = x
- bar :: String -> String -> String
- bar = \s1 s2 -> s1 ++ s2
+bar :: String -> String -> String
+bar = \s1 s2 -> s1 ++ s2
- test1 :: forall n. (Num n) => n -> n -> (n -> n -> n) -> n
- test1 x y z = x * y + z x y
+test1 :: forall n. (Num n) => n -> n -> (n -> n -> n) -> n
+test1 x y z = x * y + z x y
- test2 = (\x -> x.foo false) { foo : \_ -> 1 }
+test2 = (\x -> x.foo false) { foo : \_ -> 1.0 }
- test3 = (\x y -> x)(1 + 2 * (1 + 2)) (true && (false || false))
+test3 = (\x y -> x)(1.0 + 2.0 * (1.0 + 2.0)) (true && (false || false))
- k = \x -> \y -> x
+k = \x -> \y -> x
- test4 = 1 `k` 2
+test4 = 1 `k` 2
- infixl 5 %%
+infixl 5 %%
- (%%) :: Number -> Number -> Number
- (%%) x y = x * y + y
+(%%) :: Number -> Number -> Number
+(%%) x y = x * y + y
- test5 = 1 %% 2 %% 3
+test5 = 1.0 %% 2.0 %% 3.0
- test6 = ((\x -> x) `k` 2) 3
+test6 = ((\x -> x) `k` 2.0) 3.0
- (<+>) :: String -> String -> String
- (<+>) = \s1 s2 -> s1 ++ s2
+(<+>) :: String -> String -> String
+(<+>) = \s1 s2 -> s1 ++ s2
- test7 = "Hello" <+> "World!"
+test7 = "Hello" <+> "World!"
- (@@) :: forall a b. (a -> b) -> a -> b
- (@@) = \f x -> f x
+(@@) :: forall a b. (a -> b) -> a -> b
+(@@) = \f x -> f x
- foo :: String -> String
- foo = \s -> s
+foo :: String -> String
+foo = \s -> s
- test8 = foo @@ "Hello World"
+test8 = foo @@ "Hello World"
- test9 = Main.foo @@ "Hello World"
+test9 = Main.foo @@ "Hello World"
- test10 = "Hello" `Main.bar` "World"
+test10 = "Hello" `Main.bar` "World"
- (...) :: forall a. [a] -> [a] -> [a]
- (...) = \as -> \bs -> as
+(...) :: forall a. Array a -> Array a -> Array a
+(...) = \as -> \bs -> as
- test11 = [1, 2, 3] ... [4, 5, 6]
+test11 = [1.0, 2.0, 0.0] ... [4.0, 5.0, 6.0]
- test12 (<%>) a b = a <%> b
+test12 (<%>) a b = a <%> b
- test13 = \(<%>) a b -> a <%> b
+test13 = \(<%>) a b -> a <%> b
- test14 :: Number -> Number -> Boolean
- test14 a b = a < b
+test14 :: Number -> Number -> Boolean
+test14 a b = a < b
- test15 :: Number -> Number -> Boolean
- test15 a b = const false $ a `test14` b
+test15 :: Number -> Number -> Boolean
+test15 a b = const false $ a `test14` b
- test16 :: Number -> Number -> Number
- test16 x y = x .|. y .&. y
+test17 :: Number
+test17 = negate (-1.0)
- test17 :: Number
- test17 = negate (-1)
+test18 :: Number
+test18 = negate $ negate 1.0
- test18 :: Number
- test18 = negate $ negate 1
+test19 :: Number
+test19 = negate $ negate (-1.0)
- test19 :: Number
- test19 = negate $ negate (-1)
+test20 :: Number
+test20 = 1.0 @ 2.0
+ where
+ (@) x y = x + y * y
- test20 :: Number
- test20 = 1 @ 2
- where
- (@) x y = x + y * y
-
- main = do
- let t1 = test1 1 2 (\x y -> x + y)
- let t2 = test2
- let t3 = test3
- let t4 = test4
- let t5 = test5
- let t6 = test6
- let t7 = test7
- let t8 = test8
- let t9 = test9
- let t10 = test10
- let t11 = test11
- let t12 = test12 k 1 2
- let t13 = test13 k 1 2
- let t14 = test14 1 2
- let t15 = test15 1 2
- let t16 = test16 1 2
- let t17 = test17
- let t18 = test18
- let t19 = test19
- let t20 = test20
- trace "Done"
+main = do
+ let t1 = test1 1.0 2.0 (\x y -> x + y)
+ let t2 = test2
+ let t3 = test3
+ let t4 = test4
+ let t5 = test5
+ let t6 = test6
+ let t7 = test7
+ let t8 = test8
+ let t9 = test9
+ let t10 = test10
+ let t11 = test11
+ let t12 = test12 k 1.0 2.0
+ let t13 = test13 k 1.0 2.0
+ let t14 = test14 1.0 2.0
+ let t15 = test15 1.0 2.0
+ let t17 = test17
+ let t18 = test18
+ let t19 = test19
+ let t20 = test20
+ trace "Done"
diff --git a/examples/passing/OptimizerBug.purs b/examples/passing/OptimizerBug.purs
index dd88e96..cdddb1f 100644
--- a/examples/passing/OptimizerBug.purs
+++ b/examples/passing/OptimizerBug.purs
@@ -2,7 +2,7 @@ module Main where
import Prelude
-x a = 1 + y a
+x a = 1.0 + y a
y a = x a
diff --git a/examples/passing/PartialFunction.purs b/examples/passing/PartialFunction.purs
index 3517cb5..03d0943 100644
--- a/examples/passing/PartialFunction.purs
+++ b/examples/passing/PartialFunction.purs
@@ -1,19 +1,10 @@
module Main where
-foreign import testError
- """
- function testError(f) {
- try {
- return f();
- } catch (e) {
- if (e instanceof Error) return 'success';
- throw new Error('Pattern match failure is not Error');
- }
- }
- """ :: (Unit -> Number) -> String
+import Prelude
+import Assert
fn :: Number -> Number
-fn 0 = 0
-fn 1 = 2
+fn 0.0 = 0.0
+fn 1.0 = 2.0
-main = Debug.Trace.trace (show $ testError $ \_ -> fn 2)
+main = assertPartial $ \_ -> fn 2.0
diff --git a/examples/passing/Patterns.purs b/examples/passing/Patterns.purs
index 90fab1b..4a63ad5 100644
--- a/examples/passing/Patterns.purs
+++ b/examples/passing/Patterns.purs
@@ -1,28 +1,22 @@
module Main where
- import Prelude
+import Prelude
- test = \x -> case x of
- { str = "Foo", bool = true } -> true
- { str = "Bar", bool = b } -> b
- _ -> false
+test = \x -> case x of
+ { str = "Foo", bool = true } -> true
+ { str = "Bar", bool = b } -> b
+ _ -> false
- f = \o -> case o of
- { foo = "Foo" } -> o.bar
- _ -> 0
+f = \o -> case o of
+ { foo = "Foo" } -> o.bar
+ _ -> 0
- g = \o -> case o of
- { arr = [x : xs], take = "car" } -> x
- { arr = [_, x : xs], take = "cadr" } -> x
- _ -> 0
+h = \o -> case o of
+ a@[_,_,_] -> a
+ _ -> []
+isDesc :: Array Number -> Boolean
+isDesc [x, y] | x > y = true
+isDesc _ = false
- h = \o -> case o of
- a@[_,_,_] -> a
- _ -> []
-
- isDesc :: [Number] -> Boolean
- isDesc [x, y] | x > y = true
- isDesc _ = false
-
- main = Debug.Trace.trace "Done"
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/Person.purs b/examples/passing/Person.purs
index 57b52e8..fba54ae 100644
--- a/examples/passing/Person.purs
+++ b/examples/passing/Person.purs
@@ -1,18 +1,11 @@
module Main where
- import Prelude ((++))
+import Prelude
- data Person = Person { name :: String, age :: Number }
+data Person = Person { name :: String, age :: Number }
- foreign import itoa
- """
- function itoa(n) {
- return n.toString();
- }
- """ :: Number -> String
+showPerson :: Person -> String
+showPerson = \p -> case p of
+ Person o -> o.name ++ ", aged " ++ show o.age
- showPerson :: Person -> String
- showPerson = \p -> case p of
- Person o -> o.name ++ ", aged " ++ itoa(o.age)
-
- main = Debug.Trace.trace "Done"
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/Rank2Data.purs b/examples/passing/Rank2Data.purs
index ccc60f5..2326d67 100644
--- a/examples/passing/Rank2Data.purs
+++ b/examples/passing/Rank2Data.purs
@@ -1,29 +1,29 @@
module Main where
- import Prelude
+import Prelude
- data Id = Id forall a. a -> a
+data Id = Id forall a. a -> a
- runId = \id a -> case id of
- Id f -> f a
+runId = \id a -> case id of
+ Id f -> f a
- data Nat = Nat forall r. r -> (r -> r) -> r
+data Nat = Nat forall r. r -> (r -> r) -> r
- runNat = \nat -> case nat of
- Nat f -> f 0 (\n -> n + 1)
+runNat = \nat -> case nat of
+ Nat f -> f 0.0 (\n -> n + 1.0)
- zero' = Nat (\zero' _ -> zero')
+zero' = Nat (\zero' _ -> zero')
- succ = \n -> case n of
- Nat f -> Nat (\zero' succ -> succ (f zero' succ))
+succ = \n -> case n of
+ Nat f -> Nat (\zero' succ -> succ (f zero' succ))
- add = \n m -> case n of
- Nat f -> case m of
- Nat g -> Nat (\zero' succ -> g (f zero' succ) succ)
+add = \n m -> case n of
+ Nat f -> case m of
+ Nat g -> Nat (\zero' succ -> g (f zero' succ) succ)
- one' = succ zero'
- two = succ zero'
- four = add two two
- fourNumber = runNat four
+one' = succ zero'
+two = succ zero'
+four = add two two
+fourNumber = runNat four
- main = Debug.Trace.trace "Done'"
+main = Debug.Trace.trace "Done'"
diff --git a/examples/passing/Rank2Object.purs b/examples/passing/Rank2Object.purs
index 7de3c2f..e25516f 100644
--- a/examples/passing/Rank2Object.purs
+++ b/examples/passing/Rank2Object.purs
@@ -1,10 +1,11 @@
module Main where
+import Prelude
import Debug.Trace
data Foo = Foo { id :: forall a. a -> a }
foo :: Foo -> Number
-foo (Foo { id = f }) = f 0
+foo (Foo { id = f }) = f 0.0
main = trace "Done"
diff --git a/examples/passing/Rank2TypeSynonym.purs b/examples/passing/Rank2TypeSynonym.purs
index b58ab3d..11a51d2 100644
--- a/examples/passing/Rank2TypeSynonym.purs
+++ b/examples/passing/Rank2TypeSynonym.purs
@@ -1,5 +1,6 @@
module Main where
+import Prelude
import Control.Monad.Eff
type Foo a = forall f. (Monad f) => f a
@@ -8,7 +9,7 @@ foo :: forall a. a -> Foo a
foo x = pure x
bar :: Foo Number
-bar = foo 3
+bar = foo 3.0
main = do
x <- bar
diff --git a/examples/passing/Rank2Types.purs b/examples/passing/Rank2Types.purs
index d863050..fb92ed8 100644
--- a/examples/passing/Rank2Types.purs
+++ b/examples/passing/Rank2Types.purs
@@ -1,11 +1,11 @@
module Main where
- import Prelude
+import Prelude
- test1 :: (forall a. (a -> a)) -> Number
- test1 = \f -> f 0
+test1 :: (forall a. (a -> a)) -> Number
+test1 = \f -> f 0.0
- forever :: forall m a b. (forall a b. m a -> (a -> m b) -> m b) -> m a -> m b
- forever = \bind action -> bind action $ \_ -> forever bind action
+forever :: forall m a b. (forall a b. m a -> (a -> m b) -> m b) -> m a -> m b
+forever = \bind action -> bind action $ \_ -> forever bind action
- main = Debug.Trace.trace "Done"
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/RebindableSyntax.purs b/examples/passing/RebindableSyntax.purs
new file mode 100644
index 0000000..533e302
--- /dev/null
+++ b/examples/passing/RebindableSyntax.purs
@@ -0,0 +1,39 @@
+module Main where
+
+import Prelude
+
+example1 :: String
+example1 = do
+ "Do"
+ " notation"
+ " for"
+ " Semigroup"
+ where
+ bind x f = x <> f unit
+
+(*>) :: forall f a b. (Apply f) => f a -> f b -> f b
+(*>) fa fb = const id <$> fa <*> fb
+
+newtype Const a b = Const a
+
+runConst :: forall a b. Const a b -> a
+runConst (Const a) = a
+
+instance functorConst :: Functor (Const a) where
+ (<$>) _ (Const a) = Const a
+
+instance applyConst :: (Semigroup a) => Apply (Const a) where
+ (<*>) (Const a1) (Const a2) = Const (a1 <> a2)
+
+example2 :: Const String Unit
+example2 = do
+ Const "Do"
+ Const " notation"
+ Const " for"
+ Const " Apply"
+ where
+ bind x f = x *> f unit
+
+main = do
+ Debug.Trace.trace example1
+ Debug.Trace.trace $ runConst example2
diff --git a/examples/passing/Recursion.purs b/examples/passing/Recursion.purs
index 54afcbd..f6c88f9 100644
--- a/examples/passing/Recursion.purs
+++ b/examples/passing/Recursion.purs
@@ -1,10 +1,10 @@
module Main where
- import Prelude
+import Prelude
- fib = \n -> case n of
- 0 -> 1
- 1 -> 1
- n -> fib (n - 1) + fib (n - 2)
+fib = \n -> case n of
+ 0.0 -> 1.0
+ 1.0 -> 1.0
+ n -> fib (n - 1.0) + fib (n - 2.0)
- main = Debug.Trace.trace "Done"
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/ReservedWords.purs b/examples/passing/ReservedWords.purs
index 3a8be2e..89f023e 100644
--- a/examples/passing/ReservedWords.purs
+++ b/examples/passing/ReservedWords.purs
@@ -1,13 +1,15 @@
-- See https://github.com/purescript/purescript/issues/606
module Main where
- o :: { type :: String }
- o = { type: "o" }
+import Prelude
- p :: { type :: String }
- p = o { type = "p" }
+o :: { type :: String }
+o = { type: "o" }
- f :: forall r. { type :: String | r } -> String
- f { type = "p" } = "Done"
+p :: { type :: String }
+p = o { type = "p" }
- main = Debug.Trace.trace $ f { type: p.type, foo: "bar" }
+f :: forall r. { type :: String | r } -> String
+f { type = "p" } = "Done"
+
+main = Debug.Trace.trace $ f { type: p.type, foo: "bar" }
diff --git a/examples/passing/RowConstructors.purs b/examples/passing/RowConstructors.purs
new file mode 100644
index 0000000..0ed416f
--- /dev/null
+++ b/examples/passing/RowConstructors.purs
@@ -0,0 +1,42 @@
+module Main where
+
+import Prelude
+
+type Foo = (x :: Number | (y :: Number | (z :: Number)))
+type Bar = (x :: Number, y :: Number, z :: Number)
+type Baz = { w :: Number | Bar }
+
+foo :: { | Foo }
+foo = { x: 0.0, y: 0.0, z: 0.0 }
+
+bar :: { | Bar }
+bar = { x: 0.0, y: 0.0, z: 0.0 }
+
+id' :: Object Foo -> Object Bar
+id' = id
+
+foo' :: { | Foo }
+foo' = id' foo
+
+bar' :: { | Bar }
+bar' = id' bar
+
+baz :: Baz
+baz = { x: 0.0, y: 0.0, z: 0.0, w: 0.0 }
+
+type Quux r = (q :: Number | r)
+type Norf r = (q' :: Number | Quux r)
+
+quux :: { f :: { | Foo } | Quux Bar }
+quux = { f: foo', x: 0.0, y: 0.0, z: 0.0, q: 0.0 }
+
+quux' :: { | Norf Bar }
+quux' = { x: 0.0, y: 0.0, z: 0.0, q: 0.0, q': 0.0 }
+
+wildcard :: { w :: Number | _ } -> Baz
+wildcard { w: w } = { x: w, y: w, z: w, w: w }
+
+wildcard' :: { | Quux _ } -> Number
+wildcard' { q: q } = q
+
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/RowPolyInstanceContext.purs b/examples/passing/RowPolyInstanceContext.purs
index 5874373..fe4ad53 100644
--- a/examples/passing/RowPolyInstanceContext.purs
+++ b/examples/passing/RowPolyInstanceContext.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
class T s m where
state :: (s -> s) -> m Unit
diff --git a/examples/passing/RowSynonyms.purs b/examples/passing/RowSynonyms.purs
deleted file mode 100644
index 8b47d73..0000000
--- a/examples/passing/RowSynonyms.purs
+++ /dev/null
@@ -1,46 +0,0 @@
-module Main where
-
-import Control.Monad.Eff
-import Control.Monad.ST
-
-type State bindings =
- {
- bindings :: {addition :: Number | bindings},
- other :: String
- }
-
-type MyBindings = (test :: Number)
-
-data Shadow bindings = Shadow String
-
-shadows :: Shadow (Object MyBindings)
-shadows = Shadow "uhh"
-
-main :: Eff () Unit
-main = withIt
- shadows
- \ bindings -> do
- let state =
- {
- bindings : bindings,
- other : "Test"
- }
- runST do
- stRef <- newSTRef state
- handleKeyD stRef
- return unit
-
-
-withIt :: forall bindings eff a. Shadow (Object bindings) ->
- ({addition :: Number | bindings} -> Eff eff a) -> Eff eff a
-withIt (Shadow str) success = do
- b <- withBindings
- success (b{addition = 1})
-
-foreign import withBindings
-"""
- function withBindings() {}
-""" :: forall eff bindings. Eff eff bindings
-
-handleKeyD :: forall h eff. STRef h (State MyBindings) -> Eff (st :: ST h | eff) Unit
-handleKeyD state = return unit
diff --git a/examples/passing/RuntimeScopeIssue.purs b/examples/passing/RuntimeScopeIssue.purs
index 780192d..24e7923 100644
--- a/examples/passing/RuntimeScopeIssue.purs
+++ b/examples/passing/RuntimeScopeIssue.purs
@@ -9,11 +9,11 @@ class B a where
b :: a -> Boolean
instance aNumber :: A Number where
- a 0 = true
- a n = b (n - 1)
+ a 0.0 = true
+ a n = b (n - 1.0)
instance bNumber :: B Number where
- b 0 = false
- b n = a (n - 1)
+ b 0.0 = false
+ b n = a (n - 1.0)
-main = Debug.Trace.print $ a 10
+main = Debug.Trace.print $ a 10.0
diff --git a/examples/passing/ScopedTypeVariables.purs b/examples/passing/ScopedTypeVariables.purs
index b081697..bfc0590 100644
--- a/examples/passing/ScopedTypeVariables.purs
+++ b/examples/passing/ScopedTypeVariables.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
test1 :: forall a. (a -> a) -> a -> a
test1 f x = g (g x)
where
@@ -15,8 +17,8 @@ test2 = h
g :: b -> b
g y = f (f y)
-test3 :: Number
-test3 = ((\b -> b :: b) :: forall b. b -> b) 0
+test3 :: Number
+test3 = ((\b -> b :: b) :: forall b. b -> b) 0.0
test4 :: forall a. (a -> a) -> a -> a
test4 = h
diff --git a/examples/passing/Sequence.purs b/examples/passing/Sequence.purs
index dd17830..289a618 100644
--- a/examples/passing/Sequence.purs
+++ b/examples/passing/Sequence.purs
@@ -1,12 +1,15 @@
module Main where
+import Prelude
import Control.Monad.Eff
+data List a = Cons a (List a) | Nil
+
class Sequence t where
sequence :: forall m a. (Monad m) => t (m a) -> m (t a)
-instance sequenceArray :: Sequence [] where
- sequence [] = pure []
- sequence (x:xs) = (:) <$> x <*> sequence xs
+instance sequenceList :: Sequence List where
+ sequence Nil = pure Nil
+ sequence (Cons x xs) = Cons <$> x <*> sequence xs
-main = sequence $ [Debug.Trace.trace "Done"]
+main = sequence $ Cons (Debug.Trace.trace "Done") Nil
diff --git a/examples/passing/SequenceDesugared.purs b/examples/passing/SequenceDesugared.purs
index 101b8f8..fbc184c 100644
--- a/examples/passing/SequenceDesugared.purs
+++ b/examples/passing/SequenceDesugared.purs
@@ -1,34 +1,37 @@
module Main where
+import Prelude
import Control.Monad.Eff
+data List a = Cons a (List a) | Nil
+
data Sequence t = Sequence (forall m a. (Monad m) => t (m a) -> m (t a))
sequence :: forall t. Sequence t -> (forall m a. (Monad m) => t (m a) -> m (t a))
sequence (Sequence s) = s
-sequenceArraySeq :: forall m a. (Monad m) => Array (m a) -> m (Array a)
-sequenceArraySeq [] = pure []
-sequenceArraySeq (x:xs) = (:) <$> x <*> sequenceArraySeq xs
+sequenceListSeq :: forall m a. (Monad m) => List (m a) -> m (List a)
+sequenceListSeq Nil = pure Nil
+sequenceListSeq (Cons x xs) = Cons <$> x <*> sequenceListSeq xs
-sequenceArray :: Sequence []
-sequenceArray = Sequence (sequenceArraySeq)
+sequenceList :: Sequence List
+sequenceList = Sequence (sequenceListSeq)
-sequenceArray' :: Sequence []
-sequenceArray' = Sequence ((\val -> case val of
- [] -> pure []
- (x:xs) -> (:) <$> x <*> sequence sequenceArray' xs))
+sequenceList' :: Sequence List
+sequenceList' = Sequence ((\val -> case val of
+ Nil -> pure Nil
+ Cons x xs -> Cons <$> x <*> sequence sequenceList' xs))
-sequenceArray'' :: Sequence []
-sequenceArray'' = Sequence (sequenceArraySeq :: forall m a. (Monad m) => Array (m a) -> m (Array a))
+sequenceList'' :: Sequence List
+sequenceList'' = Sequence (sequenceListSeq :: forall m a. (Monad m) => List (m a) -> m (List a))
-sequenceArray''' :: Sequence []
-sequenceArray''' = Sequence ((\val -> case val of
- [] -> pure []
- (x:xs) -> (:) <$> x <*> sequence sequenceArray''' xs) :: forall m a. (Monad m) => Array (m a) -> m (Array a))
+sequenceList''' :: Sequence List
+sequenceList''' = Sequence ((\val -> case val of
+ Nil -> pure Nil
+ Cons x xs -> Cons <$> x <*> sequence sequenceList''' xs) :: forall m a. (Monad m) => List (m a) -> m (List a))
main = do
- sequence sequenceArray $ [Debug.Trace.trace "Done"]
- sequence sequenceArray' $ [Debug.Trace.trace "Done"]
- sequence sequenceArray'' $ [Debug.Trace.trace "Done"]
- sequence sequenceArray''' $ [Debug.Trace.trace "Done"]
+ sequence sequenceList $ Cons (Debug.Trace.trace "Done") Nil
+ sequence sequenceList' $ Cons (Debug.Trace.trace "Done") Nil
+ sequence sequenceList'' $ Cons (Debug.Trace.trace "Done") Nil
+ sequence sequenceList''' $ Cons (Debug.Trace.trace "Done") Nil
diff --git a/examples/passing/ShadowedRename.purs b/examples/passing/ShadowedRename.purs
index ba54b10..3c665c6 100644
--- a/examples/passing/ShadowedRename.purs
+++ b/examples/passing/ShadowedRename.purs
@@ -1,21 +1,14 @@
module Main where
+import Prelude
import Control.Monad.Eff
import Debug.Trace
-
-foreign import f
- """
- function f(x) {
- return function() {
- if (x !== 2) throw new Error('x is not 2');
- };
- }
- """ :: forall e. Number -> Eff e Number
+import Assert
foo foo = let foo_1 = \_ -> foo
- foo_2 = foo_1 unit + 1
+ foo_2 = foo_1 unit + 1.0
in foo_2
main = do
- f (foo 1)
+ assert $ foo 1.0 == 2.0
trace "Done"
diff --git a/examples/passing/ShadowedTCO.purs b/examples/passing/ShadowedTCO.purs
index 05d6120..ceb9883 100644
--- a/examples/passing/ShadowedTCO.purs
+++ b/examples/passing/ShadowedTCO.purs
@@ -1,6 +1,8 @@
module Main where
-runNat f = f 0 (\n -> n + 1)
+import Prelude
+
+runNat f = f 0.0 (\n -> n + 1.0)
zero' z _ = z
diff --git a/examples/passing/ShadowedTCOLet.purs b/examples/passing/ShadowedTCOLet.purs
index 6c567ee..8c9c6a0 100644
--- a/examples/passing/ShadowedTCOLet.purs
+++ b/examples/passing/ShadowedTCOLet.purs
@@ -1,7 +1,9 @@
module Main where
+import Prelude
+
f x y z =
- let f 1 2 3 = 1
+ let f 1.0 2.0 3.0 = 1.0
in f x z y
-main = Debug.Trace.trace $ show $ f 1 3 2
+main = Debug.Trace.trace $ show $ f 1.0 3.0 2.0
diff --git a/examples/passing/SignedNumericLiterals.purs b/examples/passing/SignedNumericLiterals.purs
index f5a9004..054f7a5 100644
--- a/examples/passing/SignedNumericLiterals.purs
+++ b/examples/passing/SignedNumericLiterals.purs
@@ -1,15 +1,17 @@
module Main where
- p = 0.5
- q = 1
- x = -1
- y = -0.5
- z = 0.5
- w = 1
+import Prelude
- f :: Number -> Number
- f x = -x
+p = 0.5
+q = 1.0
+x = -1.0
+y = -0.5
+z = 0.5
+w = 1.0
- test1 = 2 - 1
+f :: Number -> Number
+f x = -x
- main = Debug.Trace.trace "Done"
+test1 = 2.0 - 1.0
+
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/Superclasses1.purs b/examples/passing/Superclasses1.purs
index 32846a6..db9a039 100644
--- a/examples/passing/Superclasses1.purs
+++ b/examples/passing/Superclasses1.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
class Su a where
su :: a -> a
@@ -7,7 +9,7 @@ class (Su a) <= Cl a where
cl :: a -> a -> a
instance suNumber :: Su Number where
- su n = n + 1
+ su n = n + 1.0
instance clNumber :: Cl Number where
cl n m = n + m
@@ -15,4 +17,4 @@ instance clNumber :: Cl Number where
test :: forall a. (Cl a) => a -> a
test a = su (cl a a)
-main = Debug.Trace.print $ test 10
+main = Debug.Trace.print $ test 10.0
diff --git a/examples/passing/Superclasses2.purs b/examples/passing/Superclasses2.purs
index 38d2adc..09dfb63 100644
--- a/examples/passing/Superclasses2.purs
+++ b/examples/passing/Superclasses2.purs
@@ -1,23 +1,24 @@
module Main where
+import Prelude
import Prelude.Unsafe (unsafeIndex)
class Su a where
su :: a -> a
-class (Su [a]) <= Cl a where
+class (Su (Array a)) <= Cl a where
cl :: a -> a -> a
instance suNumber :: Su Number where
- su n = n + 1
+ su n = n + 1.0
-instance suArray :: (Su a) => Su [a] where
- su (x : _) = [su x]
+instance suArray :: (Su a) => Su (Array a) where
+ su [x] = [su x]
instance clNumber :: Cl Number where
cl n m = n + m
-test :: forall a. (Cl a) => a -> [a]
+test :: forall a. (Cl a) => a -> Array a
test x = su [cl x x]
-main = Debug.Trace.print $ test 10 `unsafeIndex` 0
+main = Debug.Trace.print $ test 10.0 `unsafeIndex` 0.0
diff --git a/examples/passing/Superclasses3.purs b/examples/passing/Superclasses3.purs
index 28e8d4c..7fa8ffa 100644
--- a/examples/passing/Superclasses3.purs
+++ b/examples/passing/Superclasses3.purs
@@ -1,14 +1,14 @@
module Main where
+import Prelude
import Debug.Trace
-
import Control.Monad.Eff
class (Monad m) <= MonadWriter w m where
tell :: w -> m Unit
testFunctor :: forall m. (Monad m) => m Number -> m Number
-testFunctor n = (+) 1 <$> n
+testFunctor n = (+) 1.0 <$> n
test :: forall w m. (Monad m, MonadWriter w m) => w -> m Unit
test w = do
@@ -31,7 +31,7 @@ instance applicativeMTrace :: Applicative MTrace where
pure = MTrace <<< return
instance bindMTrace :: Bind MTrace where
- (>>=) m f = MTrace (runMTrace m >>= (runMTrace <<< f))
+ bind m f = MTrace (runMTrace m >>= (runMTrace <<< f))
instance monadMTrace :: Monad MTrace
diff --git a/examples/passing/TCOCase.purs b/examples/passing/TCOCase.purs
index 563e628..2f8454a 100644
--- a/examples/passing/TCOCase.purs
+++ b/examples/passing/TCOCase.purs
@@ -1,10 +1,12 @@
module Main where
+import Prelude
+
data Data = One | More Data
-main = Debug.Trace.trace (from (to 10000 One))
+main = Debug.Trace.trace (from (to 10000.0 One))
where
- to 0 a = a
- to n a = to (n - 1) (More a)
+ to 0.0 a = a
+ to n a = to (n - 1.0) (More a)
from One = "Done"
from (More d) = from d
diff --git a/examples/passing/TailCall.purs b/examples/passing/TailCall.purs
index dbc3046..505f38c 100644
--- a/examples/passing/TailCall.purs
+++ b/examples/passing/TailCall.purs
@@ -2,14 +2,16 @@ module Main where
import Prelude
-test :: Number -> [Number] -> Number
-test n [] = n
-test n (x:xs) = test (n + x) xs
+data L a = C a (L a) | N
+
+test :: Number -> L Number -> Number
+test n N = n
+test n (C x xs) = test (n + x) xs
loop :: forall a. Number -> a
-loop x = loop (x + 1)
+loop x = loop (x + 1.0)
notATailCall = \x ->
(\notATailCall -> notATailCall x) (\x -> x)
-main = Debug.Trace.print (test 0 [1, 2, 3])
+main = Debug.Trace.print (test 0.0 (1.0 `C` (2.0 `C` (3.0 `C` N))))
diff --git a/examples/passing/Tick.purs b/examples/passing/Tick.purs
index d799fa7..718420f 100644
--- a/examples/passing/Tick.purs
+++ b/examples/passing/Tick.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
test' x = x
main = Debug.Trace.trace "Done"
diff --git a/examples/passing/TopLevelCase.purs b/examples/passing/TopLevelCase.purs
index 2c938d0..557ab6f 100644
--- a/examples/passing/TopLevelCase.purs
+++ b/examples/passing/TopLevelCase.purs
@@ -1,18 +1,18 @@
module Main where
- import Prelude
+import Prelude
- gcd :: Number -> Number -> Number
- gcd 0 x = x
- gcd x 0 = x
- gcd x y | x > y = gcd (x % y) y
- gcd x y = gcd (y % x) x
+gcd :: Number -> Number -> Number
+gcd 0.0 x = x
+gcd x 0.0 = x
+gcd x y | x > y = gcd (x % y) y
+gcd x y = gcd (y % x) x
- guardsTest (x:xs) | x > 0 = guardsTest xs
- guardsTest xs = xs
+guardsTest [x] | x > 0.0 = []
+guardsTest xs = xs
- data A = A
+data A = A
- parseTest A 0 = 0
+parseTest A 0.0 = 0.0
- main = Debug.Trace.trace "Done"
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/TypeClassImport.purs b/examples/passing/TypeClassImport.purs
deleted file mode 100644
index 9423941..0000000
--- a/examples/passing/TypeClassImport.purs
+++ /dev/null
@@ -1,18 +0,0 @@
-module Main where
-
-foreign import data T :: *
-
-foreign import data C :: *
-
-foreign import t "var t = null;" :: T
-
-foreign import inst """
- var inst = {
- show: function(t) {
- return 'Done';
- }
- }""" :: C
-
-foreign import instance inst :: Show T
-
-main = Debug.Trace.print t
diff --git a/examples/passing/TypeClassMemberOrderChange.purs b/examples/passing/TypeClassMemberOrderChange.purs
index 2d7744d..f05dcfe 100644
--- a/examples/passing/TypeClassMemberOrderChange.purs
+++ b/examples/passing/TypeClassMemberOrderChange.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
class Test a where
fn :: a -> a -> a
val :: a
diff --git a/examples/passing/TypeClasses.purs b/examples/passing/TypeClasses.purs
index a81acdb..a9b2f1c 100644
--- a/examples/passing/TypeClasses.purs
+++ b/examples/passing/TypeClasses.purs
@@ -31,7 +31,7 @@ instance applicativeData :: Applicative Data where
pure = Data
instance bindData :: Bind Data where
- (>>=) (Data a) f = f a
+ bind (Data a) f = f a
instance monadData :: Monad Data
@@ -47,23 +47,23 @@ instance applicativeMaybe :: Applicative Maybe where
pure = Just
instance bindMaybe :: Bind Maybe where
- (>>=) Nothing _ = Nothing
- (>>=) (Just a) f = f a
+ bind Nothing _ = Nothing
+ bind (Just a) f = f a
instance monadMaybe :: Monad Maybe
test4 :: forall a m. (Monad m) => a -> m Number
-test4 = \_ -> return 1
+test4 = \_ -> return 1.0
-test5 = \_ -> Just 1 >>= \n -> return (n + 1)
+test5 = \_ -> Just 1.0 >>= \n -> return (n + 1.0)
ask r = r
runReader r f = f r
-test9 _ = runReader 0 $ do
+test9 _ = runReader 0.0 $ do
n <- ask
- return $ n + 1
+ return $ n + 1.0
main = Debug.Trace.trace (test7 "Done")
diff --git a/examples/passing/TypeClassesWithOverlappingTypeVariables.purs b/examples/passing/TypeClassesWithOverlappingTypeVariables.purs
index e8eae78..66b8b80 100644
--- a/examples/passing/TypeClassesWithOverlappingTypeVariables.purs
+++ b/examples/passing/TypeClassesWithOverlappingTypeVariables.purs
@@ -1,11 +1,11 @@
module Main where
- import Prelude
+import Prelude
- data Either a b = Left a | Right b
+data Either a b = Left a | Right b
- instance functorEither :: Prelude.Functor (Either a) where
- (<$>) _ (Left x) = Left x
- (<$>) f (Right y) = Right (f y)
+instance functorEither :: Prelude.Functor (Either a) where
+ (<$>) _ (Left x) = Left x
+ (<$>) f (Right y) = Right (f y)
- main = Debug.Trace.trace "Done"
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/TypeDecl.purs b/examples/passing/TypeDecl.purs
index b7c7296..9b78b38 100644
--- a/examples/passing/TypeDecl.purs
+++ b/examples/passing/TypeDecl.purs
@@ -1,12 +1,12 @@
module Main where
- import Prelude
+import Prelude
- k :: String -> Number -> String
- k x y = x
+k :: String -> Number -> String
+k x y = x
- iterate :: forall a. Number -> (a -> a) -> a -> a
- iterate 0 f a = a
- iterate n f a = iterate (n - 1) f (f a)
+iterate :: forall a. Number -> (a -> a) -> a -> a
+iterate 0.0 f a = a
+iterate n f a = iterate (n - 1.0) f (f a)
- main = Debug.Trace.trace "Done"
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/TypeSynonymInData.purs b/examples/passing/TypeSynonymInData.purs
index fff44e1..591ef53 100644
--- a/examples/passing/TypeSynonymInData.purs
+++ b/examples/passing/TypeSynonymInData.purs
@@ -1,6 +1,8 @@
module Main where
-type A a = [a]
+import Prelude
+
+type A a = Array a
data Foo a = Foo (A a) | Bar
diff --git a/examples/passing/TypeSynonyms.purs b/examples/passing/TypeSynonyms.purs
index f4f812b..4dbc27f 100644
--- a/examples/passing/TypeSynonyms.purs
+++ b/examples/passing/TypeSynonyms.purs
@@ -1,25 +1,27 @@
module Main where
- type Lens a b =
- { get :: a -> b
- , set :: a -> b -> a
- }
+import Prelude
- composeLenses :: forall a b c. Lens a b -> Lens b c -> Lens a c
- composeLenses = \l1 -> \l2 ->
- { get: \a -> l2.get (l1.get a)
- , set: \a c -> l1.set a (l2.set (l1.get a) c)
- }
+type Lens a b =
+ { get :: a -> b
+ , set :: a -> b -> a
+ }
- type Pair a b = { fst :: a, snd :: b }
+composeLenses :: forall a b c. Lens a b -> Lens b c -> Lens a c
+composeLenses = \l1 -> \l2 ->
+ { get: \a -> l2.get (l1.get a)
+ , set: \a c -> l1.set a (l2.set (l1.get a) c)
+ }
- fst :: forall a b. Lens (Pair a b) a
- fst =
- { get: \p -> p.fst
- , set: \p a -> { fst: a, snd: p.snd }
- }
+type Pair a b = { fst :: a, snd :: b }
- test1 :: forall a b c. Lens (Pair (Pair a b) c) a
- test1 = composeLenses fst fst
+fst :: forall a b. Lens (Pair a b) a
+fst =
+ { get: \p -> p.fst
+ , set: \p a -> { fst: a, snd: p.snd }
+ }
- main = Debug.Trace.trace "Done"
+test1 :: forall a b c. Lens (Pair (Pair a b) c) a
+test1 = composeLenses fst fst
+
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/TypeWildcards.purs b/examples/passing/TypeWildcards.purs
index cdfd7f1..fa3f761 100644
--- a/examples/passing/TypeWildcards.purs
+++ b/examples/passing/TypeWildcards.purs
@@ -1,7 +1,9 @@
module Main where
+import Prelude
+
testTopLevel :: _ -> _
-testTopLevel n = n + 1
+testTopLevel n = n + 1.0
test :: forall a. (Eq a) => (a -> a) -> a -> a
test f a = go (f a) a
diff --git a/examples/passing/TypeWildcardsRecordExtension.purs b/examples/passing/TypeWildcardsRecordExtension.purs
index ecab817..3a636f4 100644
--- a/examples/passing/TypeWildcardsRecordExtension.purs
+++ b/examples/passing/TypeWildcardsRecordExtension.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
foo :: forall a. {b :: Number | a} -> {b :: Number | _}
foo f = f
diff --git a/examples/passing/TypedWhere.purs b/examples/passing/TypedWhere.purs
index 637af69..690c6b9 100644
--- a/examples/passing/TypedWhere.purs
+++ b/examples/passing/TypedWhere.purs
@@ -1,13 +1,17 @@
module Main where
+import Prelude
+
data E a b = L a | R b
-lefts :: forall a b. [E a b] -> [a]
-lefts = go []
+data L a = C a (L a) | N
+
+lefts :: forall a b. L (E a b) -> L a
+lefts = go N
where
- go :: forall a b. [a] -> [E a b] -> [a]
- go ls [] = ls
- go ls (L a : rest) = go (a : ls) rest
- go ls (_ : rest) = go ls rest
+ go :: forall a b. L a -> L (E a b) -> L a
+ go ls N = ls
+ go ls (C (L a) rest) = go (C a ls) rest
+ go ls (C _ rest) = go ls rest
main = Debug.Trace.trace "Done"
diff --git a/examples/passing/UnderscoreIdent.purs b/examples/passing/UnderscoreIdent.purs
index 0bdfb08..c669f2e 100644
--- a/examples/passing/UnderscoreIdent.purs
+++ b/examples/passing/UnderscoreIdent.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
data Data_type = Con_Structor | Con_2 String
type Type_name = Data_type
diff --git a/examples/passing/UnknownInTypeClassLookup.purs b/examples/passing/UnknownInTypeClassLookup.purs
index 90a2097..7b2cdc7 100644
--- a/examples/passing/UnknownInTypeClassLookup.purs
+++ b/examples/passing/UnknownInTypeClassLookup.purs
@@ -1,5 +1,7 @@
module Main where
+import Prelude
+
class EQ a b
instance eqAA :: EQ a a
@@ -9,4 +11,4 @@ test _ _ = "Done"
runTest a = test a a
-main = Debug.Trace.trace $ runTest 0
+main = Debug.Trace.trace $ runTest 0.0
diff --git a/examples/passing/Where.purs b/examples/passing/Where.purs
index ff0b4d4..1493f8c 100644
--- a/examples/passing/Where.purs
+++ b/examples/passing/Where.purs
@@ -7,29 +7,29 @@ import Control.Monad.ST
test1 x = y
where
y :: Number
- y = x + 1
+ y = x + 1.0
test2 x y = x' + y'
where
- x' = x + 1
- y' = y + 1
+ x' = x + 1.0
+ y' = y + 1.0
-test3 = f 1 2 3
+test3 = f 1.0 2.0 3.0
where f x y z = x + y + z
-test4 = f (+) [1, 2]
+test4 = f (+) [1.0, 2.0]
where f x [y, z] = x y z
-test5 = g 10
+test5 = g 10.0
where
- f x | x > 0 = g (x / 2) + 1
- f x = 0
- g x = f (x - 1) + 1
+ f x | x > 0.0 = g (x / 2.0) + 1.0
+ f x = 0.0
+ g x = f (x - 1.0) + 1.0
-test6 = if f true then f 1 else f 2
+test6 = if f true then f 1.0 else f 2.0
where f :: forall a. a -> a
f x = x
@@ -37,13 +37,13 @@ test7 :: Number -> Number
test7 x = go x
where
go y | (x - 0.1 < y * y) && (y * y < x + 0.1) = y
- go y = go $ (y + x / y) / 2
+ go y = go $ (y + x / y) / 2.0
main = do
- Debug.Trace.print (test1 1)
- Debug.Trace.print (test2 1 2)
+ Debug.Trace.print (test1 1.0)
+ Debug.Trace.print (test2 1.0 2.0)
Debug.Trace.print test3
Debug.Trace.print test4
Debug.Trace.print test5
Debug.Trace.print test6
- Debug.Trace.print (test7 100)
+ Debug.Trace.print (test7 100.0)
diff --git a/examples/passing/iota.purs b/examples/passing/iota.purs
index 8d65c1c..48d98fb 100644
--- a/examples/passing/iota.purs
+++ b/examples/passing/iota.purs
@@ -1,9 +1,9 @@
module Main where
- s = \x -> \y -> \z -> x z (y z)
+s = \x -> \y -> \z -> x z (y z)
- k = \x -> \y -> x
+k = \x -> \y -> x
- iota = \x -> x s k
+iota = \x -> x s k
- main = Debug.Trace.trace "Done"
+main = Debug.Trace.trace "Done"
diff --git a/examples/passing/s.purs b/examples/passing/s.purs
index fe33bf4..c26a50e 100644
--- a/examples/passing/s.purs
+++ b/examples/passing/s.purs
@@ -1,5 +1,7 @@
module Main where
- s = \x y z -> x z (y z)
+import Prelude
- main = Debug.Trace.trace "Done"
+s = \x y z -> x z (y z)
+
+main = Debug.Trace.trace "Done"
diff --git a/hierarchy/Main.hs b/hierarchy/Main.hs
index 3828fd2..b8f2841 100644
--- a/hierarchy/Main.hs
+++ b/hierarchy/Main.hs
@@ -13,6 +13,8 @@
--
-----------------------------------------------------------------------------
+{-# LANGUAGE TupleSections #-}
+
module Main where
import Control.Monad (unless)
@@ -24,15 +26,13 @@ import Data.Version (showVersion)
import Options.Applicative
import System.Directory (createDirectoryIfMissing)
import System.FilePath ((</>))
+import System.FilePath.Glob (glob)
import System.Exit (exitFailure, exitSuccess)
import System.IO (hPutStr, stderr)
-import Text.Parsec as Par (ParseError)
-
import qualified Language.PureScript as P
import qualified Paths_purescript as Paths
-
data HierarchyOptions = HierarchyOptions
{ hierachyInput :: FilePath
, hierarchyOutput :: Maybe FilePath
@@ -53,16 +53,17 @@ instance Ord SuperMap where
runModuleName :: P.ModuleName -> String
runModuleName (P.ModuleName pns) = intercalate "_" (P.runProperName `map` pns)
-readInput :: FilePath -> IO (Either Par.ParseError [P.Module])
-readInput filename = do
- content <- readFile filename
- return $ fmap (map snd) $ P.parseModulesFromFiles id [(filename, content)]
+readInput :: [FilePath] -> IO (Either P.MultipleErrors [P.Module])
+readInput paths = do
+ content <- mapM (\path -> (path, ) <$> readFile path) paths
+ return $ map snd <$> P.parseModulesFromFiles id content
compile :: HierarchyOptions -> IO ()
-compile (HierarchyOptions input mOutput) = do
+compile (HierarchyOptions inputGlob mOutput) = do
+ input <- glob inputGlob
modules <- readInput input
case modules of
- Left err -> hPutStr stderr (show err) >> exitFailure
+ Left errs -> hPutStr stderr (P.prettyPrintMultipleErrors False errs) >> exitFailure
Right ms -> do
for_ ms $ \(P.Module _ moduleName decls _) ->
let name = runModuleName moduleName
diff --git a/prelude/prelude.purs b/prelude/prelude.purs
deleted file mode 100644
index 1531461..0000000
--- a/prelude/prelude.purs
+++ /dev/null
@@ -1,1478 +0,0 @@
-module Prelude
- ( otherwise
- , flip
- , const
- , asTypeOf
- , Semigroupoid, (<<<), (>>>)
- , Category, id
- , ($), (#)
- , (:), cons
- , Show, show
- , Functor, (<$>), (<#>), void
- , Apply, (<*>)
- , Applicative, pure, liftA1
- , Bind, (>>=)
- , Monad, return, liftM1, ap
- , Semiring, (+), zero, (*), one
- , ModuloSemiring, (/), mod
- , Ring, (-)
- , (%)
- , negate
- , DivisionRing
- , Num
- , Eq, (==), (/=)
- , Ord, Ordering(..), compare, (<), (>), (<=), (>=)
- , Bits, (.&.), (.|.), (.^.), shl, shr, zshr, complement
- , BoolLike, (&&), (||)
- , not
- , Semigroup, (<>), (++)
- , Unit(..), unit
- ) where
-
- -- | An alias for `true`, which can be useful in guard clauses:
- -- |
- -- | ```purescript
- -- | max x y | x >= y = x
- -- | | otherwise = y
- -- | ```
- -- |
- otherwise :: Boolean
- otherwise = true
-
- -- | Flips the order of the arguments to a function of two arguments.
- -- |
- -- | ```purescript
- -- | flip const 1 2 = const 2 1 = 2
- -- | ```
- -- |
- flip :: forall a b c. (a -> b -> c) -> b -> a -> c
- flip f b a = f a b
-
- -- | Returns its first argument and ignores its second.
- -- |
- -- | ```purescript
- -- | const 1 "hello" = 1
- -- | ```
- -- |
- const :: forall a b. a -> b -> a
- const a _ = a
-
- -- | This function returns its first argument, and can be used to assert type equalities.
- -- | This can be useful when types are otherwise ambiguous.
- -- |
- -- | ```purescript
- -- | main = print $ [] `asTypeOf` [0]
- -- | ```
- -- |
- -- | If instead, we had written `main = print []`, the type of the argument `[]` would have
- -- | been ambiguous, resulting in a compile-time error.
- asTypeOf :: forall a. a -> a -> a
- asTypeOf x _ = x
-
- infixr 9 >>>
- infixr 9 <<<
-
- -- | A `Semigroupoid` is similar to a [`Category`](#category) but does not require an identity
- -- | element `id`, just composable morphisms.
- -- |
- -- | `Semigroupoid`s should obey the following rule:
- -- |
- -- | - Associativity: `p <<< (q <<< r) = (p <<< q) <<< r`
- -- |
- -- | One example of a `Semigroupoid` is the function type constructor `(->)`, with `(<<<)` defined
- -- | as function composition.
- class Semigroupoid a where
- (<<<) :: forall b c d. a c d -> a b c -> a b d
-
- instance semigroupoidArr :: Semigroupoid (->) where
- (<<<) f g x = f (g x)
-
- -- | Forwards composition, or `(<<<)` with its arguments reversed.
- (>>>) :: forall a b c d. (Semigroupoid a) => a b c -> a c d -> a b d
- (>>>) f g = g <<< f
-
- -- | `Category`s consist of objects and composable morphisms between them, and as such are
- -- | [`Semigroupoids`](#semigroupoid), but unlike `semigroupoids` must have an identity element.
- -- |
- -- | `Category`s should obey the following rules.
- -- |
- -- | - Left Identity: `id <<< p = p`
- -- | - Right Identity: `p <<< id = p`
- -- |
- class (Semigroupoid a) <= Category a where
- id :: forall t. a t t
-
- instance categoryArr :: Category (->) where
- id x = x
-
- infixr 0 $
- infixl 0 #
-
- -- | Applies a function to its argument
- -- |
- -- | ```purescript
- -- | length $ groupBy productCategory $ filter isInStock products
- -- | ```
- -- |
- -- | is equivalent to
- -- |
- -- | ```purescript
- -- | length (groupBy productCategory (filter isInStock (products)))
- -- | ```
- -- |
- -- | `($)` is different from [`(#)`](#-2) because it is right-infix instead of left, so
- -- | `a $ b $ c $ d x` = `a $ (b $ (c $ (d $ x)))` = `a (b (c (d x)))`
- -- |
- ($) :: forall a b. (a -> b) -> a -> b
- ($) f x = f x
-
- -- | Applies a function to its argument
- -- |
- -- | ```purescript
- -- | products # groupBy productCategory # filter isInStock # length
- -- | ```
- -- |
- -- | is equivalent to
- -- |
- -- | ```purescript
- -- | length (groupBy productCategory (filter isInStock (products)))
- -- | ```
- -- |
- -- | `(#)` is different from [`($)`](#-1) because it is left-infix instead of right, so
- -- | `x # a # b # c # d` = `(((x # a) # b) # c) # d` = `d (c (b (a x)))`
- -- |
- (#) :: forall a b. a -> (a -> b) -> b
- (#) x f = f x
-
- infixr 6 :
-
- -- | An infix alias for `cons`.
- -- |
- -- | Note, the running time of this function is `O(n)`.
- (:) :: forall a. a -> [a] -> [a]
- (:) = cons
-
- -- | Attaches an element to the front of an array, creating a new array.
- -- |
- -- | ```purescript
- -- | cons 1 [2, 3, 4] = [1, 2, 3, 4]
- -- | ```
- -- |
- -- | Note, the running time of this function is `O(n)`.
- foreign import cons
- """
- function cons(e) {
- return function(l) {
- return [e].concat(l);
- };
- }
- """ :: forall a. a -> [a] -> [a]
-
- -- | The `Show` type class represents those types which can be converted into a human-readable `String` representation.
- -- |
- -- | While not required, it is recommended that for any expression `x`, the string `show x` be executable PureScript code
- -- | which evaluates to the same value as the expression `x`.
- class Show a where
- show :: a -> String
-
- foreign import showStringImpl
- """
- function showStringImpl(s) {
- return JSON.stringify(s);
- }
- """ :: String -> String
-
- instance showUnit :: Show Unit where
- show (Unit {}) = "Unit {}"
-
- instance showString :: Show String where
- show = showStringImpl
-
- instance showBoolean :: Show Boolean where
- show true = "true"
- show false = "false"
-
- foreign import showNumberImpl
- """
- function showNumberImpl(n) {
- return n.toString();
- }
- """ :: Number -> String
-
- instance showNumber :: Show Number where
- show = showNumberImpl
-
- foreign import showArrayImpl
- """
- function showArrayImpl(f) {
- return function(xs) {
- var ss = [];
- for (var i = 0, l = xs.length; i < l; i++) {
- ss[i] = f(xs[i]);
- }
- return '[' + ss.join(',') + ']';
- };
- }
- """ :: forall a. (a -> String) -> [a] -> String
-
- instance showArray :: (Show a) => Show [a] where
- show = showArrayImpl show
-
- infixl 4 <$>
- infixl 1 <#>
-
- -- | A `Functor` is a type constructor which supports a mapping operation `(<$>)`.
- -- |
- -- | `(<$>)` can be used to turn functions `a -> b` into functions `f a -> f b` whose argument and return
- -- | types use the type constructor `f` to represent some computational context.
- -- |
- -- | `Functor` instances should satisfy the following laws:
- -- |
- -- | - Identity: `(<$>) id = id`
- -- | - Composition: `(<$>) (f <<< g) = (f <$>) <<< (g <$>)`
- -- |
- class Functor f where
- (<$>) :: forall a b. (a -> b) -> f a -> f b
-
- -- | `(<#>)` is `(<$>)` with its arguments reversed. For example:
- -- |
- -- | ```purescript
- -- | [1, 2, 3] <#> \n -> n * n
- -- | ```
- (<#>) :: forall f a b. (Functor f) => f a -> (a -> b) -> f b
- (<#>) fa f = f <$> fa
-
- -- | The `void` function is used to ignore the type wrapped by a [`Functor`](#functor), replacing it with `Unit` and
- -- | keeping only the type information provided by the type constructor itself.
- -- |
- -- | `void` is often useful when using `do` notation to change the return type of a monadic computation:
- -- |
- -- | ```purescript
- -- | main = forE 1 10 \n -> void do
- -- | print n
- -- | print (n * n)
- -- | ```
- void :: forall f a. (Functor f) => f a -> f Unit
- void fa = const unit <$> fa
-
- infixl 4 <*>
-
- -- | The `Apply` class provides the `(<*>)` which is used to apply a function to an argument under a type constructor.
- -- |
- -- | `Apply` can be used to lift functions of two or more arguments to work on values wrapped with the type constructor `f`.
- -- | It might also be understood in terms of the `lift2` function:
- -- |
- -- | ```purescript
- -- | lift2 :: forall f a b c. (Apply f) => (a -> b -> c) -> f a -> f b -> f c
- -- | lift2 f a b = f <$> a <*> b
- -- | ```
- -- |
- -- | `(<*>)` is recovered from `lift2` as `lift2 ($)`. That is, `(<*>)` lifts the function application operator `($)` to arguments
- -- | wrapped with the type constructor `f`.
- -- |
- -- | `Apply` instances should satisfy the following law:
- -- |
- -- | - Associative Composition: `(<<<) <$> f <*> g <*> h = f <*> (g <*> h)`
- -- |
- -- | Formally, `Apply` represents a strong lax semi-monoidal endofunctor.
- class (Functor f) <= Apply f where
- (<*>) :: forall a b. f (a -> b) -> f a -> f b
-
- -- | The `Applicative` type class extends the [`Apply`](#apply) type class with a `pure` function, which can be used to
- -- | create values of type `f a` from values of type `a`.
- -- |
- -- | Where [`Apply`](#apply) provides the ability to lift functions of two or more arguments to functions whose arguments are wrapped using `f`,
- -- | and [`Functor`](#functor) provides the ability to lift functions of one argument, `pure` can be seen as the function which lifts functions of
- -- | _zero_ arguments. That is, `Applicative` functors support a lifting operation for any number of function arguments.
- -- |
- -- | `Applicative` instances should satisfy the following laws:
- -- |
- -- | - Identity: `(pure id) <*> v = v`
- -- | - Composition: `(pure <<<) <*> f <*> g <*> h = f <*> (g <*> h)`
- -- | - Homomorphism: `(pure f) <*> (pure x) = pure (f x)`
- -- | - Interchange: `u <*> (pure y) = (pure ($ y)) <*> u`
- -- |
- class (Apply f) <= Applicative f where
- pure :: forall a. a -> f a
-
- -- | `liftA1` provides a default implementation of `(<$>)` for any [`Applicative`](#applicative) functor,
- -- | without using `(<$>)` as provided by the [`Functor`](#functor)-[`Applicative`](#applicative) superclass relationship.
- -- |
- -- | `liftA1` can therefore be used to write [`Functor`](#functor) instances as follows:
- -- |
- -- | ```purescript
- -- | instance functorF :: Functor F where
- -- | (<$>) = liftA1
- -- | ```
- liftA1 :: forall f a b. (Applicative f) => (a -> b) -> f a -> f b
- liftA1 f a = pure f <*> a
-
- infixl 1 >>=
-
- -- | The `Bind` type class extends the [`Apply`](#apply) type class with a "bind" operation `(>>=)` which composes computations
- -- | in sequence, using the return value of one computation to determine the next computation.
- -- |
- -- | The `>>=` operator can also be expressed using `do` notation, as follows:
- -- |
- -- | ```purescript
- -- | x >>= f = do y <- x
- -- | f y
- -- | ```
- -- |
- -- | where the function argument of `f` is given the name `y`.
- -- |
- -- | `Bind` instances should satisfy the following law:
- -- |
- -- | - Associativity: `(x >>= f) >>= g = x >>= (\k => f k >>= g)`
- -- |
- -- | Or, expressed using `do` notation:
- -- |
- -- | - Associativity: `do { z <- do { y <- x ; f y } ; g z } = do { k <- x ; do { y <- f k ; g y } }`
- -- |
- -- | Associativity tells us that we can regroup operations which use do-notation, so that we can unambiguously write, for example:
- -- |
- -- | ```purescript
- -- | do x <- m1
- -- | y <- m2 x
- -- | m3 x y
- -- | ```
- class (Apply m) <= Bind m where
- (>>=) :: forall a b. m a -> (a -> m b) -> m b
-
- -- | The `Monad` type class combines the operations of the `Bind` and `Applicative` type classes. Therefore, `Monad` instances
- -- | represent type constructors which support sequential composition, and also lifting of functions of arbitrary arity.
- -- |
- -- | `Monad` instances should satisfy the following laws:
- -- |
- -- | - Left Identity: `pure x >>= f = f x`
- -- | - Right Identity: `x >>= pure = x`
- -- |
- -- | Or, expressed using `do` notation:
- -- |
- -- | - Left Identity: `do { y <- pure x ; f y } = f x`
- -- | - Right Identity: `do { y <- x ; pure y } = x`
- -- |
- class (Applicative m, Bind m) <= Monad m
-
- -- | `return` is an alias for `pure`.
- return :: forall m a. (Monad m) => a -> m a
- return = pure
-
- -- | `liftM1` provides a default implementation of `(<$>)` for any [`Monad`](#monad),
- -- | without using `(<$>)` as provided by the [`Functor`](#functor)-[`Monad`](#monad) superclass relationship.
- -- |
- -- | `liftM1` can therefore be used to write [`Functor`](#functor) instances as follows:
- -- |
- -- | ```purescript
- -- | instance functorF :: Functor F where
- -- | (<$>) = liftM1
- -- | ```
- liftM1 :: forall m a b. (Monad m) => (a -> b) -> m a -> m b
- liftM1 f a = do
- a' <- a
- return (f a')
-
- -- | `ap` provides a default implementation of `(<*>)` for any [`Monad`](#monad),
- -- | without using `(<*>)` as provided by the [`Apply`](#apply)-[`Monad`](#monad) superclass relationship.
- -- |
- -- | `ap` can therefore be used to write [`Apply`](#apply) instances as follows:
- -- |
- -- | ```purescript
- -- | instance applyF :: Apply F where
- -- | (<*>) = ap
- -- | ```
- ap :: forall m a b. (Monad m) => m (a -> b) -> m a -> m b
- ap f a = do
- f' <- f
- a' <- a
- return (f' a')
-
- instance functorArr :: Functor ((->) r) where
- (<$>) = (<<<)
-
- instance applyArr :: Apply ((->) r) where
- (<*>) f g x = f x (g x)
-
- instance applicativeArr :: Applicative ((->) r) where
- pure = const
-
- instance bindArr :: Bind ((->) r) where
- (>>=) m f x = f (m x) x
-
- instance monadArr :: Monad ((->) r)
-
- infixl 7 *
- infixl 7 /
- infixl 7 %
-
- infixl 6 -
- infixl 6 +
-
- -- | Addition and multiplication, satisfying the following laws:
- -- |
- -- | - `a` is a commutative monoid under addition
- -- | - `a` is a monoid under multiplication
- -- | - multiplication distributes over addition
- -- | - multiplication by `zero` annihilates `a`
- -- |
- class Semiring a where
- (+) :: a -> a -> a
- zero :: a
- (*) :: a -> a -> a
- one :: a
-
- -- | Addition, multiplication, modulo operation and division, satisfying:
- -- |
- -- | - ```a / b * b + (a `mod` b) = a```
- -- |
- class (Semiring a) <= ModuloSemiring a where
- (/) :: a -> a -> a
- mod :: a -> a -> a
-
- -- | Addition, multiplication, and subtraction.
- -- |
- -- | Has the same laws as `Semiring` but additionally satisfying:
- -- |
- -- | - `a` is an abelian group under addition
- -- |
- class (Semiring a) <= Ring a where
- (-) :: a -> a -> a
-
- negate :: forall a. (Ring a) => a -> a
- negate a = zero - a
-
- -- | Ring where every nonzero element has a multiplicative inverse so that:
- -- |
- -- | - ```a `mod` b = zero```
- -- |
- class (Ring a, ModuloSemiring a) <= DivisionRing a
-
- -- | A commutative field
- class (DivisionRing a) <= Num a
-
- foreign import numAdd
- """
- function numAdd(n1) {
- return function(n2) {
- return n1 + n2;
- };
- }
- """ :: Number -> Number -> Number
-
- foreign import numSub
- """
- function numSub(n1) {
- return function(n2) {
- return n1 - n2;
- };
- }
- """ :: Number -> Number -> Number
-
- foreign import numMul
- """
- function numMul(n1) {
- return function(n2) {
- return n1 * n2;
- };
- }
- """ :: Number -> Number -> Number
-
- foreign import numDiv
- """
- function numDiv(n1) {
- return function(n2) {
- return n1 / n2;
- };
- }
- """ :: Number -> Number -> Number
-
- foreign import numMod
- """
- function numMod(n1) {
- return function(n2) {
- return n1 % n2;
- };
- }
- """ :: Number -> Number -> Number
-
- (%) = numMod
-
- instance semiringNumber :: Semiring Number where
- (+) = numAdd
- zero = 0
- (*) = numMul
- one = 1
-
- instance ringNumber :: Ring Number where
- (-) = numSub
-
- instance moduloSemiringNumber :: ModuloSemiring Number where
- (/) = numDiv
- mod _ _ = 0
-
- instance divisionRingNumber :: DivisionRing Number
-
- instance numNumber :: Num Number
-
- -- | The `Unit` type has a single inhabitant, called `unit`. It represents values with no computational content.
- -- |
- -- | `Unit` is often used, wrapped in a monadic type constructor, as the return type of a computation where only
- -- | the _effects_ are important.
- newtype Unit = Unit {}
-
- -- | `unit` is the sole inhabitant of the `Unit` type.
- unit :: Unit
- unit = Unit {}
-
- infix 4 ==
- infix 4 /=
-
- -- | The `Eq` type class represents types which support decidable equality.
- -- |
- -- | `Eq` instances should satisfy the following laws:
- -- |
- -- | - Reflexivity: `x == x = true`
- -- | - Symmetry: `x == y = y == x`
- -- | - Transitivity: if `x == y` and `y == z` then `x == z`
- -- | - Negation: `x /= y = not (x == y)`
- -- |
- -- | `(/=)` may be implemented in terms of `(==)`, but it might give a performance improvement to implement it separately.
- class Eq a where
- (==) :: a -> a -> Boolean
- (/=) :: a -> a -> Boolean
-
- foreign import refEq
- """
- function refEq(r1) {
- return function(r2) {
- return r1 === r2;
- };
- }
- """ :: forall a. a -> a -> Boolean
-
- foreign import refIneq
- """
- function refIneq(r1) {
- return function(r2) {
- return r1 !== r2;
- };
- }
- """ :: forall a. a -> a -> Boolean
-
- instance eqUnit :: Eq Unit where
- (==) (Unit {}) (Unit {}) = true
- (/=) (Unit {}) (Unit {}) = false
-
- instance eqString :: Eq String where
- (==) = refEq
- (/=) = refIneq
-
- instance eqNumber :: Eq Number where
- (==) = refEq
- (/=) = refIneq
-
- instance eqBoolean :: Eq Boolean where
- (==) = refEq
- (/=) = refIneq
-
- foreign import eqArrayImpl
- """
- function eqArrayImpl(f) {
- return function(xs) {
- return function(ys) {
- if (xs.length !== ys.length) return false;
- for (var i = 0; i < xs.length; i++) {
- if (!f(xs[i])(ys[i])) return false;
- }
- return true;
- };
- };
- }
- """ :: forall a. (a -> a -> Boolean) -> [a] -> [a] -> Boolean
-
- instance eqArray :: (Eq a) => Eq [a] where
- (==) xs ys = eqArrayImpl (==) xs ys
- (/=) xs ys = not (xs == ys)
-
- -- | The `Ordering` data type represents the three possible outcomes of comparing two values:
- -- |
- -- | `LT` - The first value is _less than_ the second.
- -- | `GT` - The first value is _greater than_ the second.
- -- | `EQ` - The first value is _equal to_ or _incomparable to_ the second.
- data Ordering = LT | GT | EQ
-
- instance eqOrdering :: Eq Ordering where
- (==) LT LT = true
- (==) GT GT = true
- (==) EQ EQ = true
- (==) _ _ = false
- (/=) x y = not (x == y)
-
- instance showOrdering :: Show Ordering where
- show LT = "LT"
- show GT = "GT"
- show EQ = "EQ"
-
- instance semigroupOrdering :: Semigroup Ordering where
- (<>) LT _ = LT
- (<>) GT _ = GT
- (<>) EQ y = y
-
- -- | The `Ord` type class represents types which support comparisons.
- -- |
- -- | `Ord` instances should satisfy the laws of _partially orderings_:
- -- |
- -- | - Reflexivity: `a <= a`
- -- | - Antisymmetry: if `a <= b` and `b <= a` then `a = b`
- -- | - Transitivity: if `a <= b` and `b <= c` then `a <= c`
- -- |
- class (Eq a) <= Ord a where
- compare :: a -> a -> Ordering
-
- infixl 4 <
-
- -- | Test whether one value is _strictly less than_ another.
- (<) :: forall a. (Ord a) => a -> a -> Boolean
- (<) a1 a2 = case a1 `compare` a2 of
- LT -> true
- _ -> false
-
- infixl 4 >
-
- -- | Test whether one value is _strictly greater than_ another.
- (>) :: forall a. (Ord a) => a -> a -> Boolean
- (>) a1 a2 = case a1 `compare` a2 of
- GT -> true
- _ -> false
-
- infixl 4 <=
-
- -- | Test whether one value is _non-strictly less than_ another.
- (<=) :: forall a. (Ord a) => a -> a -> Boolean
- (<=) a1 a2 = case a1 `compare` a2 of
- GT -> false
- _ -> true
-
- infixl 4 >=
-
- -- | Test whether one value is _non-strictly greater than_ another.
- (>=) :: forall a. (Ord a) => a -> a -> Boolean
- (>=) a1 a2 = case a1 `compare` a2 of
- LT -> false
- _ -> true
-
- foreign import unsafeCompareImpl
- """
- function unsafeCompareImpl(lt) {
- return function(eq) {
- return function(gt) {
- return function(x) {
- return function(y) {
- return x < y ? lt : x > y ? gt : eq;
- };
- };
- };
- };
- }
- """ :: forall a. Ordering -> Ordering -> Ordering -> a -> a -> Ordering
-
- unsafeCompare :: forall a. a -> a -> Ordering
- unsafeCompare = unsafeCompareImpl LT EQ GT
-
- instance ordUnit :: Ord Unit where
- compare (Unit {}) (Unit {}) = EQ
-
- instance ordBoolean :: Ord Boolean where
- compare false false = EQ
- compare false true = LT
- compare true true = EQ
- compare true false = GT
-
- instance ordNumber :: Ord Number where
- compare = unsafeCompare
-
- instance ordString :: Ord String where
- compare = unsafeCompare
-
- instance ordArray :: (Ord a) => Ord [a] where
- compare [] [] = EQ
- compare [] _ = LT
- compare _ [] = GT
- compare (x:xs) (y:ys) = case compare x y of
- EQ -> compare xs ys
- other -> other
-
- infixl 10 .&.
- infixl 10 .|.
- infixl 10 .^.
-
- -- | The `Bits` type class identifies types which support bitwise operations.
- class Bits b where
- (.&.) :: b -> b -> b
- (.|.) :: b -> b -> b
- (.^.) :: b -> b -> b
- shl :: b -> Number -> b
- shr :: b -> Number -> b
- zshr :: b -> Number -> b
- complement :: b -> b
-
- foreign import numShl
- """
- function numShl(n1) {
- return function(n2) {
- return n1 << n2;
- };
- }
- """ :: Number -> Number -> Number
-
- foreign import numShr
- """
- function numShr(n1) {
- return function(n2) {
- return n1 >> n2;
- };
- }
- """ :: Number -> Number -> Number
-
- foreign import numZshr
- """
- function numZshr(n1) {
- return function(n2) {
- return n1 >>> n2;
- };
- }
- """ :: Number -> Number -> Number
-
- foreign import numAnd
- """
- function numAnd(n1) {
- return function(n2) {
- return n1 & n2;
- };
- }
- """ :: Number -> Number -> Number
-
- foreign import numOr
- """
- function numOr(n1) {
- return function(n2) {
- return n1 | n2;
- };
- }
- """ :: Number -> Number -> Number
-
- foreign import numXor
- """
- function numXor(n1) {
- return function(n2) {
- return n1 ^ n2;
- };
- }
- """ :: Number -> Number -> Number
-
- foreign import numComplement
- """
- function numComplement(n) {
- return ~n;
- }
- """ :: Number -> Number
-
- instance bitsNumber :: Bits Number where
- (.&.) = numAnd
- (.|.) = numOr
- (.^.) = numXor
- shl = numShl
- shr = numShr
- zshr = numZshr
- complement = numComplement
-
- infixr 2 ||
- infixr 3 &&
-
- -- | The `BoolLike` type class identifies types which support Boolean operations.
- -- |
- -- | `BoolLike` instances are required to satisfy the laws of a _Boolean algebra_.
- -- |
- class BoolLike b where
- (&&) :: b -> b -> b
- (||) :: b -> b -> b
- not :: b -> b
-
- foreign import boolAnd
- """
- function boolAnd(b1) {
- return function(b2) {
- return b1 && b2;
- };
- }
- """ :: Boolean -> Boolean -> Boolean
-
- foreign import boolOr
- """
- function boolOr(b1) {
- return function(b2) {
- return b1 || b2;
- };
- }
- """ :: Boolean -> Boolean -> Boolean
-
- foreign import boolNot
- """
- function boolNot(b) {
- return !b;
- }
- """ :: Boolean -> Boolean
-
- instance boolLikeBoolean :: BoolLike Boolean where
- (&&) = boolAnd
- (||) = boolOr
- not = boolNot
-
- infixr 5 <>
-
- -- | The `Semigroup` type class identifies an associative operation on a type.
- -- |
- -- | `Semigroup` instances are required to satisfy the following law:
- -- |
- -- | - Associativity: `(x <> y) <> z = x <> (y <> z)`
- -- |
- -- | For example, the `String` type is an instance of `Semigroup`, where `(<>)` is defined to be string concatenation.
- class Semigroup a where
- (<>) :: a -> a -> a
-
- foreign import concatString
- """
- function concatString(s1) {
- return function(s2) {
- return s1 + s2;
- };
- }
- """ :: String -> String -> String
-
- instance semigroupUnit :: Semigroup Unit where
- (<>) (Unit {}) (Unit {}) = Unit {}
-
- instance semigroupString :: Semigroup String where
- (<>) = concatString
-
- instance semigroupArr :: (Semigroup s') => Semigroup (s -> s') where
- (<>) f g = \x -> f x <> g x
-
- infixr 5 ++
-
- -- | `(++)` is an alias for `(<>)`.
- (++) :: forall s. (Semigroup s) => s -> s -> s
- (++) = (<>)
-
-module Data.Function where
-
- -- | The `on` function is used to change the domain of a binary operator.
- -- |
- -- | For example, we can create a function which compares two records based on the values of their `x` properties:
- -- |
- -- | ```purescript
- -- | compareX :: forall r. { x :: Number | r } -> { x :: Number | r } -> Ordering
- -- | compareX = compare `on` _.x
- -- | ```
- on :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c
- on f g x y = g x `f` g y
-
- -- | A function of zero arguments
- foreign import data Fn0 :: * -> *
-
- -- | A function of one argument
- foreign import data Fn1 :: * -> * -> *
-
- -- | A function of two arguments
- foreign import data Fn2 :: * -> * -> * -> *
-
- -- | A function of three arguments
- foreign import data Fn3 :: * -> * -> * -> * -> *
-
- -- | A function of four arguments
- foreign import data Fn4 :: * -> * -> * -> * -> * -> *
-
- -- | A function of five arguments
- foreign import data Fn5 :: * -> * -> * -> * -> * -> * -> *
-
- -- | A function of six arguments
- foreign import data Fn6 :: * -> * -> * -> * -> * -> * -> * -> *
-
- -- | A function of seven arguments
- foreign import data Fn7 :: * -> * -> * -> * -> * -> * -> * -> * -> *
-
- -- | A function of eight arguments
- foreign import data Fn8 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> *
-
- -- | A function of nine arguments
- foreign import data Fn9 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *
-
- -- | A function of ten arguments
- foreign import data Fn10 :: * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> * -> *
-
- -- | Create a function of no arguments
- foreign import mkFn0
- """
- function mkFn0(fn) {
- return function() {
- return fn({});
- };
- }
- """ :: forall a. (Unit -> a) -> Fn0 a
-
- -- | Create a function of one argument
- foreign import mkFn1
- """
- function mkFn1(fn) {
- return function(a) {
- return fn(a);
- };
- }
- """ :: forall a b. (a -> b) -> Fn1 a b
-
- -- | Create a function of two arguments from a curried function
- foreign import mkFn2
- """
- function mkFn2(fn) {
- return function(a, b) {
- return fn(a)(b);
- };
- }
- """ :: forall a b c. (a -> b -> c) -> Fn2 a b c
-
- -- | Create a function of three arguments from a curried function
- foreign import mkFn3
- """
- function mkFn3(fn) {
- return function(a, b, c) {
- return fn(a)(b)(c);
- };
- }
- """ :: forall a b c d. (a -> b -> c -> d) -> Fn3 a b c d
-
- -- | Create a function of four arguments from a curried function
- foreign import mkFn4
- """
- function mkFn4(fn) {
- return function(a, b, c, d) {
- return fn(a)(b)(c)(d);
- };
- }
- """ :: forall a b c d e. (a -> b -> c -> d -> e) -> Fn4 a b c d e
-
- -- | Create a function of five arguments from a curried function
- foreign import mkFn5
- """
- function mkFn5(fn) {
- return function(a, b, c, d, e) {
- return fn(a)(b)(c)(d)(e);
- };
- }
- """ :: forall a b c d e f. (a -> b -> c -> d -> e -> f) -> Fn5 a b c d e f
-
- -- | Create a function of six arguments from a curried function
- foreign import mkFn6
- """
- function mkFn6(fn) {
- return function(a, b, c, d, e, f) {
- return fn(a)(b)(c)(d)(e)(f);
- };
- }
- """ :: forall a b c d e f g. (a -> b -> c -> d -> e -> f -> g) -> Fn6 a b c d e f g
-
- -- | Create a function of seven arguments from a curried function
- foreign import mkFn7
- """
- function mkFn7(fn) {
- return function(a, b, c, d, e, f, g) {
- return fn(a)(b)(c)(d)(e)(f)(g);
- };
- }
- """ :: 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
-
- -- | Create a function of eight arguments from a curried function
- foreign import mkFn8
- """
- function mkFn8(fn) {
- return function(a, b, c, d, e, f, g, h) {
- return fn(a)(b)(c)(d)(e)(f)(g)(h);
- };
- }
- """ :: 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
-
- -- | Create a function of nine arguments from a curried function
- foreign import mkFn9
- """
- function mkFn9(fn) {
- return function(a, b, c, d, e, f, g, h, i) {
- return fn(a)(b)(c)(d)(e)(f)(g)(h)(i);
- };
- }
- """ :: 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
-
- -- | Create a function of ten arguments from a curried function
- foreign import mkFn10
- """
- function mkFn10(fn) {
- return function(a, b, c, d, e, f, g, h, i, j) {
- return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(j);
- };
- }
- """ :: 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
-
- -- | Apply a function of no arguments
- foreign import runFn0
- """
- function runFn0(fn) {
- return fn();
- }
- """ :: forall a. Fn0 a -> a
-
- -- | Apply a function of one argument
- foreign import runFn1
- """
- function runFn1(fn) {
- return function(a) {
- return fn(a);
- };
- }
- """ :: forall a b. Fn1 a b -> a -> b
-
- -- | Apply a function of two arguments
- foreign import runFn2
- """
- function runFn2(fn) {
- return function(a) {
- return function(b) {
- return fn(a, b);
- };
- };
- }
- """ :: forall a b c. Fn2 a b c -> a -> b -> c
-
- -- | Apply a function of three arguments
- foreign import runFn3
- """
- function runFn3(fn) {
- return function(a) {
- return function(b) {
- return function(c) {
- return fn(a, b, c);
- };
- };
- };
- }
- """ :: forall a b c d. Fn3 a b c d -> a -> b -> c -> d
-
- -- | Apply a function of four arguments
- foreign import runFn4
- """
- function runFn4(fn) {
- return function(a) {
- return function(b) {
- return function(c) {
- return function(d) {
- return fn(a, b, c, d);
- };
- };
- };
- };
- }
- """ :: forall a b c d e. Fn4 a b c d e -> a -> b -> c -> d -> e
-
- -- | Apply a function of five arguments
- foreign import runFn5
- """
- function runFn5(fn) {
- return function(a) {
- return function(b) {
- return function(c) {
- return function(d) {
- return function(e) {
- return fn(a, b, c, d, e);
- };
- };
- };
- };
- };
- }
- """ :: forall a b c d e f. Fn5 a b c d e f -> a -> b -> c -> d -> e -> f
-
- -- | Apply a function of six arguments
- foreign import runFn6
- """
- function runFn6(fn) {
- return function(a) {
- return function(b) {
- return function(c) {
- return function(d) {
- return function(e) {
- return function(f) {
- return fn(a, b, c, d, e, f);
- };
- };
- };
- };
- };
- };
- }
- """ :: forall a b c d e f g. Fn6 a b c d e f g -> a -> b -> c -> d -> e -> f -> g
-
- -- | Apply a function of seven arguments
- foreign import runFn7
- """
- function runFn7(fn) {
- return function(a) {
- return function(b) {
- return function(c) {
- return function(d) {
- return function(e) {
- return function(f) {
- return function(g) {
- return fn(a, b, c, d, e, f, g);
- };
- };
- };
- };
- };
- };
- };
- }
- """ :: 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
-
- -- | Apply a function of eight arguments
- foreign import runFn8
- """
- function runFn8(fn) {
- return function(a) {
- return function(b) {
- return function(c) {
- return function(d) {
- return function(e) {
- return function(f) {
- return function(g) {
- return function(h) {
- return fn(a, b, c, d, e, f, g, h);
- };
- };
- };
- };
- };
- };
- };
- };
- }
- """ :: 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
-
- -- | Apply a function of nine arguments
- foreign import runFn9
- """
- function runFn9(fn) {
- return function(a) {
- return function(b) {
- return function(c) {
- return function(d) {
- return function(e) {
- return function(f) {
- return function(g) {
- return function(h) {
- return function(i) {
- return fn(a, b, c, d, e, f, g, h, i);
- };
- };
- };
- };
- };
- };
- };
- };
- };
- }
- """ :: 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
-
- -- | Apply a function of ten arguments
- foreign import runFn10
- """
- function runFn10(fn) {
- return function(a) {
- return function(b) {
- return function(c) {
- return function(d) {
- return function(e) {
- return function(f) {
- return function(g) {
- return function(h) {
- return function(i) {
- return function(j) {
- return fn(a, b, c, d, e, f, g, h, i, j);
- };
- };
- };
- };
- };
- };
- };
- };
- };
- };
- }
- """ :: 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
-
-module Prelude.Unsafe where
-
- -- | Find the element of an array at the specified index.
- -- |
- -- | Note: this function can cause unpredictable failure at runtime if the index is out-of-bounds.
- foreign import unsafeIndex
- """
- function unsafeIndex(xs) {
- return function(n) {
- return xs[n];
- };
- }
- """ :: forall a. [a] -> Number -> a
-
-module Control.Monad.Eff
- ( Eff()
- , Pure()
- , runPure
- , untilE, whileE, forE, foreachE
- ) where
-
- -- | The `Eff` type constructor is used to represent _native_ effects.
- -- |
- -- | See [Handling Native Effects with the Eff Monad](https://github.com/purescript/purescript/wiki/Handling-Native-Effects-with-the-Eff-Monad) for more details.
- -- |
- -- | The first type parameter is a row of effects which represents the contexts in which a computation can be run, and the second type parameter is the return type.
- foreign import data Eff :: # ! -> * -> *
-
- foreign import returnE
- """
- function returnE(a) {
- return function() {
- return a;
- };
- }
- """ :: forall e a. a -> Eff e a
-
- foreign import bindE
- """
- function bindE(a) {
- return function(f) {
- return function() {
- return f(a())();
- };
- };
- }
- """ :: forall e a b. Eff e a -> (a -> Eff e b) -> Eff e b
-
- -- | The `Pure` type synonym represents _pure_ computations, i.e. ones in which all effects have been handled.
- -- |
- -- | The `runPure` function can be used to run pure computations and obtain their result.
- type Pure a = forall e. Eff e a
-
- -- | Run a pure computation and return its result.
- -- |
- -- | Note: since this function has a rank-2 type, it may cause problems to apply this function using the `$` operator. The recommended approach
- -- | is to use parentheses instead.
- foreign import runPure
- """
- function runPure(f) {
- return f();
- }
- """ :: forall a. Pure a -> a
-
- instance functorEff :: Functor (Eff e) where
- (<$>) = liftA1
-
- instance applyEff :: Apply (Eff e) where
- (<*>) = ap
-
- instance applicativeEff :: Applicative (Eff e) where
- pure = returnE
-
- instance bindEff :: Bind (Eff e) where
- (>>=) = bindE
-
- instance monadEff :: Monad (Eff e)
-
- -- | Loop until a condition becomes `true`.
- -- |
- -- | `untilE b` is an effectful computation which repeatedly runs the effectful computation `b`,
- -- | until its return value is `true`.
- foreign import untilE
- """
- function untilE(f) {
- return function() {
- while (!f());
- return {};
- };
- }
- """ :: forall e. Eff e Boolean -> Eff e Unit
-
- -- | Loop while a condition is `true`.
- -- |
- -- | `whileE b m` is effectful computation which runs the effectful computation `b`. If its result is
- -- | `true`, it runs the effectful computation `m` and loops. If not, the computation ends.
- foreign import whileE
- """
- function whileE(f) {
- return function(a) {
- return function() {
- while (f()) {
- a();
- }
- return {};
- };
- };
- }
- """ :: forall e a. Eff e Boolean -> Eff e a -> Eff e Unit
-
- -- | Loop over a consecutive collection of numbers.
- -- |
- -- | `forE lo hi f` runs the computation returned by the function `f` for each of the inputs
- -- | between `lo` (inclusive) and `hi` (exclusive).
- foreign import forE
- """
- function forE(lo) {
- return function(hi) {
- return function(f) {
- return function() {
- for (var i = lo; i < hi; i++) {
- f(i)();
- }
- };
- };
- };
- }
- """ :: forall e. Number -> Number -> (Number -> Eff e Unit) -> Eff e Unit
-
- -- | Loop over an array of values.
- -- |
- -- | `foreach xs f` runs the computation returned by the function `f` for each of the inputs `xs`.
- foreign import foreachE
- """
- function foreachE(as) {
- return function(f) {
- return function() {
- for (var i = 0; i < as.length; i++) {
- f(as[i])();
- }
- };
- };
- }
- """ :: forall e a. [a] -> (a -> Eff e Unit) -> Eff e Unit
-
-module Control.Monad.Eff.Unsafe where
-
- import Control.Monad.Eff
-
- -- | Change the type of an effectful computation, allowing it to be run in another context.
- -- |
- -- | Note: use of this function can result in arbitrary side-effects.
- foreign import unsafeInterleaveEff
- """
- function unsafeInterleaveEff(f) {
- return f;
- }
- """ :: forall eff1 eff2 a. Eff eff1 a -> Eff eff2 a
-
-module Debug.Trace where
-
- import Control.Monad.Eff
-
- -- | The `Trace` effect represents those computations which write to the console.
- foreign import data Trace :: !
-
- -- | Write a `String` to the console.
- foreign import trace
- """
- function trace(s) {
- return function() {
- console.log(s);
- return {};
- };
- }
- """ :: forall r. String -> Eff (trace :: Trace | r) Unit
-
- -- | Write a value to the console, using its `Show` instance to produce a `String`.
- print :: forall a r. (Show a) => a -> Eff (trace :: Trace | r) Unit
- print o = trace (show o)
-
-module Control.Monad.ST where
-
- import Control.Monad.Eff
-
- -- | The `ST` effect represents _local mutation_, i.e. mutation which does not "escape" into the surrounding computation.
- -- |
- -- | An `ST` computation is parameterized by a phantom type which is used to restrict the set of reference cells it is allowed to access.
- -- |
- -- | The `runST` function can be used to handle the `ST` effect.
- foreign import data ST :: * -> !
-
- -- | The type `STRef s a` represents a mutable reference holding a value of type `a`, which can be used with the `ST s` effect.
- foreign import data STRef :: * -> * -> *
-
- -- | Create a new mutable reference.
- foreign import newSTRef
- """
- function newSTRef(val) {
- return function() {
- return { value: val };
- };
- }
- """ :: forall a h r. a -> Eff (st :: ST h | r) (STRef h a)
-
- -- | Read the current value of a mutable reference.
- foreign import readSTRef
- """
- function readSTRef(ref) {
- return function() {
- return ref.value;
- };
- }
- """ :: forall a h r. STRef h a -> Eff (st :: ST h | r) a
-
- -- | Modify the value of a mutable reference by applying a function to the current value.
- foreign import modifySTRef
- """
- function modifySTRef(ref) {
- return function(f) {
- return function() {
- return ref.value = f(ref.value);
- };
- };
- }
- """ :: forall a h r. STRef h a -> (a -> a) -> Eff (st :: ST h | r) a
-
- -- | Set the value of a mutable reference.
- foreign import writeSTRef
- """
- function writeSTRef(ref) {
- return function(a) {
- return function() {
- return ref.value = a;
- };
- };
- }
- """ :: forall a h r. STRef h a -> a -> Eff (st :: ST h | r) a
-
- -- | Run an `ST` computation.
- -- |
- -- | Note: the type of `runST` uses a rank-2 type to constrain the phantom type `s`, such that the computation must not leak any mutable references
- -- | to the surrounding computation.
- -- |
- -- | It may cause problems to apply this function using the `$` operator. The recommended approach is to use parentheses instead.
- foreign import runST
- """
- function runST(f) {
- return f;
- }
- """ :: forall a r. (forall h. Eff (st :: ST h | r) a) -> Eff r a
-
- -- | A convenience function which combines `runST` with `runPure`, which can be used when the only required effect is `ST`.
- -- |
- -- | Note: since this function has a rank-2 type, it may cause problems to apply this function using the `$` operator. The recommended approach
- -- | is to use parentheses instead.
- pureST :: forall a. (forall h r. Eff (st :: ST h | r) a) -> a
- pureST st = runPure (runST st)
diff --git a/psc-bundle/Main.hs b/psc-bundle/Main.hs
new file mode 100644
index 0000000..f939e2f
--- /dev/null
+++ b/psc-bundle/Main.hs
@@ -0,0 +1,621 @@
+-----------------------------------------------------------------------------
+--
+-- Module : psc-bundle
+-- Copyright : (c) Phil Freeman 2015
+-- License : MIT
+--
+-- Maintainer : Phil Freeman <paf31@cantab.net>
+-- Stability : experimental
+-- Portability :
+--
+-- | Bundles compiled PureScript modules for the browser.
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Main (main) where
+
+import Data.List (nub)
+import Data.Maybe (mapMaybe, catMaybes)
+import Data.Traversable (for)
+import Data.Generics (everything, everywhere, mkQ, mkT)
+import Data.Graph
+import Data.Version (showVersion)
+
+import qualified Data.Set as S
+
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Error.Class
+import Control.Monad.Trans.Except
+import Control.Monad.IO.Class
+
+import System.FilePath (takeFileName, takeDirectory)
+import System.FilePath.Glob (glob)
+import System.Exit (exitFailure)
+import System.IO (stderr, hPutStrLn)
+import System.Directory (createDirectoryIfMissing)
+
+import Language.JavaScript.Parser
+
+import Options.Applicative as Opts
+
+import qualified Paths_purescript as Paths
+
+-- | The type of error messages. We separate generation and rendering of errors using a data
+-- type, in case we need to match on error types later.
+data ErrorMessage
+ = UnsupportedModulePath String
+ | InvalidTopLevel
+ | UnableToParseModule
+ | UnsupportedExport
+ | ErrorInFile FilePath ErrorMessage
+ deriving Show
+
+-- | Modules are either "regular modules" (i.e. those generated by psc-make) or foreign modules.
+data ModuleType
+ = Regular
+ | Foreign
+ deriving (Show, Eq, Ord)
+
+-- | A module is identified by its module name and its type.
+data ModuleIdentifier = ModuleIdentifier String ModuleType deriving (Show, Eq, Ord)
+
+moduleName :: ModuleIdentifier -> String
+moduleName (ModuleIdentifier name _) = name
+
+-- | A piece of code is identified by its module and its name. These keys are used to label vertices
+-- in the dependency graph.
+type Key = (ModuleIdentifier, String)
+
+-- | An export is either a "regular export", which exports a name from the regular module we are in,
+-- or a reexport of a declaration in the corresponding foreign module.
+--
+-- Regular exports are labelled, since they might re-export an operator with another name.
+data ExportType
+ = RegularExport String
+ | ForeignReexport
+ deriving (Show, Eq, Ord)
+
+-- | There are four types of module element we are interested in:
+--
+-- 1) Require statements
+-- 2) Member declarations
+-- 3) Export lists
+-- 4) Everything else
+--
+-- Each is labelled with the original AST node which generated it, so that we can dump it back
+-- into the output during codegen.
+data ModuleElement
+ = Require JSNode String ModuleIdentifier
+ | Member JSNode Bool String [JSNode] [Key]
+ | ExportsList [(ExportType, String, JSNode, [Key])]
+ | Other JSNode
+ deriving Show
+
+-- | A module is just a list of elements of the types listed above.
+data Module = Module ModuleIdentifier [ModuleElement] deriving Show
+
+-- | Command line options.
+data Options = Options
+ { optionsInputFiles :: [FilePath]
+ , optionsOutputFile :: Maybe FilePath
+ , optionsEntryPoints :: [String]
+ , optionsMainModule :: Maybe String
+ , optionsNamespace :: String
+ } deriving Show
+
+-- | Prepare an error message for consumption by humans.
+printErrorMessage :: ErrorMessage -> [String]
+printErrorMessage (UnsupportedModulePath s) =
+ [ "A CommonJS module has an unsupported name (" ++ show s ++ ")."
+ , "The following file names are supported:"
+ , " 1) index.js (psc-make native modules)"
+ , " 2) foreign.js (psc-make foreign modules)"
+ ]
+printErrorMessage InvalidTopLevel =
+ [ "Expected a list of source elements at the top level." ]
+printErrorMessage UnableToParseModule =
+ [ "The module could not be parsed." ]
+printErrorMessage UnsupportedExport =
+ [ "An export was unsupported. Exports can be defined in one of two ways: "
+ , " 1) exports.name = ..."
+ , " 2) exports = { ... }"
+ ]
+printErrorMessage (ErrorInFile filename e) =
+ ("Error in file " ++ show filename ++ ":")
+ : ""
+ : map (" " ++) (printErrorMessage e)
+
+-- | Unpack the node inside a JSNode. This is useful when pattern matching.
+node :: JSNode -> Node
+node (NN n) = n
+node (NT n _ _) = n
+
+-- | Given a filename, assuming it is in the correct place on disk, infer a ModuleIdentifier.
+guessModuleIdentifier :: (Applicative m, MonadError ErrorMessage m) => FilePath -> m ModuleIdentifier
+guessModuleIdentifier filename = ModuleIdentifier (takeFileName (takeDirectory filename)) <$> (guessModuleType (takeFileName filename))
+ where
+ guessModuleType "index.js" = pure Regular
+ guessModuleType "foreign.js" = pure Foreign
+ guessModuleType name = throwError $ UnsupportedModulePath name
+
+-- | Calculate the ModuleIdentifier which a require(...) statement imports.
+checkImportPath :: String -> ModuleIdentifier -> S.Set String -> Maybe ModuleIdentifier
+checkImportPath "./foreign" m _ =
+ Just (ModuleIdentifier (moduleName m) Foreign)
+checkImportPath name _ names
+ | name `S.member` names = Just (ModuleIdentifier name Regular)
+checkImportPath _ _ _ = Nothing
+
+-- | Compute the dependencies of all elements in a module, and add them to the tree.
+--
+-- Members and exports can have dependencies. A dependency is of one of the following forms:
+--
+-- 1) module.name or member["name"]
+--
+-- where module was imported using
+--
+-- var module = require("Module.Name");
+--
+-- 2) name
+--
+-- where name is the name of a member defined in the current module.
+withDeps :: Module -> Module
+withDeps (Module modulePath es) = Module modulePath (map expandDeps es)
+ where
+ -- | Collects all modules which are imported, so that we can identify dependencies of the first type.
+ imports :: [(String, ModuleIdentifier)]
+ imports = mapMaybe toImport es
+ where
+ toImport :: ModuleElement -> Maybe (String, ModuleIdentifier)
+ toImport (Require _ nm mid) = Just (nm, mid)
+ toImport _ = Nothing
+
+ -- | Collects all member names in scope, so that we can identify dependencies of the second type.
+ boundNames :: [String]
+ boundNames = mapMaybe toBoundName es
+ where
+ toBoundName :: ModuleElement -> Maybe String
+ toBoundName (Member _ _ nm _ _) = Just nm
+ toBoundName _ = Nothing
+
+ -- | Calculate dependencies and add them to the current element.
+ expandDeps :: ModuleElement -> ModuleElement
+ expandDeps (Member n f nm decl _) = Member n f nm decl (nub (concatMap (dependencies modulePath) decl))
+ expandDeps (ExportsList exps) = ExportsList (map expand exps)
+ where
+ expand (ty, nm, n1, _) = (ty, nm, n1, nub (dependencies modulePath n1))
+ expandDeps other = other
+
+ dependencies :: ModuleIdentifier -> JSNode -> [(ModuleIdentifier, String)]
+ dependencies m = everything (++) (mkQ [] toReference)
+ where
+ toReference :: Node -> [(ModuleIdentifier, String)]
+ toReference (JSMemberDot [ mn ] _ nm)
+ | JSIdentifier mn' <- node mn
+ , JSIdentifier nm' <- node nm
+ , Just mid <- lookup mn' imports
+ = [(mid, nm')]
+ toReference (JSMemberSquare [ mn ] _ nm _)
+ | JSIdentifier mn' <- node mn
+ , JSExpression [ s ] <- node nm
+ , JSStringLiteral _ nm' <- node s
+ , Just mid <- lookup mn' imports
+ = [(mid, nm')]
+ toReference (JSIdentifier nm)
+ | nm `elem` boundNames
+ = [(m, nm)]
+ toReference _ = []
+
+-- | Attempt to create a Module from a Javascript AST.
+--
+-- Each type of module element is matched using pattern guards, and everything else is bundled into the
+-- Other constructor.
+toModule :: forall m. (Applicative m, MonadError ErrorMessage m) => S.Set String -> ModuleIdentifier -> JSNode -> m Module
+toModule mids mid top
+ | JSSourceElementsTop ns <- node top = Module mid <$> mapM toModuleElement ns
+ | otherwise = throwError InvalidTopLevel
+ where
+ toModuleElement :: JSNode -> m ModuleElement
+ toModuleElement n
+ | JSVariables var [ varIntro ] _ <- node n
+ , JSLiteral "var" <- node var
+ , JSVarDecl impN [ eq, req, impP ] <- node varIntro
+ , JSIdentifier importName <- node impN
+ , JSLiteral "=" <- node eq
+ , JSIdentifier "require" <- node req
+ , JSArguments _ [ impS ] _ <- node impP
+ , JSStringLiteral _ importPath <- node impS
+ , Just importPath' <- checkImportPath importPath mid mids
+ = pure (Require n importName importPath')
+ toModuleElement n
+ | JSVariables var [ varIntro ] _ <- node n
+ , JSLiteral "var" <- node var
+ , JSVarDecl declN (eq : decl) <- node varIntro
+ , JSIdentifier name <- node declN
+ , JSLiteral "=" <- node eq
+ = pure (Member n False name decl [])
+ toModuleElement n
+ | JSExpression (e : op : decl) <- node n
+ , Just name <- accessor (node e)
+ , JSOperator eq <- node op
+ , JSLiteral "=" <- node eq
+ = pure (Member n True name decl [])
+ where
+ accessor :: Node -> Maybe String
+ accessor (JSMemberDot [ exports ] _ nm)
+ | JSIdentifier "exports" <- node exports
+ , JSIdentifier name <- node nm
+ = Just name
+ accessor (JSMemberSquare [ exports ] _ nm _)
+ | JSIdentifier "exports" <- node exports
+ , JSExpression [e] <- node nm
+ , JSStringLiteral _ name <- node e
+ = Just name
+ accessor _ = Nothing
+ toModuleElement n
+ | JSExpression (mnExp : op : obj: _) <- node n
+ , JSMemberDot [ mn ] _ e <- node mnExp
+ , JSIdentifier "module" <- node mn
+ , JSIdentifier "exports" <- node e
+ , JSOperator eq <- node op
+ , JSLiteral "=" <- node eq
+ , JSObjectLiteral _ props _ <- node obj
+ = ExportsList <$> mapM toExport (filter (not . isSeparator) (map node props))
+ where
+ toExport :: Node -> m (ExportType, String, JSNode, [Key])
+ toExport (JSPropertyNameandValue name _ [val] ) =
+ (,,val,[]) <$> exportType (node val)
+ <*> extractLabel (node name)
+ toExport _ = throwError UnsupportedExport
+
+ exportType :: Node -> m ExportType
+ exportType (JSMemberDot [f] _ _)
+ | JSIdentifier "$foreign" <- node f
+ = pure ForeignReexport
+ exportType (JSMemberSquare [f] _ _ _)
+ | JSIdentifier "$foreign" <- node f
+ = pure ForeignReexport
+ exportType (JSIdentifier s) = pure (RegularExport s)
+ exportType _ = throwError UnsupportedExport
+
+ extractLabel :: Node -> m String
+ extractLabel (JSStringLiteral _ nm) = pure nm
+ extractLabel (JSIdentifier nm) = pure nm
+ extractLabel _ = throwError UnsupportedExport
+
+ isSeparator :: Node -> Bool
+ isSeparator (JSLiteral ",") = True
+ isSeparator _ = False
+ toModuleElement other = pure (Other other)
+
+-- | Eliminate unused code based on the specified entry point set.
+compile :: [Module] -> [ModuleIdentifier] -> [Module]
+compile modules [] = modules
+compile modules entryPoints = filteredModules
+ where
+ (graph, _, vertexFor) = graphFromEdges verts
+
+ -- | The vertex set
+ verts :: [(ModuleElement, Key, [Key])]
+ verts = do
+ Module mid els <- modules
+ concatMap (toVertices mid) els
+ where
+ -- | Create a set of vertices for a module element.
+ --
+ -- Some special cases worth commenting on:
+ --
+ -- 1) Regular exports which simply export their own name do not count as dependencies.
+ -- Regular exports which rename and reexport an operator do count, however.
+ --
+ -- 2) Require statements don't contribute towards dependencies, since they effectively get
+ -- inlined wherever they are used inside other module elements.
+ toVertices :: ModuleIdentifier -> ModuleElement -> [(ModuleElement, Key, [Key])]
+ toVertices p m@(Member _ _ nm _ deps) = [(m, (p, nm), deps)]
+ toVertices p m@(ExportsList exps) = mapMaybe toVertex exps
+ where
+ toVertex (ForeignReexport, nm, _, ks) = Just (m, (p, nm), ks)
+ toVertex (RegularExport nm, nm1, _, ks) | nm /= nm1 = Just (m, (p, nm1), ks)
+ toVertex _ = Nothing
+ toVertices _ _ = []
+
+ -- | The set of vertices whose connected components we are interested in keeping.
+ entryPointVertices :: [Vertex]
+ entryPointVertices = catMaybes $ do
+ (_, k@(mid, _), _) <- verts
+ guard $ mid `elem` entryPoints
+ return (vertexFor k)
+
+ -- | The set of vertices reachable from an entry point
+ reachableSet :: S.Set Vertex
+ reachableSet = S.fromList (concatMap (reachable graph) entryPointVertices)
+
+ filteredModules :: [Module]
+ filteredModules = map filterUsed modules
+ where
+ filterUsed :: Module -> Module
+ filterUsed (Module mid ds) = Module mid (map filterExports (go ds))
+ where
+ go :: [ModuleElement] -> [ModuleElement]
+ go [] = []
+ go (d : Other semi : rest)
+ | JSLiteral ";" <- node semi
+ , not (isDeclUsed d)
+ = go rest
+ go (d : rest)
+ | not (isDeclUsed d) = go rest
+ | otherwise = d : go rest
+
+ -- | Filter out the exports for members which aren't used.
+ filterExports :: ModuleElement -> ModuleElement
+ filterExports (ExportsList exps) = ExportsList (filter (\(_, nm, _, _) -> isKeyUsed (mid, nm)) exps)
+ filterExports me = me
+
+ isDeclUsed :: ModuleElement -> Bool
+ isDeclUsed (Member _ _ nm _ _) = isKeyUsed (mid, nm)
+ isDeclUsed _ = True
+
+ isKeyUsed :: Key -> Bool
+ isKeyUsed k
+ | Just me <- vertexFor k = me `S.member` reachableSet
+ | otherwise = False
+
+-- | Topologically sort the module dependency graph, so that when we generate code, modules can be
+-- defined in the right order.
+sortModules :: [Module] -> [Module]
+sortModules modules = map (\v -> case nodeFor v of (n, _, _) -> n) (reverse (topSort graph))
+ where
+ (graph, nodeFor, _) = graphFromEdges $ do
+ m@(Module mid els) <- modules
+ return (m, mid, mapMaybe getKey els)
+
+ getKey :: ModuleElement -> Maybe ModuleIdentifier
+ getKey (Require _ _ mi) = Just mi
+ getKey _ = Nothing
+
+-- | A module is empty if it contains no exported members (in other words,
+-- if the only things left after dead code elimination are module imports and
+-- "other" foreign code).
+--
+-- If a module is empty, we don't want to generate code for it.
+isModuleEmpty :: Module -> Bool
+isModuleEmpty (Module _ els) = all isElementEmpty els
+ where
+ isElementEmpty :: ModuleElement -> Bool
+ isElementEmpty (ExportsList exps) = null exps
+ isElementEmpty (Require _ _ _) = True
+ isElementEmpty (Other _) = True
+ isElementEmpty _ = False
+
+-- | Generate code for a set of modules, including a call to main().
+--
+-- Modules get defined on the global PS object, as follows:
+--
+-- var PS = { };
+-- (function(exports) {
+-- ...
+-- })(PS["Module.Name"] = PS["Module.Name"] || {});
+--
+-- In particular, a module and its foreign imports share the same namespace inside PS.
+-- This saves us from having to generate unique names for a module and its foreign imports,
+-- and is safe since a module shares a namespace with its foreign imports in PureScript as well
+-- (so there is no way to have overlaps in code generated by psc-make).
+codeGen :: Options -> [Module] -> String
+codeGen Options{..} ms = renderToString (NN (JSSourceElementsTop (prelude ++ concatMap moduleToJS ms ++ maybe [] runMain optionsMainModule)))
+ where
+ moduleToJS :: Module -> [JSNode]
+ moduleToJS (Module mn ds) = wrap (moduleName mn) (indent (concatMap declToJS ds))
+ where
+ declToJS :: ModuleElement -> [JSNode]
+ declToJS (Member n _ _ _ _) = [n]
+ declToJS (Other n) = [n]
+ declToJS (Require _ nm req) =
+ [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n " ])
+ [ NN (JSVarDecl (sp (JSIdentifier nm))
+ [ sp (JSLiteral "=")
+ , moduleReference sp (moduleName req)
+ ])
+ ]
+ (nt (JSLiteral ";"))) ]
+ declToJS (ExportsList exps) = map toExport exps
+
+ where
+ toExport :: (ExportType, String, JSNode, [Key]) -> JSNode
+ toExport (_, nm, val, _) =
+ NN (JSExpression [ NN (JSMemberSquare [ NT (JSIdentifier "exports") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n " ] ]
+ (nt (JSLiteral "["))
+ (NN (JSExpression [ nt (JSStringLiteral '"' nm) ]))
+ (nt (JSLiteral "]")))
+ , NN (JSOperator (sp (JSLiteral "=")))
+ , reindent val
+ , nt (JSLiteral ";")
+ ])
+
+ reindent :: JSNode -> JSNode
+ reindent (NT n _ _) = sp n
+ reindent nn = nn
+
+ indent :: [JSNode] -> [JSNode]
+ indent = everywhere (mkT squash)
+ where
+ squash (NT n pos ann) = NT n (keepCol pos) (map splat ann)
+ squash nn = nn
+
+ splat (CommentA pos s) = CommentA (keepCol pos) s
+ splat (WhiteSpace pos w) = WhiteSpace (keepCol pos) w
+ splat ann = ann
+
+ keepCol (TokenPn _ _ c) = TokenPn 0 0 (c + 2)
+
+ prelude :: [JSNode]
+ prelude =
+ [ NN (JSVariables (NT (JSLiteral "var") tokenPosnEmpty [ CommentA tokenPosnEmpty ("// Generated by psc-bundle " ++ showVersion Paths.version)
+ , WhiteSpace tokenPosnEmpty "\n"
+ ])
+ [ NN (JSVarDecl (sp (JSIdentifier optionsNamespace))
+ [ sp (JSLiteral "=")
+ , NN (JSObjectLiteral (sp (JSLiteral "{"))
+ []
+ (sp (JSLiteral "}")))
+ ])
+ ]
+ (nt (JSLiteral ";")))
+ , lf
+ ]
+
+ moduleReference :: (Node -> JSNode) -> String -> JSNode
+ moduleReference f mn =
+ NN (JSMemberSquare [ f (JSIdentifier optionsNamespace) ]
+ (nt (JSLiteral "["))
+ (NN (JSExpression [ nt (JSStringLiteral '"' mn) ]))
+ (nt (JSLiteral "]")))
+
+ wrap :: String -> [JSNode] -> [JSNode]
+ wrap mn ds =
+ [ NN (JSExpression [ NN (JSExpressionParen (nt (JSLiteral "("))
+ (NN (JSExpression [ NN (JSFunctionExpression (nt (JSLiteral "function"))
+ []
+ (nt (JSLiteral "(") ) [nt (JSIdentifier "exports")] (nt (JSLiteral ")"))
+ (NN (JSBlock [sp (JSLiteral "{")]
+ (lf : ds)
+ [nl (JSLiteral "}")])))]))
+ (nt (JSLiteral ")")))
+ , NN (JSArguments (nt (JSLiteral "("))
+ [ NN (JSExpression [ moduleReference nt mn
+ , NN (JSOperator (sp (JSLiteral "=")))
+ , NN (JSExpressionBinary "||"
+ [ moduleReference sp mn ]
+ (sp (JSLiteral "||"))
+ [ emptyObj ])
+ ])
+ ]
+ (nt (JSLiteral ")")))
+ ])
+ , nt (JSLiteral ";")
+ , lf
+ ]
+ where
+ emptyObj = NN (JSObjectLiteral (sp (JSLiteral "{")) [] (nt (JSLiteral "}")))
+
+ runMain :: String -> [JSNode]
+ runMain mn =
+ [ NN (JSExpression [ NN (JSMemberDot [ NN (JSMemberSquare [ nl (JSIdentifier optionsNamespace) ]
+ (nt (JSLiteral "["))
+ (NN (JSExpression [ nt (JSStringLiteral '"' mn) ]))
+ (nt (JSLiteral "]")))
+ ]
+ (nt (JSLiteral "."))
+ (nt (JSIdentifier "main")))
+ , NN (JSArguments (nt (JSLiteral "(")) [] (nt (JSLiteral ")")))
+ ])
+ , nt (JSLiteral ";")
+ ]
+
+ nt :: Node -> JSNode
+ nt n = NT n tokenPosnEmpty []
+
+ lf :: JSNode
+ lf = NT (JSLiteral "") tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]
+
+ sp :: Node -> JSNode
+ sp n = NT n tokenPosnEmpty [ WhiteSpace tokenPosnEmpty " " ]
+
+ nl :: Node -> JSNode
+ nl n = NT n tokenPosnEmpty [ WhiteSpace tokenPosnEmpty "\n" ]
+
+-- | The main application function.
+-- This function parses the input files, performs dead code elimination, filters empty modules
+-- and generates and prints the final Javascript bundle.
+app :: forall m. (Applicative m, MonadError ErrorMessage m, MonadIO m) => Options -> m String
+app opts@Options{..} = do
+ inputFiles <- concat <$> mapM (liftIO . glob) optionsInputFiles
+ when (null inputFiles) . liftIO $ do
+ hPutStrLn stderr "psc-bundle: No input files."
+ exitFailure
+ input <- for inputFiles $ \filename -> do
+ js <- liftIO (readFile filename)
+ ast <- fromRight (parse js filename)
+ mid <- guessModuleIdentifier filename
+ return (mid, ast)
+
+ let mids = S.fromList (map (moduleName . fst) input)
+
+ modules <- mapM (fmap withDeps . uncurry (toModule mids)) input
+
+ let compiled = compile modules (map (`ModuleIdentifier` Regular) optionsEntryPoints)
+ sorted = sortModules (filter (not . isModuleEmpty) compiled)
+
+ return (codeGen opts sorted)
+
+ where
+ fromRight :: Either a b -> m b
+ fromRight (Right b) = pure b
+ fromRight (Left _) = throwError UnableToParseModule
+
+-- | Command line options parser.
+options :: Parser Options
+options = Options <$> some inputFile
+ <*> optional outputFile
+ <*> many entryPoint
+ <*> optional mainModule
+ <*> namespace
+ where
+ inputFile :: Parser FilePath
+ inputFile = strArgument $
+ metavar "FILE"
+ <> help "The input .js file(s)"
+
+ outputFile :: Parser FilePath
+ outputFile = strOption $
+ short 'o'
+ <> long "output"
+ <> help "The output .js file"
+
+ entryPoint :: Parser String
+ entryPoint = strOption $
+ short 'm'
+ <> long "module"
+ <> help "Entry point module name(s). All code which is not a transitive dependency of an entry point module will be removed."
+
+ mainModule :: Parser String
+ mainModule = strOption $
+ long "main"
+ <> help "Generate code to run the main method in the specified module."
+
+ namespace :: Parser String
+ namespace = strOption $
+ short 'n'
+ <> long "namespace"
+ <> Opts.value "PS"
+ <> showDefault
+ <> help "Specify the namespace that PureScript modules will be exported to when running in the browser."
+
+-- | Make it go.
+main :: IO ()
+main = do
+ opts <- execParser (info (version <*> helper <*> options) infoModList)
+ output <- runExceptT (app opts)
+ case output of
+ Left err -> do
+ hPutStrLn stderr (unlines (printErrorMessage err))
+ exitFailure
+ Right js ->
+ case optionsOutputFile opts of
+ Just outputFile -> do
+ createDirectoryIfMissing True (takeDirectory outputFile)
+ writeFile outputFile js
+ Nothing -> putStrLn js
+ where
+ infoModList = fullDesc <> headerInfo <> footerInfo
+ headerInfo = header "psc-bundle - Bundles compiled PureScript modules for the browser"
+ footerInfo = footer $ "psc-bundle " ++ showVersion Paths.version
+
+ version :: Parser (a -> a)
+ version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
diff --git a/psc-docs/Main.hs b/psc-docs/Main.hs
index 9255880..a82a8f3 100644
--- a/psc-docs/Main.hs
+++ b/psc-docs/Main.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TupleSections #-}
----------------------------------------------------------------------------
--
-- Module : Main
@@ -15,223 +16,135 @@
module Main where
import Control.Applicative
-import Control.Monad
+import Control.Arrow (first, second)
+import Control.Category ((>>>))
import Control.Monad.Writer
-import Control.Arrow (first)
+import Data.Function (on)
import Data.List
import Data.Maybe (fromMaybe)
+import Data.Tuple (swap)
import Data.Version (showVersion)
-import Data.Foldable (traverse_)
import Options.Applicative
+import qualified Text.PrettyPrint.ANSI.Leijen as PP
import qualified Language.PureScript as P
import qualified Paths_purescript as Paths
-import System.Exit (exitSuccess, exitFailure)
+import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr)
+import System.Directory (createDirectoryIfMissing)
+import System.FilePath (takeDirectory)
+import System.FilePath.Glob (glob)
import Etags
import Ctags
+import qualified Language.PureScript.Docs as D
+import qualified Language.PureScript.Docs.AsMarkdown as D
-- Available output formats
data Format = Markdown -- Output documentation in Markdown format
| Ctags -- Output ctags symbol index suitable for use with vi
| Etags -- Output etags symbol index suitable for use with emacs
+ deriving (Show, Eq, Ord)
+
+-- | Available methods of outputting Markdown documentation
+data DocgenOutput
+ = EverythingToStdOut
+ | ToStdOut [P.ModuleName]
+ | ToFiles [(P.ModuleName, FilePath)]
+ deriving (Show)
data PSCDocsOptions = PSCDocsOptions
{ pscdFormat :: Format
, pscdInputFiles :: [FilePath]
+ , pscdDocgen :: DocgenOutput
}
+ deriving (Show)
docgen :: PSCDocsOptions -> IO ()
-docgen (PSCDocsOptions fmt input) = do
- e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)
- case e of
- Left err -> do
- hPutStrLn stderr $ show err
- exitFailure
- Right ms -> do
- case fmt of
- Markdown -> putStrLn . runDocs $ renderModules (map snd ms)
- Etags -> ldump $ dumpEtags $ pairs ms
- Ctags -> ldump $ dumpCtags $ pairs ms
- exitSuccess
- where pairs :: [(Maybe String, m)] -> [(String, m)]
- pairs = map (\(k,m) -> (fromMaybe "" k,m))
- ldump :: [String] -> IO ()
- ldump = mapM_ putStrLn
-
-parseFile :: FilePath -> IO (FilePath, String)
-parseFile input = (,) input <$> readFile input
-
-type Docs = Writer [String] ()
-
-runDocs :: Docs -> String
-runDocs = unlines . execWriter
-
-spacer :: Docs
-spacer = tell [""]
-
-headerLevel :: Int -> String -> Docs
-headerLevel level hdr = tell [replicate level '#' ++ ' ' : hdr]
-
-withIndent :: Int -> Docs -> Docs
-withIndent indent = censor (map (replicate indent ' ' ++ ))
-
-atIndent :: Int -> String -> Docs
-atIndent indent text =
- let ls = lines text in
- withIndent indent (tell ls)
-
-fenced :: String -> Docs
-fenced text = fencedBlock (tell $ lines text)
-
-fencedBlock :: Docs -> Docs
-fencedBlock inner = do
- tell ["``` purescript"]
- inner
- tell ["```"]
-
-ticks :: String -> String
-ticks = ("`" ++) . (++ "`")
-
-renderModules :: [P.Module] -> Docs
-renderModules ms = do
- headerLevel 1 "Module Documentation"
- spacer
- mapM_ renderModule ms
-
-renderModule :: P.Module -> Docs
-renderModule mdl@(P.Module coms moduleName _ exps) = do
- headerLevel 2 $ "Module " ++ P.runModuleName moduleName
- spacer
- unless (null coms) $ do
- renderComments coms
- spacer
- renderTopLevel exps (P.exportedDeclarations mdl)
- spacer
-
-renderTopLevel :: Maybe [P.DeclarationRef] -> [P.Declaration] -> Docs
-renderTopLevel exps decls = forM_ decls $ \decl ->
- when (canRenderDecl decl) $ do
- traverse_ (headerLevel 4) (ticks `fmap` getDeclarationTitle decl)
- spacer
- renderDeclaration exps decl
- spacer
-
-renderTypeclassImage :: P.ModuleName -> Docs
-renderTypeclassImage name =
- let name' = P.runModuleName name
- in tell ["![" ++ name' ++ "](images/" ++ name' ++ ".png)"]
-
-getDeclarationTitle :: P.Declaration -> Maybe String
-getDeclarationTitle (P.TypeDeclaration name _) = Just (show name)
-getDeclarationTitle (P.ExternDeclaration _ name _ _) = Just (show name)
-getDeclarationTitle (P.DataDeclaration _ name _ _) = Just (show name)
-getDeclarationTitle (P.ExternDataDeclaration name _) = Just (show name)
-getDeclarationTitle (P.TypeSynonymDeclaration name _ _) = Just (show name)
-getDeclarationTitle (P.TypeClassDeclaration name _ _ _) = Just (show name)
-getDeclarationTitle (P.TypeInstanceDeclaration name _ _ _ _) = Just (show name)
-getDeclarationTitle (P.PositionedDeclaration _ _ d) = getDeclarationTitle d
-getDeclarationTitle _ = Nothing
-
-renderDeclaration :: Maybe [P.DeclarationRef] -> P.Declaration -> Docs
-renderDeclaration _ (P.TypeDeclaration ident ty) =
- fenced $ show ident ++ " :: " ++ prettyPrintType' ty
-renderDeclaration _ (P.ExternDeclaration _ ident _ ty) =
- fenced $ show ident ++ " :: " ++ prettyPrintType' ty
-renderDeclaration exps (P.DataDeclaration dtype name args ctors) = do
- let
- typeApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
- typeName = prettyPrintType' typeApp
- exported = filter (P.isDctorExported name exps . fst) ctors
- fencedBlock $ do
- tell [show dtype ++ " " ++ typeName]
- zipWithM_ (\isFirst (ctor, tys) ->
- atIndent 2 $ (if isFirst then "= " else "| ") ++ P.runProperName ctor ++ " " ++ unwords (map P.prettyPrintTypeAtom tys))
- (True : repeat False) exported
-renderDeclaration _ (P.ExternDataDeclaration name kind) =
- fenced $ "data " ++ P.runProperName name ++ " :: " ++ P.prettyPrintKind kind
-renderDeclaration _ (P.TypeSynonymDeclaration name args ty) = do
- let
- typeApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
- typeName = prettyPrintType' typeApp
- fenced $ "type " ++ typeName ++ " = " ++ prettyPrintType' ty
-renderDeclaration _ (P.TypeClassDeclaration name args implies ds) = do
- let impliesText = case implies of
- [] -> ""
- is -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map P.prettyPrintTypeAtom tys')) is) ++ ") <= "
- classApp = foldl P.TypeApp (P.TypeConstructor (P.Qualified Nothing name)) (map toTypeVar args)
- className = prettyPrintType' classApp
- fencedBlock $ do
- tell ["class " ++ impliesText ++ className ++ " where"]
- mapM_ renderClassMember ds
+docgen (PSCDocsOptions fmt inputGlob output) = do
+ input <- concat <$> mapM glob inputGlob
+ case fmt of
+ Etags -> dumpTags input dumpEtags
+ Ctags -> dumpTags input dumpCtags
+ Markdown -> do
+ e <- D.parseAndDesugar input [] (\_ ms -> return ms)
+ case e of
+ Left (D.ParseError err) -> do
+ hPutStrLn stderr $ show err
+ exitFailure
+ Left (D.SortModulesError err) -> do
+ hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
+ exitFailure
+ Left (D.DesugarError err) -> do
+ hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
+ exitFailure
+ Right ms' ->
+ case output of
+ EverythingToStdOut ->
+ putStrLn (D.renderModulesAsMarkdown ms')
+ ToStdOut names -> do
+ let (ms, missing) = takeModulesByName ms' names
+ guardMissing missing
+ putStrLn (D.renderModulesAsMarkdown ms)
+ ToFiles names -> do
+ let (ms, missing) = takeModulesByName' ms' names
+ guardMissing missing
+ let ms'' = groupBy ((==) `on` fst) . sortBy (compare `on` fst) $ map swap ms
+ forM_ ms'' $ \grp -> do
+ let fp = fst (head grp)
+ createDirectoryIfMissing True (takeDirectory fp)
+ writeFile fp (D.renderModulesAsMarkdown $ snd `map` grp)
where
- renderClassMember (P.PositionedDeclaration _ _ d) = renderClassMember d
- renderClassMember (P.TypeDeclaration ident ty) = atIndent 2 $ show ident ++ " :: " ++ prettyPrintType' ty
- renderClassMember _ = error "Invalid argument to renderClassMember."
-renderDeclaration _ (P.TypeInstanceDeclaration name constraints className tys _) = do
- let constraintsText = case constraints of
- [] -> ""
- cs -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map P.prettyPrintTypeAtom tys')) cs) ++ ") => "
- fenced $ "instance " ++ show name ++ " :: " ++ constraintsText ++ show className ++ " " ++ unwords (map P.prettyPrintTypeAtom tys)
-renderDeclaration exps (P.PositionedDeclaration _ com d) = do
- renderDeclaration exps d
- renderComments com
-renderDeclaration _ _ = return ()
-
-renderComments :: [P.Comment] -> Docs
-renderComments cs = do
- let raw = concatMap toLines cs
- when (all hasPipe raw) $ do
- spacer
- atIndent 0 . unlines . map stripPipes $ raw
- where
-
- toLines (P.LineComment s) = [s]
- toLines (P.BlockComment s) = lines s
+ guardMissing [] = return ()
+ guardMissing [mn] = do
+ hPutStrLn stderr ("psc-docs: error: unknown module \"" ++ show mn ++ "\"")
+ exitFailure
+ guardMissing mns = do
+ hPutStrLn stderr "psc-docs: error: unknown modules:"
+ forM_ mns $ \mn ->
+ hPutStrLn stderr (" * " ++ show mn)
+ exitFailure
- hasPipe s = case dropWhile (== ' ') s of { ('|':_) -> True; _ -> False }
-
- stripPipes = dropPipe . dropWhile (== ' ')
+-- |
+-- Given a list of module names and a list of modules, return a list of modules
+-- whose names appeared in the given name list, together with a list of names
+-- for which no module could be found in the module list.
+--
+takeModulesByName :: [P.Module] -> [P.ModuleName] -> ([P.Module], [P.ModuleName])
+takeModulesByName modules names =
+ first (map fst) (takeModulesByName' modules (map (,()) names))
- dropPipe ('|':' ':s) = s
- dropPipe ('|':s) = s
- dropPipe s = s
+-- |
+-- Like takeModulesByName but also keeps some extra data with the module.
+--
+takeModulesByName' :: [P.Module] -> [(P.ModuleName, a)] -> ([(P.Module, a)], [P.ModuleName])
+takeModulesByName' modules = foldl go ([], [])
+ where
+ go (ms, missing) (name, x) =
+ case find ((== name) . P.getModuleName) modules of
+ Just m -> ((m, x) : ms, missing)
+ Nothing -> (ms, name : missing)
-toTypeVar :: (String, Maybe P.Kind) -> P.Type
-toTypeVar (s, Nothing) = P.TypeVar s
-toTypeVar (s, Just k) = P.KindedType (P.TypeVar s) k
+dumpTags :: [FilePath] -> ([(String, P.Module)] -> [String]) -> IO ()
+dumpTags input renderTags = do
+ e <- P.parseModulesFromFiles (fromMaybe "") <$> mapM (fmap (first Just) . parseFile) (nub input)
+ case e of
+ Left err -> do
+ hPutStrLn stderr (show err)
+ exitFailure
+ Right ms ->
+ ldump (renderTags (pairs ms))
-prettyPrintType' :: P.Type -> String
-prettyPrintType' = P.prettyPrintType . P.everywhereOnTypes dePrim
where
- dePrim ty@(P.TypeConstructor (P.Qualified _ name))
- | ty == P.tyBoolean || ty == P.tyNumber || ty == P.tyString =
- P.TypeConstructor $ P.Qualified Nothing name
- dePrim other = other
+ pairs :: [(Maybe String, m)] -> [(String, m)]
+ pairs = map (first (fromMaybe ""))
-getName :: P.Declaration -> String
-getName (P.TypeDeclaration ident _) = show ident
-getName (P.ExternDeclaration _ ident _ _) = show ident
-getName (P.DataDeclaration _ name _ _) = P.runProperName name
-getName (P.ExternDataDeclaration name _) = P.runProperName name
-getName (P.TypeSynonymDeclaration name _ _) = P.runProperName name
-getName (P.TypeClassDeclaration name _ _ _) = P.runProperName name
-getName (P.TypeInstanceDeclaration name _ _ _ _) = show name
-getName (P.PositionedDeclaration _ _ d) = getName d
-getName _ = error "Invalid argument to getName"
+ ldump :: [String] -> IO ()
+ ldump = mapM_ putStrLn
-canRenderDecl :: P.Declaration -> Bool
-canRenderDecl P.TypeDeclaration{} = True
-canRenderDecl P.ExternDeclaration{} = True
-canRenderDecl P.DataDeclaration{} = True
-canRenderDecl P.ExternDataDeclaration{} = True
-canRenderDecl P.TypeSynonymDeclaration{} = True
-canRenderDecl P.TypeClassDeclaration{} = True
-canRenderDecl P.TypeInstanceDeclaration{} = True
-canRenderDecl (P.PositionedDeclaration _ _ d) = canRenderDecl d
-canRenderDecl _ = False
+parseFile :: FilePath -> IO (FilePath, String)
+parseFile input = (,) input <$> readFile input
inputFile :: Parser FilePath
inputFile = strArgument $
@@ -242,24 +155,97 @@ instance Read Format where
readsPrec _ "etags" = [(Etags, "")]
readsPrec _ "ctags" = [(Ctags, "")]
readsPrec _ "markdown" = [(Markdown, "")]
- readsPrec _ _ = []
+ readsPrec _ _ = []
format :: Parser Format
format = option auto $ value Markdown
<> long "format"
<> metavar "FORMAT"
- <> help "Set output FORMAT (markdown | etags | ctags)"
+ <> help "Set output FORMAT (markdown | etags | ctags)"
-pscDocsOptions :: Parser PSCDocsOptions
-pscDocsOptions = PSCDocsOptions <$> format <*> many inputFile
+docgenModule :: Parser String
+docgenModule = strOption $
+ long "docgen"
+ <> 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."
+
+pscDocsOptions :: Parser (Format, [FilePath], [String])
+pscDocsOptions = (,,) <$> format <*> many inputFile <*> many docgenModule
+
+parseDocgen :: [String] -> Either String DocgenOutput
+parseDocgen [] = Right EverythingToStdOut
+parseDocgen xs = go xs
+ where
+ go = intersperse " "
+ >>> concat
+ >>> words
+ >>> map parseItem
+ >>> combine
+
+data DocgenOutputItem
+ = IToStdOut P.ModuleName
+ | IToFile (P.ModuleName, FilePath)
+
+parseItem :: String -> DocgenOutputItem
+parseItem s = case elemIndex ':' s of
+ Just i ->
+ s # splitAt i
+ >>> first P.moduleNameFromString
+ >>> second (drop 1)
+ >>> IToFile
+ Nothing ->
+ IToStdOut (P.moduleNameFromString s)
+
+ where
+ infixr 1 #
+ (#) = flip ($)
+
+combine :: [DocgenOutputItem] -> Either String DocgenOutput
+combine [] = Right EverythingToStdOut
+combine (x:xs) = foldM go (initial x) xs
+ where
+ initial (IToStdOut m) = ToStdOut [m]
+ initial (IToFile m) = ToFiles [m]
+
+ go (ToStdOut ms) (IToStdOut m) = Right (ToStdOut (m:ms))
+ go (ToFiles ms) (IToFile m) = Right (ToFiles (m:ms))
+ go _ _ = Left "Can't mix module names and module name/file path pairs in the same invocation."
+
+buildOptions :: (Format, [FilePath], [String]) -> IO PSCDocsOptions
+buildOptions (fmt, input, mapping) =
+ case parseDocgen mapping of
+ Right mapping' -> return (PSCDocsOptions fmt input mapping')
+ Left err -> do
+ hPutStrLn stderr "psc-docs: error in --docgen option:"
+ hPutStrLn stderr (" " ++ err)
+ exitFailure
main :: IO ()
-main = execParser opts >>= docgen
+main = execParser opts >>= buildOptions >>= docgen
where
opts = info (version <*> helper <*> pscDocsOptions) infoModList
infoModList = fullDesc <> headerInfo <> footerInfo
- headerInfo = header "psc-docs - Generate Markdown documentation from PureScript extern files"
- footerInfo = footer $ "psc-docs " ++ showVersion Paths.version
+ headerInfo = header "psc-docs - Generate Markdown documentation from PureScript source files"
+ footerInfo = footerDoc $ Just $ PP.vcat
+ [ examples, PP.empty, PP.text ("psc-docs " ++ showVersion Paths.version) ]
version :: Parser (a -> a)
version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
+
+examples :: PP.Doc
+examples =
+ PP.vcat $ map PP.text
+ [ "Examples:"
+ , " print documentation for Data.List to stdout:"
+ , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
+ , " --docgen Data.List"
+ , ""
+ , " write documentation for Data.List to docs/Data.List.md:"
+ , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
+ , " --docgen Data.List:docs/Data.List.md"
+ , ""
+ , " write documentation for Data.List to docs/Data.List.md, and"
+ , " documentation for Data.List.Lazy to docs/Data.List.Lazy.md:"
+ , " psc-docs src/**/*.purs bower_components/*/src/**/*.purs \\"
+ , " --docgen Data.List:docs/Data.List.md \\"
+ , " --docgen Data.List.Lazy:docs/Data.List.Lazy.md"
+ ]
diff --git a/psc-docs/Tags.hs b/psc-docs/Tags.hs
index 9f8294e..461a7f6 100644
--- a/psc-docs/Tags.hs
+++ b/psc-docs/Tags.hs
@@ -11,7 +11,7 @@ tags = concatMap dtags . P.exportedDeclarations
names (P.DataDeclaration _ name _ dcons) = P.runProperName name : consNames
where consNames = map (\(cname, _) -> P.runProperName cname) dcons
names (P.TypeDeclaration ident _) = [show ident]
- names (P.ExternDeclaration _ ident _ _) = [show ident]
+ names (P.ExternDeclaration ident _) = [show ident]
names (P.TypeSynonymDeclaration name _ _) = [P.runProperName name]
names (P.TypeClassDeclaration name _ _ _) = [P.runProperName name]
names (P.TypeInstanceDeclaration name _ _ _ _) = [show name]
diff --git a/psc-make/Main.hs b/psc-make/Main.hs
deleted file mode 100644
index 370826c..0000000
--- a/psc-make/Main.hs
+++ /dev/null
@@ -1,177 +0,0 @@
------------------------------------------------------------------------------
---
--- Module : Main
--- Copyright : (c) Phil Freeman 2013
--- License : MIT
---
--- Maintainer : Phil Freeman <paf31@cantab.net>
--- Stability : experimental
--- Portability :
---
--- |
---
------------------------------------------------------------------------------
-
-{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TupleSections, RecordWildCards #-}
-
-module Main where
-
-import Control.Applicative
-import Control.Monad.Except
-import Control.Monad.Reader
-
-import Data.Version (showVersion)
-import Data.Traversable (traverse)
-
-import Options.Applicative as Opts
-
-import System.Directory
- (doesFileExist, getModificationTime, createDirectoryIfMissing)
-import System.FilePath (takeDirectory)
-import System.Exit (exitSuccess, exitFailure)
-import System.IO.Error (tryIOError)
-
-import qualified Language.PureScript as P
-import qualified Paths_purescript as Paths
-
-
-data PSCMakeOptions = PSCMakeOptions
- { pscmInput :: [FilePath]
- , pscmOutputDir :: FilePath
- , pscmOpts :: P.Options P.Make
- , pscmUsePrefix :: Bool
- }
-
-data InputOptions = InputOptions
- { ioNoPrelude :: Bool
- , ioInputFiles :: [FilePath]
- }
-
-readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]
-readInput InputOptions{..} = do
- content <- forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readFile inFile
- return (if ioNoPrelude then content else (Left P.RebuildNever, P.prelude) : content)
-
-newtype Make a = Make { unMake :: ReaderT (P.Options P.Make) (ExceptT String IO) a }
- deriving (Functor, Applicative, Monad, MonadIO, MonadError String, MonadReader (P.Options P.Make))
-
-runMake :: P.Options P.Make -> Make a -> IO (Either String a)
-runMake opts = runExceptT . flip runReaderT opts . unMake
-
-makeIO :: IO a -> Make a
-makeIO = Make . lift . ExceptT . fmap (either (Left . show) Right) . tryIOError
-
-instance P.MonadMake Make where
- getTimestamp path = makeIO $ do
- exists <- doesFileExist path
- traverse (const $ getModificationTime path) $ guard exists
- readTextFile path = makeIO $ do
- putStrLn $ "Reading " ++ path
- readFile path
- writeTextFile path text = makeIO $ do
- mkdirp path
- putStrLn $ "Writing " ++ path
- writeFile path text
- progress = makeIO . putStrLn
-
-compile :: PSCMakeOptions -> IO ()
-compile (PSCMakeOptions input outputDir opts usePrefix) = do
- modules <- P.parseModulesFromFiles (either (const "") id) <$> readInput (InputOptions (P.optionsNoPrelude opts) input)
- case modules of
- Left err -> do
- print err
- exitFailure
- Right ms -> do
- e <- runMake opts $ P.make outputDir ms prefix
- case e of
- Left err -> do
- putStrLn err
- exitFailure
- Right _ -> do
- exitSuccess
- where
- prefix = if usePrefix
- then ["Generated by psc-make version " ++ showVersion Paths.version]
- else []
-
-mkdirp :: FilePath -> IO ()
-mkdirp = createDirectoryIfMissing True . takeDirectory
-
-inputFile :: Parser FilePath
-inputFile = strArgument $
- metavar "FILE"
- <> help "The input .purs file(s)"
-
-outputDirectory :: Parser FilePath
-outputDirectory = strOption $
- short 'o'
- <> long "output"
- <> Opts.value "output"
- <> showDefault
- <> help "The output directory"
-
-noTco :: Parser Bool
-noTco = switch $
- long "no-tco"
- <> help "Disable tail call optimizations"
-
-noPrelude :: Parser Bool
-noPrelude = switch $
- long "no-prelude"
- <> help "Omit the Prelude"
-
-noMagicDo :: Parser Bool
-noMagicDo = switch $
- long "no-magic-do"
- <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad."
-
-noOpts :: Parser Bool
-noOpts = switch $
- long "no-opts"
- <> help "Skip the optimization phase."
-
-comments :: Parser Bool
-comments = switch $
- short 'c'
- <> long "comments"
- <> help "Include comments in the generated code."
-
-verboseErrors :: Parser Bool
-verboseErrors = switch $
- short 'v'
- <> long "verbose-errors"
- <> help "Display verbose error messages"
-
-noPrefix :: Parser Bool
-noPrefix = switch $
- short 'p'
- <> long "no-prefix"
- <> help "Do not include comment header"
-
-
-options :: Parser (P.Options P.Make)
-options = P.Options <$> noPrelude
- <*> noTco
- <*> noMagicDo
- <*> pure Nothing
- <*> noOpts
- <*> verboseErrors
- <*> (not <$> comments)
- <*> pure P.MakeOptions
-
-pscMakeOptions :: Parser PSCMakeOptions
-pscMakeOptions = PSCMakeOptions <$> many inputFile
- <*> outputDirectory
- <*> options
- <*> (not <$> noPrefix)
-
-main :: IO ()
-main = execParser opts >>= compile
- where
- opts = info (version <*> helper <*> pscMakeOptions) infoModList
- infoModList = fullDesc <> headerInfo <> footerInfo
- headerInfo = header "psc-make - Compiles PureScript to Javascript"
- footerInfo = footer $ "psc-make " ++ showVersion Paths.version
-
- version :: Parser (a -> a)
- version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
diff --git a/psc-publish/BoxesHelpers.hs b/psc-publish/BoxesHelpers.hs
new file mode 100644
index 0000000..7ab0c67
--- /dev/null
+++ b/psc-publish/BoxesHelpers.hs
@@ -0,0 +1,38 @@
+module BoxesHelpers
+ ( Boxes.Box
+ , Boxes.nullBox
+ , module BoxesHelpers
+ ) where
+
+import System.IO (hPutStr, stderr)
+import qualified Text.PrettyPrint.Boxes as Boxes
+
+width :: Int
+width = 79
+
+indentWidth :: Int
+indentWidth = 2
+
+para :: String -> Boxes.Box
+para = Boxes.para Boxes.left width
+
+indented :: Boxes.Box -> Boxes.Box
+indented b = Boxes.hcat Boxes.left [Boxes.emptyBox 1 indentWidth, b]
+
+successivelyIndented :: [String] -> Boxes.Box
+successivelyIndented [] =
+ Boxes.nullBox
+successivelyIndented (x:xs) =
+ Boxes.vcat Boxes.left [para x, indented (successivelyIndented xs)]
+
+vcat :: [Boxes.Box] -> Boxes.Box
+vcat = Boxes.vcat Boxes.left
+
+spacer :: Boxes.Box
+spacer = Boxes.emptyBox 1 1
+
+bulletedList :: (a -> String) -> [a] -> [Boxes.Box]
+bulletedList f = map (indented . para . ("* " ++) . f)
+
+printToStderr :: Boxes.Box -> IO ()
+printToStderr = hPutStr stderr . Boxes.render
diff --git a/psc-publish/ErrorsWarnings.hs b/psc-publish/ErrorsWarnings.hs
new file mode 100644
index 0000000..20509d8
--- /dev/null
+++ b/psc-publish/ErrorsWarnings.hs
@@ -0,0 +1,359 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module ErrorsWarnings where
+
+import Control.Applicative ((<$>))
+import Data.Aeson.BetterErrors
+import Data.Version
+import Data.Maybe
+import Data.Monoid
+import Data.Foldable (foldMap)
+import Data.List (intersperse)
+import Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.List.NonEmpty as NonEmpty
+
+import qualified Data.Text as T
+
+import Control.Exception (IOException)
+import Web.Bower.PackageMeta (BowerError, PackageName, runPackageName)
+import qualified Web.Bower.PackageMeta as Bower
+
+import qualified Language.PureScript as P
+import qualified Language.PureScript.Docs as D
+
+import BoxesHelpers
+
+-- | An error which meant that it was not possible to retrieve metadata for a
+-- package.
+data PackageError
+ = UserError UserError
+ | InternalError InternalError
+ | OtherError OtherError
+ deriving (Show)
+
+data PackageWarning
+ = ResolutionNotVersion PackageName
+ | UndeclaredDependency PackageName
+ | UnacceptableVersion (PackageName, String)
+ deriving (Show)
+
+-- | An error that should be fixed by the user.
+data UserError
+ = BowerJSONNotFound
+ | CouldntParseBowerJSON (ParseError BowerError)
+ | BowerJSONNameMissing
+ | TagMustBeCheckedOut
+ | AmbiguousVersions [Version] -- Invariant: should contain at least two elements
+ | BadRepositoryField RepositoryFieldError
+ | MissingDependencies (NonEmpty PackageName)
+ | ParseAndDesugarError D.ParseDesugarError
+ deriving (Show)
+
+data RepositoryFieldError
+ = RepositoryFieldMissing
+ | BadRepositoryType String
+ | NotOnGithub
+ deriving (Show)
+
+-- | An error that probably indicates a bug in this module.
+data InternalError
+ = JSONError JSONSource (ParseError BowerError)
+ deriving (Show)
+
+data JSONSource
+ = FromFile FilePath
+ | FromBowerList
+ deriving (Show)
+
+data OtherError
+ = ProcessFailed String [String] IOException
+ | IOExceptionThrown IOException
+ deriving (Show)
+
+printError :: PackageError -> IO ()
+printError = printToStderr . renderError
+
+renderError :: PackageError -> Box
+renderError err =
+ case err of
+ UserError e ->
+ vcat
+ [ para (concat
+ [ "There is a problem with your package, which meant that "
+ , "it could not be published."
+ ])
+ , para "Details:"
+ , indented (displayUserError e)
+ ]
+ InternalError e ->
+ vcat
+ [ para "Internal error: this is probably a bug. Please report it:"
+ , indented (para "https://github.com/purescript/purescript/issues/new")
+ , spacer
+ , para "Details:"
+ , successivelyIndented (displayInternalError e)
+ ]
+ OtherError e ->
+ vcat
+ [ para "An error occurred, and your package could not be published."
+ , para "Details:"
+ , indented (displayOtherError e)
+ ]
+
+displayUserError :: UserError -> Box
+displayUserError e = case e of
+ BowerJSONNotFound ->
+ para (concat
+ [ "The bower.json file was not found. Please create one, or run "
+ , "`pulp init`."
+ ])
+ CouldntParseBowerJSON err ->
+ vcat
+ [ successivelyIndented
+ [ "The bower.json file could not be parsed as JSON:"
+ , "aeson reported: " ++ show err
+ ]
+ , para "Please ensure that your bower.json file is valid JSON."
+ ]
+ BowerJSONNameMissing ->
+ vcat
+ [ successivelyIndented
+ [ "In bower.json:"
+ , "the \"name\" key was not found."
+ ]
+ , para "Please give your package a name first."
+ ]
+ TagMustBeCheckedOut ->
+ vcat
+ [ para (concat
+ [ "psc-publish requires a tagged version to be checked out in "
+ , "order to build documentation, and no suitable tag was found. "
+ , "Please check out a previously tagged version, or tag a new "
+ , "version."
+ ])
+ , spacer
+ , para "Note: tagged versions must be in one of the following forms:"
+ , indented (para "* v{MAJOR}.{MINOR}.{PATCH} (example: \"v1.6.2\")")
+ , indented (para "* {MAJOR}.{MINOR}.{PATCH} (example: \"1.6.2\")")
+ ]
+ AmbiguousVersions vs ->
+ vcat $
+ [ para (concat
+ [ "The currently checked out commit seems to have been tagged with "
+ , "more than 1 version, and I don't know which one should be used. "
+ , "Please either delete some of the tags, or create a new commit "
+ , "to tag the desired verson with."
+ ])
+ , spacer
+ , para "Tags for the currently checked out commit:"
+ ] ++ bulletedList showVersion vs
+ BadRepositoryField err ->
+ displayRepositoryError err
+ MissingDependencies pkgs ->
+ let singular = NonEmpty.length pkgs == 1
+ pl a b = if singular then b else a
+ do_ = pl "do" "does"
+ dependencies = pl "dependencies" "dependency"
+ them = pl "them" "it"
+ in vcat $
+ [ para (concat
+ [ "The following Bower ", dependencies, " ", do_, " not appear to be "
+ , "installed:"
+ ])
+ ] ++
+ bulletedList runPackageName (NonEmpty.toList pkgs)
+ ++
+ [ spacer
+ , para (concat
+ [ "Please install ", them, " first, by running `bower install`."
+ ])
+ ]
+ ParseAndDesugarError (D.ParseError err) ->
+ vcat
+ [ para "Parse error:"
+ , indented (para (show err))
+ ]
+ ParseAndDesugarError (D.SortModulesError err) ->
+ vcat
+ [ para "Error in sortModules:"
+ , indented (para (P.prettyPrintMultipleErrors False err))
+ ]
+ ParseAndDesugarError (D.DesugarError err) ->
+ vcat
+ [ para "Error while desugaring:"
+ , indented (para (P.prettyPrintMultipleErrors False err))
+ ]
+
+displayRepositoryError :: RepositoryFieldError -> Box
+displayRepositoryError err = case err of
+ RepositoryFieldMissing ->
+ vcat
+ [ para (concat
+ [ "The 'repository' field is not present in your bower.json file. "
+ , "Without this information, Pursuit would not be able to generate "
+ , "source links in your package's documentation. Please add one - like "
+ , "this, for example:"
+ ])
+ , spacer
+ , indented (vcat
+ [ para "\"repository\": {"
+ , indented (para "\"type\": \"git\",")
+ , indented (para "\"url\": \"git://github.com/purescript/purescript-prelude.git\"")
+ , para "}"
+ ]
+ )
+ ]
+ BadRepositoryType ty ->
+ para (concat
+ [ "In your bower.json file, the repository type is currently listed as "
+ , "\"" ++ ty ++ "\". Currently, only git repositories are supported. "
+ , "Please publish your code in a git repository, and then update the "
+ , "repository type in your bower.json file to \"git\"."
+ ])
+ NotOnGithub ->
+ vcat
+ [ para (concat
+ [ "The repository url in your bower.json file does not point to a "
+ , "GitHub repository. Currently, Pursuit does not support packages "
+ , "which are not hosted on GitHub."
+ ])
+ , spacer
+ , para (concat
+ [ "Please update your bower.json file to point to a GitHub repository. "
+ , "Alternatively, if you would prefer not to host your package on "
+ , "GitHub, please open an issue:"
+ ])
+ , indented (para "https://github.com/purescript/purescript/issues/new")
+ ]
+
+displayInternalError :: InternalError -> [String]
+displayInternalError e = case e of
+ JSONError src r ->
+ [ "Error in JSON " ++ displayJSONSource src ++ ":"
+ , T.unpack (Bower.displayError r)
+ ]
+
+displayJSONSource :: JSONSource -> String
+displayJSONSource s = case s of
+ FromFile fp ->
+ "in file " ++ show fp
+ FromBowerList ->
+ "in the output of `bower list --json --offline`"
+
+displayOtherError :: OtherError -> Box
+displayOtherError e = case e of
+ ProcessFailed prog args exc ->
+ successivelyIndented
+ [ "While running `" ++ prog ++ " " ++ unwords args ++ "`:"
+ , show exc
+ ]
+ IOExceptionThrown exc ->
+ successivelyIndented
+ [ "An IO exception occurred:", show exc ]
+
+data CollectedWarnings = CollectedWarnings
+ { resolutionNotVersions :: [PackageName]
+ , undeclaredDependencies :: [PackageName]
+ , unacceptableVersions :: [(PackageName, String)]
+ }
+ deriving (Show, Eq, Ord)
+
+instance Monoid CollectedWarnings where
+ mempty = CollectedWarnings mempty mempty mempty
+ mappend (CollectedWarnings as bs cs) (CollectedWarnings as' bs' cs') =
+ CollectedWarnings (as <> as') (bs <> bs') (cs <> cs')
+
+collectWarnings :: [PackageWarning] -> CollectedWarnings
+collectWarnings = foldMap singular
+ where
+ singular w = case w of
+ ResolutionNotVersion pn -> CollectedWarnings [pn] [] []
+ UndeclaredDependency pn -> CollectedWarnings [] [pn] []
+ UnacceptableVersion t -> CollectedWarnings [] [] [t]
+
+renderWarnings :: [PackageWarning] -> Box
+renderWarnings warns =
+ let CollectedWarnings{..} = collectWarnings warns
+ go toBox warns' = toBox <$> NonEmpty.nonEmpty warns'
+ mboxes = [ go warnResolutionNotVersions resolutionNotVersions
+ , go warnUndeclaredDependencies undeclaredDependencies
+ , go warnUnacceptableVersions unacceptableVersions
+ ]
+ in case catMaybes mboxes of
+ [] -> nullBox
+ boxes -> vcat [ para "Warnings:"
+ , indented (vcat (intersperse spacer boxes))
+ ]
+
+warnResolutionNotVersions :: NonEmpty PackageName -> Box
+warnResolutionNotVersions pkgNames =
+ let singular = NonEmpty.length pkgNames == 1
+ pl a b = if singular then b else a
+
+ packages = pl "packages" "package"
+ were = pl "were" "was"
+ anyOfThese = pl "any of these" "this"
+ these = pl "these" "this"
+ in vcat $
+ [ para (concat
+ ["The following ", packages, " ", were, " not resolved to a version:"])
+ ] ++
+ bulletedList runPackageName (NonEmpty.toList pkgNames)
+ ++
+ [ spacer
+ , para (concat
+ ["Links to types in ", anyOfThese, " ", packages, " will not work. In "
+ , "order to make links work, edit your bower.json to specify a version"
+ , " or a version range for ", these, " ", packages, ", and rerun "
+ , "`bower install`."
+ ])
+ ]
+
+warnUndeclaredDependencies :: NonEmpty PackageName -> Box
+warnUndeclaredDependencies pkgNames =
+ let singular = NonEmpty.length pkgNames == 1
+ pl a b = if singular then b else a
+
+ packages = pl "packages" "package"
+ are = pl "are" "is"
+ dependencies = pl "dependencies" "a dependency"
+ in vcat $
+ [ para (concat
+ [ "The following Bower ", packages, " ", are, " installed, but not "
+ , "declared as ", dependencies, " in your bower.json file:"
+ ])
+ ] ++
+ bulletedList runPackageName (NonEmpty.toList pkgNames)
+
+warnUnacceptableVersions :: NonEmpty (PackageName, String) -> Box
+warnUnacceptableVersions pkgs =
+ let singular = NonEmpty.length pkgs == 1
+ pl a b = if singular then b else a
+
+ packages' = pl "packages'" "package's"
+ packages = pl "packages" "package"
+ anyOfThese = pl "any of these" "this"
+ these = pl "these" "this"
+ versions = pl "versions" "version"
+ in vcat $
+ [ para (concat
+ [ "The following installed Bower ", packages', " ", versions, " could "
+ , "not be parsed:"
+ ])
+ ] ++
+ bulletedList showTuple (NonEmpty.toList pkgs)
+ ++
+ [ spacer
+ , para (concat
+ ["Links to types in ", anyOfThese, " ", packages, " will not work. In "
+ , "order to make links work, edit your bower.json to specify an "
+ , "acceptable version or version range for ", these, " ", packages, ", "
+ , "and rerun `bower install`."
+ ])
+ ]
+ where
+ showTuple (pkgName, tag) = runPackageName pkgName ++ "#" ++ tag
+
+printWarnings :: [PackageWarning] -> IO ()
+printWarnings = printToStderr . renderWarnings
diff --git a/psc-publish/Main.hs b/psc-publish/Main.hs
new file mode 100644
index 0000000..bff4fb2
--- /dev/null
+++ b/psc-publish/Main.hs
@@ -0,0 +1,286 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+import Prelude hiding (userError)
+
+import Data.Maybe
+import Data.Char (isSpace)
+import Data.String (fromString)
+import Data.List (stripPrefix, isSuffixOf, (\\))
+import Data.List.Split (splitOn)
+import Data.List.NonEmpty (NonEmpty(..))
+import Data.Version
+import Safe (headMay)
+
+import qualified Data.ByteString.Lazy.Char8 as BL
+import qualified Data.Text as T
+
+import qualified Data.Aeson as A
+import Data.Aeson.BetterErrors
+
+import Control.Applicative
+import Control.Category ((>>>))
+import Control.Arrow ((***))
+import Control.Exception (catch, try)
+import Control.Monad.Trans.Except
+import Control.Monad.Error.Class (MonadError(..))
+import Control.Monad.Writer
+
+import System.Directory (doesFileExist)
+import System.Process (readProcess)
+import System.Exit (exitFailure)
+import qualified System.FilePath.Glob as Glob
+
+import Web.Bower.PackageMeta (PackageMeta(..), BowerError(..), PackageName,
+ runPackageName, parsePackageName, Repository(..))
+import qualified Web.Bower.PackageMeta as Bower
+
+import qualified Language.PureScript.Docs as D
+import Utils
+import ErrorsWarnings
+
+main :: IO ()
+main = do
+ pkg <- preparePackage
+ BL.putStrLn (A.encode pkg)
+
+-- | Attempt to retrieve package metadata from the current directory.
+-- Calls exitFailure if no package metadata could be retrieved.
+preparePackage :: IO D.UploadedPackage
+preparePackage =
+ runPrepareM preparePackage'
+ >>= either (\e -> printError e >> exitFailure)
+ handleWarnings
+ where
+ handleWarnings (result, warns) = do
+ printWarnings warns
+ return result
+
+newtype PrepareM a =
+ PrepareM { unPrepareM :: WriterT [PackageWarning] (ExceptT PackageError IO) a }
+ deriving (Functor, Applicative, Monad,
+ MonadWriter [PackageWarning],
+ MonadError PackageError)
+
+-- This MonadIO instance ensures that IO errors don't crash the program.
+instance MonadIO PrepareM where
+ liftIO act =
+ lift' (try act) >>= either (otherError . IOExceptionThrown) return
+ where
+ lift' :: IO a -> PrepareM a
+ lift' = PrepareM . lift . lift
+
+runPrepareM :: PrepareM a -> IO (Either PackageError (a, [PackageWarning]))
+runPrepareM = runExceptT . runWriterT . unPrepareM
+
+warn :: PackageWarning -> PrepareM ()
+warn w = tell [w]
+
+userError :: UserError -> PrepareM a
+userError = throwError . UserError
+
+internalError :: InternalError -> PrepareM a
+internalError = throwError . InternalError
+
+otherError :: OtherError -> PrepareM a
+otherError = throwError . OtherError
+
+catchLeft :: Applicative f => Either a b -> (a -> f b) -> f b
+catchLeft a f = either f pure a
+
+preparePackage' :: PrepareM D.UploadedPackage
+preparePackage' = do
+ exists <- liftIO (doesFileExist "bower.json")
+ unless exists (userError BowerJSONNotFound)
+
+ pkgMeta <- liftIO (Bower.decodeFile "bower.json")
+ >>= flip catchLeft (userError . CouldntParseBowerJSON)
+ (pkgVersionTag, pkgVersion) <- getVersionFromGitTag
+ pkgGithub <- getBowerInfo pkgMeta
+ (pkgBookmarks, pkgModules) <- getModulesAndBookmarks
+
+ let declaredDeps = map fst (bowerDependencies pkgMeta ++
+ bowerDevDependencies pkgMeta)
+ pkgResolvedDependencies <- getResolvedDependencies declaredDeps
+
+ let pkgUploader = D.NotYetKnown
+
+ return D.Package{..}
+
+getModulesAndBookmarks :: PrepareM ([D.Bookmark], [D.Module])
+getModulesAndBookmarks = do
+ (inputFiles, depsFiles) <- liftIO getInputAndDepsFiles
+ liftIO (D.parseAndDesugar inputFiles depsFiles renderModules)
+ >>= either (userError . ParseAndDesugarError) return
+ where
+ renderModules bookmarks modules =
+ return (bookmarks, map D.convertModule modules)
+
+getVersionFromGitTag :: PrepareM (String, Version)
+getVersionFromGitTag = do
+ out <- readProcess' "git" ["tag", "--list", "--points-at", "HEAD"] ""
+ let vs = map trimWhitespace (lines out)
+ case mapMaybe parseMay vs of
+ [] -> userError TagMustBeCheckedOut
+ [x] -> return x
+ xs -> userError (AmbiguousVersions (map snd xs))
+ where
+ trimWhitespace =
+ dropWhile isSpace >>> reverse >>> dropWhile isSpace >>> reverse
+ parseMay str =
+ (str,) <$> D.parseVersion' (dropPrefix "v" str)
+ dropPrefix prefix str =
+ fromMaybe str (stripPrefix prefix str)
+
+getBowerInfo :: PackageMeta -> PrepareM (D.GithubUser, D.GithubRepo)
+getBowerInfo = either (userError . BadRepositoryField) return . tryExtract
+ where
+ tryExtract pkgMeta =
+ case bowerRepository pkgMeta of
+ Nothing -> Left RepositoryFieldMissing
+ Just Repository{..} -> do
+ unless (repositoryType == "git")
+ (Left (BadRepositoryType repositoryType))
+ maybe (Left NotOnGithub) Right (extractGithub repositoryUrl)
+
+extractGithub :: String -> Maybe (D.GithubUser, D.GithubRepo)
+extractGithub =
+ stripPrefix "git://github.com/"
+ >>> fmap (splitOn "/")
+ >=> takeTwo
+ >>> fmap (D.GithubUser *** (D.GithubRepo . dropDotGit))
+
+ where
+ takeTwo :: [a] -> Maybe (a, a)
+ takeTwo [x, y] = Just (x, y)
+ takeTwo _ = Nothing
+
+ dropDotGit :: String -> String
+ dropDotGit str
+ | ".git" `isSuffixOf` str = take (length str - 4) str
+ | otherwise = str
+
+readProcess' :: String -> [String] -> String -> PrepareM String
+readProcess' prog args stdin = do
+ out <- liftIO (catch (Right <$> readProcess prog args stdin)
+ (return . Left))
+ either (otherError . ProcessFailed prog args) return out
+
+data DependencyStatus
+ = Missing
+ | ResolvedOther String
+ -- ^ Resolved, but to something other than a version. The String argument
+ -- is the resolution type. The values it can take that I'm aware of are
+ -- "commit" and "branch".
+ | ResolvedVersion String
+ -- ^ Resolved to a version. The String argument is the resolution tag (eg,
+ -- "v0.1.0").
+ deriving (Show, Eq)
+
+-- Go through all bower dependencies which contain purescript code, and
+-- extract their versions.
+--
+-- In the case where a bower dependency is taken from a particular version,
+-- that's easy; take that version. In any other case (eg, a branch, or a commit
+-- sha) we print a warning that documentation links will not work, and avoid
+-- linking to documentation for any types from that package.
+--
+-- The rationale for this is: people will prefer to use a released version
+-- where possible. If they are not using a released version, then this is
+-- probably for a reason. However, docs are only ever available for released
+-- versions. Therefore there will probably be no version of the docs which is
+-- appropriate to link to, and we should omit links.
+getResolvedDependencies :: [PackageName] -> PrepareM [(PackageName, Version)]
+getResolvedDependencies declaredDeps = do
+ depsBS <- fromString <$> readProcess' "bower" ["list", "--json", "--offline"] ""
+
+ deps <- catchLeft (parse asBowerResolvedDependencies depsBS)
+ (internalError . JSONError FromBowerList)
+
+ warnUndeclared declaredDeps (map fst deps)
+ handleDeps deps
+
+ where
+ asBowerResolvedDependencies ::
+ Parse BowerError [(PackageName, DependencyStatus)]
+ asBowerResolvedDependencies =
+ key "dependencies"
+ (eachInObjectWithKey (parsePackageName . T.unpack) asDependencyStatus)
+
+asDependencyStatus :: Parse e DependencyStatus
+asDependencyStatus = do
+ isMissing <- keyOrDefault "missing" False asBool
+ if isMissing
+ then
+ return Missing
+ else
+ key "pkgMeta" $
+ key "_resolution" $ do
+ type_ <- key "type" asString
+ case type_ of
+ "version" -> ResolvedVersion <$> key "tag" asString
+ other -> return (ResolvedOther other)
+
+warnUndeclared :: [PackageName] -> [PackageName] -> PrepareM ()
+warnUndeclared declared actual =
+ mapM_ (warn . UndeclaredDependency) (actual \\ declared)
+
+handleDeps ::
+ [(PackageName, DependencyStatus)] -> PrepareM [(PackageName, Version)]
+handleDeps deps = do
+ let (missing, notVersion, installed) = partitionDeps deps
+ case missing of
+ (x:xs) ->
+ userError (MissingDependencies (x :| xs))
+ [] -> do
+ mapM_ (warn . ResolutionNotVersion . fst) notVersion
+ withVersions <- catMaybes <$> mapM tryExtractVersion' installed
+ filterM (liftIO . isPureScript . bowerDir . fst) withVersions
+
+ where
+ partitionDeps = foldr go ([], [], [])
+ go (pkgName, d) (ms, os, is) =
+ case d of
+ Missing -> (pkgName : ms, os, is)
+ ResolvedOther o -> (ms, (pkgName, o) : os, is)
+ ResolvedVersion v -> (ms, os, (pkgName, v) : is)
+
+ bowerDir pkgName = "bower_components/" ++ runPackageName pkgName
+
+ -- Try to extract a version, and warn if unsuccessful.
+ tryExtractVersion' pair =
+ maybe (warn (UnacceptableVersion pair) >> return Nothing)
+ (return . Just)
+ (tryExtractVersion pair)
+
+tryExtractVersion :: (PackageName, String) -> Maybe (PackageName, Version)
+tryExtractVersion (pkgName, tag) =
+ let tag' = fromMaybe tag (stripPrefix "v" tag)
+ in (pkgName,) <$> D.parseVersion' tag'
+
+-- | Returns whether it looks like there is a purescript package checked out
+-- in the given directory.
+isPureScript :: FilePath -> IO Bool
+isPureScript dir = do
+ files <- Glob.globDir1 purescriptSourceFiles dir
+ return (not (null files))
+
+getInputAndDepsFiles :: IO ([FilePath], [(PackageName, FilePath)])
+getInputAndDepsFiles = do
+ inputFiles <- globRelative purescriptSourceFiles
+ depsFiles' <- globRelative purescriptDepsFiles
+ return (inputFiles, mapMaybe withPackageName depsFiles')
+
+withPackageName :: FilePath -> Maybe (PackageName, FilePath)
+withPackageName fp = (,fp) <$> getPackageName fp
+
+getPackageName :: FilePath -> Maybe PackageName
+getPackageName fp = do
+ let xs = splitOn "/" fp
+ ys <- stripPrefix ["bower_components"] xs
+ y <- headMay ys
+ case Bower.mkPackageName y of
+ Right name -> Just name
+ Left _ -> Nothing
diff --git a/psc-publish/Utils.hs b/psc-publish/Utils.hs
new file mode 100644
index 0000000..c61b6c7
--- /dev/null
+++ b/psc-publish/Utils.hs
@@ -0,0 +1,22 @@
+
+module Utils where
+
+import Data.List
+import Data.Maybe
+import System.Directory
+import qualified System.FilePath.Glob as Glob
+
+-- | Glob relative to the current directory, and produce relative pathnames.
+globRelative :: Glob.Pattern -> IO [FilePath]
+globRelative pat = do
+ currentDir <- getCurrentDirectory
+ filesAbsolute <- Glob.globDir1 pat currentDir
+ return (mapMaybe (stripPrefix (currentDir ++ "/")) filesAbsolute)
+
+-- | Glob pattern for PureScript source files.
+purescriptSourceFiles :: Glob.Pattern
+purescriptSourceFiles = Glob.compile "src/**/*.purs"
+
+-- | Glob pattern for PureScript dependency files.
+purescriptDepsFiles :: Glob.Pattern
+purescriptDepsFiles = Glob.compile "bower_components/*/src/**/*.purs"
diff --git a/psc/Main.hs b/psc/Main.hs
index 6be836d..f38dd5a 100644
--- a/psc/Main.hs
+++ b/psc/Main.hs
@@ -12,160 +12,134 @@
--
-----------------------------------------------------------------------------
-{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TupleSections, RecordWildCards #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
module Main where
import Control.Applicative
-import Control.Monad.Except
-import Control.Monad.Reader
+import Control.Monad
+import Control.Monad.Error.Class (MonadError(..))
+import Control.Monad.Writer
-import Data.Maybe (fromMaybe)
import Data.Version (showVersion)
+import qualified Data.Map as M
import Options.Applicative as Opts
-import System.Directory (createDirectoryIfMissing)
-import System.FilePath (takeDirectory)
+
import System.Exit (exitSuccess, exitFailure)
import System.IO (hPutStrLn, stderr)
+import System.FilePath.Glob (glob)
import qualified Language.PureScript as P
import qualified Paths_purescript as Paths
+import Make
-data PSCOptions = PSCOptions
- { pscInput :: [FilePath]
- , pscOpts :: P.Options P.Compile
- , pscStdIn :: Bool
- , pscOutput :: Maybe FilePath
- , pscExterns :: Maybe FilePath
- , pscUsePrefix :: Bool
+data PSCMakeOptions = PSCMakeOptions
+ { pscmInput :: [FilePath]
+ , pscmForeignInput :: [FilePath]
+ , pscmOutputDir :: FilePath
+ , pscmOpts :: P.Options
+ , pscmUsePrefix :: Bool
}
data InputOptions = InputOptions
- { ioNoPrelude :: Bool
- , ioUseStdIn :: Bool
- , ioInputFiles :: [FilePath]
+ { ioInputFiles :: [FilePath]
}
-readInput :: InputOptions -> IO [(Maybe FilePath, String)]
-readInput InputOptions{..}
- | ioUseStdIn = return . (Nothing ,) <$> getContents
- | otherwise = do content <- forM ioInputFiles $ \inFile -> (Just inFile, ) <$> readFile inFile
- return (if ioNoPrelude then content else (Nothing, P.prelude) : content)
-
-compile :: PSCOptions -> IO ()
-compile (PSCOptions input opts stdin output externs usePrefix) = do
- modules <- P.parseModulesFromFiles (fromMaybe "") <$> readInput (InputOptions (P.optionsNoPrelude opts) stdin input)
- case modules of
- Left err -> do
- hPutStrLn stderr $ show err
+compile :: PSCMakeOptions -> IO ()
+compile (PSCMakeOptions inputGlob inputForeignGlob outputDir opts usePrefix) = do
+ input <- concat <$> mapM glob inputGlob
+ when (null input) $ do
+ hPutStrLn stderr "psc: No input files."
+ exitFailure
+ moduleFiles <- readInput (InputOptions input)
+ inputForeign <- concat <$> mapM glob inputForeignGlob
+ foreignFiles <- forM inputForeign (\inFile -> (inFile,) <$> readFile inFile)
+ case runWriterT (parseInputs moduleFiles foreignFiles) of
+ Left errs -> do
+ hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
exitFailure
- Right ms -> do
- case P.compile (map snd ms) prefix `runReaderT` opts of
- Left err -> do
- hPutStrLn stderr err
+ Right ((ms, foreigns), warnings) -> do
+ when (P.nonEmpty warnings) $
+ hPutStrLn stderr (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings)
+ let filePathMap = M.fromList $ map (\(fp, P.Module _ mn _ _) -> (mn, fp)) ms
+ makeActions = buildMakeActions outputDir filePathMap foreigns usePrefix
+ e <- runMake opts $ P.make makeActions ms
+ case e of
+ Left errs -> do
+ hPutStrLn stderr (P.prettyPrintMultipleErrors (P.optionsVerboseErrors opts) errs)
exitFailure
- Right (js, exts, _) -> do
- case output of
- Just path -> mkdirp path >> writeFile path js
- Nothing -> putStrLn js
- case externs of
- Just path -> mkdirp path >> writeFile path exts
- Nothing -> return ()
+ Right (_, warnings') -> do
+ when (P.nonEmpty warnings') $
+ putStrLn (P.prettyPrintMultipleWarnings (P.optionsVerboseErrors opts) warnings')
exitSuccess
- where
- prefix = if usePrefix
- then ["Generated by psc version " ++ showVersion Paths.version]
- else []
-
-mkdirp :: FilePath -> IO ()
-mkdirp = createDirectoryIfMissing True . takeDirectory
-
-codeGenModule :: Parser String
-codeGenModule = strOption $
- long "codegen"
- <> help "A list of modules for which Javascript and externs should be generated. This argument can be used multiple times."
-
-dceModule :: Parser String
-dceModule = strOption $
- short 'm'
- <> long "module"
- <> help "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."
-
-browserNamespace :: Parser String
-browserNamespace = strOption $
- long "browser-namespace"
- <> Opts.value "PS"
- <> showDefault
- <> help "Specify the namespace that PureScript modules will be exported to when running in the browser."
-verboseErrors :: Parser Bool
-verboseErrors = switch $
- short 'v'
- <> long "verbose-errors"
- <> help "Display verbose error messages"
+readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]
+readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readFile inFile
-noOpts :: Parser Bool
-noOpts = switch $
- long "no-opts"
- <> help "Skip the optimization phase."
+parseInputs :: (Functor m, Applicative m, MonadError P.MultipleErrors m, MonadWriter P.MultipleErrors m)
+ => [(Either P.RebuildPolicy FilePath, String)]
+ -> [(FilePath, P.ForeignJS)]
+ -> m ([(Either P.RebuildPolicy FilePath, P.Module)], M.Map P.ModuleName (FilePath, P.ForeignJS))
+parseInputs modules foreigns =
+ (,) <$> P.parseModulesFromFiles (either (const "") id) modules
+ <*> P.parseForeignModulesFromFiles foreigns
-runMain :: Parser (Maybe String)
-runMain = optional $ noArgs <|> withArgs
- where
- defaultVal = "Main"
- noArgs = flag' defaultVal (long "main")
- withArgs = strOption $
- long "main"
- <> help (concat [
- "Generate code to run the main method in the specified module. ",
- "(no argument: \"", defaultVal, "\")"
- ])
+inputFile :: Parser FilePath
+inputFile = strArgument $
+ metavar "FILE"
+ <> help "The input .purs file(s)"
-noMagicDo :: Parser Bool
-noMagicDo = switch $
- long "no-magic-do"
- <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad."
+inputForeignFile :: Parser FilePath
+inputForeignFile = strOption $
+ short 'f'
+ <> long "ffi"
+ <> help "The input .js file(s) providing foreign import implementations"
+
+outputDirectory :: Parser FilePath
+outputDirectory = strOption $
+ short 'o'
+ <> long "output"
+ <> Opts.value "output"
+ <> showDefault
+ <> help "The output directory"
+
+requirePath :: Parser (Maybe FilePath)
+requirePath = optional $ strOption $
+ short 'r'
+ <> long "require-path"
+ <> help "The path prefix to use for require() calls in the generated JavaScript"
noTco :: Parser Bool
noTco = switch $
long "no-tco"
<> help "Disable tail call optimizations"
-noPrelude :: Parser Bool
-noPrelude = switch $
- long "no-prelude"
- <> help "Omit the Prelude"
+noMagicDo :: Parser Bool
+noMagicDo = switch $
+ long "no-magic-do"
+ <> help "Disable the optimization that overloads the do keyword to generate efficient code specifically for the Eff monad"
+
+noOpts :: Parser Bool
+noOpts = switch $
+ long "no-opts"
+ <> help "Skip the optimization phase"
comments :: Parser Bool
comments = switch $
short 'c'
<> long "comments"
- <> help "Include comments in the generated code."
-
-useStdIn :: Parser Bool
-useStdIn = switch $
- short 's'
- <> long "stdin"
- <> help "Read from standard input"
-
-inputFile :: Parser FilePath
-inputFile = strArgument $
- metavar "FILE"
- <> help "The input .purs file(s)"
-
-outputFile :: Parser (Maybe FilePath)
-outputFile = optional . strOption $
- short 'o'
- <> long "output"
- <> help "The output .js file"
+ <> help "Include comments in the generated code"
-externsFile :: Parser (Maybe FilePath)
-externsFile = optional . strOption $
- short 'e'
- <> long "externs"
- <> help "The output .e.purs file"
+verboseErrors :: Parser Bool
+verboseErrors = switch $
+ short 'v'
+ <> long "verbose-errors"
+ <> help "Display verbose error messages"
noPrefix :: Parser Bool
noPrefix = switch $
@@ -173,37 +147,30 @@ noPrefix = switch $
<> long "no-prefix"
<> help "Do not include comment header"
-options :: Parser (P.Options P.Compile)
-options = P.Options <$> noPrelude
- <*> noTco
+
+options :: Parser P.Options
+options = P.Options <$> noTco
<*> noMagicDo
- <*> runMain
+ <*> pure Nothing
<*> noOpts
<*> verboseErrors
<*> (not <$> comments)
- <*> additionalOptions
- where
- additionalOptions =
- P.CompileOptions <$> browserNamespace
- <*> many dceModule
- <*> many codeGenModule
-
-pscOptions :: Parser PSCOptions
-pscOptions = PSCOptions <$> many inputFile
- <*> options
- <*> useStdIn
- <*> outputFile
- <*> externsFile
- <*> (not <$> noPrefix)
+ <*> requirePath
+
+pscMakeOptions :: Parser PSCMakeOptions
+pscMakeOptions = PSCMakeOptions <$> many inputFile
+ <*> many inputForeignFile
+ <*> outputDirectory
+ <*> options
+ <*> (not <$> noPrefix)
main :: IO ()
main = execParser opts >>= compile
where
- opts = info (version <*> helper <*> pscOptions) infoModList
+ opts = info (version <*> helper <*> pscMakeOptions) infoModList
infoModList = fullDesc <> headerInfo <> footerInfo
headerInfo = header "psc - Compiles PureScript to Javascript"
footerInfo = footer $ "psc " ++ showVersion Paths.version
version :: Parser (a -> a)
version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> help "Show the version number" <> hidden
-
diff --git a/psc/Make.hs b/psc/Make.hs
new file mode 100644
index 0000000..4ab18bc
--- /dev/null
+++ b/psc/Make.hs
@@ -0,0 +1,140 @@
+-----------------------------------------------------------------------------
+--
+-- Module : Make
+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
+-- License : MIT
+--
+-- Maintainer : Phil Freeman <paf31@cantab.net>
+-- Stability : experimental
+-- Portability :
+--
+-- |
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TupleSections #-}
+
+module Make
+ ( Make(..)
+ , runMake
+ , buildMakeActions
+ ) where
+
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Error.Class (MonadError(..))
+import Control.Monad.Trans.Except
+import Control.Monad.Reader
+import Control.Monad.Writer
+
+import Data.Maybe (fromMaybe)
+import Data.Time.Clock
+import Data.Traversable (traverse)
+import Data.Version (showVersion)
+import qualified Data.Map as M
+
+import System.Directory
+ (doesFileExist, getModificationTime, createDirectoryIfMissing)
+import System.FilePath ((</>), takeDirectory)
+import System.IO.Error (tryIOError)
+
+import qualified Language.PureScript as P
+import qualified Language.PureScript.CodeGen.JS as J
+import qualified Language.PureScript.CoreFn as CF
+import qualified Paths_purescript as Paths
+
+newtype Make a = Make { unMake :: ReaderT P.Options (WriterT P.MultipleErrors (ExceptT P.MultipleErrors IO)) a }
+ deriving (Functor, Applicative, Monad, MonadIO, MonadError P.MultipleErrors, MonadWriter P.MultipleErrors, MonadReader P.Options)
+
+runMake :: P.Options -> Make a -> IO (Either P.MultipleErrors (a, P.MultipleErrors))
+runMake opts = runExceptT . runWriterT . flip runReaderT opts . unMake
+
+makeIO :: (IOError -> P.ErrorMessage) -> IO a -> Make a
+makeIO f io = do
+ e <- liftIO $ tryIOError io
+ either (throwError . P.singleError . f) return e
+
+-- Traverse (Either e) instance (base 4.7)
+traverseEither :: Applicative f => (a -> f b) -> Either e a -> f (Either e b)
+traverseEither _ (Left x) = pure (Left x)
+traverseEither f (Right y) = Right <$> f y
+
+buildMakeActions :: FilePath
+ -> M.Map P.ModuleName (Either P.RebuildPolicy String)
+ -> M.Map P.ModuleName (FilePath, P.ForeignJS)
+ -> Bool
+ -> P.MakeActions Make
+buildMakeActions outputDir filePathMap foreigns usePrefix =
+ P.MakeActions getInputTimestamp getOutputTimestamp readExterns codegen progress
+ where
+
+ getInputTimestamp :: P.ModuleName -> Make (Either P.RebuildPolicy (Maybe UTCTime))
+ getInputTimestamp mn = do
+ let path = fromMaybe (error "Module has no filename in 'make'") $ M.lookup mn filePathMap
+ e1 <- traverseEither getTimestamp path
+ fPath <- maybe (return Nothing) (getTimestamp . fst) $ M.lookup mn foreigns
+ return $ fmap (max fPath) e1
+
+ getOutputTimestamp :: P.ModuleName -> Make (Maybe UTCTime)
+ getOutputTimestamp mn = do
+ let filePath = P.runModuleName mn
+ jsFile = outputDir </> filePath </> "index.js"
+ externsFile = outputDir </> filePath </> "externs.purs"
+ min <$> getTimestamp jsFile <*> getTimestamp externsFile
+
+ readExterns :: P.ModuleName -> Make (FilePath, String)
+ readExterns mn = do
+ let path = outputDir </> P.runModuleName mn </> "externs.purs"
+ (path, ) <$> readTextFile path
+
+ codegen :: CF.Module CF.Ann -> P.Environment -> P.SupplyVar -> P.Externs -> Make ()
+ codegen m _ nextVar exts = do
+ let mn = CF.moduleName m
+ foreignInclude <- case mn `M.lookup` foreigns of
+ Just (path, _)
+ | not $ requiresForeign m -> do
+ tell $ P.errorMessage $ P.UnnecessaryFFIModule mn path
+ return Nothing
+ | otherwise -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]
+ Nothing | requiresForeign m -> throwError . P.errorMessage $ P.MissingFFIModule mn
+ | otherwise -> return Nothing
+ pjs <- P.evalSupplyT nextVar $ P.prettyPrintJS <$> J.moduleToJs m foreignInclude
+ let filePath = P.runModuleName mn
+ jsFile = outputDir </> filePath </> "index.js"
+ externsFile = outputDir </> filePath </> "externs.purs"
+ foreignFile = outputDir </> filePath </> "foreign.js"
+ prefix = ["Generated by psc version " ++ showVersion Paths.version | usePrefix]
+ js = unlines $ map ("// " ++) prefix ++ [pjs]
+ writeTextFile jsFile js
+ maybe (return ()) (writeTextFile foreignFile . snd) $ mn `M.lookup` foreigns
+ writeTextFile externsFile exts
+
+ requiresForeign :: CF.Module a -> Bool
+ requiresForeign = not . null . CF.moduleForeign
+
+ getTimestamp :: FilePath -> Make (Maybe UTCTime)
+ getTimestamp path = makeIO (const (P.SimpleErrorWrapper $ P.CannotGetFileInfo path)) $ do
+ exists <- doesFileExist path
+ traverse (const $ getModificationTime path) $ guard exists
+
+ readTextFile :: FilePath -> Make String
+ readTextFile path = do
+ verboseErrorsEnabled <- asks P.optionsVerboseErrors
+ makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile path)) $ do
+ when verboseErrorsEnabled $ putStrLn $ "Reading " ++ path
+ readFile path
+
+ writeTextFile :: FilePath -> String -> Make ()
+ writeTextFile path text = makeIO (const (P.SimpleErrorWrapper $ P.CannotWriteFile path)) $ do
+ mkdirp path
+ putStrLn $ "Writing " ++ path
+ writeFile path text
+ where
+ mkdirp :: FilePath -> IO ()
+ mkdirp = createDirectoryIfMissing True . takeDirectory
+
+ progress :: String -> Make ()
+ progress = liftIO . putStrLn
diff --git a/psci/Commands.hs b/psci/Commands.hs
deleted file mode 100644
index e7a8025..0000000
--- a/psci/Commands.hs
+++ /dev/null
@@ -1,78 +0,0 @@
------------------------------------------------------------------------------
---
--- Module : Commands
--- Copyright : (c) Phil Freeman 2014
--- License : MIT
---
--- Maintainer : Phil Freeman <paf31@cantab.net>
--- Stability : experimental
--- Portability :
---
--- |
--- Commands for PSCI.
---
------------------------------------------------------------------------------
-
-module Commands where
-
-import Language.PureScript
-
--- |
--- Valid Meta-commands for PSCI
---
-data Command
- -- |
- -- A purescript expression
- --
- = Expression Expr
- -- |
- -- Show the help command
- --
- | Help
- -- |
- -- Import a module from a loaded file
- --
- | Import ImportedModule
- -- |
- -- Browse a module
- --
- | Browse ModuleName
- -- |
- -- Load a file for use with importing
- --
- | LoadFile FilePath
- -- |
- -- Exit PSCI
- --
- | Quit
- -- |
- -- Reset the state of the REPL
- --
- | Reset
- -- |
- -- Add some declarations to the current evaluation context.
- --
- | Decls [Declaration]
- -- |
- -- Find the type of an expression
- --
- | TypeOf Expr
- -- |
- -- Find the kind of an expression
- --
- | KindOf Type
- -- |
- -- Show command
- --
- | Show String
-
--- | All of the data that is contained by an ImportDeclaration in the AST.
--- That is:
---
--- * A module name, the name of the module which is being imported
--- * An ImportDeclarationType which specifies whether there is an explicit
--- import list, a hiding list, or neither.
--- * If the module is imported qualified, its qualified name in the importing
--- module. Otherwise, Nothing.
---
-type ImportedModule = (ModuleName, ImportDeclarationType, Maybe ModuleName)
diff --git a/psci/Completion.hs b/psci/Completion.hs
new file mode 100644
index 0000000..4bd0e27
--- /dev/null
+++ b/psci/Completion.hs
@@ -0,0 +1,224 @@
+module Completion where
+
+import Data.Maybe (mapMaybe)
+import Data.List (nub, nubBy, sortBy, isPrefixOf, stripPrefix)
+import Data.Char (isUpper)
+import Data.Function (on)
+import Data.Traversable (traverse)
+
+import Control.Applicative ((<$>), (<*>))
+import Control.Monad.Trans.Reader (asks, runReaderT, ReaderT)
+import Control.Monad.Trans.State.Strict
+
+import System.Console.Haskeline
+
+import qualified Language.PureScript as P
+import qualified Language.PureScript.Names as N
+
+import qualified Directive as D
+import Types
+
+-- Completions may read the state, but not modify it.
+type CompletionM = ReaderT PSCiState IO
+
+-- Lift a `CompletionM` action to a `StateT PSCiState IO` one.
+liftCompletionM :: CompletionM a -> StateT PSCiState IO a
+liftCompletionM act = StateT (\s -> (\a -> (a, s)) <$> runReaderT act s)
+
+-- Haskeline completions
+
+data CompletionContext
+ = CtxDirective String
+ | CtxFilePath String
+ | CtxModule
+ | CtxIdentifier
+ | CtxType
+ | CtxFixed String
+ deriving (Show)
+
+-- |
+-- Loads module, function, and file completions.
+--
+completion :: CompletionFunc (StateT PSCiState IO)
+completion = liftCompletionM . completion'
+
+completion' :: CompletionFunc CompletionM
+completion' = completeWordWithPrev Nothing " \t\n\r" findCompletions
+
+-- |
+-- Decide what kind of completion we need based on input. This function expects
+-- a list of complete words (to the left of the cursor) as the first argument,
+-- and the current word as the second argument.
+completionContext :: [String] -> String -> [CompletionContext]
+completionContext [] _ = [CtxDirective "", CtxIdentifier, CtxFixed "import"]
+completionContext ws w | headSatisfies (":" `isPrefixOf`) ws = completeDirective ws w
+completionContext ws w | headSatisfies (== "import") ws = completeImport ws w
+completionContext _ _ = [CtxIdentifier]
+
+completeDirective :: [String] -> String -> [CompletionContext]
+completeDirective ws w =
+ case ws of
+ [] -> [CtxDirective w]
+ [dir] -> case D.directivesFor <$> stripPrefix ":" dir of
+ -- only offer completions if the directive is unambiguous
+ Just [dir'] -> directiveArg w dir'
+ _ -> []
+
+ -- All directives take exactly one argument. If we haven't yet matched,
+ -- that means one argument has already been supplied. So don't complete
+ -- any others.
+ _ -> []
+
+directiveArg :: String -> Directive -> [CompletionContext]
+directiveArg _ Browse = [CtxModule]
+directiveArg w Load = [CtxFilePath w]
+directiveArg w Foreign = [CtxFilePath w]
+directiveArg _ Quit = []
+directiveArg _ Reset = []
+directiveArg _ Help = []
+directiveArg _ Show = map CtxFixed replQueryStrings
+directiveArg _ Type = [CtxIdentifier]
+directiveArg _ Kind = [CtxType]
+
+completeImport :: [String] -> String -> [CompletionContext]
+completeImport ws w' =
+ case (ws, w') of
+ (["import"], w) | headSatisfies isUpper w -> [CtxModule]
+ (["import"], _) -> [CtxModule, CtxFixed "qualified"]
+ (["import", "qualified"], _) -> [CtxModule]
+ _ -> []
+
+headSatisfies :: (a -> Bool) -> [a] -> Bool
+headSatisfies p str =
+ case str of
+ (c:_) -> p c
+ _ -> False
+
+-- | Callback for Haskeline's `completeWordWithPrev`.
+-- Expects:
+-- * Line contents to the left of the word, reversed
+-- * Word to be completed
+findCompletions :: String -> String -> CompletionM [Completion]
+findCompletions prev word = do
+ let ctx = completionContext (words (reverse prev)) word
+ completions <- concat <$> traverse getCompletions ctx
+ return $ sortBy directivesFirst completions
+ where
+ getCompletions :: CompletionContext -> CompletionM [Completion]
+ getCompletions = fmap (mapMaybe (either (prefixedBy word) Just)) . getCompletion
+
+ prefixedBy :: String -> String -> Maybe Completion
+ prefixedBy w cand = if w `isPrefixOf` cand
+ then Just (simpleCompletion cand)
+ else Nothing
+
+getCompletion :: CompletionContext -> CompletionM [Either String Completion]
+getCompletion ctx =
+ case ctx of
+ CtxFilePath f -> map Right <$> listFiles f
+ CtxModule -> map Left <$> getModuleNames
+ CtxIdentifier -> map Left <$> ((++) <$> getIdentNames <*> getDctorNames)
+ CtxType -> map Left <$> getTypeNames
+ CtxFixed str -> return [Left str]
+ CtxDirective d -> return (map Left (completeDirectives d))
+
+ where
+ completeDirectives :: String -> [String]
+ completeDirectives = map (':' :) . D.directiveStringsFor
+
+
+getLoadedModules :: CompletionM [P.Module]
+getLoadedModules = asks (map snd . psciLoadedModules)
+
+getImportedModules :: CompletionM [ImportedModule]
+getImportedModules = asks psciImportedModules
+
+getModuleNames :: CompletionM [String]
+getModuleNames = moduleNames <$> getLoadedModules
+
+mapLoadedModulesAndQualify :: (Show a) => (P.Module -> [(a, P.Declaration)]) -> CompletionM [String]
+mapLoadedModulesAndQualify f = do
+ ms <- getLoadedModules
+ let argPairs = do m <- ms
+ fm <- f m
+ return (m, fm)
+ concat <$> traverse (uncurry getAllQualifications) argPairs
+
+getIdentNames :: CompletionM [String]
+getIdentNames = mapLoadedModulesAndQualify identNames
+
+getDctorNames :: CompletionM [String]
+getDctorNames = mapLoadedModulesAndQualify dctorNames
+
+getTypeNames :: CompletionM [String]
+getTypeNames = mapLoadedModulesAndQualify typeDecls
+
+-- | Given a module and a declaration in that module, return all possible ways
+-- it could have been referenced given the current PSCiState - including fully
+-- qualified, qualified using an alias, and unqualified.
+getAllQualifications :: (Show a) => P.Module -> (a, P.Declaration) -> CompletionM [String]
+getAllQualifications m (declName, decl) = do
+ imports <- getAllImportsOf m
+ let fullyQualified = qualifyWith (Just (P.getModuleName m))
+ let otherQuals = nub (concatMap qualificationsUsing imports)
+ return $ fullyQualified : otherQuals
+ where
+ qualifyWith mMod = show (P.Qualified mMod declName)
+ referencedBy refs = P.isExported (Just refs) decl
+
+ qualificationsUsing (_, importType, asQ') =
+ let q = qualifyWith asQ'
+ in case importType of
+ P.Implicit -> [q]
+ P.Explicit refs -> if referencedBy refs
+ then [q]
+ else []
+ P.Hiding refs -> if referencedBy refs
+ then []
+ else [q]
+
+
+-- | Returns all the ImportedModule values referring to imports of a particular
+-- module.
+getAllImportsOf :: P.Module -> CompletionM [ImportedModule]
+getAllImportsOf = asks . allImportsOf
+
+nubOnFst :: Eq a => [(a, b)] -> [(a, b)]
+nubOnFst = nubBy ((==) `on` fst)
+
+typeDecls :: P.Module -> [(N.ProperName, P.Declaration)]
+typeDecls = mapMaybe getTypeName . filter P.isDataDecl . P.exportedDeclarations
+ where
+ getTypeName :: P.Declaration -> Maybe (N.ProperName, P.Declaration)
+ getTypeName d@(P.TypeSynonymDeclaration name _ _) = Just (name, d)
+ getTypeName d@(P.DataDeclaration _ name _ _) = Just (name, d)
+ getTypeName (P.PositionedDeclaration _ _ d) = getTypeName d
+ getTypeName _ = Nothing
+
+identNames :: P.Module -> [(N.Ident, P.Declaration)]
+identNames = nubOnFst . mapMaybe getDeclName . P.exportedDeclarations
+ where
+ getDeclName :: P.Declaration -> Maybe (P.Ident, P.Declaration)
+ getDeclName d@(P.ValueDeclaration ident _ _ _) = Just (ident, d)
+ getDeclName d@(P.ExternDeclaration ident _) = Just (ident, d)
+ getDeclName (P.PositionedDeclaration _ _ d) = getDeclName d
+ getDeclName _ = Nothing
+
+dctorNames :: P.Module -> [(N.ProperName, P.Declaration)]
+dctorNames = nubOnFst . concatMap go . P.exportedDeclarations
+ where
+ go :: P.Declaration -> [(N.ProperName, P.Declaration)]
+ go decl@(P.DataDeclaration _ _ _ ctors) = map (\n -> (n, decl)) (map fst ctors)
+ go (P.PositionedDeclaration _ _ d) = go d
+ go _ = []
+
+moduleNames :: [P.Module] -> [String]
+moduleNames ms = nub [show moduleName | P.Module _ moduleName _ _ <- ms]
+
+directivesFirst :: Completion -> Completion -> Ordering
+directivesFirst (Completion _ d1 _) (Completion _ d2 _) = go d1 d2
+ where
+ go (':' : xs) (':' : ys) = compare xs ys
+ go (':' : _) _ = LT
+ go _ (':' : _) = GT
+ go xs ys = compare xs ys
diff --git a/psci/Directive.hs b/psci/Directive.hs
index c7bebd2..f2a3ca6 100644
--- a/psci/Directive.hs
+++ b/psci/Directive.hs
@@ -15,65 +15,101 @@
module Directive where
-import Data.List (nub, isPrefixOf)
-
-data Directive
- = Help
- | Quit
- | Reset
- | Browse
- | Load
- | Type
- | Kind
- | Show
- deriving Eq
+import Data.Maybe (fromJust, listToMaybe)
+import Data.List (isPrefixOf)
+import Data.Tuple (swap)
+
+import Types
-- |
--- Maps given directive to relating command strings.
+-- List of all avaliable directives.
--
-commands :: Directive -> [String]
-commands Help = ["?", "help"]
-commands Quit = ["quit"]
-commands Reset = ["reset"]
-commands Browse = ["browse"]
-commands Load = ["load", "module"]
-commands Type = ["type"]
-commands Kind = ["kind"]
-commands Show = ["show"]
+directives :: [Directive]
+directives = map fst directiveStrings
-- |
--- Tries to parse given string into a directive.
+-- A mapping of directives to the different strings that can be used to invoke
+-- them.
--
-parseDirective :: String -> Maybe Directive
-parseDirective cmd =
- case filter (matches . snd) mapping of
- [directive] -> Just $ fst directive
- _ -> Nothing
+directiveStrings :: [(Directive, [String])]
+directiveStrings =
+ [ (Help , ["?", "help"])
+ , (Quit , ["quit"])
+ , (Reset , ["reset"])
+ , (Browse , ["browse"])
+ , (Load , ["load", "module"])
+ , (Foreign, ["foreign"])
+ , (Type , ["type"])
+ , (Kind , ["kind"])
+ , (Show , ["show"])
+ ]
+
+-- |
+-- Like directiveStrings, but the other way around.
+--
+directiveStrings' :: [(String, Directive)]
+directiveStrings' = concatMap go directiveStrings
where
- mapping :: [(Directive, [String])]
- mapping = zip directives (map commands directives)
+ go (dir, strs) = map (\s -> (s, dir)) strs
- matches :: [String] -> Bool
- matches = any (cmd `isPrefixOf`)
+-- |
+-- List of all directive strings.
+--
+strings :: [String]
+strings = concatMap snd directiveStrings
+
+-- |
+-- Returns all possible string representations of a directive.
+--
+stringsFor :: Directive -> [String]
+stringsFor d = fromJust (lookup d directiveStrings)
+
+-- |
+-- Returns the default string representation of a directive.
+--
+stringFor :: Directive -> String
+stringFor = head . stringsFor
+
+-- |
+-- Returns the list of directives which could be expanded from the string
+-- argument, together with the string alias that matched.
+--
+directivesFor' :: String -> [(Directive, String)]
+directivesFor' str = go directiveStrings'
+ where
+ go = map swap . filter ((str `isPrefixOf`) . fst)
+
+directivesFor :: String -> [Directive]
+directivesFor = map fst . directivesFor'
+
+directiveStringsFor :: String -> [String]
+directiveStringsFor = map snd . directivesFor'
+
+parseDirective :: String -> Maybe Directive
+parseDirective = listToMaybe . directivesFor
+
+-- |
+-- True if the given directive takes an argument, false otherwise.
+hasArgument :: Directive -> Bool
+hasArgument Help = False
+hasArgument Quit = False
+hasArgument Reset = False
+hasArgument _ = True
-- |
-- The help menu.
--
help :: [(Directive, String, String)]
help =
- [ (Help, "", "Show this help menu")
- , (Quit, "", "Quit PSCi")
- , (Reset, "", "Reset")
- , (Browse, "<module>", "Browse <module>")
- , (Load, "<file>", "Load <file> for importing")
- , (Type, "<expr>", "Show the type of <expr>")
- , (Kind, "<type>", "Show the kind of <type>")
- , (Show, "import", "Show imported modules")
- , (Show, "loaded", "Show loaded modules")
+ [ (Help, "", "Show this help menu")
+ , (Quit, "", "Quit PSCi")
+ , (Reset, "", "Discard all imported modules and declared bindings")
+ , (Browse, "<module>", "See all functions in <module>")
+ , (Load, "<file>", "Load <file> for importing")
+ , (Foreign, "<file>", "Load foreign module <file>")
+ , (Type, "<expr>", "Show the type of <expr>")
+ , (Kind, "<type>", "Show the kind of <type>")
+ , (Show, "import", "Show all imported modules")
+ , (Show, "loaded", "Show all loaded modules")
]
--- |
--- List of all avaliable directives.
---
-directives :: [Directive]
-directives = nub . map (\(dir, _, _) -> dir) $ help
diff --git a/psci/IO.hs b/psci/IO.hs
new file mode 100644
index 0000000..36a55d1
--- /dev/null
+++ b/psci/IO.hs
@@ -0,0 +1,21 @@
+-----------------------------------------------------------------------------
+--
+-- Module : IO
+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
+-- License : MIT
+--
+-- Maintainer : Phil Freeman <paf31@cantab.net>
+-- Stability : experimental
+-- Portability :
+--
+-- |
+--
+-----------------------------------------------------------------------------
+
+module IO where
+
+import System.Directory (createDirectoryIfMissing)
+import System.FilePath (takeDirectory)
+
+mkdirp :: FilePath -> IO ()
+mkdirp = createDirectoryIfMissing True . takeDirectory
diff --git a/psci/Main.hs b/psci/Main.hs
deleted file mode 100644
index 5969d70..0000000
--- a/psci/Main.hs
+++ /dev/null
@@ -1,702 +0,0 @@
------------------------------------------------------------------------------
---
--- Module : Main
--- Copyright : (c) Phil Freeman 2013
--- License : MIT
---
--- Maintainer : Phil Freeman <paf31@cantab.net>
--- Stability : experimental
--- Portability :
---
--- |
--- PureScript Compiler Interactive.
---
------------------------------------------------------------------------------
-
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DoAndIfThenElse #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE RecordWildCards #-}
-
-module Main where
-
-import Data.Foldable (traverse_)
-import Data.List (intercalate, isPrefixOf, nub, sortBy, sort)
-import Data.Maybe (mapMaybe)
-import Data.Traversable (traverse)
-import Data.Version (showVersion)
-import Data.Char (isSpace)
-import qualified Data.Map as M
-
-import Control.Applicative
-import Control.Monad
-import Control.Monad.Except (ExceptT(..), MonadError, runExceptT)
-import Control.Monad.Reader (MonadReader, ReaderT, runReaderT)
-import Control.Monad.Trans.Class
-import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
-import Control.Monad.Trans.State.Strict
-import qualified Control.Monad.Trans.State.Lazy as L
-
-import Options.Applicative as Opts
-
-import System.Console.Haskeline
-import System.Directory (createDirectoryIfMissing, getModificationTime, doesFileExist, findExecutable, getHomeDirectory, getCurrentDirectory)
-import System.Exit
-import System.FilePath (pathSeparator, takeDirectory, (</>), isPathSeparator)
-import System.IO.Error (tryIOError)
-import System.Process (readProcessWithExitCode)
-
-import qualified Text.Parsec as Par (ParseError)
-
-import qualified Language.PureScript as P
-import qualified Language.PureScript.AST as D
-import qualified Language.PureScript.Names as N
-import qualified Paths_purescript as Paths
-
-import qualified Commands as C
-import qualified Directive as D
-import Parser
-
-data PSCiOptions = PSCiOptions
- { psciMultiLineMode :: Bool
- , psciInputFile :: [FilePath]
- , psciInputNodeFlags :: [String]
- }
-
--- |
--- The PSCI state.
--- Holds a list of imported modules, loaded files, and partial let bindings.
--- The let bindings are partial,
--- because it makes more sense to apply the binding to the final evaluated expression.
---
-data PSCiState = PSCiState
- { psciImportedFilenames :: [FilePath]
- , psciImportedModules :: [C.ImportedModule]
- , psciLoadedModules :: [(Either P.RebuildPolicy FilePath, P.Module)]
- , psciLetBindings :: [P.Declaration]
- , psciNodeFlags :: [String]
- }
-
-psciImportedModuleNames :: PSCiState -> [P.ModuleName]
-psciImportedModuleNames (PSCiState{psciImportedModules = is}) =
- map (\(mn, _, _) -> mn) is
-
--- State helpers
-
--- |
--- Updates the state to have more imported modules.
---
-updateImportedFiles :: FilePath -> PSCiState -> PSCiState
-updateImportedFiles filename st = st { psciImportedFilenames = filename : psciImportedFilenames st }
-
--- |
--- Updates the state to have more imported modules.
---
-updateImportedModules :: C.ImportedModule -> PSCiState -> PSCiState
-updateImportedModules im st = st { psciImportedModules = im : psciImportedModules st }
-
--- |
--- Updates the state to have more loaded files.
---
-updateModules :: [(Either P.RebuildPolicy FilePath, P.Module)] -> PSCiState -> PSCiState
-updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }
-
--- |
--- Updates the state to have more let bindings.
---
-updateLets :: [P.Declaration] -> PSCiState -> PSCiState
-updateLets ds st = st { psciLetBindings = psciLetBindings st ++ ds }
-
--- File helpers
--- |
--- Load the necessary modules.
---
-defaultImports :: [C.ImportedModule]
-defaultImports = [(P.ModuleName [P.ProperName "Prelude"], D.Implicit, Nothing)]
-
--- |
--- Locates the node executable.
--- Checks for either @nodejs@ or @node@.
---
-findNodeProcess :: IO (Maybe String)
-findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
- where names = ["nodejs", "node"]
-
--- |
--- Grabs the filename where the history is stored.
---
-getHistoryFilename :: IO FilePath
-getHistoryFilename = do
- home <- getHomeDirectory
- let filename = home </> ".purescript" </> "psci_history"
- mkdirp filename
- return filename
-
--- |
--- Loads a file for use with imports.
---
-loadModule :: FilePath -> IO (Either String [P.Module])
-loadModule filename = do
- content <- readFile filename
- return $ either (Left . show) (Right . map snd) $ P.parseModulesFromFiles id [(filename, content)]
-
--- |
--- Load all modules, including the Prelude
---
-loadAllModules :: [FilePath] -> IO (Either Par.ParseError [(Either P.RebuildPolicy FilePath, P.Module)])
-loadAllModules files = do
- filesAndContent <- forM files $ \filename -> do
- content <- readFile filename
- return (Right filename, content)
- return $ P.parseModulesFromFiles (either (const "") id) $ (Left P.RebuildNever, P.prelude) : filesAndContent
-
--- |
--- Load all modules, updating the application state
---
-loadAllImportedModules :: PSCI ()
-loadAllImportedModules = do
- files <- PSCI . lift $ fmap psciImportedFilenames get
- modulesOrFirstError <- psciIO $ loadAllModules files
- case modulesOrFirstError of
- Left err -> psciIO $ print err
- Right modules -> PSCI . lift . modify $ \st -> st { psciLoadedModules = modules }
-
--- |
--- Expands tilde in path.
---
-expandTilde :: FilePath -> IO FilePath
-expandTilde ('~':p:rest) | isPathSeparator p = (</> rest) <$> getHomeDirectory
-expandTilde p = return p
--- Messages
-
--- |
--- The help message.
---
-helpMessage :: String
-helpMessage = "The following commands are available:\n\n " ++
- intercalate "\n " (map line D.help)
- where
- line :: (D.Directive, String, String) -> String
- line (dir, arg, desc) = intercalate " "
- [ cmd
- , replicate (11 - length cmd) ' '
- , arg
- , replicate (11 - length arg) ' '
- , desc
- ]
- where cmd = ":" ++ head (D.commands dir)
-
--- |
--- The welcome prologue.
---
-prologueMessage :: String
-prologueMessage = intercalate "\n"
- [ " ____ ____ _ _ "
- , "| _ \\ _ _ _ __ ___/ ___| ___ _ __(_)_ __ | |_ "
- , "| |_) | | | | '__/ _ \\___ \\ / __| '__| | '_ \\| __|"
- , "| __/| |_| | | | __/___) | (__| | | | |_) | |_ "
- , "|_| \\__,_|_| \\___|____/ \\___|_| |_| .__/ \\__|"
- , " |_| "
- , ""
- , ":? shows help"
- ]
-
--- |
--- The quit message.
---
-quitMessage :: String
-quitMessage = "See ya!"
-
--- Haskeline completions
-
-data CompletionContext = Command String | FilePath String | Module | Identifier
- | Type | Fixed [String] | Multiple [CompletionContext]
- deriving (Show)
-
--- |
--- Decide what kind of completion we need based on input.
-completionContext :: String -> String -> Maybe CompletionContext
-completionContext cmd@"" _ = Just $ Multiple [Command cmd, Identifier]
-completionContext (':' : cmd) word =
- case D.parseDirective dstr of
- Just directive | dstr `elem` D.commands directive -> context directive
- _ -> Just $ Command cmd
- where
- dstr :: String
- dstr = takeWhile (not . isSpace) cmd
-
- context :: D.Directive -> Maybe CompletionContext
- context D.Browse = Just Module
- context D.Load = Just $ FilePath word
- context D.Quit = Nothing
- context D.Reset = Nothing
- context D.Help = Nothing
- context D.Show = Just $ Fixed ["import", "loaded"]
- context D.Type = Just Identifier
- context D.Kind = Just Type
-completionContext _ _ = Just Identifier
-
--- |
--- Loads module, function, and file completions.
---
-completion :: CompletionFunc (StateT PSCiState IO)
-completion = completeWordWithPrev Nothing " \t\n\r" findCompletions
- where
- findCompletions :: String -> String -> StateT PSCiState IO [Completion]
- findCompletions prev word = do
- let ctx = completionContext ((dropWhile isSpace (reverse prev)) ++ word) word
- completions <- case ctx of
- Nothing -> return []
- (Just c) -> (mapMaybe $ either (\cand -> if word `isPrefixOf` cand
- then Just $ simpleCompletion cand
- else Nothing) Just)
- <$> getCompletion c
- return $ sortBy sorter completions
-
- getCompletion :: CompletionContext -> StateT PSCiState IO [Either String Completion]
- getCompletion (FilePath f) = (map Right) <$> listFiles f
- getCompletion Module = (map Left) <$> getModuleNames
- getCompletion Identifier = (map Left) <$> ((++) <$> getIdentNames <*> getDctorNames)
- getCompletion Type = (map Left) <$> getTypeNames
- getCompletion (Fixed list) = return $ (map Left) list
- getCompletion (Multiple contexts) = concat <$> mapM getCompletion contexts
- getCompletion (Command cmd) = return . map (Left . (":" ++)) . nub $ matching
- where
- matching :: [String]
- matching = filter (isPrefixOf cmd) . concatMap (D.commands) $ D.directives
-
- getLoadedModules :: StateT PSCiState IO [P.Module]
- getLoadedModules = map snd . psciLoadedModules <$> get
-
- getModuleNames :: StateT PSCiState IO [String]
- getModuleNames = moduleNames <$> getLoadedModules
-
- mapLoadedModulesAndQualify :: (Show a) => (P.Module -> [a]) -> StateT PSCiState IO [String]
- mapLoadedModulesAndQualify f = do
- ms <- getLoadedModules
- q <- sequence [qualifyIfNeeded m (f m) | m <- ms]
- return $ concat q
-
- getIdentNames :: StateT PSCiState IO [String]
- getIdentNames = mapLoadedModulesAndQualify identNames
-
- getDctorNames :: StateT PSCiState IO [String]
- getDctorNames = mapLoadedModulesAndQualify dctorNames
-
- getTypeNames :: StateT PSCiState IO [String]
- getTypeNames = mapLoadedModulesAndQualify typeDecls
-
- qualifyIfNeeded :: (Show a) => P.Module -> [a] -> StateT PSCiState IO [String]
- qualifyIfNeeded m decls = do
- let name = P.getModuleName m
- imported <- psciImportedModuleNames <$> get
- let qualified = map (P.Qualified $ Just name) decls
- if name `elem` imported then
- return $ map show $ qualified ++ (map (P.Qualified Nothing) decls)
- else
- return $ map show qualified
-
- typeDecls :: P.Module -> [N.ProperName]
- typeDecls m = mapMaybe getTypeName $ filter P.isDataDecl (P.exportedDeclarations m)
- where getTypeName :: P.Declaration -> Maybe N.ProperName
- getTypeName (P.TypeSynonymDeclaration name _ _) = Just name
- getTypeName (P.DataDeclaration _ name _ _) = Just name
- getTypeName (P.PositionedDeclaration _ _ d) = getTypeName d
- getTypeName _ = Nothing
-
- identNames :: P.Module -> [N.Ident]
- identNames (P.Module _ _ ds exports) = nub [ ident | ident <- mapMaybe (getDeclName exports) (D.flattenDecls ds) ]
- where getDeclName :: Maybe [P.DeclarationRef] -> P.Declaration -> Maybe P.Ident
- getDeclName exts decl@(P.ValueDeclaration ident _ _ _) | P.isExported exts decl = Just ident
- getDeclName exts decl@(P.ExternDeclaration _ ident _ _) | P.isExported exts decl = Just ident
- getDeclName exts (P.PositionedDeclaration _ _ d) = getDeclName exts d
- getDeclName _ _ = Nothing
-
- dctorNames :: P.Module -> [N.ProperName]
- dctorNames m = nub $ concat $ map (P.exportedDctors m) dnames
- where getDataDeclName :: P.Declaration -> Maybe N.ProperName
- getDataDeclName (P.DataDeclaration _ name _ _) = Just name
- getDataDeclName (P.PositionedDeclaration _ _ d) = getDataDeclName d
- getDataDeclName _ = Nothing
-
- dnames :: [N.ProperName]
- dnames = (mapMaybe getDataDeclName onlyDataDecls)
-
- onlyDataDecls :: [P.Declaration]
- onlyDataDecls = (filter P.isDataDecl (P.exportedDeclarations m))
-
- moduleNames :: [P.Module] -> [String]
- moduleNames ms = nub [show moduleName | P.Module _ moduleName _ _ <- ms]
-
- sorter :: Completion -> Completion -> Ordering
- sorter (Completion _ d1 _) (Completion _ d2 _) = if ":" `isPrefixOf` d1 then LT else compare d1 d2
-
--- Compilation
-
--- | Compilation options.
---
-options :: P.Options P.Make
-options = P.Options False False False Nothing False False False P.MakeOptions
-
--- |
--- PSCI monad
---
-newtype PSCI a = PSCI { runPSCI :: InputT (StateT PSCiState IO) a } deriving (Functor, Applicative, Monad)
-
-psciIO :: IO a -> PSCI a
-psciIO io = PSCI . lift $ lift io
-
-newtype Make a = Make { unMake :: ReaderT (P.Options P.Make) (ExceptT String IO) a }
- deriving (Functor, Applicative, Monad, MonadError String, MonadReader (P.Options P.Make))
-
-runMake :: Make a -> IO (Either String a)
-runMake = runExceptT . flip runReaderT options . unMake
-
-makeIO :: IO a -> Make a
-makeIO = Make . lift . ExceptT . fmap (either (Left . show) Right) . tryIOError
-
-instance P.MonadMake Make where
- getTimestamp path = makeIO $ do
- exists <- doesFileExist path
- traverse (const $ getModificationTime path) $ guard exists
- readTextFile path = makeIO $ readFile path
- writeTextFile path text = makeIO $ do
- mkdirp path
- writeFile path text
- progress s = unless (s == "Compiling $PSCI") $ makeIO . putStrLn $ s
-
-mkdirp :: FilePath -> IO ()
-mkdirp = createDirectoryIfMissing True . takeDirectory
-
--- |
--- Makes a volatile module to execute the current expression.
---
-createTemporaryModule :: Bool -> PSCiState -> P.Expr -> P.Module
-createTemporaryModule exec PSCiState{psciImportedModules = imports, psciLetBindings = lets} val =
- let
- moduleName = P.ModuleName [P.ProperName "$PSCI"]
- traceModule = P.ModuleName [P.ProperName "Debug", P.ProperName "Trace"]
- trace = P.Var (P.Qualified (Just traceModule) (P.Ident "print"))
- mainValue = P.App trace (P.Var (P.Qualified Nothing (P.Ident "it")))
- itDecl = P.ValueDeclaration (P.Ident "it") P.Value [] $ Right val
- mainDecl = P.ValueDeclaration (P.Ident "main") P.Value [] $ Right mainValue
- decls = if exec then [itDecl, mainDecl] else [itDecl]
- in
- P.Module [] moduleName ((importDecl `map` imports) ++ lets ++ decls) Nothing
-
-
--- |
--- Makes a volatile module to hold a non-qualified type synonym for a fully-qualified data type declaration.
---
-createTemporaryModuleForKind :: PSCiState -> P.Type -> P.Module
-createTemporaryModuleForKind PSCiState{psciImportedModules = imports} typ =
- let
- moduleName = P.ModuleName [P.ProperName "$PSCI"]
- itDecl = P.TypeSynonymDeclaration (P.ProperName "IT") [] typ
- in
- P.Module [] moduleName ((importDecl `map` imports) ++ [itDecl]) Nothing
-
--- |
--- Makes a volatile module to execute the current imports.
---
-createTemporaryModuleForImports :: PSCiState -> P.Module
-createTemporaryModuleForImports PSCiState{psciImportedModules = imports} =
- let
- moduleName = P.ModuleName [P.ProperName "$PSCI"]
- in
- P.Module [] moduleName (importDecl `map` imports) Nothing
-
-importDecl :: C.ImportedModule -> P.Declaration
-importDecl (mn, declType, asQ) = P.ImportDeclaration mn declType asQ
-
-modulesDir :: FilePath
-modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"
-
-indexFile :: FilePath
-indexFile = ".psci_modules" ++ pathSeparator : "index.js"
-
--- |
--- Takes a value declaration and evaluates it with the current state.
---
-handleDeclaration :: P.Expr -> PSCI ()
-handleDeclaration val = do
- st <- PSCI $ lift get
- let m = createTemporaryModule True st val
- let nodeArgs = psciNodeFlags st ++ [indexFile]
- e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
- case e of
- Left err -> PSCI $ outputStrLn err
- Right _ -> do
- psciIO $ writeFile indexFile "require('$PSCI').main();"
- process <- psciIO findNodeProcess
- result <- psciIO $ traverse (\node -> readProcessWithExitCode node nodeArgs "") process
- case result of
- Just (ExitSuccess, out, _) -> PSCI $ outputStrLn out
- Just (ExitFailure _, _, err) -> PSCI $ outputStrLn err
- Nothing -> PSCI $ outputStrLn "Couldn't find node.js"
-
--- |
--- Takes a list of declarations and updates the environment, then run a make. If the declaration fails,
--- restore the original environment.
---
-handleDecls :: [P.Declaration] -> PSCI ()
-handleDecls ds = do
- st <- PSCI $ lift get
- let st' = updateLets ds st
- let m = createTemporaryModule False st' (P.ObjectLiteral [])
- e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st' ++ [(Left P.RebuildAlways, m)]) []
- case e of
- Left err -> PSCI $ outputStrLn err
- Right _ -> PSCI $ lift (put st')
-
--- |
--- Show actual loaded modules in psci.
---
-handleShowLoadedModules :: PSCI ()
-handleShowLoadedModules = do
- PSCiState { psciLoadedModules = loadedModules } <- PSCI $ lift get
- psciIO $ readModules loadedModules >>= putStrLn
- return ()
- where readModules = return . unlines . sort . nub . map toModuleName
- toModuleName = N.runModuleName . (\ (D.Module _ mdName _ _) -> mdName) . snd
-
--- |
--- Show the imported modules in psci.
---
-handleShowImportedModules :: PSCI ()
-handleShowImportedModules = do
- PSCiState { psciImportedModules = importedModules } <- PSCI $ lift get
- psciIO $ showModules importedModules >>= putStrLn
- return ()
- where
- showModules = return . unlines . sort . map showModule
- showModule (mn, declType, asQ) =
- "import " ++ case asQ of
- Just mn' -> "qualified " ++ N.runModuleName mn ++ " as " ++ N.runModuleName mn'
- Nothing -> N.runModuleName mn ++ " " ++ showDeclType declType
-
- showDeclType D.Implicit = ""
- showDeclType (D.Explicit refs) = refsList refs
- showDeclType (D.Hiding refs) = "hiding " ++ refsList refs
- refsList refs = "(" ++ commaList (map showRef refs) ++ ")"
-
- showRef :: P.DeclarationRef -> String
- showRef (D.TypeRef pn dctors) = show pn ++ "(" ++ maybe ".." (commaList . map N.runProperName) dctors ++ ")"
- showRef (D.ValueRef ident) = show ident
- showRef (D.TypeClassRef pn) = show pn
- showRef (D.TypeInstanceRef ident) = show ident
- showRef (D.PositionedDeclarationRef _ _ ref) = showRef ref
-
- commaList :: [String] -> String
- commaList = intercalate ", "
-
--- |
--- Imports a module, preserving the initial state on failure.
---
-handleImport :: C.ImportedModule -> PSCI ()
-handleImport im = do
- st <- updateImportedModules im <$> PSCI (lift get)
- let m = createTemporaryModuleForImports st
- e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
- case e of
- Left err -> PSCI $ outputStrLn err
- Right _ -> do
- PSCI $ lift $ put st
- return ()
-
--- |
--- Takes a value and prints its type
---
-handleTypeOf :: P.Expr -> PSCI ()
-handleTypeOf val = do
- st <- PSCI $ lift get
- let m = createTemporaryModule False st val
- e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
- case e of
- Left err -> PSCI $ outputStrLn err
- Right env' ->
- case M.lookup (P.ModuleName [P.ProperName "$PSCI"], P.Ident "it") (P.names env') of
- Just (ty, _, _) -> PSCI . outputStrLn . P.prettyPrintType $ ty
- Nothing -> PSCI $ outputStrLn "Could not find type"
-
--- |
--- Pretty print a module's signatures
---
-printModuleSignatures :: P.ModuleName -> P.Environment -> PSCI ()
-printModuleSignatures moduleName env =
- PSCI $ let namesEnv = P.names env
- moduleNamesIdent = (filter ((== moduleName) . fst) . M.keys) namesEnv
- in case moduleNamesIdent of
- [] -> outputStrLn $ "This module '"++ P.runModuleName moduleName ++"' does not export functions."
- _ -> ( outputStrLn
- . unlines
- . sort
- . map (showType . findType namesEnv)) moduleNamesIdent
- 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))
- findType envNames m@(_, mIdent) = (mIdent, M.lookup m envNames)
- showType :: (P.Ident, Maybe (P.Type, P.NameKind, P.NameVisibility)) -> String
- showType (mIdent, Just (mType, _, _)) = show mIdent ++ " :: " ++ P.prettyPrintType mType
- showType _ = error "The impossible happened in printModuleSignatures."
-
--- |
--- Browse a module and displays its signature (if module exists).
---
-handleBrowse :: P.ModuleName -> PSCI ()
-handleBrowse moduleName = do
- st <- PSCI $ lift get
- let loadedModules = psciLoadedModules st
- env <- psciIO . runMake $ P.make modulesDir loadedModules []
- case env of
- Left err -> PSCI $ outputStrLn err
- Right env' ->
- if moduleName `notElem` (nub . map ((\ (P.Module _ modName _ _ ) -> modName) . snd)) loadedModules
- then PSCI $ outputStrLn $ "Module '" ++ N.runModuleName moduleName ++ "' is not valid."
- else printModuleSignatures moduleName env'
-
--- |
--- Takes a value and prints its kind
---
-handleKindOf :: P.Type -> PSCI ()
-handleKindOf typ = do
- st <- PSCI $ lift get
- let m = createTemporaryModuleForKind st typ
- mName = P.ModuleName [P.ProperName "$PSCI"]
- e <- psciIO . runMake $ P.make modulesDir (psciLoadedModules st ++ [(Left P.RebuildAlways, m)]) []
- case e of
- Left err -> PSCI $ outputStrLn err
- Right env' ->
- case M.lookup (P.Qualified (Just mName) $ P.ProperName "IT") (P.typeSynonyms env') of
- Just (_, typ') -> do
- let chk = P.CheckState env' 0 0 (Just mName)
- k = L.runStateT (P.unCheck (P.kindOf mName typ')) chk
- case k of
- Left errStack -> PSCI . outputStrLn . P.prettyPrintMultipleErrors False $ errStack
- Right (kind, _) -> PSCI . outputStrLn . P.prettyPrintKind $ kind
- Nothing -> PSCI $ outputStrLn "Could not find kind"
-
--- Commands
-
--- |
--- Parses the input and returns either a Metacommand or an expression.
---
-getCommand :: Bool -> InputT (StateT PSCiState IO) (Either String (Maybe C.Command))
-getCommand singleLineMode = do
- firstLine <- getInputLine "> "
- case firstLine of
- Nothing -> return (Right Nothing)
- Just "" -> return (Right Nothing)
- Just s | singleLineMode || head s == ':' -> return . either Left (Right . Just) $ parseCommand s
- Just s -> either Left (Right . Just) . parseCommand <$> go [s]
- where
- go :: [String] -> InputT (StateT PSCiState IO) String
- go ls = maybe (return . unlines $ reverse ls) (go . (:ls)) =<< getInputLine " "
-
--- |
--- Performs an action for each meta-command given, and also for expressions..
---
-handleCommand :: C.Command -> PSCI ()
-handleCommand (C.Expression val) = handleDeclaration val
-handleCommand C.Help = PSCI $ outputStrLn helpMessage
-handleCommand (C.Import im) = handleImport im
-handleCommand (C.Decls l) = handleDecls l
-handleCommand (C.LoadFile filePath) = do
- absPath <- psciIO $ expandTilde filePath
- exists <- psciIO $ doesFileExist absPath
- if exists then do
- PSCI . lift $ modify (updateImportedFiles absPath)
- m <- psciIO $ loadModule absPath
- case m of
- Left err -> PSCI $ outputStrLn err
- Right mods -> PSCI . lift $ modify (updateModules (map ((,) (Right absPath)) mods))
- else
- PSCI . outputStrLn $ "Couldn't locate: " ++ filePath
-handleCommand C.Reset = do
- files <- psciImportedFilenames <$> PSCI (lift get)
- PSCI . lift . modify $ \st -> st
- { psciImportedFilenames = files
- , psciImportedModules = defaultImports
- , psciLetBindings = []
- }
- loadAllImportedModules
-handleCommand (C.TypeOf val) = handleTypeOf val
-handleCommand (C.KindOf typ) = handleKindOf typ
-handleCommand (C.Browse moduleName) = handleBrowse moduleName
-handleCommand (C.Show "loaded") = handleShowLoadedModules
-handleCommand (C.Show "import") = handleShowImportedModules
-handleCommand _ = PSCI $ outputStrLn "Unknown command"
-
-loadUserConfig :: IO (Maybe [C.Command])
-loadUserConfig = do
- configFile <- (</> ".psci") <$> getCurrentDirectory
- exists <- doesFileExist configFile
- if exists
- then do
- ls <- lines <$> readFile configFile
- case mapM parseCommand ls of
- Left err -> print err >> exitFailure
- Right cs -> return $ Just cs
- else
- return Nothing
-
--- |
--- The PSCI main loop.
---
-loop :: PSCiOptions -> IO ()
-loop PSCiOptions{..} = do
- config <- loadUserConfig
- modulesOrFirstError <- loadAllModules psciInputFile
- case modulesOrFirstError of
- Left err -> print err >> exitFailure
- Right modules -> do
- historyFilename <- getHistoryFilename
- let settings = defaultSettings { historyFile = Just historyFilename }
- flip evalStateT (PSCiState psciInputFile defaultImports modules [] psciInputNodeFlags) . runInputT (setComplete completion settings) $ do
- outputStrLn prologueMessage
- traverse_ (mapM_ (runPSCI . handleCommand)) config
- go
- where
- go :: InputT (StateT PSCiState IO) ()
- go = do
- c <- getCommand (not psciMultiLineMode)
- case c of
- Left err -> outputStrLn err >> go
- Right Nothing -> go
- Right (Just C.Quit) -> outputStrLn quitMessage
- Right (Just c') -> runPSCI (loadAllImportedModules >> handleCommand c') >> go
-
-multiLineMode :: Parser Bool
-multiLineMode = switch $
- long "multi-line-mode"
- <> short 'm'
- <> Opts.help "Run in multi-line mode (use ^D to terminate commands)"
-
-inputFile :: Parser FilePath
-inputFile = strArgument $
- metavar "FILE"
- <> Opts.help "Optional .purs files to load on start"
-
-nodeFlagsFlag :: Parser [String]
-nodeFlagsFlag = option parser $
- long "node-opts"
- <> metavar "NODE_OPTS"
- <> value []
- <> Opts.help "Flags to pass to node, separated by spaces"
- where
- parser = words <$> str
-
-psciOptions :: Parser PSCiOptions
-psciOptions = PSCiOptions <$> multiLineMode
- <*> many inputFile
- <*> nodeFlagsFlag
-
-main :: IO ()
-main = execParser opts >>= loop
- where
- opts = info (version <*> helper <*> psciOptions) infoModList
- infoModList = fullDesc <> headerInfo <> footerInfo
- headerInfo = header "psci - Interactive mode for PureScript"
- footerInfo = footer $ "psci " ++ showVersion Paths.version
-
- version :: Parser (a -> a)
- version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> Opts.help "Show the version number" <> hidden
diff --git a/psci/Make.hs b/psci/Make.hs
new file mode 100644
index 0000000..b416c57
--- /dev/null
+++ b/psci/Make.hs
@@ -0,0 +1,127 @@
+-----------------------------------------------------------------------------
+--
+-- Module : Make
+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
+-- License : MIT
+--
+-- Maintainer : Phil Freeman <paf31@cantab.net>
+-- Stability : experimental
+-- Portability :
+--
+-- |
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TupleSections #-}
+
+module Make where
+
+import Data.List (isPrefixOf)
+import Data.Maybe (fromMaybe)
+import Data.Time.Clock
+import Data.Traversable (traverse)
+import qualified Data.Map as M
+
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Error.Class (MonadError(..))
+import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.Reader (MonadReader, ReaderT, runReaderT)
+import Control.Monad.Trans.Except (ExceptT(..), runExceptT)
+import Control.Monad.Writer (MonadWriter, WriterT, runWriterT, tell)
+
+import System.Directory (getModificationTime, doesFileExist)
+import System.FilePath ((</>), pathSeparator)
+import System.IO.Error (tryIOError)
+
+import qualified Language.PureScript as P
+import qualified Language.PureScript.CodeGen.JS as J
+import qualified Language.PureScript.CoreFn as CF
+
+import IO (mkdirp)
+
+options :: P.Options
+options = P.Options False False Nothing False False False Nothing
+
+modulesDir :: FilePath
+modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"
+
+newtype Make a = Make { unMake :: ReaderT P.Options (WriterT P.MultipleErrors (ExceptT P.MultipleErrors IO)) a }
+ deriving (Functor, Applicative, Monad, MonadIO, MonadError P.MultipleErrors, MonadWriter P.MultipleErrors, MonadReader P.Options)
+
+runMake :: Make a -> IO (Either P.MultipleErrors a)
+runMake = runExceptT . fmap fst . runWriterT . flip runReaderT options . unMake
+
+makeIO :: (IOError -> P.ErrorMessage) -> IO a -> Make a
+makeIO f io = do
+ e <- liftIO $ tryIOError io
+ either (throwError . P.singleError . f) return e
+
+-- Traverse (Either e) instance (base 4.7)
+traverseEither :: Applicative f => (a -> f b) -> Either e a -> f (Either e b)
+traverseEither _ (Left x) = pure (Left x)
+traverseEither f (Right y) = Right <$> f y
+
+buildMakeActions :: M.Map P.ModuleName (Either P.RebuildPolicy String)
+ -> M.Map P.ModuleName P.ForeignJS
+ -> P.MakeActions Make
+buildMakeActions filePathMap foreigns =
+ P.MakeActions getInputTimestamp getOutputTimestamp readExterns codegen progress
+ where
+
+ getInputTimestamp :: P.ModuleName -> Make (Either P.RebuildPolicy (Maybe UTCTime))
+ getInputTimestamp mn = do
+ let path = fromMaybe (error "Module has no filename in 'make'") $ M.lookup mn filePathMap
+ traverseEither getTimestamp path
+
+ getOutputTimestamp :: P.ModuleName -> Make (Maybe UTCTime)
+ getOutputTimestamp mn = do
+ let filePath = P.runModuleName mn
+ jsFile = modulesDir </> filePath </> "index.js"
+ externsFile = modulesDir </> filePath </> "externs.purs"
+ min <$> getTimestamp jsFile <*> getTimestamp externsFile
+
+ readExterns :: P.ModuleName -> Make (FilePath, String)
+ readExterns mn = do
+ let path = modulesDir </> P.runModuleName mn </> "externs.purs"
+ (path, ) <$> readTextFile path
+
+ codegen :: CF.Module CF.Ann -> P.Environment -> P.SupplyVar -> P.Externs -> Make ()
+ codegen m _ nextVar exts = do
+ let mn = CF.moduleName m
+ foreignInclude <- case CF.moduleName m `M.lookup` foreigns of
+ Just path
+ | not $ requiresForeign m -> do tell $ P.errorMessage $ P.UnnecessaryFFIModule mn path
+ return Nothing
+ | otherwise -> return $ Just $ J.JSApp (J.JSVar "require") [J.JSStringLiteral "./foreign"]
+ Nothing | requiresForeign m -> throwError . P.errorMessage $ P.MissingFFIModule mn
+ | otherwise -> return Nothing
+ pjs <- P.evalSupplyT nextVar $ P.prettyPrintJS <$> J.moduleToJs m foreignInclude
+ let filePath = P.runModuleName $ CF.moduleName m
+ jsFile = modulesDir </> filePath </> "index.js"
+ externsFile = modulesDir </> filePath </> "externs.purs"
+ foreignFile = modulesDir </> filePath </> "foreign.js"
+ writeTextFile jsFile pjs
+ maybe (return ()) (writeTextFile foreignFile) $ CF.moduleName m `M.lookup` foreigns
+ writeTextFile externsFile exts
+
+ requiresForeign :: CF.Module a -> Bool
+ requiresForeign = not . null . CF.moduleForeign
+
+ getTimestamp :: FilePath -> Make (Maybe UTCTime)
+ getTimestamp path = makeIO (const (P.SimpleErrorWrapper $ P.CannotGetFileInfo path)) $ do
+ exists <- doesFileExist path
+ traverse (const $ getModificationTime path) $ guard exists
+
+ readTextFile :: FilePath -> Make String
+ readTextFile path = makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile path)) $ readFile path
+
+ writeTextFile :: FilePath -> String -> Make ()
+ writeTextFile path text = makeIO (const (P.SimpleErrorWrapper $ P.CannotWriteFile path)) $ do
+ mkdirp path
+ writeFile path text
+
+ progress :: String -> Make ()
+ progress s = unless ("Compiling $PSCI" `isPrefixOf` s) $ liftIO . putStrLn $ s
diff --git a/psci/PSCi.hs b/psci/PSCi.hs
new file mode 100644
index 0000000..fd38f04
--- /dev/null
+++ b/psci/PSCi.hs
@@ -0,0 +1,569 @@
+-----------------------------------------------------------------------------
+--
+-- Module : PSCi
+-- Copyright : (c) Phil Freeman 2013
+-- License : MIT
+--
+-- Maintainer : Phil Freeman <paf31@cantab.net>
+-- Stability : experimental
+-- Portability :
+--
+-- |
+-- PureScript Compiler Interactive.
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE DoAndIfThenElse #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
+
+module PSCi where
+
+import Data.Foldable (traverse_)
+import Data.List (intercalate, nub, sort)
+import Data.Traversable (traverse)
+import Data.Tuple (swap)
+import Data.Version (showVersion)
+import qualified Data.Map as M
+
+import Control.Applicative
+import Control.Arrow (first)
+import Control.Monad
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Except (runExceptT)
+import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
+import Control.Monad.Trans.State.Strict
+import Control.Monad.Writer (runWriter)
+import qualified Control.Monad.Trans.State.Lazy as L
+
+import Options.Applicative as Opts
+
+import System.Console.Haskeline
+import System.Directory (doesFileExist, findExecutable, getHomeDirectory, getCurrentDirectory)
+import System.Exit
+import System.FilePath (pathSeparator, (</>), isPathSeparator)
+import System.FilePath.Glob (glob)
+import System.Process (readProcessWithExitCode)
+
+import qualified Language.PureScript as P
+import qualified Language.PureScript.Names as N
+import qualified Paths_purescript as Paths
+
+import qualified Directive as D
+import Completion (completion)
+import IO (mkdirp)
+import Make
+import Parser (parseCommand)
+import Types
+
+-- | The name of the PSCI support module
+supportModuleName :: P.ModuleName
+supportModuleName = P.ModuleName [P.ProperName "$PSCI", P.ProperName "Support"]
+
+-- | Support module, contains code to evaluate terms
+supportModule :: P.Module
+supportModule =
+ case P.parseModulesFromFiles id [("", code)] of
+ Right [(_, P.Module cs _ ds exps)] -> P.Module cs supportModuleName ds exps
+ _ -> error "Support module could not be parsed"
+ where
+ code :: String
+ code = unlines
+ [ "module S where"
+ , ""
+ , "import Prelude"
+ , "import Control.Monad.Eff"
+ , "import Control.Monad.Eff.Console"
+ , "import Control.Monad.Eff.Unsafe"
+ , ""
+ , "class Eval a where"
+ , " eval :: a -> Eff (console :: CONSOLE) Unit"
+ , ""
+ , "instance evalShow :: (Show a) => Eval a where"
+ , " eval = print"
+ , ""
+ , "instance evalEff :: (Eval a) => Eval (Eff eff a) where"
+ , " eval x = unsafeInterleaveEff x >>= eval"
+ ]
+
+-- File helpers
+
+-- |
+-- Locates the node executable.
+-- Checks for either @nodejs@ or @node@.
+--
+findNodeProcess :: IO (Maybe String)
+findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
+ where names = ["nodejs", "node"]
+
+-- |
+-- Grabs the filename where the history is stored.
+--
+getHistoryFilename :: IO FilePath
+getHistoryFilename = do
+ home <- getHomeDirectory
+ let filename = home </> ".purescript" </> "psci_history"
+ mkdirp filename
+ return filename
+
+-- |
+-- Loads a file for use with imports.
+--
+loadModule :: FilePath -> IO (Either String [P.Module])
+loadModule filename = do
+ content <- readFile filename
+ return $ either (Left . P.prettyPrintMultipleErrors False) (Right . map snd) $ P.parseModulesFromFiles id [(filename, content)]
+
+-- |
+-- Load all modules.
+--
+loadAllModules :: [FilePath] -> IO (Either P.MultipleErrors [(Either P.RebuildPolicy FilePath, P.Module)])
+loadAllModules files = do
+ filesAndContent <- forM files $ \filename -> do
+ content <- readFile filename
+ return (Right filename, content)
+ return $ P.parseModulesFromFiles (either (const "") id) filesAndContent
+
+-- |
+-- Load all modules, updating the application state
+--
+loadAllImportedModules :: PSCI ()
+loadAllImportedModules = do
+ files <- PSCI . lift $ fmap psciImportedFilenames get
+ modulesOrFirstError <- psciIO $ loadAllModules files
+ case modulesOrFirstError of
+ Left errs -> printErrors errs
+ Right modules -> PSCI . lift . modify $ \st -> st { psciLoadedModules = modules }
+
+-- |
+-- Expands tilde in path.
+--
+expandTilde :: FilePath -> IO FilePath
+expandTilde ('~':p:rest) | isPathSeparator p = (</> rest) <$> getHomeDirectory
+expandTilde p = return p
+
+-- Messages
+
+-- |
+-- The help message.
+--
+helpMessage :: String
+helpMessage = "The following commands are available:\n\n " ++
+ intercalate "\n " (map line D.help) ++
+ "\n\n" ++ extraHelp
+ where
+ line :: (Directive, String, String) -> String
+ line (dir, arg, desc) =
+ let cmd = ':' : D.stringFor dir
+ in unwords [ cmd
+ , replicate (11 - length cmd) ' '
+ , arg
+ , replicate (11 - length arg) ' '
+ , desc
+ ]
+
+ extraHelp =
+ "Further information is available on the PureScript wiki:\n" ++
+ " --> https://github.com/purescript/purescript/wiki/psci"
+
+
+-- |
+-- The welcome prologue.
+--
+prologueMessage :: String
+prologueMessage = intercalate "\n"
+ [ " ____ ____ _ _ "
+ , "| _ \\ _ _ _ __ ___/ ___| ___ _ __(_)_ __ | |_ "
+ , "| |_) | | | | '__/ _ \\___ \\ / __| '__| | '_ \\| __|"
+ , "| __/| |_| | | | __/___) | (__| | | | |_) | |_ "
+ , "|_| \\__,_|_| \\___|____/ \\___|_| |_| .__/ \\__|"
+ , " |_| "
+ , ""
+ , ":? shows help"
+ ]
+
+-- |
+-- The quit message.
+--
+quitMessage :: String
+quitMessage = "See ya!"
+
+-- |
+-- PSCI monad
+--
+newtype PSCI a = PSCI { runPSCI :: InputT (StateT PSCiState IO) a } deriving (Functor, Applicative, Monad)
+
+psciIO :: IO a -> PSCI a
+psciIO io = PSCI . lift $ lift io
+
+-- |
+-- Makes a volatile module to execute the current expression.
+--
+createTemporaryModule :: Bool -> PSCiState -> P.Expr -> P.Module
+createTemporaryModule exec PSCiState{psciImportedModules = imports, psciLetBindings = lets} val =
+ let
+ moduleName = P.ModuleName [P.ProperName "$PSCI"]
+ trace = P.Var (P.Qualified (Just supportModuleName) (P.Ident "eval"))
+ mainValue = P.App trace (P.Var (P.Qualified Nothing (P.Ident "it")))
+ itDecl = P.ValueDeclaration (P.Ident "it") P.Public [] $ Right val
+ mainDecl = P.ValueDeclaration (P.Ident "main") P.Public [] $ Right mainValue
+ decls = if exec then [itDecl, mainDecl] else [itDecl]
+ in
+ P.Module [] moduleName ((importDecl `map` imports) ++ lets ++ decls) Nothing
+
+
+-- |
+-- Makes a volatile module to hold a non-qualified type synonym for a fully-qualified data type declaration.
+--
+createTemporaryModuleForKind :: PSCiState -> P.Type -> P.Module
+createTemporaryModuleForKind PSCiState{psciImportedModules = imports} typ =
+ let
+ moduleName = P.ModuleName [P.ProperName "$PSCI"]
+ itDecl = P.TypeSynonymDeclaration (P.ProperName "IT") [] typ
+ in
+ P.Module [] moduleName ((importDecl `map` imports) ++ [itDecl]) Nothing
+
+-- |
+-- Makes a volatile module to execute the current imports.
+--
+createTemporaryModuleForImports :: PSCiState -> P.Module
+createTemporaryModuleForImports PSCiState{psciImportedModules = imports} =
+ let
+ moduleName = P.ModuleName [P.ProperName "$PSCI"]
+ in
+ P.Module [] moduleName (importDecl `map` imports) Nothing
+
+importDecl :: ImportedModule -> P.Declaration
+importDecl (mn, declType, asQ) = P.ImportDeclaration mn declType asQ
+
+indexFile :: FilePath
+indexFile = ".psci_modules" ++ pathSeparator : "index.js"
+
+make :: PSCiState -> [(Either P.RebuildPolicy FilePath, P.Module)] -> Make P.Environment
+make PSCiState{..} ms =
+ let filePathMap = M.fromList $ (first P.getModuleName . swap) `map` (psciLoadedModules ++ ms)
+ in P.make (buildMakeActions filePathMap (M.map snd psciForeignFiles)) (psciLoadedModules ++ ms)
+
+-- |
+-- Takes a value declaration and evaluates it with the current state.
+--
+handleDeclaration :: P.Expr -> PSCI ()
+handleDeclaration val = do
+ st <- PSCI $ lift get
+ let m = createTemporaryModule True st val
+ let nodeArgs = psciNodeFlags st ++ [indexFile]
+ e <- psciIO . runMake $ make st [(Left P.RebuildAlways, supportModule), (Left P.RebuildAlways, m)]
+ case e of
+ Left errs -> printErrors errs
+ Right _ -> do
+ psciIO $ writeFile indexFile "require('$PSCI').main();"
+ process <- psciIO findNodeProcess
+ result <- psciIO $ traverse (\node -> readProcessWithExitCode node nodeArgs "") process
+ case result of
+ Just (ExitSuccess, out, _) -> PSCI $ outputStrLn out
+ Just (ExitFailure _, _, err) -> PSCI $ outputStrLn err
+ Nothing -> PSCI $ outputStrLn "Couldn't find node.js"
+
+-- |
+-- Takes a list of declarations and updates the environment, then run a make. If the declaration fails,
+-- restore the original environment.
+--
+handleDecls :: [P.Declaration] -> PSCI ()
+handleDecls ds = do
+ st <- PSCI $ lift get
+ let st' = updateLets ds st
+ let m = createTemporaryModule False st' (P.ObjectLiteral [])
+ e <- psciIO . runMake $ make st' [(Left P.RebuildAlways, m)]
+ case e of
+ Left err -> printErrors err
+ Right _ -> PSCI $ lift (put st')
+
+-- |
+-- Show actual loaded modules in psci.
+--
+handleShowLoadedModules :: PSCI ()
+handleShowLoadedModules = do
+ PSCiState { psciLoadedModules = loadedModules } <- PSCI $ lift get
+ psciIO $ readModules loadedModules >>= putStrLn
+ return ()
+ where readModules = return . unlines . sort . nub . map toModuleName
+ toModuleName = N.runModuleName . (\ (P.Module _ mdName _ _) -> mdName) . snd
+
+-- |
+-- Show the imported modules in psci.
+--
+handleShowImportedModules :: PSCI ()
+handleShowImportedModules = do
+ PSCiState { psciImportedModules = importedModules } <- PSCI $ lift get
+ psciIO $ showModules importedModules >>= putStrLn
+ return ()
+ where
+ showModules = return . unlines . sort . map showModule
+ showModule (mn, declType, asQ) =
+ "import " ++ case asQ of
+ Just mn' -> "qualified " ++ N.runModuleName mn ++ " as " ++ N.runModuleName mn'
+ Nothing -> N.runModuleName mn ++ " " ++ showDeclType declType
+
+ showDeclType P.Implicit = ""
+ showDeclType (P.Explicit refs) = refsList refs
+ showDeclType (P.Hiding refs) = "hiding " ++ refsList refs
+ refsList refs = "(" ++ commaList (map showRef refs) ++ ")"
+
+ showRef :: P.DeclarationRef -> String
+ showRef (P.TypeRef pn dctors) = show pn ++ "(" ++ maybe ".." (commaList . map N.runProperName) dctors ++ ")"
+ showRef (P.ValueRef ident) = show ident
+ showRef (P.TypeClassRef pn) = show pn
+ showRef (P.TypeInstanceRef ident) = show ident
+ showRef (P.ModuleRef name) = "module " ++ show name
+ showRef (P.PositionedDeclarationRef _ _ ref) = showRef ref
+
+ commaList :: [String] -> String
+ commaList = intercalate ", "
+
+-- |
+-- Imports a module, preserving the initial state on failure.
+--
+handleImport :: ImportedModule -> PSCI ()
+handleImport im = do
+ st <- updateImportedModules im <$> PSCI (lift get)
+ let m = createTemporaryModuleForImports st
+ e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]
+ case e of
+ Left errs -> printErrors errs
+ Right _ -> do
+ PSCI $ lift $ put st
+ return ()
+
+-- |
+-- Takes a value and prints its type
+--
+handleTypeOf :: P.Expr -> PSCI ()
+handleTypeOf val = do
+ st <- PSCI $ lift get
+ let m = createTemporaryModule False st val
+ e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]
+ case e of
+ Left errs -> printErrors errs
+ Right env' ->
+ case M.lookup (P.ModuleName [P.ProperName "$PSCI"], P.Ident "it") (P.names env') of
+ Just (ty, _, _) -> PSCI . outputStrLn . P.prettyPrintType $ ty
+ Nothing -> PSCI $ outputStrLn "Could not find type"
+
+-- |
+-- Pretty print a module's signatures
+--
+printModuleSignatures :: P.ModuleName -> P.Environment -> PSCI ()
+printModuleSignatures moduleName env =
+ PSCI $ let namesEnv = P.names env
+ moduleNamesIdent = (filter ((== moduleName) . fst) . M.keys) namesEnv
+ in case moduleNamesIdent of
+ [] -> outputStrLn $ "This module '"++ P.runModuleName moduleName ++"' does not export functions."
+ _ -> ( outputStrLn
+ . unlines
+ . sort
+ . map (showType . findType namesEnv)) moduleNamesIdent
+ 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))
+ findType envNames m@(_, mIdent) = (mIdent, M.lookup m envNames)
+ showType :: (P.Ident, Maybe (P.Type, P.NameKind, P.NameVisibility)) -> String
+ showType (mIdent, Just (mType, _, _)) = show mIdent ++ " :: " ++ P.prettyPrintType mType
+ showType _ = error "The impossible happened in printModuleSignatures."
+
+-- |
+-- Browse a module and displays its signature (if module exists).
+--
+handleBrowse :: P.ModuleName -> PSCI ()
+handleBrowse moduleName = do
+ st <- PSCI $ lift get
+ env <- psciIO . runMake $ make st []
+ case env of
+ Left errs -> printErrors errs
+ Right env' ->
+ if moduleName `notElem` (nub . map ((\ (P.Module _ modName _ _ ) -> modName) . snd)) (psciLoadedModules st)
+ then PSCI $ outputStrLn $ "Module '" ++ N.runModuleName moduleName ++ "' is not valid."
+ else printModuleSignatures moduleName env'
+
+-- | Pretty-print errors
+printErrors :: P.MultipleErrors -> PSCI ()
+printErrors = PSCI . outputStrLn . P.prettyPrintMultipleErrors False
+
+-- |
+-- Takes a value and prints its kind
+--
+handleKindOf :: P.Type -> PSCI ()
+handleKindOf typ = do
+ st <- PSCI $ lift get
+ let m = createTemporaryModuleForKind st typ
+ mName = P.ModuleName [P.ProperName "$PSCI"]
+ e <- psciIO . runMake $ make st [(Left P.RebuildAlways, m)]
+ case e of
+ Left errs -> printErrors errs
+ Right env' ->
+ case M.lookup (P.Qualified (Just mName) $ P.ProperName "IT") (P.typeSynonyms env') of
+ Just (_, typ') -> do
+ let chk = P.CheckState env' 0 0 (Just mName)
+ k = fst . runWriter . runExceptT $ L.runStateT (P.unCheck (P.kindOf mName typ')) chk
+ case k of
+ Left errStack -> PSCI . outputStrLn . P.prettyPrintMultipleErrors False $ errStack
+ Right (kind, _) -> PSCI . outputStrLn . P.prettyPrintKind $ kind
+ Nothing -> PSCI $ outputStrLn "Could not find kind"
+
+-- Commands
+
+-- |
+-- Parses the input and returns either a Metacommand, or an error as a string.
+--
+getCommand :: Bool -> InputT (StateT PSCiState IO) (Either String (Maybe Command))
+getCommand singleLineMode = do
+ firstLine <- getInputLine "> "
+ case firstLine of
+ Nothing -> return (Right Nothing)
+ Just "" -> return (Right Nothing)
+ Just s | singleLineMode || head s == ':' -> return . either Left (Right . Just) $ parseCommand s
+ Just s -> either Left (Right . Just) . parseCommand <$> go [s]
+ where
+ go :: [String] -> InputT (StateT PSCiState IO) String
+ go ls = maybe (return . unlines $ reverse ls) (go . (:ls)) =<< getInputLine " "
+
+-- |
+-- Performs an action for each meta-command given, and also for expressions.
+--
+handleCommand :: Command -> PSCI ()
+handleCommand (Expression val) = handleDeclaration val
+handleCommand ShowHelp = PSCI $ outputStrLn helpMessage
+handleCommand (Import im) = handleImport im
+handleCommand (Decls l) = handleDecls l
+handleCommand (LoadFile filePath) = whenFileExists filePath $ \absPath -> do
+ PSCI . lift $ modify (updateImportedFiles absPath)
+ m <- psciIO $ loadModule absPath
+ case m of
+ Left err -> PSCI $ outputStrLn err
+ Right mods -> PSCI . lift $ modify (updateModules (map ((,) (Right absPath)) mods))
+handleCommand (LoadForeign filePath) = whenFileExists filePath $ \absPath -> do
+ foreignsOrError <- psciIO . runMake $ do
+ foreignFile <- makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile absPath)) (readFile absPath)
+ P.parseForeignModulesFromFiles [(absPath, foreignFile)]
+ case foreignsOrError of
+ Left err -> PSCI $ outputStrLn $ P.prettyPrintMultipleErrors False err
+ Right foreigns -> PSCI . lift $ modify (updateForeignFiles foreigns)
+handleCommand ResetState = do
+ files <- psciImportedFilenames <$> PSCI (lift get)
+ PSCI . lift . modify $ \st -> st
+ { psciImportedFilenames = files
+ , psciImportedModules = []
+ , psciLetBindings = []
+ }
+ loadAllImportedModules
+handleCommand (TypeOf val) = handleTypeOf val
+handleCommand (KindOf typ) = handleKindOf typ
+handleCommand (BrowseModule moduleName) = handleBrowse moduleName
+handleCommand (ShowInfo QueryLoaded) = handleShowLoadedModules
+handleCommand (ShowInfo QueryImport) = handleShowImportedModules
+handleCommand QuitPSCi = error "`handleCommand QuitPSCi` was called. This is a bug."
+
+whenFileExists :: FilePath -> (FilePath -> PSCI ()) -> PSCI ()
+whenFileExists filePath f = do
+ absPath <- psciIO $ expandTilde filePath
+ exists <- psciIO $ doesFileExist absPath
+ if exists
+ then f absPath
+ else PSCI . outputStrLn $ "Couldn't locate: " ++ filePath
+
+loadUserConfig :: IO (Maybe [Command])
+loadUserConfig = do
+ configFile <- (</> ".psci") <$> getCurrentDirectory
+ exists <- doesFileExist configFile
+ if exists
+ then do
+ ls <- lines <$> readFile configFile
+ case mapM parseCommand ls of
+ Left err -> print err >> exitFailure
+ Right cs -> return $ Just cs
+ else
+ return Nothing
+
+-- | Checks if the Console module is defined
+consoleIsDefined :: [P.Module] -> Bool
+consoleIsDefined = any ((== P.ModuleName (map P.ProperName [ "Control", "Monad", "Eff", "Console" ])) . P.getModuleName)
+
+-- |
+-- The PSCI main loop.
+--
+loop :: PSCiOptions -> IO ()
+loop PSCiOptions{..} = do
+ config <- loadUserConfig
+ inputFiles <- concat <$> mapM glob psciInputFile
+ foreignFiles <- concat <$> mapM glob psciForeignInputFiles
+ modulesOrFirstError <- loadAllModules inputFiles
+ case modulesOrFirstError of
+ Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
+ Right modules -> do
+ historyFilename <- getHistoryFilename
+ let settings = defaultSettings { historyFile = Just historyFilename }
+ foreignsOrError <- runMake $ do
+ foreignFilesContent <- forM foreignFiles (\inFile -> (inFile,) <$> makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile inFile)) (readFile inFile))
+ P.parseForeignModulesFromFiles foreignFilesContent
+ case foreignsOrError of
+ Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
+ Right foreigns ->
+ flip evalStateT (PSCiState inputFiles [] modules foreigns [] psciInputNodeFlags) . runInputT (setComplete completion settings) $ do
+ outputStrLn prologueMessage
+ traverse_ (mapM_ (runPSCI . handleCommand)) config
+ modules' <- lift $ gets psciLoadedModules
+ unless (consoleIsDefined (map snd modules')) . outputStrLn $ unlines
+ [ "PSCi requires the purescript-console module to be installed."
+ , "For help getting started, visit http://wiki.purescript.org/PSCi"
+ ]
+ go
+ where
+ go :: InputT (StateT PSCiState IO) ()
+ go = do
+ c <- getCommand (not psciMultiLineMode)
+ case c of
+ Left err -> outputStrLn err >> go
+ Right Nothing -> go
+ Right (Just QuitPSCi) -> outputStrLn quitMessage
+ Right (Just c') -> runPSCI (loadAllImportedModules >> handleCommand c') >> go
+
+multiLineMode :: Parser Bool
+multiLineMode = switch $
+ long "multi-line-mode"
+ <> short 'm'
+ <> Opts.help "Run in multi-line mode (use ^D to terminate commands)"
+
+inputFile :: Parser FilePath
+inputFile = strArgument $
+ metavar "FILE"
+ <> Opts.help "Optional .purs files to load on start"
+
+inputForeignFile :: Parser FilePath
+inputForeignFile = strOption $
+ short 'f'
+ <> long "ffi"
+ <> help "The input .js file(s) providing foreign import implementations"
+
+nodeFlagsFlag :: Parser [String]
+nodeFlagsFlag = option parser $
+ long "node-opts"
+ <> metavar "NODE_OPTS"
+ <> value []
+ <> Opts.help "Flags to pass to node, separated by spaces"
+ where
+ parser = words <$> str
+
+psciOptions :: Parser PSCiOptions
+psciOptions = PSCiOptions <$> multiLineMode
+ <*> many inputFile
+ <*> many inputForeignFile
+ <*> nodeFlagsFlag
+
+runPSCi :: IO ()
+runPSCi = execParser opts >>= loop
+ where
+ opts = info (version <*> helper <*> psciOptions) infoModList
+ infoModList = fullDesc <> headerInfo <> footerInfo
+ headerInfo = header "psci - Interactive mode for PureScript"
+ footerInfo = footer $ "psci " ++ showVersion Paths.version
+
+ version :: Parser (a -> a)
+ version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> Opts.help "Show the version number" <> hidden
diff --git a/psci/Parser.hs b/psci/Parser.hs
index d28cc7b..549fb17 100644
--- a/psci/Parser.hs
+++ b/psci/Parser.hs
@@ -19,22 +19,23 @@ module Parser
import Prelude hiding (lex)
-import qualified Commands as C
-import qualified Directive as D
-
import Data.Char (isSpace)
+import Data.List (intercalate)
import Control.Applicative hiding (many)
import Text.Parsec hiding ((<|>))
import qualified Language.PureScript as P
-import qualified Language.PureScript.Parser.Common as C (mark, same)
+import Language.PureScript.Parser.Common (mark, same)
+
+import qualified Directive as D
+import Types
-- |
-- Parses PSCI metacommands or expressions input from the user.
--
-parseCommand :: String -> Either String C.Command
+parseCommand :: String -> Either String Command
parseCommand cmdString =
case cmdString of
(':' : cmd) -> parseDirective cmd
@@ -45,7 +46,7 @@ parseRest p s = either (Left . show) Right $ do
ts <- P.lex "" s
P.runTokenParser "" (p <* eof) ts
-psciCommand :: P.TokenParser C.Command
+psciCommand :: P.TokenParser Command
psciCommand = choice (map try parsers)
where
parsers =
@@ -64,25 +65,32 @@ trimStart = dropWhile isSpace
trimEnd :: String -> String
trimEnd = reverse . trimStart . reverse
-parseDirective :: String -> Either String C.Command
+parseDirective :: String -> Either String Command
parseDirective cmd =
- case D.parseDirective dstr of
- Just D.Help -> return C.Help
- Just D.Quit -> return C.Quit
- Just D.Reset -> return C.Reset
- Just D.Browse -> C.Browse <$> parseRest P.moduleName arg
- Just D.Load -> return $ C.LoadFile (trim arg)
- Just D.Show -> return $ C.Show (trim arg)
- Just D.Type -> C.TypeOf <$> parseRest P.parseValue arg
- Just D.Kind -> C.KindOf <$> parseRest P.parseType arg
- Nothing -> Left $ "Unrecognized command. Type :? for help."
- where (dstr, arg) = break isSpace cmd
+ case D.directivesFor' dstr of
+ [(d, _)] -> commandFor d
+ [] -> Left "Unrecognized directive. Type :? for help."
+ ds -> Left ("Ambiguous directive. Possible matches: " ++
+ intercalate ", " (map snd ds) ++ ". Type :? for help.")
+ where
+ (dstr, arg) = break isSpace cmd
+
+ commandFor d = case d of
+ Help -> return ShowHelp
+ Quit -> return QuitPSCi
+ Reset -> return ResetState
+ Browse -> BrowseModule <$> parseRest P.moduleName arg
+ Load -> return $ LoadFile (trim arg)
+ Foreign -> return $ LoadForeign (trim arg)
+ Show -> ShowInfo <$> parseReplQuery' (trim arg)
+ Type -> TypeOf <$> parseRest P.parseValue arg
+ Kind -> KindOf <$> parseRest P.parseType arg
-- |
-- Parses expressions entered at the PSCI repl.
--
-psciExpression :: P.TokenParser C.Command
-psciExpression = C.Expression <$> P.parseValue
+psciExpression :: P.TokenParser Command
+psciExpression = Expression <$> P.parseValue
-- |
-- PSCI version of @let@.
@@ -90,21 +98,21 @@ psciExpression = C.Expression <$> P.parseValue
-- However, since we don't support the @Eff@ monad,
-- we actually want the normal @let@.
--
-psciLet :: P.TokenParser C.Command
-psciLet = C.Decls <$> (P.reserved "let" *> P.indented *> manyDecls)
+psciLet :: P.TokenParser Command
+psciLet = Decls <$> (P.reserved "let" *> P.indented *> manyDecls)
where
manyDecls :: P.TokenParser [P.Declaration]
- manyDecls = C.mark (many1 (C.same *> P.parseLocalDeclaration))
+ manyDecls = mark (many1 (same *> P.parseLocalDeclaration))
-- | Imports must be handled separately from other declarations, so that
-- :show import works, for example.
-psciImport :: P.TokenParser C.Command
-psciImport = C.Import <$> P.parseImportDeclaration'
+psciImport :: P.TokenParser Command
+psciImport = Import <$> P.parseImportDeclaration'
-- | Any other declaration that we don't need a 'special case' parser for
-- (like let or import declarations).
-psciOtherDeclaration :: P.TokenParser C.Command
-psciOtherDeclaration = C.Decls . (:[]) <$> do
+psciOtherDeclaration :: P.TokenParser Command
+psciOtherDeclaration = Decls . (:[]) <$> do
decl <- discardPositionInfo <$> P.parseDeclaration
if acceptable decl
then return decl
@@ -115,11 +123,18 @@ discardPositionInfo (P.PositionedDeclaration _ _ d) = d
discardPositionInfo d = d
acceptable :: P.Declaration -> Bool
-acceptable (P.DataDeclaration _ _ _ _) = True
-acceptable (P.TypeSynonymDeclaration _ _ _) = True
-acceptable (P.ExternDeclaration _ _ _ _) = True
-acceptable (P.ExternDataDeclaration _ _) = True
-acceptable (P.ExternInstanceDeclaration _ _ _ _) = True
-acceptable (P.TypeClassDeclaration _ _ _ _) = True
-acceptable (P.TypeInstanceDeclaration _ _ _ _ _) = True
+acceptable P.DataDeclaration{} = True
+acceptable P.TypeSynonymDeclaration{} = True
+acceptable P.ExternDeclaration{} = True
+acceptable P.ExternDataDeclaration{} = True
+acceptable P.ExternInstanceDeclaration{} = True
+acceptable P.TypeClassDeclaration{} = True
+acceptable P.TypeInstanceDeclaration{} = True
acceptable _ = False
+
+parseReplQuery' :: String -> Either String ReplQuery
+parseReplQuery' str =
+ case parseReplQuery str of
+ Nothing -> Left ("Don't know how to show " ++ str ++ ". Try one of: " ++
+ intercalate ", " replQueryStrings ++ ".")
+ Just query -> Right query
diff --git a/psci/Types.hs b/psci/Types.hs
new file mode 100644
index 0000000..b7684ab
--- /dev/null
+++ b/psci/Types.hs
@@ -0,0 +1,181 @@
+-----------------------------------------------------------------------------
+--
+-- Module : Types
+-- Copyright : (c) Phil Freeman 2014
+-- License : MIT
+--
+-- Maintainer : Phil Freeman <paf31@cantab.net>
+-- Stability : experimental
+-- Portability :
+--
+-- |
+-- Type declarations and associated basic functions for PSCI.
+--
+-----------------------------------------------------------------------------
+
+module Types where
+
+import qualified Data.Map as M
+import qualified Language.PureScript as P
+
+data PSCiOptions = PSCiOptions
+ { psciMultiLineMode :: Bool
+ , psciInputFile :: [FilePath]
+ , psciForeignInputFiles :: [FilePath]
+ , psciInputNodeFlags :: [String]
+ }
+
+-- |
+-- The PSCI state.
+-- Holds a list of imported modules, loaded files, and partial let bindings.
+-- The let bindings are partial,
+-- because it makes more sense to apply the binding to the final evaluated expression.
+--
+data PSCiState = PSCiState
+ { psciImportedFilenames :: [FilePath]
+ , psciImportedModules :: [ImportedModule]
+ , psciLoadedModules :: [(Either P.RebuildPolicy FilePath, P.Module)]
+ , psciForeignFiles :: M.Map P.ModuleName (FilePath, P.ForeignJS)
+ , psciLetBindings :: [P.Declaration]
+ , psciNodeFlags :: [String]
+ }
+
+-- | All of the data that is contained by an ImportDeclaration in the AST.
+-- That is:
+--
+-- * A module name, the name of the module which is being imported
+-- * An ImportDeclarationType which specifies whether there is an explicit
+-- import list, a hiding list, or neither.
+-- * If the module is imported qualified, its qualified name in the importing
+-- module. Otherwise, Nothing.
+--
+type ImportedModule = (P.ModuleName, P.ImportDeclarationType, Maybe P.ModuleName)
+
+psciImportedModuleNames :: PSCiState -> [P.ModuleName]
+psciImportedModuleNames (PSCiState{psciImportedModules = is}) =
+ map (\(mn, _, _) -> mn) is
+
+allImportsOf :: P.Module -> PSCiState -> [ImportedModule]
+allImportsOf m (PSCiState{psciImportedModules = is}) =
+ filter isImportOfThis is
+ where
+ name = P.getModuleName m
+ isImportOfThis (name', _, _) = name == name'
+
+-- State helpers
+
+-- |
+-- Updates the state to have more imported modules.
+--
+updateImportedFiles :: FilePath -> PSCiState -> PSCiState
+updateImportedFiles filename st = st { psciImportedFilenames = filename : psciImportedFilenames st }
+
+-- |
+-- Updates the state to have more imported modules.
+--
+updateImportedModules :: ImportedModule -> PSCiState -> PSCiState
+updateImportedModules im st = st { psciImportedModules = im : psciImportedModules st }
+
+-- |
+-- Updates the state to have more loaded files.
+--
+updateModules :: [(Either P.RebuildPolicy FilePath, P.Module)] -> PSCiState -> PSCiState
+updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modules }
+
+-- |
+-- Updates the state to have more let bindings.
+--
+updateLets :: [P.Declaration] -> PSCiState -> PSCiState
+updateLets ds st = st { psciLetBindings = psciLetBindings st ++ ds }
+
+-- |
+-- Updates the state to have more let bindings.
+--
+updateForeignFiles :: M.Map P.ModuleName (FilePath, P.ForeignJS) -> PSCiState -> PSCiState
+updateForeignFiles fs st = st { psciForeignFiles = psciForeignFiles st `M.union` fs }
+
+-- |
+-- Valid Meta-commands for PSCI
+--
+data Command
+ -- |
+ -- A purescript expression
+ --
+ = Expression P.Expr
+ -- |
+ -- Show the help (ie, list of directives)
+ --
+ | ShowHelp
+ -- |
+ -- Import a module from a loaded file
+ --
+ | Import ImportedModule
+ -- |
+ -- Browse a module
+ --
+ | BrowseModule P.ModuleName
+ -- |
+ -- Load a file for use with importing
+ --
+ | LoadFile FilePath
+ -- |
+ -- Load a foreign module
+ --
+ | LoadForeign FilePath
+ -- |
+ -- Exit PSCI
+ --
+ | QuitPSCi
+ -- |
+ -- Reset the state of the REPL
+ --
+ | ResetState
+ -- |
+ -- Add some declarations to the current evaluation context.
+ --
+ | Decls [P.Declaration]
+ -- |
+ -- Find the type of an expression
+ --
+ | TypeOf P.Expr
+ -- |
+ -- Find the kind of an expression
+ --
+ | KindOf P.Type
+ -- |
+ -- Shows information about the current state of the REPL
+ --
+ | ShowInfo ReplQuery
+
+data ReplQuery
+ = QueryLoaded
+ | QueryImport
+ deriving (Eq, Show)
+
+-- | A list of all ReplQuery values.
+replQueries :: [ReplQuery]
+replQueries = [QueryLoaded, QueryImport]
+
+replQueryStrings :: [String]
+replQueryStrings = map showReplQuery replQueries
+
+showReplQuery :: ReplQuery -> String
+showReplQuery QueryLoaded = "loaded"
+showReplQuery QueryImport = "import"
+
+parseReplQuery :: String -> Maybe ReplQuery
+parseReplQuery "loaded" = Just QueryLoaded
+parseReplQuery "import" = Just QueryImport
+parseReplQuery _ = Nothing
+
+data Directive
+ = Help
+ | Quit
+ | Reset
+ | Browse
+ | Load
+ | Foreign
+ | Type
+ | Kind
+ | Show
+ deriving (Eq, Show)
diff --git a/psci/main/Main.hs b/psci/main/Main.hs
new file mode 100644
index 0000000..e430648
--- /dev/null
+++ b/psci/main/Main.hs
@@ -0,0 +1,6 @@
+module Main where
+
+import PSCi
+
+main :: IO ()
+main = runPSCi
diff --git a/psci/tests/Main.hs b/psci/tests/Main.hs
new file mode 100644
index 0000000..17fd3c7
--- /dev/null
+++ b/psci/tests/Main.hs
@@ -0,0 +1,150 @@
+{-# LANGUAGE RecordWildCards, TupleSections #-}
+
+module Main where
+
+import Control.Monad.Trans.State.Strict (runStateT)
+import Control.Monad (when, forM)
+import Control.Applicative
+import Control.Monad.Writer (runWriterT)
+import Control.Monad.Trans.Except (runExceptT)
+
+import Data.List (isSuffixOf, sort)
+
+import System.Exit (exitFailure)
+import System.Console.Haskeline
+import System.FilePath ((</>))
+import System.Directory (getCurrentDirectory, getDirectoryContents)
+
+import Test.HUnit
+
+import qualified Language.PureScript as P
+
+import PSCi
+import Completion
+import Types
+
+main :: IO ()
+main = do
+ Counts{..} <- runTestTT allTests
+ when (errors + failures > 0) exitFailure
+
+allTests :: Test
+allTests = completionTests
+
+completionTests :: Test
+completionTests =
+ TestLabel "completionTests"
+ (TestList (map (TestCase . assertCompletedOk) completionTestData))
+
+-- If the cursor is at the right end of the line, with the 1st element of the
+-- pair as the text in the line, then pressing tab should offer all the
+-- elements of the list (which is the 2nd element) as completions.
+completionTestData :: [(String, [String])]
+completionTestData =
+ -- basic directives
+ [ (":h", [":help"])
+ , (":re", [":reset"])
+ , (":q", [":quit"])
+ , (":mo", [":module"])
+ , (":b", [":browse"])
+
+ -- :browse should complete modules
+ , (":b Prel", [":b Prelude", ":b Prelude.Unsafe"])
+ , (":b Prelude.", [":b Prelude.Unsafe"])
+
+ -- :load, :module should complete file paths
+ , (":l psci/tests/data/", [":l psci/tests/data/Sample.purs"])
+ , (":module psci/tests/data/", [":module psci/tests/data/Sample.purs"])
+
+ -- :quit, :help, :reset should not complete
+ , (":help ", [])
+ , (":quit ", [])
+ , (":reset ", [])
+
+ -- :show should complete to "loaded" and "import"
+ , (":show ", [":show import", ":show loaded"])
+ , (":show a", [])
+
+ -- :type should complete values and data constructors in scope
+ , (":type Prelude.Unsafe.un", [":type Prelude.Unsafe.unsafeIndex"])
+ , (":type un", [":type unit"])
+ , (":type E", [":type EQ"])
+
+ -- :kind should complete types in scope
+ , (":kind C", [":kind Control.Monad.Eff.Pure"])
+ , (":kind O", [":kind Ordering"])
+
+ -- Only one argument for directives should be completed
+ , (":show import ", [])
+ , (":type EQ ", [])
+ , (":kind Ordering ", [])
+
+ -- import should complete module names
+ , ("import Control.Monad.S", ["import Control.Monad.ST"])
+ , ("import qualified Control.Monad.S", ["import qualified Control.Monad.ST"])
+ , ("import Control.Monad.", map ("import Control.Monad." ++)
+ ["Eff", "ST"])
+
+ -- a few other import tests
+ , ("impor", ["import"])
+ , ("import q", ["import qualified"])
+ , ("import ", map ("import " ++) allModuleNames ++ ["import qualified"])
+ , ("import Prelude.Unsafe ", [])
+
+ -- String and number literals should not be completed
+ , ("\"hi", [])
+ , ("34", [])
+
+ -- Identifiers and data constructors should be completed
+ , ("un", ["unit"])
+ , ("Debug.Trace.", map ("Debug.Trace." ++) ["print", "trace"])
+ , ("G", ["GT"])
+ , ("Prelude.L", ["Prelude.LT"])
+
+ -- if a module is imported qualified, values should complete under the
+ -- qualified name, as well as the original name.
+ , ("ST.new", ["ST.newSTRef"])
+ , ("Control.Monad.ST.new", ["Control.Monad.ST.newSTRef"])
+ ]
+ where
+ allModuleNames = [ "Assert"
+ , "Control.Monad.Eff"
+ , "Control.Monad.ST"
+ , "Data.Function"
+ , "Debug.Trace"
+ , "Prelude"
+ , "Prelude.Unsafe"
+ ]
+
+assertCompletedOk :: (String, [String]) -> Assertion
+assertCompletedOk (line, expecteds) = do
+ (unusedR, completions) <- runCM (completion' (reverse line, ""))
+ let unused = reverse unusedR
+ let actuals = map ((unused ++) . replacement) completions
+ sort expecteds @=? sort actuals
+
+runCM :: CompletionM a -> IO a
+runCM act = do
+ psciState <- getPSCiState
+ fmap fst (runStateT (liftCompletionM act) psciState)
+
+getPSCiState :: IO PSCiState
+getPSCiState = do
+ cwd <- getCurrentDirectory
+ let preludeDir = cwd </> "tests" </> "prelude"
+ jsDir = preludeDir </> "js"
+ modulesOrFirstError <- loadAllModules [ preludeDir </> "Prelude.purs" ]
+ jsFiles <- map (jsDir </>) . filter (".js" `isSuffixOf`) <$> getDirectoryContents jsDir
+ foreignFiles <- forM jsFiles (\f -> (f,) <$> readFile f)
+ Right (foreigns, _) <- runExceptT $ runWriterT $ P.parseForeignModulesFromFiles foreignFiles
+ case modulesOrFirstError of
+ Left err ->
+ print err >> exitFailure
+ Right modules ->
+ let imports = [controlMonadSTasST, (P.ModuleName [P.ProperName "Prelude"], P.Implicit, Nothing)]
+ in return (PSCiState [] imports modules foreigns [] [])
+
+controlMonadSTasST :: ImportedModule
+controlMonadSTasST = (s "Control.Monad.ST", P.Implicit, Just (s "ST"))
+ where
+ s = P.moduleNameFromString
diff --git a/purescript.cabal b/purescript.cabal
index 3de7978..81cf95f 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,10 +1,10 @@
name: purescript
-version: 0.6.9.5
+version: 0.7.0.0
cabal-version: >=1.8
build-type: Simple
license: MIT
license-file: LICENSE
-copyright: (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
+copyright: (c) 2013-15 Phil Freeman, (c) 2014-15 Gary Burgess
maintainer: Phil Freeman <paf31@cantab.net>
stability: experimental
synopsis: PureScript Programming Language Compiler
@@ -13,10 +13,12 @@ category: Language
Homepage: http://www.purescript.org/
author: Phil Freeman <paf31@cantab.net>,
Gary Burgess <gary.burgess@gmail.com>,
- Hardy Jones <jones3.hardy@gmail.com>
+ Hardy Jones <jones3.hardy@gmail.com>,
+ Harry Garrood <harry@garrood.me>
-extra-source-files: prelude/prelude.purs
- , examples/passing/*.purs
+tested-with: GHC==7.8
+
+extra-source-files: examples/passing/*.purs
, examples/failing/*.purs
source-repository head
@@ -27,16 +29,25 @@ library
build-depends: base >=4.6 && <5,
containers -any,
unordered-containers -any,
+ dlist -any,
directory >= 1.2,
filepath -any,
mtl >= 2.1.0 && < 2.3.0,
parsec -any,
- transformers >= 0.4.0 && < 0.5,
+ transformers >= 0.3.0 && < 0.5,
+ transformers-compat >= 0.3.0,
utf8-string >= 1 && < 2,
pattern-arrows >= 0.0.2 && < 0.1,
- file-embed >= 0.0.7 && < 0.0.8,
time -any,
- boxes >= 0.1.4 && < 0.2.0
+ boxes >= 0.1.4 && < 0.2.0,
+ aeson >= 0.8 && < 0.9,
+ vector -any,
+ bower-json >= 0.7,
+ aeson-better-errors >= 0.8,
+ bytestring -any,
+ text -any,
+ split -any
+
exposed-modules: Language.PureScript
Language.PureScript.AST
Language.PureScript.AST.Binders
@@ -44,6 +55,7 @@ library
Language.PureScript.AST.Operators
Language.PureScript.AST.SourcePos
Language.PureScript.AST.Traversals
+ Language.PureScript.AST.Exported
Language.PureScript.CodeGen
Language.PureScript.CodeGen.Externs
Language.PureScript.CodeGen.JS
@@ -67,10 +79,10 @@ library
Language.PureScript.CoreFn.Module
Language.PureScript.CoreFn.Traversals
Language.PureScript.Comments
- Language.PureScript.DeadCodeElimination
Language.PureScript.Environment
Language.PureScript.Errors
Language.PureScript.Kinds
+ Language.PureScript.Linter
Language.PureScript.ModuleDependencies
Language.PureScript.Names
Language.PureScript.Options
@@ -78,6 +90,7 @@ library
Language.PureScript.Parser.Lexer
Language.PureScript.Parser.Common
Language.PureScript.Parser.Declarations
+ Language.PureScript.Parser.JS
Language.PureScript.Parser.Kinds
Language.PureScript.Parser.State
Language.PureScript.Parser.Types
@@ -111,9 +124,21 @@ library
Language.PureScript.TypeClassDictionaries
Language.PureScript.Types
+ Language.PureScript.Docs
+ Language.PureScript.Docs.Convert
+ Language.PureScript.Docs.Render
+ Language.PureScript.Docs.Types
+ Language.PureScript.Docs.RenderedCode
+ Language.PureScript.Docs.RenderedCode.Types
+ Language.PureScript.Docs.RenderedCode.Render
+ Language.PureScript.Docs.AsMarkdown
+ Language.PureScript.Docs.ParseAndDesugar
+ Language.PureScript.Docs.Utils.MonoidExtras
+
Control.Monad.Unify
Control.Monad.Supply
Control.Monad.Supply.Class
+
exposed: True
buildable: True
hs-source-dirs: src
@@ -123,40 +148,36 @@ library
executable psc
build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,
- transformers -any
+ time -any, transformers -any, transformers-compat -any, Glob >= 0.7 && < 0.8
main-is: Main.hs
buildable: True
hs-source-dirs: psc
- other-modules:
- ghc-options: -Wall -O2 -fno-warn-unused-do-bind
-
-executable psc-make
- build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
- mtl -any, optparse-applicative >= 0.10.0, parsec -any, purescript -any,
- transformers -any
- main-is: Main.hs
- buildable: True
- hs-source-dirs: psc-make
- other-modules:
+ other-modules: Make
ghc-options: -Wall -O2 -fno-warn-unused-do-bind
executable psci
build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
mtl -any, optparse-applicative >= 0.10.0, parsec -any,
haskeline >= 0.7.0.0, purescript -any, transformers -any,
- process -any
+ transformers-compat -any, process -any, time -any, Glob -any
main-is: Main.hs
buildable: True
- hs-source-dirs: psci
- other-modules: Commands
+ hs-source-dirs: psci psci/main
+ other-modules: Types
Parser
Directive
+ Completion
+ PSCi
+ Make
+ IO
ghc-options: -Wall -O2
executable psc-docs
build-depends: base >=4 && <5, purescript -any,
- optparse-applicative >= 0.10.0, process -any, mtl -any
+ optparse-applicative >= 0.10.0, process -any, mtl -any,
+ split -any, ansi-wl-pprint -any, directory -any,
+ filepath -any, Glob -any
main-is: Main.hs
buildable: True
hs-source-dirs: psc-docs
@@ -165,20 +186,67 @@ executable psc-docs
Tags
ghc-options: -Wall -O2
+executable psc-publish
+ build-depends: base >=4 && <5, purescript -any,
+ optparse-applicative >= 0.10.0, process -any, mtl -any,
+ pattern-arrows -any, aeson -any, bytestring -any,
+ directory -any, transformers -any, text -any, containers
+ -any, boxes -any, split -any, Glob -any, aeson-better-errors
+ -any, transformers-compat -any, bower-json -any, semigroups
+ -any, safe -any
+ main-is: Main.hs
+ buildable: True
+ hs-source-dirs: psc-publish
+ other-modules: Utils
+ ErrorsWarnings
+ BoxesHelpers
+ ghc-options: -Wall -O2
+
executable psc-hierarchy
build-depends: base >=4 && <5, purescript -any, optparse-applicative >= 0.10.0,
- process -any, mtl -any, parsec -any, filepath -any, directory -any
+ process -any, mtl -any, parsec -any, filepath -any, directory -any,
+ Glob -any
main-is: Main.hs
buildable: True
hs-source-dirs: hierarchy
other-modules:
ghc-options: -Wall -O2
+executable psc-bundle
+ main-is: Main.hs
+ other-modules:
+ other-extensions:
+ build-depends: base >=4 && <5,
+ language-javascript == 0.5.*,
+ syb -any,
+ containers -any,
+ filepath -any,
+ directory -any,
+ mtl -any,
+ transformers -any,
+ transformers-compat -any,
+ optparse-applicative >= 0.10.0,
+ Glob -any
+ ghc-options: -Wall -O2
+ hs-source-dirs: psc-bundle
+
test-suite tests
build-depends: base >=4 && <5, containers -any, directory -any,
filepath -any, mtl -any, parsec -any, purescript -any,
- transformers -any, process -any
+ transformers -any, process -any, transformers-compat -any, time -any
type: exitcode-stdio-1.0
main-is: Main.hs
buildable: True
hs-source-dirs: tests
+
+test-suite psci-tests
+ build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
+ mtl -any, optparse-applicative >= 0.10.0, parsec -any,
+ haskeline >= 0.7.0.0, purescript -any, transformers -any,
+ transformers-compat -any, process -any, HUnit -any, time -any,
+ Glob -any
+ type: exitcode-stdio-1.0
+ main-is: Main.hs
+ buildable: True
+ hs-source-dirs: psci psci/tests
+ ghc-options: -Wall
diff --git a/src/Control/Monad/Supply.hs b/src/Control/Monad/Supply.hs
index 895f6b4..1920c67 100644
--- a/src/Control/Monad/Supply.hs
+++ b/src/Control/Monad/Supply.hs
@@ -21,7 +21,7 @@ import Data.Functor.Identity
import Control.Applicative
import Control.Monad.State
-import Control.Monad.Except
+import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.Reader
import Control.Monad.Writer
@@ -40,4 +40,4 @@ runSupply :: Integer -> Supply a -> (a, Integer)
runSupply n = runIdentity . runSupplyT n
evalSupply :: Integer -> Supply a -> a
-evalSupply n = runIdentity . evalSupplyT n \ No newline at end of file
+evalSupply n = runIdentity . evalSupplyT n
diff --git a/src/Control/Monad/Unify.hs b/src/Control/Monad/Unify.hs
index c4ef0a0..ade324b 100644
--- a/src/Control/Monad/Unify.hs
+++ b/src/Control/Monad/Unify.hs
@@ -27,7 +27,7 @@ import Data.Monoid
import Control.Applicative
import Control.Monad.State
-import Control.Monad.Error.Class
+import Control.Monad.Error.Class (MonadError(..))
import Data.HashMap.Strict as M
diff --git a/src/Language/PureScript.hs b/src/Language/PureScript.hs
index d0d293f..f7c3f2d 100644
--- a/src/Language/PureScript.hs
+++ b/src/Language/PureScript.hs
@@ -14,47 +14,43 @@
-----------------------------------------------------------------------------
{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Language.PureScript
( module P
- , compile
- , compile'
, RebuildPolicy(..)
- , MonadMake(..)
+ , MakeActions(..)
+ , SupplyVar()
+ , Externs()
, make
- , prelude
, version
) where
-import Data.FileEmbed (embedFile)
import Data.Function (on)
-import Data.List (sortBy, groupBy, intercalate)
+import Data.List (sortBy, groupBy)
import Data.Maybe (fromMaybe)
import Data.Time.Clock
import Data.Version (Version)
-import qualified Data.Traversable as T (traverse)
-import qualified Data.ByteString.UTF8 as BU
import qualified Data.Map as M
import qualified Data.Set as S
import Control.Applicative
import Control.Arrow ((&&&))
-import Control.Monad.Except
+import Control.Monad
+import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.Reader
-
-import System.FilePath ((</>))
+import Control.Monad.Writer
+import Control.Monad.Supply.Class (fresh)
import Language.PureScript.AST as P
import Language.PureScript.Comments as P
-import Language.PureScript.CodeGen as P
-import Language.PureScript.DeadCodeElimination as P
+import Language.PureScript.CodeGen.Externs (moduleToPs)
import Language.PureScript.Environment as P
import Language.PureScript.Errors as P
import Language.PureScript.Kinds as P
+import Language.PureScript.Linter as P
import Language.PureScript.ModuleDependencies as P
import Language.PureScript.Names as P
import Language.PureScript.Options as P
@@ -71,84 +67,44 @@ import qualified Language.PureScript.Constants as C
import qualified Paths_purescript as Paths
-- |
--- Compile a collection of modules
---
--- The compilation pipeline proceeds as follows:
---
--- * Sort the modules based on module dependencies, checking for cyclic dependencies.
---
--- * Perform a set of desugaring passes.
---
--- * Type check, and elaborate values to include type annotations and type class dictionaries.
---
--- * Regroup values to take into account new value dependencies introduced by elaboration.
---
--- * Eliminate dead code.
---
--- * Generate Javascript, and perform optimization passes.
---
--- * Pretty-print the generated Javascript
---
-compile :: (Functor m, Applicative m, MonadError String m, MonadReader (Options Compile) m)
- => [Module] -> [String] -> m (String, String, Environment)
-compile = compile' initEnvironment
-
-compile' :: (Functor m, Applicative m, MonadError String m, MonadReader (Options Compile) m)
- => Environment -> [Module] -> [String] -> m (String, String, Environment)
-compile' env ms prefix = do
- noPrelude <- asks optionsNoPrelude
- additional <- asks optionsAdditional
- mainModuleIdent <- asks (fmap moduleNameFromString . optionsMain)
- (sorted, _) <- sortModules $ map importPrim $ if noPrelude then ms else map importPrelude ms
- (desugared, nextVar) <- interpretMultipleErrors True $ runSupplyT 0 $ desugar sorted
- (elaborated, env') <- runCheck' env $ forM desugared $ typeCheckModule mainModuleIdent
- regrouped <- interpretMultipleErrors True $ createBindingGroupsModule . collapseBindingGroupsModule $ elaborated
- let corefn = map (CoreFn.moduleToCoreFn env') regrouped
- let entryPoints = moduleNameFromString `map` entryPointModules additional
- let elim = if null entryPoints then corefn else eliminateDeadCode entryPoints corefn
- let renamed = renameInModules elim
- let codeGenModuleNames = moduleNameFromString `map` codeGenModules additional
- let modulesToCodeGen = if null codeGenModuleNames then renamed else filter (\(CoreFn.Module _ mn _ _ _ _) -> mn `elem` codeGenModuleNames) renamed
- js <- concat <$> (evalSupplyT nextVar $ T.traverse moduleToJs modulesToCodeGen)
- let exts = intercalate "\n" . map (`moduleToPs` env') $ regrouped
- js' <- generateMain env' js
- let pjs = unlines $ map ("// " ++) prefix ++ [prettyPrintJS js']
- return (pjs, exts, env')
-
-generateMain :: (MonadError String m, MonadReader (Options Compile) m) => Environment -> [JS] -> m [JS]
-generateMain env js = do
- main <- asks optionsMain
- additional <- asks optionsAdditional
- case moduleNameFromString <$> main of
- Just mmi -> do
- when ((mmi, Ident C.main) `M.notMember` names env) $
- throwError $ show mmi ++ "." ++ C.main ++ " is undefined"
- return $ js ++ [JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar (browserNamespace additional)))) []]
- _ -> return js
-
--- |
--- A type class which collects the IO actions we need to be able to run in "make" mode
+-- Actions that require implementations when running in "make" mode.
--
-class (MonadReader (P.Options P.Make) m, MonadError String m) => MonadMake m where
+data MakeActions m = MakeActions {
-- |
- -- Get a file timestamp
+ -- Get the timestamp for the input file(s) for a module. If there are multiple
+ -- files (.purs and foreign files, for example) the timestamp should be for
+ -- the most recently modified file.
--
- getTimestamp :: FilePath -> m (Maybe UTCTime)
-
+ getInputTimestamp :: ModuleName -> m (Either RebuildPolicy (Maybe UTCTime))
-- |
- -- Read a file as a string
+ -- Get the timestamp for the output files for a module. This should be the
+ -- timestamp for the oldest modified file, or Nothing if any of the required
+ -- output files are missing.
--
- readTextFile :: FilePath -> m String
-
+ , getOutputTimestamp :: ModuleName -> m (Maybe UTCTime)
+ -- |
+ -- Read the externs file for a module as a string and also return the actual
+ -- path for the file.
+ , readExterns :: ModuleName -> m (FilePath, String)
-- |
- -- Write a text file
+ -- Run the code generator for the module and write any required output files.
--
- writeTextFile :: FilePath -> String -> m ()
-
+ , codegen :: CoreFn.Module CoreFn.Ann -> Environment -> SupplyVar -> Externs -> m ()
-- |
- -- Respond to a progress update
+ -- Respond to a progress update.
--
- progress :: String -> m ()
+ , progress :: String -> m ()
+ }
+
+-- |
+-- Generated code for an externs file.
+--
+type Externs = String
+
+-- |
+-- A value to be used in the Supply monad.
+--
+type SupplyVar = Integer
-- |
-- Determines when to rebuild a module
@@ -159,76 +115,47 @@ data RebuildPolicy
-- | Always rebuild this module
| RebuildAlways deriving (Show, Eq, Ord)
--- Traverse (Either e) instance (base 4.7)
-traverseEither :: Applicative f => (a -> f b) -> Either e a -> f (Either e b)
-traverseEither _ (Left x) = pure (Left x)
-traverseEither f (Right y) = Right <$> f y
-
-- |
-- Compiles in "make" mode, compiling each module separately to a js files and an externs file
--
-- If timestamps have not changed, the externs file can be used to provide the module's types without
-- having to typecheck the module again.
--
-make :: forall m. (Functor m, Applicative m, Monad m, MonadMake m)
- => FilePath -> [(Either RebuildPolicy FilePath, Module)] -> [String] -> m Environment
-make outputDir ms prefix = do
- noPrelude <- asks optionsNoPrelude
- let filePathMap = M.fromList (map (\(fp, Module _ mn _ _) -> (mn, fp)) ms)
-
- (sorted, graph) <- sortModules $ map importPrim $ if noPrelude then map snd ms else map (importPrelude . snd) ms
-
+make :: forall m. (Functor m, Applicative m, Monad m, MonadReader P.Options m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)
+ => MakeActions m
+ -> [(Either RebuildPolicy FilePath, Module)]
+ -> m Environment
+make MakeActions{..} ms = do
+ (sorted, graph) <- sortModules $ map (importPrim . snd) ms
+ mapM_ lint sorted
toRebuild <- foldM (\s (Module _ moduleName' _ _) -> do
- let filePath = runModuleName moduleName'
-
- jsFile = outputDir </> filePath </> "index.js"
- externsFile = outputDir </> filePath </> "externs.purs"
- inputFile = fromMaybe (error "Module has no filename in 'make'") $ M.lookup moduleName' filePathMap
-
- jsTimestamp <- getTimestamp jsFile
- externsTimestamp <- getTimestamp externsFile
- inputTimestamp <- traverseEither getTimestamp inputFile
-
- return $ case (inputTimestamp, jsTimestamp, externsTimestamp) of
- (Right (Just t1), Just t2, Just t3) | t1 < min t2 t3 -> s
- (Left RebuildNever, Just _, Just _) -> s
+ inputTimestamp <- getInputTimestamp moduleName'
+ outputTimestamp <- getOutputTimestamp moduleName'
+ return $ case (inputTimestamp, outputTimestamp) of
+ (Right (Just t1), Just t2) | t1 < t2 -> s
+ (Left RebuildNever, Just _) -> s
_ -> S.insert moduleName' s) S.empty sorted
marked <- rebuildIfNecessary (reverseDependencies graph) toRebuild sorted
-
- (desugared, nextVar) <- interpretMultipleErrors True $ runSupplyT 0 $ zip (map fst marked) <$> desugar (map snd marked)
-
+ (desugared, nextVar) <- runSupplyT 0 $ zip (map fst marked) <$> desugar (map snd marked)
evalSupplyT nextVar $ go initEnvironment desugared
-
where
+
go :: Environment -> [(Bool, Module)] -> SupplyT m Environment
go env [] = return env
go env ((False, m) : ms') = do
(_, env') <- lift . runCheck' env $ typeCheckModule Nothing m
-
go env' ms'
go env ((True, m@(Module coms moduleName' _ exps)) : ms') = do
- let filePath = runModuleName moduleName'
- jsFile = outputDir </> filePath </> "index.js"
- externsFile = outputDir </> filePath </> "externs.purs"
-
- lift . progress $ "Compiling " ++ runModuleName moduleName'
-
+ lift $ progress $ "Compiling " ++ runModuleName moduleName'
(Module _ _ elaborated _, env') <- lift . runCheck' env $ typeCheckModule Nothing m
-
- regrouped <- interpretMultipleErrors True . createBindingGroups moduleName' . collapseBindingGroups $ elaborated
-
+ regrouped <- createBindingGroups moduleName' . collapseBindingGroups $ elaborated
let mod' = Module coms moduleName' regrouped exps
- let corefn = CoreFn.moduleToCoreFn env' mod'
- let [renamed] = renameInModules [corefn]
-
- pjs <- prettyPrintJS <$> moduleToJs renamed
- let js = unlines $ map ("// " ++) prefix ++ [pjs]
- let exts = unlines $ map ("-- " ++) prefix ++ [moduleToPs mod' env']
-
- lift $ writeTextFile jsFile js
- lift $ writeTextFile externsFile exts
-
+ corefn = CoreFn.moduleToCoreFn env' mod'
+ [renamed] = renameInModules [corefn]
+ exts = moduleToPs mod' env'
+ nextVar <- fresh
+ lift $ codegen renamed env' nextVar exts
go env' ms'
rebuildIfNecessary :: M.Map ModuleName [ModuleName] -> S.Set ModuleName -> [Module] -> m [(Bool, Module)]
@@ -238,12 +165,16 @@ make outputDir ms prefix = do
toRebuild' = toRebuild `S.union` S.fromList deps
(:) (True, m) <$> rebuildIfNecessary graph toRebuild' ms'
rebuildIfNecessary graph toRebuild (Module _ moduleName' _ _ : ms') = do
- let externsFile = outputDir </> runModuleName moduleName' </> "externs.purs"
- externs <- readTextFile externsFile
- externsModules <- fmap (map snd) . either (throwError . show) return $ P.parseModulesFromFiles id [(externsFile, externs)]
+ (path, externs) <- readExterns moduleName'
+ externsModules <- fmap (map snd) . alterErrors $ P.parseModulesFromFiles id [(path, externs)]
case externsModules of
[m'@(Module _ moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms'
- _ -> throwError $ "Externs file " ++ externsFile ++ " was invalid"
+ _ -> throwError . errorMessage . InvalidExternsFile $ path
+ where
+ alterErrors = flip catchError $ \(MultipleErrors errs) ->
+ throwError . MultipleErrors $ flip map errs $ \e -> case e of
+ SimpleErrorWrapper (ErrorParsingModule err) -> SimpleErrorWrapper (ErrorParsingExterns err)
+ _ -> e
reverseDependencies :: ModuleGraph -> M.Map ModuleName [ModuleName]
reverseDependencies g = combine [ (dep, mn) | (mn, deps) <- g, dep <- deps ]
@@ -266,11 +197,5 @@ addDefaultImport toImport m@(Module coms mn decls exps) =
importPrim :: Module -> Module
importPrim = addDefaultImport (ModuleName [ProperName C.prim])
-importPrelude :: Module -> Module
-importPrelude = addDefaultImport (ModuleName [ProperName C.prelude])
-
-prelude :: String
-prelude = BU.toString $(embedFile "prelude/prelude.purs")
-
version :: Version
version = Paths.version
diff --git a/src/Language/PureScript/AST.hs b/src/Language/PureScript/AST.hs
index 7e4e692..417ec41 100644
--- a/src/Language/PureScript/AST.hs
+++ b/src/Language/PureScript/AST.hs
@@ -21,3 +21,4 @@ import Language.PureScript.AST.Declarations as AST
import Language.PureScript.AST.Operators as AST
import Language.PureScript.AST.SourcePos as AST
import Language.PureScript.AST.Traversals as AST
+import Language.PureScript.AST.Exported as AST
diff --git a/src/Language/PureScript/AST/Binders.hs b/src/Language/PureScript/AST/Binders.hs
index d77ae96..e6eaec7 100644
--- a/src/Language/PureScript/AST/Binders.hs
+++ b/src/Language/PureScript/AST/Binders.hs
@@ -39,6 +39,10 @@ data Binder
--
| StringBinder String
-- |
+ -- A binder which matches a character literal
+ --
+ | CharBinder Char
+ -- |
-- A binder which matches a numeric literal
--
| NumberBinder (Either Integer Double)
@@ -59,10 +63,6 @@ data Binder
--
| ArrayBinder [Binder]
-- |
- -- A binder which matches an array and binds its head and tail
- --
- | ConsBinder Binder Binder
- -- |
-- A binder which binds its input to an identifier
--
| NamedBinder Ident Binder
@@ -81,7 +81,6 @@ binderNames = go []
go ns (ConstructorBinder _ bs) = foldl go ns bs
go ns (ObjectBinder bs) = foldl go ns (map snd bs)
go ns (ArrayBinder bs) = foldl go ns bs
- go ns (ConsBinder b1 b2) = go (go ns b1) b2
go ns (NamedBinder name b) = go (name : ns) b
go ns (PositionedBinder _ _ b) = go ns b
go ns _ = ns
diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs
index f857fa0..d52c5d0 100644
--- a/src/Language/PureScript/AST/Declarations.hs
+++ b/src/Language/PureScript/AST/Declarations.hs
@@ -17,6 +17,7 @@
module Language.PureScript.AST.Declarations where
import qualified Data.Data as D
+import qualified Data.Map as M
import Language.PureScript.AST.Binders
import Language.PureScript.AST.Operators
@@ -26,7 +27,6 @@ import Language.PureScript.Names
import Language.PureScript.Kinds
import Language.PureScript.TypeClassDictionaries
import Language.PureScript.Comments
-import Language.PureScript.CodeGen.JS.AST
import Language.PureScript.Environment
-- |
@@ -41,53 +41,6 @@ getModuleName :: Module -> ModuleName
getModuleName (Module _ name _ _) = name
-- |
--- Test if a declaration is exported, given a module's export list.
---
-isExported :: Maybe [DeclarationRef] -> Declaration -> Bool
-isExported Nothing _ = True
-isExported _ TypeInstanceDeclaration{} = True
-isExported exps (PositionedDeclaration _ _ d) = isExported exps d
-isExported (Just exps) decl = any (matches decl) exps
- where
- matches (TypeDeclaration ident _) (ValueRef ident') = ident == ident'
- matches (ValueDeclaration ident _ _ _) (ValueRef ident') = ident == ident'
- matches (ExternDeclaration _ ident _ _) (ValueRef ident') = ident == ident'
- matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'
- matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'
- matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'
- matches (TypeClassDeclaration ident _ _ _) (TypeClassRef ident') = ident == ident'
- matches (PositionedDeclaration _ _ d) r = d `matches` r
- matches d (PositionedDeclarationRef _ _ r) = d `matches` r
- matches _ _ = False
-
-exportedDeclarations :: Module -> [Declaration]
-exportedDeclarations (Module _ _ decls exps) = filter (isExported exps) (flattenDecls decls)
-
--- |
--- Test if a data constructor for a given type is exported, given a module's export list.
---
-isDctorExported :: ProperName -> Maybe [DeclarationRef] -> ProperName -> Bool
-isDctorExported _ Nothing _ = True
-isDctorExported ident (Just exps) ctor = test `any` exps
- where
- test (PositionedDeclarationRef _ _ d) = test d
- test (TypeRef ident' Nothing) = ident == ident'
- test (TypeRef ident' (Just ctors)) = ident == ident' && ctor `elem` ctors
- test _ = False
-
--- |
--- Return the exported data constructors for a given type.
---
-exportedDctors :: Module -> ProperName -> [ProperName]
-exportedDctors (Module _ _ decls exps) ident =
- filter (isDctorExported ident exps) dctors
- where
- dctors = concatMap getDctors (flattenDecls decls)
- getDctors (DataDeclaration _ _ _ ctors) = map fst ctors
- getDctors (PositionedDeclaration _ _ d) = getDctors d
- getDctors _ = []
-
--- |
-- An item in a list of explicit imports or exports
--
data DeclarationRef
@@ -108,6 +61,10 @@ data DeclarationRef
--
| TypeInstanceRef Ident
-- |
+ -- A module, in its entirety
+ --
+ | ModuleRef ModuleName
+ -- |
-- A declaration reference with source position information
--
| PositionedDeclarationRef SourceSpan [Comment] DeclarationRef
@@ -118,6 +75,7 @@ instance Eq DeclarationRef where
(ValueRef name) == (ValueRef name') = name == name'
(TypeClassRef name) == (TypeClassRef name') = name == name'
(TypeInstanceRef name) == (TypeInstanceRef name') = name == name'
+ (ModuleRef name) == (ModuleRef name') = name == name'
(PositionedDeclarationRef _ _ r) == r' = r == r'
r == (PositionedDeclarationRef _ _ r') = r == r'
_ == _ = False
@@ -169,9 +127,9 @@ data Declaration
--
| BindingGroupDeclaration [(Ident, NameKind, Expr)]
-- |
- -- A foreign import declaration (type, name, optional inline Javascript, type)
+ -- A foreign import declaration (name, type)
--
- | ExternDeclaration ForeignImportType Ident (Maybe JS) Type
+ | ExternDeclaration Ident Type
-- |
-- A data type foreign import (name, kind)
--
@@ -302,6 +260,10 @@ data Expr
--
| StringLiteral String
-- |
+ -- A character literal
+ --
+ | CharLiteral Char
+ -- |
-- A boolean literal
--
| BooleanLiteral Bool
@@ -404,7 +366,7 @@ data Expr
-- at superclass implementations when searching for a dictionary, the type class name and
-- instance type, and the type class dictionaries in scope.
--
- | TypeClassDictionary Bool Constraint [TypeClassDictionaryInScope]
+ | TypeClassDictionary Bool Constraint (M.Map (Maybe ModuleName) (M.Map (Qualified ProperName) (M.Map (Qualified Ident) TypeClassDictionaryInScope)))
-- |
-- A typeclass dictionary accessor, the implementation is left unspecified until CoreFn desugaring.
--
diff --git a/src/Language/PureScript/AST/Exported.hs b/src/Language/PureScript/AST/Exported.hs
new file mode 100644
index 0000000..8f2007c
--- /dev/null
+++ b/src/Language/PureScript/AST/Exported.hs
@@ -0,0 +1,136 @@
+
+module Language.PureScript.AST.Exported (
+ exportedDeclarations,
+ isExported
+) where
+
+import Control.Category ((>>>))
+import Data.Maybe (mapMaybe)
+
+import Language.PureScript.AST.Declarations
+import Language.PureScript.Types
+import Language.PureScript.Names
+
+-- |
+-- Return a list of all declarations which are exported from a module.
+-- This function descends into data declarations to filter out unexported
+-- data constructors, and also filters out type instance declarations if
+-- they refer to classes or types which are not themselves exported.
+--
+-- Note that this function assumes that the module has already had its imports
+-- desugared using 'Language.PureScript.Sugar.Names.desugarImports'. It will
+-- produce incorrect results if this is not the case - for example, type class
+-- instances will be incorrectly removed in some cases.
+--
+exportedDeclarations :: Module -> [Declaration]
+exportedDeclarations (Module _ _ decls exps) = go decls
+ where
+ go = flattenDecls
+ >>> filter (isExported exps)
+ >>> map (filterDataConstructors exps)
+ >>> filterInstances exps
+
+-- |
+-- Filter out all data constructors from a declaration which are not exported.
+-- If the supplied declaration is not a data declaration, this function returns
+-- it unchanged.
+--
+filterDataConstructors :: Maybe [DeclarationRef] -> Declaration -> Declaration
+filterDataConstructors exps (DataDeclaration dType tyName tyArgs dctors) =
+ DataDeclaration dType tyName tyArgs $
+ filter (isDctorExported tyName exps . fst) dctors
+filterDataConstructors exps (PositionedDeclaration srcSpan coms d) =
+ PositionedDeclaration srcSpan coms (filterDataConstructors exps d)
+filterDataConstructors _ other = other
+
+-- |
+-- Filter out all the type instances from a list of declarations which
+-- reference a type or type class which is both local and not exported.
+--
+-- Note that this function assumes that the module has already had its imports
+-- desugared using "Language.PureScript.Sugar.Names.desugarImports". It will
+-- produce incorrect results if this is not the case - for example, type class
+-- instances will be incorrectly removed in some cases.
+--
+filterInstances :: Maybe [DeclarationRef] -> [Declaration] -> [Declaration]
+filterInstances Nothing = id
+filterInstances (Just exps) =
+ let refs = mapMaybe typeName exps ++ mapMaybe typeClassName exps
+ in filter (all (visibleOutside refs) . typeInstanceConstituents)
+ where
+ -- Given a Qualified ProperName, and a list of all exported types and type
+ -- classes, returns whether the supplied Qualified ProperName is visible
+ -- outside this module. This is true if one of the following hold:
+ --
+ -- * the name is defined in the same module and is exported,
+ -- * the name is defined in a different module (and must be exported from
+ -- that module; the code would fail to compile otherwise).
+ visibleOutside _ (Qualified (Just _) _) = True
+ visibleOutside refs (Qualified Nothing n) = any (== n) refs
+
+ typeName (TypeRef n _) = Just n
+ typeName (PositionedDeclarationRef _ _ r) = typeName r
+ typeName _ = Nothing
+
+ typeClassName (TypeClassRef n) = Just n
+ typeClassName (PositionedDeclarationRef _ _ r) = typeClassName r
+ typeClassName _ = Nothing
+
+-- |
+-- Get all type and type class names referenced by a type instance declaration.
+--
+typeInstanceConstituents :: Declaration -> [Qualified ProperName]
+typeInstanceConstituents (TypeInstanceDeclaration _ constraints className tys _) =
+ className : (concatMap fromConstraint constraints ++ concatMap fromType tys)
+ where
+
+ fromConstraint (name, tys') = name : concatMap fromType tys'
+ fromType = everythingOnTypes (++) go
+
+ -- Note that type synonyms are disallowed in instance declarations, so
+ -- we don't need to handle them here.
+ go (TypeConstructor n) = [n]
+ go (ConstrainedType cs _) = concatMap fromConstraint cs
+ go _ = []
+
+typeInstanceConstituents (PositionedDeclaration _ _ d) = typeInstanceConstituents d
+typeInstanceConstituents _ = []
+
+
+-- |
+-- Test if a declaration is exported, given a module's export list. Note that
+-- this function does not account for type instance declarations of
+-- non-exported types, or non-exported data constructors. Therefore, you should
+-- prefer 'exportedDeclarations' to this function, where possible.
+--
+isExported :: Maybe [DeclarationRef] -> Declaration -> Bool
+isExported Nothing _ = True
+isExported _ TypeInstanceDeclaration{} = True
+isExported exps (PositionedDeclaration _ _ d) = isExported exps d
+isExported (Just exps) decl = any (matches decl) exps
+ where
+ matches (TypeDeclaration ident _) (ValueRef ident') = ident == ident'
+ matches (ValueDeclaration ident _ _ _) (ValueRef ident') = ident == ident'
+ matches (ExternDeclaration ident _) (ValueRef ident') = ident == ident'
+ matches (FixityDeclaration _ name) (ValueRef ident') = name == runIdent ident'
+ matches (DataDeclaration _ ident _ _) (TypeRef ident' _) = ident == ident'
+ matches (ExternDataDeclaration ident _) (TypeRef ident' _) = ident == ident'
+ matches (TypeSynonymDeclaration ident _ _) (TypeRef ident' _) = ident == ident'
+ matches (TypeClassDeclaration ident _ _ _) (TypeClassRef ident') = ident == ident'
+
+ matches (PositionedDeclaration _ _ d) r = d `matches` r
+ matches d (PositionedDeclarationRef _ _ r) = d `matches` r
+ matches _ _ = False
+
+-- |
+-- Test if a data constructor for a given type is exported, given a module's
+-- export list. Prefer 'exportedDeclarations' to this function, where possible.
+--
+isDctorExported :: ProperName -> Maybe [DeclarationRef] -> ProperName -> Bool
+isDctorExported _ Nothing _ = True
+isDctorExported ident (Just exps) ctor = test `any` exps
+ where
+ test (PositionedDeclarationRef _ _ d) = test d
+ test (TypeRef ident' Nothing) = ident == ident'
+ test (TypeRef ident' (Just ctors)) = ident == ident' && ctor `elem` ctors
+ test _ = False
diff --git a/src/Language/PureScript/AST/Operators.hs b/src/Language/PureScript/AST/Operators.hs
index 0aa46af..53b60cd 100644
--- a/src/Language/PureScript/AST/Operators.hs
+++ b/src/Language/PureScript/AST/Operators.hs
@@ -12,11 +12,14 @@
--
-----------------------------------------------------------------------------
+{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Language.PureScript.AST.Operators where
import qualified Data.Data as D
+import Data.Aeson ((.=))
+import qualified Data.Aeson as A
-- |
-- A precedence level for an infix operator
@@ -26,14 +29,23 @@ type Precedence = Integer
-- |
-- Associativity for infix operators
--
-data Associativity = Infixl | Infixr | Infix deriving (D.Data, D.Typeable)
+data Associativity = Infixl | Infixr | Infix deriving (Eq, Ord, D.Data, D.Typeable)
instance Show Associativity where
show Infixl = "infixl"
show Infixr = "infixr"
show Infix = "infix"
+instance A.ToJSON Associativity where
+ toJSON = A.toJSON . show
+
-- |
-- Fixity data for infix operators
--
-data Fixity = Fixity Associativity Precedence deriving (Show, D.Data, D.Typeable)
+data Fixity = Fixity Associativity Precedence deriving (Show, Eq, Ord, D.Data, D.Typeable)
+
+instance A.ToJSON Fixity where
+ toJSON (Fixity associativity precedence) =
+ A.object [ "associativity" .= associativity
+ , "precedence" .= precedence
+ ]
diff --git a/src/Language/PureScript/AST/SourcePos.hs b/src/Language/PureScript/AST/SourcePos.hs
index 97c3dc6..bc6689a 100644
--- a/src/Language/PureScript/AST/SourcePos.hs
+++ b/src/Language/PureScript/AST/SourcePos.hs
@@ -12,11 +12,13 @@
--
-----------------------------------------------------------------------------
-{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}
+{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables, RecordWildCards, OverloadedStrings #-}
module Language.PureScript.AST.SourcePos where
import qualified Data.Data as D
+import Data.Aeson ((.=))
+import qualified Data.Aeson as A
-- |
-- Source position information
@@ -30,10 +32,16 @@ data SourcePos = SourcePos
-- Column number
--
, sourcePosColumn :: Int
- } deriving (Eq, D.Data, D.Typeable)
+ } deriving (Eq, Ord, Show, D.Data, D.Typeable)
-instance Show SourcePos where
- show sp = "line " ++ show (sourcePosLine sp) ++ ", column " ++ show (sourcePosColumn sp)
+displaySourcePos :: SourcePos -> String
+displaySourcePos sp =
+ "line " ++ show (sourcePosLine sp) ++
+ ", column " ++ show (sourcePosColumn sp)
+
+instance A.ToJSON SourcePos where
+ toJSON SourcePos{..} =
+ A.toJSON [sourcePosLine, sourcePosColumn]
data SourceSpan = SourceSpan
{ -- |
@@ -47,7 +55,17 @@ data SourceSpan = SourceSpan
-- End of the span
--
, spanEnd :: SourcePos
- } deriving (Eq, D.Data, D.Typeable)
+ } deriving (Eq, Ord, Show, D.Data, D.Typeable)
+
+displaySourceSpan :: SourceSpan -> String
+displaySourceSpan sp =
+ spanName sp ++ " " ++
+ displaySourcePos (spanStart sp) ++ " - " ++
+ displaySourcePos (spanEnd sp)
-instance Show SourceSpan where
- show sp = spanName sp ++ " " ++ show (spanStart sp) ++ " - " ++ show (spanEnd sp)
+instance A.ToJSON SourceSpan where
+ toJSON SourceSpan{..} =
+ A.object [ "name" .= spanName
+ , "start" .= spanStart
+ , "end" .= spanEnd
+ ]
diff --git a/src/Language/PureScript/AST/Traversals.hs b/src/Language/PureScript/AST/Traversals.hs
index e501b23..652369d 100644
--- a/src/Language/PureScript/AST/Traversals.hs
+++ b/src/Language/PureScript/AST/Traversals.hs
@@ -68,7 +68,6 @@ everywhereOnValues f g h = (f', g', h')
h' (ConstructorBinder ctor bs) = h (ConstructorBinder ctor (map h' bs))
h' (ObjectBinder bs) = h (ObjectBinder (map (fmap h') bs))
h' (ArrayBinder bs) = h (ArrayBinder (map h' bs))
- h' (ConsBinder b1 b2) = h (ConsBinder (h' b1) (h' b2))
h' (NamedBinder name b) = h (NamedBinder name (h' b))
h' (PositionedBinder pos com b) = h (PositionedBinder pos com (h' b))
h' other = h other
@@ -125,7 +124,6 @@ everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)
h' (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> mapM (h' <=< h) bs
h' (ObjectBinder bs) = ObjectBinder <$> mapM (sndM (h' <=< h)) bs
h' (ArrayBinder bs) = ArrayBinder <$> mapM (h' <=< h) bs
- h' (ConsBinder b1 b2) = ConsBinder <$> (h b1 >>= h') <*> (h b2 >>= h')
h' (NamedBinder name b) = NamedBinder name <$> (h b >>= h')
h' (PositionedBinder pos com b) = PositionedBinder pos com <$> (h b >>= h')
h' other = h other
@@ -178,7 +176,6 @@ everywhereOnValuesM f g h = (f', g', h')
h' (ConstructorBinder ctor bs) = (ConstructorBinder ctor <$> mapM h' bs) >>= h
h' (ObjectBinder bs) = (ObjectBinder <$> mapM (sndM h') bs) >>= h
h' (ArrayBinder bs) = (ArrayBinder <$> mapM h' bs) >>= h
- h' (ConsBinder b1 b2) = (ConsBinder <$> h' b1 <*> h' b2) >>= h
h' (NamedBinder name b) = (NamedBinder name <$> h' b) >>= h
h' (PositionedBinder pos com b) = (PositionedBinder pos com <$> h' b) >>= h
h' other = h other
@@ -234,7 +231,6 @@ everythingOnValues (<>) f g h i j = (f', g', h', i', j')
h' b@(ConstructorBinder _ bs) = foldl (<>) (h b) (map h' bs)
h' b@(ObjectBinder bs) = foldl (<>) (h b) (map (h' . snd) bs)
h' b@(ArrayBinder bs) = foldl (<>) (h b) (map h' bs)
- h' b@(ConsBinder b1 b2) = h b <> h' b1 <> h' b2
h' b@(NamedBinder _ b1) = h b <> h' b1
h' b@(PositionedBinder _ _ b1) = h b <> h' b1
h' b = h b
@@ -303,7 +299,6 @@ everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'
h' s (ConstructorBinder _ bs) = foldl (<>) r0 (map (h'' s) bs)
h' s (ObjectBinder bs) = foldl (<>) r0 (map (h'' s . snd) bs)
h' s (ArrayBinder bs) = foldl (<>) r0 (map (h'' s) bs)
- h' s (ConsBinder b1 b2) = h'' s b1 <> h'' s b2
h' s (NamedBinder _ b1) = h'' s b1
h' s (PositionedBinder _ _ b1) = h'' s b1
h' _ _ = r0
@@ -373,7 +368,6 @@ everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j
h' s (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> mapM (h'' s) bs
h' s (ObjectBinder bs) = ObjectBinder <$> mapM (sndM (h'' s)) bs
h' s (ArrayBinder bs) = ArrayBinder <$> mapM (h'' s) bs
- h' s (ConsBinder b1 b2) = ConsBinder <$> h'' s b1 <*> h'' s b2
h' s (NamedBinder name b) = NamedBinder name <$> h'' s b
h' s (PositionedBinder pos com b) = PositionedBinder pos com <$> h'' s b
h' _ other = return other
@@ -393,7 +387,7 @@ accumTypes :: (Monoid r) => (Type -> r) -> (Declaration -> r, Expr -> r, Binder
accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)
where
forDecls (DataDeclaration _ _ _ dctors) = mconcat (concatMap (map f . snd) dctors)
- forDecls (ExternDeclaration _ _ _ ty) = f ty
+ forDecls (ExternDeclaration _ ty) = f ty
forDecls (ExternInstanceDeclaration _ cs _ tys) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)
forDecls (TypeClassDeclaration _ _ implies _) = mconcat (concatMap (map f . snd) implies)
forDecls (TypeInstanceDeclaration _ cs _ tys _) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)
diff --git a/src/Language/PureScript/CodeGen/Externs.hs b/src/Language/PureScript/CodeGen/Externs.hs
index 956b06e..4a6f074 100644
--- a/src/Language/PureScript/CodeGen/Externs.hs
+++ b/src/Language/PureScript/CodeGen/Externs.hs
@@ -24,13 +24,13 @@ import qualified Data.Map as M
import Control.Monad.Writer
import Language.PureScript.AST
+import Language.PureScript.Comments
import Language.PureScript.Environment
import Language.PureScript.Kinds
import Language.PureScript.Names
import Language.PureScript.Pretty
import Language.PureScript.TypeClassDictionaries
import Language.PureScript.Types
-import Language.PureScript.Comments
-- |
-- Generate foreign imports for all declarations in a module
@@ -38,11 +38,24 @@ import Language.PureScript.Comments
moduleToPs :: Module -> Environment -> String
moduleToPs (Module _ _ _ Nothing) _ = error "Module exports were not elaborated in moduleToPs"
moduleToPs (Module _ moduleName ds (Just exts)) env = intercalate "\n" . execWriter $ do
- tell [ "module " ++ runModuleName moduleName ++ " where"]
+ let exps = listExports exts
+ tell ["module " ++ runModuleName moduleName ++ (if null exps then "" else " (" ++ exps ++ ")") ++ " where"]
mapM_ declToPs ds
mapM_ exportToPs exts
where
+ listExports :: [DeclarationRef] -> String
+ listExports = intercalate ", " . mapMaybe listExport
+
+ listExport :: DeclarationRef -> Maybe String
+ listExport (PositionedDeclarationRef _ _ d) = listExport d
+ listExport (TypeRef name Nothing) = Just $ show name ++ "()"
+ listExport (TypeRef name (Just dctors)) = Just $ show name ++ "(" ++ intercalate ", " (map show dctors) ++ ")"
+ listExport (ValueRef name) = Just $ show name
+ listExport (TypeClassRef name) = Just $ show name
+ listExport (ModuleRef name) = Just $ "module " ++ show name
+ listExport _ = Nothing
+
declToPs :: Declaration -> Writer [String] ()
declToPs (ImportDeclaration mn _ _) = tell ["import " ++ show mn ++ " ()"]
declToPs (FixityDeclaration (Fixity assoc prec) op) =
@@ -54,7 +67,7 @@ moduleToPs (Module _ moduleName ds (Just exts)) env = intercalate "\n" . execWri
exportsOp (PositionedDeclarationRef _ _ r) = exportsOp r
exportsOp (ValueRef ident') = ident' == Op op
exportsOp _ = False
- declToPs (PositionedDeclaration _ com d) = mapM commentToPs com >> declToPs d
+ declToPs (PositionedDeclaration _ com d) = mapM_ commentToPs com >> declToPs d
declToPs _ = return ()
commentToPs :: Comment -> Writer [String] ()
@@ -63,7 +76,7 @@ moduleToPs (Module _ moduleName ds (Just exts)) env = intercalate "\n" . execWri
exportToPs :: DeclarationRef -> Writer [String] ()
exportToPs (PositionedDeclarationRef _ _ r) = exportToPs r
- exportToPs (TypeRef pn dctors) = do
+ exportToPs (TypeRef pn dctors) =
case Qualified (Just moduleName) pn `M.lookup` types env of
Nothing -> error $ show pn ++ " has no kind in exportToPs"
Just (kind, ExternData) ->
@@ -90,7 +103,7 @@ moduleToPs (Module _ moduleName ds (Just exts)) env = intercalate "\n" . execWri
exportToPs (ValueRef ident) =
case (moduleName, ident) `M.lookup` names env of
Nothing -> error $ show ident ++ " has no type in exportToPs"
- Just (ty, nameKind, _) | nameKind == Value || nameKind == Extern ForeignImport || nameKind == Extern InlineJavascript ->
+ Just (ty, nk, _) | nk == Public || nk == External ->
tell ["foreign import " ++ show ident ++ " :: " ++ prettyPrintType ty]
_ -> return ()
exportToPs (TypeClassRef className) =
@@ -107,12 +120,14 @@ moduleToPs (Module _ moduleName ds (Just exts)) env = intercalate "\n" . execWri
exportToPs (TypeInstanceRef ident) = do
let TypeClassDictionaryInScope { tcdClassName = className, tcdInstanceTypes = tys, tcdDependencies = deps} =
- fromMaybe (error $ "Type class instance has no dictionary in exportToPs") . find (\tcd -> tcdName tcd == Qualified (Just moduleName) ident && tcdType tcd == TCDRegular) $ M.elems $ typeClassDictionaries env
+ fromMaybe (error $ "Type class instance has no dictionary in exportToPs") . find (\tcd -> tcdName tcd == Qualified (Just moduleName) ident && tcdType tcd == TCDRegular) . maybe [] (M.elems >=> M.elems) . M.lookup (Just moduleName) $ typeClassDictionaries env
let constraintsText = case fromMaybe [] deps of
[] -> ""
cs -> "(" ++ intercalate ", " (map (\(pn, tys') -> show pn ++ " " ++ unwords (map prettyPrintTypeAtom tys')) cs) ++ ") => "
tell ["foreign import instance " ++ show ident ++ " :: " ++ constraintsText ++ show className ++ " " ++ unwords (map prettyPrintTypeAtom tys)]
+ exportToPs (ModuleRef _) = return ()
+
toTypeVar :: (String, Maybe Kind) -> Type
toTypeVar (s, Nothing) = TypeVar s
toTypeVar (s, Just k) = KindedType (TypeVar s) k
diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs
index c93b7a3..f856957 100644
--- a/src/Language/PureScript/CodeGen/JS.hs
+++ b/src/Language/PureScript/CodeGen/JS.hs
@@ -18,22 +18,23 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
-module Language.PureScript.CodeGen.JS (
- module AST,
- module Common,
- moduleToJs
-) where
+module Language.PureScript.CodeGen.JS
+ ( module AST
+ , module Common
+ , moduleToJs
+ , mainCall
+ ) where
-import Data.List ((\\), delete)
-import Data.Maybe (mapMaybe)
+import Data.List ((\\), delete, intersect)
import qualified Data.Traversable as T (traverse)
import Control.Applicative
import Control.Arrow ((&&&))
-import Control.Monad (foldM, replicateM, forM)
+import Control.Monad (replicateM, forM)
import Control.Monad.Reader (MonadReader, asks)
import Control.Monad.Supply.Class
+import Language.PureScript.AST.SourcePos
import Language.PureScript.CodeGen.JS.AST as AST
import Language.PureScript.CodeGen.JS.Common as Common
import Language.PureScript.CoreFn
@@ -43,33 +44,28 @@ import Language.PureScript.Options
import Language.PureScript.Traversals (sndM)
import qualified Language.PureScript.Constants as C
+import System.FilePath.Posix ((</>))
+
-- |
-- Generate code in the simplified Javascript intermediate representation for all declarations in a
-- module.
--
-moduleToJs :: forall m mode. (Applicative m, Monad m, MonadReader (Options mode) m, MonadSupply m)
- => Module Ann -> m [JS]
-moduleToJs (Module coms mn imps exps foreigns decls) = do
- additional <- asks optionsAdditional
+moduleToJs :: forall m. (Applicative m, Monad m, MonadReader Options m, MonadSupply m)
+ => Module Ann -> Maybe JS -> m [JS]
+moduleToJs (Module coms mn imps exps foreigns decls) foreign = do
jsImports <- T.traverse importToJs . delete (ModuleName [ProperName C.prim]) . (\\ [mn]) $ imps
- let foreigns' = mapMaybe (\(_, js, _) -> js) foreigns
jsDecls <- mapM bindToJs decls
optimized <- T.traverse (T.traverse optimize) jsDecls
- let isModuleEmpty = null exps
comments <- not <$> asks optionsNoComments
let strict = JSStringLiteral "use strict"
let header = if comments && not (null coms) then JSComment coms strict else strict
- let moduleBody = header : jsImports ++ foreigns' ++ concat optimized
- let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) exps
- return $ case additional of
- MakeOptions -> moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) exps']
- CompileOptions ns _ _ | not isModuleEmpty ->
- [ JSVariableIntroduction ns
- (Just (JSBinary Or (JSVar ns) (JSObjectLiteral [])) )
- , JSAssignment (JSAccessor (moduleNameToJs mn) (JSVar ns))
- (JSApp (JSFunction Nothing [] (JSBlock (moduleBody ++ [JSReturn exps']))) [])
- ]
- _ -> []
+ let foreign' = [JSVariableIntroduction "$foreign" foreign | not $ null foreigns || foreign == Nothing]
+ let moduleBody = header : foreign' ++ jsImports ++ concat optimized
+ let foreignExps = exps `intersect` (fst `map` foreigns)
+ let standardExps = exps \\ foreignExps
+ let exps' = JSObjectLiteral $ map (runIdent &&& JSVar . identToJs) standardExps
+ ++ map (runIdent &&& foreignIdent) foreignExps
+ return $ moduleBody ++ [JSAssignment (JSAccessor "exports" (JSVar "module")) exps']
where
@@ -78,10 +74,8 @@ moduleToJs (Module coms mn imps exps foreigns decls) = do
--
importToJs :: ModuleName -> m JS
importToJs mn' = do
- additional <- asks optionsAdditional
- let moduleBody = case additional of
- MakeOptions -> JSApp (JSVar "require") [JSStringLiteral (runModuleName mn')]
- CompileOptions ns _ _ -> JSAccessor (moduleNameToJs mn') (JSVar ns)
+ path <- asks optionsRequirePath
+ let moduleBody = JSApp (JSVar "require") [JSStringLiteral (maybe id (</>) path $ runModuleName mn')]
return $ JSVariableIntroduction (moduleNameToJs mn') (Just moduleBody)
-- |
@@ -170,11 +164,17 @@ moduleToJs (Module coms mn imps exps foreigns decls) = do
unApp :: Expr Ann -> [Expr Ann] -> (Expr Ann, [Expr Ann])
unApp (App _ val arg) args = unApp val (arg : args)
unApp other args = (other, args)
+ valueToJs (Var (_, _, _, Just IsForeign) qi@(Qualified (Just mn') ident)) =
+ return $ if mn' == mn
+ then foreignIdent ident
+ else varToJs qi
+ valueToJs (Var (_, _, _, Just IsForeign) ident) =
+ error $ "Encountered an unqualified reference to a foreign ident " ++ show ident
valueToJs (Var _ ident) =
return $ varToJs ident
- valueToJs (Case _ values binders) = do
+ valueToJs (Case (maybeSpan, _, _, _) values binders) = do
vals <- mapM valueToJs values
- bindersToJs binders vals
+ bindersToJs maybeSpan binders vals
valueToJs (Let _ ds val) = do
ds' <- concat <$> mapM bindToJs ds
ret <- valueToJs val
@@ -205,6 +205,7 @@ moduleToJs (Module coms mn imps exps foreigns decls) = do
literalToValueJS :: Literal (Expr Ann) -> m JS
literalToValueJS (NumericLiteral n) = return $ JSNumericLiteral n
literalToValueJS (StringLiteral s) = return $ JSStringLiteral s
+ literalToValueJS (CharLiteral c) = return $ JSStringLiteral [c]
literalToValueJS (BooleanLiteral b) = return $ JSBooleanLiteral b
literalToValueJS (ArrayLiteral xs) = JSArrayLiteral <$> mapM valueToJs xs
literalToValueJS (ObjectLiteral ps) = JSObjectLiteral <$> mapM (sndM valueToJs) ps
@@ -245,18 +246,21 @@ moduleToJs (Module coms mn imps exps foreigns decls) = do
qualifiedToJS f (Qualified (Just mn') a) | mn /= mn' = accessor (f a) (JSVar (moduleNameToJs mn'))
qualifiedToJS f (Qualified _ a) = JSVar $ identToJs (f a)
+ foreignIdent :: Ident -> JS
+ foreignIdent ident = accessorString (runIdent ident) (JSVar "$foreign")
+
-- |
-- Generate code in the simplified Javascript intermediate representation for pattern match binders
-- and guards.
--
- bindersToJs :: [CaseAlternative Ann] -> [JS] -> m JS
- bindersToJs binders vals = do
+ bindersToJs :: Maybe SourceSpan -> [CaseAlternative Ann] -> [JS] -> m JS
+ bindersToJs maybeSpan binders vals = do
valNames <- replicateM (length vals) freshName
let assignments = zipWith JSVariableIntroduction valNames (map Just vals)
jss <- forM binders $ \(CaseAlternative bs result) -> do
ret <- guardsToJs result
go valNames ret bs
- return $ JSApp (JSFunction Nothing [] (JSBlock (assignments ++ concat jss ++ [JSThrow $ JSUnary JSNew $ JSApp (JSVar "Error") [JSStringLiteral "Failed pattern match"]])))
+ return $ JSApp (JSFunction Nothing [] (JSBlock (assignments ++ concat jss ++ [JSThrow $ failedPatternError valNames])))
[]
where
go :: [String] -> [JS] -> [Binder Ann] -> m [JS]
@@ -266,6 +270,18 @@ moduleToJs (Module coms mn imps exps foreigns decls) = do
binderToJs v done'' b
go _ _ _ = error "Invalid arguments to bindersToJs"
+ failedPatternError :: [String] -> JS
+ failedPatternError names = JSUnary JSNew $ JSApp (JSVar "Error") [JSBinary Add (JSStringLiteral errorMessage) (JSArrayLiteral $ zipWith valueError names vals)]
+
+ errorMessage :: String
+ errorMessage = "Failed pattern match" ++ maybe "" ((" at " ++) . displaySourceSpan) maybeSpan ++ ": "
+
+ valueError :: String -> JS -> JS
+ valueError _ l@(JSNumericLiteral _) = l
+ valueError _ l@(JSStringLiteral _) = l
+ valueError _ l@(JSBooleanLiteral _) = l
+ valueError s _ = JSAccessor "name" . JSAccessor "constructor" $ JSVar s
+
guardsToJs :: Either [(Guard Ann, Expr Ann)] (Expr Ann) -> m [JS]
guardsToJs (Left gs) = forM gs $ \(cond, val) -> do
cond' <- valueToJs cond
@@ -301,23 +317,6 @@ moduleToJs (Module coms mn imps exps foreigns decls) = do
done'' <- go remain done'
js <- binderToJs argVar done'' binder
return (JSVariableIntroduction argVar (Just (JSAccessor (identToJs field) (JSVar varName))) : js)
- binderToJs varName done binder@(ConstructorBinder _ _ ctor _) | isCons ctor = do
- let (headBinders, tailBinder) = uncons [] binder
- numberOfHeadBinders = fromIntegral $ length headBinders
- js1 <- foldM (\done' (headBinder, index) -> do
- headVar <- freshName
- jss <- binderToJs headVar done' headBinder
- return (JSVariableIntroduction headVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : jss)) done (zip headBinders [0..])
- tailVar <- freshName
- js2 <- binderToJs tailVar js1 tailBinder
- return [JSIfElse (JSBinary GreaterThanOrEqualTo (JSAccessor "length" (JSVar varName)) (JSNumericLiteral (Left numberOfHeadBinders))) (JSBlock
- ( JSVariableIntroduction tailVar (Just (JSApp (JSAccessor "slice" (JSVar varName)) [JSNumericLiteral (Left numberOfHeadBinders)])) :
- js2
- )) Nothing]
- where
- uncons :: [Binder Ann] -> Binder Ann -> ([Binder Ann], Binder Ann)
- uncons acc (ConstructorBinder _ _ ctor' [h, t]) | isCons ctor' = uncons (h : acc) t
- uncons acc tailBinder = (reverse acc, tailBinder)
binderToJs _ _ b@(ConstructorBinder{}) =
error $ "Invalid ConstructorBinder in binderToJs: " ++ show b
binderToJs varName done (NamedBinder _ ident binder) = do
@@ -327,6 +326,8 @@ moduleToJs (Module coms mn imps exps foreigns decls) = do
literalToBinderJS :: String -> [JS] -> Literal (Binder Ann) -> m [JS]
literalToBinderJS varName done (NumericLiteral num) =
return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSNumericLiteral num)) (JSBlock done) Nothing]
+ literalToBinderJS varName done (CharLiteral c) =
+ return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSStringLiteral [c])) (JSBlock done) Nothing]
literalToBinderJS varName done (StringLiteral str) =
return [JSIfElse (JSBinary EqualTo (JSVar varName) (JSStringLiteral str)) (JSBlock done) Nothing]
literalToBinderJS varName done (BooleanLiteral True) =
@@ -354,6 +355,5 @@ moduleToJs (Module coms mn imps exps foreigns decls) = do
js <- binderToJs elVar done'' binder
return (JSVariableIntroduction elVar (Just (JSIndexer (JSNumericLiteral (Left index)) (JSVar varName))) : js)
- isCons :: Qualified ProperName -> Bool
- isCons (Qualified (Just mn') ctor) = mn' == ModuleName [ProperName C.prim] && ctor == ProperName "Array"
- isCons name = error $ "Unexpected argument in isCons: " ++ show name
+mainCall :: ModuleName -> String -> JS
+mainCall mmi ns = JSApp (JSAccessor C.main (JSAccessor (moduleNameToJs mmi) (JSVar ns))) []
diff --git a/src/Language/PureScript/CodeGen/JS/AST.hs b/src/Language/PureScript/CodeGen/JS/AST.hs
index 1f3ce4c..72548f5 100644
--- a/src/Language/PureScript/CodeGen/JS/AST.hs
+++ b/src/Language/PureScript/CodeGen/JS/AST.hs
@@ -17,7 +17,10 @@
module Language.PureScript.CodeGen.JS.AST where
+import Control.Applicative (Applicative, (<$>), (<*>))
+import Control.Monad.Identity
import Data.Data
+import Data.Traversable (traverse)
import Language.PureScript.Comments
@@ -281,31 +284,34 @@ everywhereOnJS f = go
go other = f other
everywhereOnJSTopDown :: (JS -> JS) -> JS -> JS
-everywhereOnJSTopDown f = go . f
+everywhereOnJSTopDown f = runIdentity . everywhereOnJSTopDownM (Identity . f)
+
+everywhereOnJSTopDownM :: (Applicative m, Monad m) => (JS -> m JS) -> JS -> m JS
+everywhereOnJSTopDownM f = f >=> go
where
- go :: JS -> JS
- go (JSUnary op j) = JSUnary op (go (f j))
- go (JSBinary op j1 j2) = JSBinary op (go (f j1)) (go (f j2))
- go (JSArrayLiteral js) = JSArrayLiteral (map (go . f) js)
- go (JSIndexer j1 j2) = JSIndexer (go (f j1)) (go (f j2))
- go (JSObjectLiteral js) = JSObjectLiteral (map (fmap (go . f)) js)
- go (JSAccessor prop j) = JSAccessor prop (go (f j))
- go (JSFunction name args j) = JSFunction name args (go (f j))
- go (JSApp j js) = JSApp (go (f j)) (map (go . f) js)
- go (JSConditional j1 j2 j3) = JSConditional (go (f j1)) (go (f j2)) (go (f j3))
- go (JSBlock js) = JSBlock (map (go . f) js)
- go (JSVariableIntroduction name j) = JSVariableIntroduction name (fmap (go . f) j)
- go (JSAssignment j1 j2) = JSAssignment (go (f j1)) (go (f j2))
- go (JSWhile j1 j2) = JSWhile (go (f j1)) (go (f j2))
- go (JSFor name j1 j2 j3) = JSFor name (go (f j1)) (go (f j2)) (go (f j3))
- go (JSForIn name j1 j2) = JSForIn name (go (f j1)) (go (f j2))
- go (JSIfElse j1 j2 j3) = JSIfElse (go (f j1)) (go (f j2)) (fmap (go . f) j3)
- go (JSReturn j) = JSReturn (go (f j))
- go (JSThrow j) = JSThrow (go (f j))
- go (JSTypeOf j) = JSTypeOf (go (f j))
- go (JSLabel name j) = JSLabel name (go (f j))
- go (JSInstanceOf j1 j2) = JSInstanceOf (go (f j1)) (go (f j2))
- go (JSComment com j) = JSComment com (go (f j))
+ f' = f >=> go
+ go (JSUnary op j) = JSUnary op <$> f' j
+ go (JSBinary op j1 j2) = JSBinary op <$> f' j1 <*> f' j2
+ go (JSArrayLiteral js) = JSArrayLiteral <$> traverse f' js
+ go (JSIndexer j1 j2) = JSIndexer <$> f' j1 <*> f' j2
+ go (JSObjectLiteral js) = JSObjectLiteral <$> traverse (traverse f') js
+ go (JSAccessor prop j) = JSAccessor prop <$> f' j
+ go (JSFunction name args j) = JSFunction name args <$> f' j
+ go (JSApp j js) = JSApp <$> f' j <*> traverse f' js
+ go (JSConditional j1 j2 j3) = JSConditional <$> f' j1 <*> f' j2 <*> f' j3
+ go (JSBlock js) = JSBlock <$> traverse f' js
+ go (JSVariableIntroduction name j) = JSVariableIntroduction name <$> traverse f' j
+ go (JSAssignment j1 j2) = JSAssignment <$> f' j1 <*> f' j2
+ go (JSWhile j1 j2) = JSWhile <$> f' j1 <*> f' j2
+ go (JSFor name j1 j2 j3) = JSFor name <$> f' j1 <*> f' j2 <*> f' j3
+ go (JSForIn name j1 j2) = JSForIn name <$> f' j1 <*> f' j2
+ go (JSIfElse j1 j2 j3) = JSIfElse <$> f' j1 <*> f' j2 <*> traverse f' j3
+ go (JSReturn j) = JSReturn <$> f' j
+ go (JSThrow j) = JSThrow <$> f' j
+ go (JSTypeOf j) = JSTypeOf <$> f' j
+ go (JSLabel name j) = JSLabel name <$> f' j
+ go (JSInstanceOf j1 j2) = JSInstanceOf <$> f' j1 <*> f' j2
+ go (JSComment com j) = JSComment com <$> f' j
go other = f other
everythingOnJS :: (r -> r -> r) -> (JS -> r) -> JS -> r
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer.hs b/src/Language/PureScript/CodeGen/JS/Optimizer.hs
index 3906cd5..4616bb6 100644
--- a/src/Language/PureScript/CodeGen/JS/Optimizer.hs
+++ b/src/Language/PureScript/CodeGen/JS/Optimizer.hs
@@ -37,7 +37,9 @@ module Language.PureScript.CodeGen.JS.Optimizer (
optimize
) where
+import Control.Applicative (Applicative)
import Control.Monad.Reader (MonadReader, ask, asks)
+import Control.Monad.Supply.Class (MonadSupply)
import Language.PureScript.CodeGen.JS.AST
import Language.PureScript.Options
@@ -53,15 +55,15 @@ import Language.PureScript.CodeGen.JS.Optimizer.Blocks
-- |
-- Apply a series of optimizer passes to simplified Javascript code
--
-optimize :: (Monad m, MonadReader (Options mode) m) => JS -> m JS
+optimize :: (Monad m, MonadReader Options m, Applicative m, MonadSupply m) => JS -> m JS
optimize js = do
noOpt <- asks optionsNoOptimizations
if noOpt then return js else optimize' js
-optimize' :: (Monad m, MonadReader (Options mode) m) => JS -> m JS
+optimize' :: (Monad m, MonadReader Options m, Applicative m, MonadSupply m) => JS -> m JS
optimize' js = do
opts <- ask
- return $ untilFixedPoint (applyAll
+ untilFixedPoint (inlineArrComposition . applyAll
[ collapseNestedBlocks
, collapseNestedIfs
, tco opts
@@ -76,11 +78,12 @@ optimize' js = do
, inlineValues
, inlineOperator (C.prelude, (C.$)) $ \f x -> JSApp f [x]
, inlineOperator (C.prelude, (C.#)) $ \x f -> JSApp f [x]
- , inlineOperator (C.preludeUnsafe, C.unsafeIndex) $ flip JSIndexer
+ , inlineOperator (C.dataArrayUnsafe, C.unsafeIndex) $ flip JSIndexer
, inlineCommonOperators ]) js
-untilFixedPoint :: (Eq a) => (a -> a) -> a -> a
+untilFixedPoint :: (Monad m, Eq a) => (a -> m a) -> a -> m a
untilFixedPoint f = go
where
- go a = let a' = f a in
- if a' == a then a' else go a'
+ go a = do
+ a' <- f a
+ if a' == a then return a' else go a'
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs b/src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs
index caf7017..2777956 100644
--- a/src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs
+++ b/src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs
@@ -18,11 +18,14 @@ module Language.PureScript.CodeGen.JS.Optimizer.Inliner (
inlineValues,
inlineOperator,
inlineCommonOperators,
+ inlineArrComposition,
etaConvert,
unThunk,
evaluateIifes
) where
+import Control.Applicative (Applicative)
+import Control.Monad.Supply.Class (MonadSupply, freshName)
import Data.Maybe (fromMaybe)
import Language.PureScript.CodeGen.JS.AST
@@ -31,6 +34,10 @@ import Language.PureScript.Names
import Language.PureScript.CodeGen.JS.Optimizer.Common
import qualified Language.PureScript.Constants as C
+-- TODO: Potential bug:
+-- Shouldn't just inline this case: { var x = 0; x.toFixed(10); }
+-- Needs to be: { 0..toFixed(10); }
+-- Probably needs to be fixed in pretty-printer instead.
shouldInline :: JS -> Bool
shouldInline (JSVar _) = True
shouldInline (JSNumericLiteral _) = True
@@ -84,10 +91,26 @@ inlineValues :: JS -> JS
inlineValues = everywhereOnJS convert
where
convert :: JS -> JS
- convert (JSApp fn [dict]) | isPreludeDict C.semiringNumber dict && isPreludeFn C.zero fn = JSNumericLiteral (Left 0)
- convert (JSApp fn [dict]) | isPreludeDict C.semiringNumber dict && isPreludeFn C.one fn = JSNumericLiteral (Left 1)
- convert (JSApp (JSApp fn [x]) [y]) | isPreludeFn (C.%) fn = JSBinary Modulus x y
+ convert (JSApp fn [dict]) | isDict semiringNumber dict && isFn fnZero fn = JSNumericLiteral (Left 0)
+ | isDict semiringNumber dict && isFn fnOne fn = JSNumericLiteral (Left 1)
+ | isDict semiringInt dict && isFn fnZero fn = JSNumericLiteral (Left 0)
+ | isDict semiringInt dict && isFn fnOne fn = JSNumericLiteral (Left 1)
+ | isDict boundedBoolean dict && isFn fnBottom fn = JSBooleanLiteral False
+ | isDict boundedBoolean dict && isFn fnTop fn = JSBooleanLiteral True
+ convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y])
+ | isDict semiringInt dict && isFn fnAdd fn = JSBinary BitwiseOr (JSBinary Add x y) (JSNumericLiteral (Left 0))
+ | isDict semiringInt dict && isFn fnMultiply fn = JSBinary BitwiseOr (JSBinary Multiply x y) (JSNumericLiteral (Left 0))
+ | isDict moduloSemiringInt dict && isFn fnDivide fn = JSBinary BitwiseOr (JSBinary Divide x y) (JSNumericLiteral (Left 0))
+ | isDict ringInt dict && isFn fnSubtract fn = JSBinary BitwiseOr (JSBinary Subtract x y) (JSNumericLiteral (Left 0))
convert other = other
+ fnZero = (C.prelude, C.zero)
+ fnOne = (C.prelude, C.one)
+ fnBottom = (C.prelude, C.bottom)
+ fnTop = (C.prelude, C.top)
+ fnAdd = (C.prelude, (C.+))
+ fnDivide = (C.prelude, (C./))
+ fnMultiply = (C.prelude, (C.*))
+ fnSubtract = (C.prelude, (C.-))
inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS
inlineOperator (m, op) f = everywhereOnJS convert
@@ -101,58 +124,83 @@ inlineOperator (m, op) f = everywhereOnJS convert
inlineCommonOperators :: JS -> JS
inlineCommonOperators = applyAll $
- [ binary C.semiringNumber (C.+) Add
- , binary C.semiringNumber (C.*) Multiply
- , binary C.ringNumber (C.-) Subtract
- , unary C.ringNumber C.negate Negate
- , binary C.moduloSemiringNumber (C./) Divide
-
- , binary C.ordNumber (C.<) LessThan
- , binary C.ordNumber (C.>) GreaterThan
- , binary C.ordNumber (C.<=) LessThanOrEqualTo
- , binary C.ordNumber (C.>=) GreaterThanOrEqualTo
-
- , binary C.eqNumber (C.==) EqualTo
- , binary C.eqNumber (C./=) NotEqualTo
- , binary C.eqString (C.==) EqualTo
- , binary C.eqString (C./=) NotEqualTo
- , binary C.eqBoolean (C.==) EqualTo
- , binary C.eqBoolean (C./=) NotEqualTo
-
- , binary C.semigroupString (C.<>) Add
- , binary C.semigroupString (C.++) Add
-
- , binaryFunction C.bitsNumber C.shl ShiftLeft
- , binaryFunction C.bitsNumber C.shr ShiftRight
- , binaryFunction C.bitsNumber C.zshr ZeroFillShiftRight
- , binary C.bitsNumber (C..&.) BitwiseAnd
- , binary C.bitsNumber (C..|.) BitwiseOr
- , binary C.bitsNumber (C..^.) BitwiseXor
- , unary C.bitsNumber C.complement BitwiseNot
-
- , binary C.boolLikeBoolean (C.&&) And
- , binary C.boolLikeBoolean (C.||) Or
- , unary C.boolLikeBoolean C.not Not
+ [ binary semiringNumber (C.+) Add
+ , binary semiringNumber (C.*) Multiply
+
+ , binary ringNumber (C.-) Subtract
+ , unary ringNumber C.negate Negate
+ , binary ringInt (C.-) Subtract
+ , unary ringInt C.negate Negate
+
+ , binary moduloSemiringNumber (C./) Divide
+ , binary moduloSemiringInt C.mod Modulus
+
+ , binary eqNumber (C.==) EqualTo
+ , binary eqNumber (C./=) NotEqualTo
+ , binary eqInt (C.==) EqualTo
+ , binary eqInt (C./=) NotEqualTo
+ , binary eqString (C.==) EqualTo
+ , binary eqString (C./=) NotEqualTo
+ , binary eqBoolean (C.==) EqualTo
+ , binary eqBoolean (C./=) NotEqualTo
+
+ , binary ordNumber (C.<) LessThan
+ , binary ordNumber (C.>) GreaterThan
+ , binary ordNumber (C.<=) LessThanOrEqualTo
+ , binary ordNumber (C.>=) GreaterThanOrEqualTo
+ , binary ordInt (C.<) LessThan
+ , binary ordInt (C.>) GreaterThan
+ , binary ordInt (C.<=) LessThanOrEqualTo
+ , binary ordInt (C.>=) GreaterThanOrEqualTo
+
+ , binary semigroupString (C.<>) Add
+ , binary semigroupString (C.++) Add
+
+ , binary latticeBoolean (C.&&) And
+ , binary latticeBoolean (C.||) Or
+ , binaryFunction latticeBoolean C.inf And
+ , binaryFunction latticeBoolean C.sup Or
+ , unary complementedLatticeBoolean C.not Not
+
+ , binary' C.dataIntBits (C..|.) BitwiseOr
+ , binary' C.dataIntBits (C..&.) BitwiseAnd
+ , binary' C.dataIntBits (C..^.) BitwiseXor
+ , binary' C.dataIntBits C.shl ShiftLeft
+ , binary' C.dataIntBits C.shr ShiftRight
+ , binary' C.dataIntBits C.zshr ZeroFillShiftRight
+ , unary' C.dataIntBits C.complement BitwiseNot
] ++
[ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]
where
- binary :: String -> String -> BinaryOperator -> JS -> JS
- binary dictName opString op = everywhereOnJS convert
+ binary :: (String, String) -> String -> BinaryOperator -> JS -> JS
+ binary dict opString op = everywhereOnJS convert
where
convert :: JS -> JS
- convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isPreludeDict dictName dict && isPreludeFn opString fn = JSBinary op x y
+ convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isDict dict dict' && isPreludeFn opString fn = JSBinary op x y
convert other = other
- binaryFunction :: String -> String -> BinaryOperator -> JS -> JS
- binaryFunction dictName fnName op = everywhereOnJS convert
+ binary' :: String -> String -> BinaryOperator -> JS -> JS
+ binary' moduleName opString op = everywhereOnJS convert
where
convert :: JS -> JS
- convert (JSApp (JSApp (JSApp fn [dict]) [x]) [y]) | isPreludeFn fnName fn && isPreludeDict dictName dict = JSBinary op x y
+ convert (JSApp (JSApp fn [x]) [y]) | isFn (moduleName, opString) fn = JSBinary op x y
convert other = other
- unary :: String -> String -> UnaryOperator -> JS -> JS
- unary dictName fnName op = everywhereOnJS convert
+ binaryFunction :: (String, String) -> String -> BinaryOperator -> JS -> JS
+ binaryFunction dict fnName op = everywhereOnJS convert
where
convert :: JS -> JS
- convert (JSApp (JSApp fn [dict]) [x]) | isPreludeFn fnName fn && isPreludeDict dictName dict = JSUnary op x
+ convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isPreludeFn fnName fn && isDict dict dict' = JSBinary op x y
+ convert other = other
+ unary :: (String, String) -> String -> UnaryOperator -> JS -> JS
+ unary dict fnName op = everywhereOnJS convert
+ where
+ convert :: JS -> JS
+ convert (JSApp (JSApp fn [dict']) [x]) | isPreludeFn fnName fn && isDict dict dict' = JSUnary op x
+ convert other = other
+ unary' :: String -> String -> UnaryOperator -> JS -> JS
+ unary' moduleName fnName op = everywhereOnJS convert
+ where
+ convert :: JS -> JS
+ convert (JSApp fn [x]) | isFn (moduleName, fnName) fn = JSUnary op x
convert other = other
mkFn :: Int -> JS -> JS
mkFn 0 = everywhereOnJS convert
@@ -190,12 +238,80 @@ inlineCommonOperators = applyAll $
go m acc (JSApp lhs [arg]) = go (m - 1) (arg : acc) lhs
go _ _ _ = Nothing
-isPreludeDict :: String -> JS -> Bool
-isPreludeDict dictName (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && prop == dictName
-isPreludeDict _ _ = False
+-- (f <<< g $ x) = f (g x)
+-- (f <<< g) = \x -> f (g x)
+inlineArrComposition :: (Applicative m, MonadSupply m) => JS -> m JS
+inlineArrComposition = everywhereOnJSTopDownM convert
+ where
+ convert :: (MonadSupply m) => JS -> m JS
+ convert (JSApp (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) [z]) | isArrCompose dict' fn =
+ return $ JSApp x [JSApp y [z]]
+ convert (JSApp (JSApp (JSApp fn [dict']) [x]) [y]) | isArrCompose dict' fn = do
+ arg <- freshName
+ return $ JSFunction Nothing [arg] (JSBlock [JSReturn $ JSApp x [JSApp y [JSVar arg]]])
+ convert other = return other
+ isArrCompose :: JS -> JS -> Bool
+ isArrCompose dict' fn = isDict semigroupoidArr dict' && isPreludeFn (C.<<<) fn
+
+isDict :: (String, String) -> JS -> Bool
+isDict (moduleName, dictName) (JSAccessor x (JSVar y)) = x == dictName && y == moduleName
+isDict _ _ = False
+
+isFn :: (String, String) -> JS -> Bool
+isFn (moduleName, fnName) (JSAccessor x (JSVar y)) = x == fnName && y == moduleName
+isFn (moduleName, fnName) (JSIndexer (JSStringLiteral x) (JSVar y)) = x == fnName && y == moduleName
+isFn _ _ = False
isPreludeFn :: String -> JS -> Bool
-isPreludeFn fnName (JSAccessor fnName' (JSVar prelude)) = prelude == C.prelude && fnName' == fnName
-isPreludeFn fnName (JSIndexer (JSStringLiteral fnName') (JSVar prelude)) = prelude == C.prelude && fnName' == fnName
-isPreludeFn fnName (JSAccessor longForm (JSAccessor prelude (JSVar _))) = prelude == C.prelude && longForm == identToJs (Op fnName)
-isPreludeFn _ _ = False
+isPreludeFn fnName = isFn (C.prelude, fnName)
+
+semiringNumber :: (String, String)
+semiringNumber = (C.prelude, C.semiringNumber)
+
+semiringInt :: (String, String)
+semiringInt = (C.dataInt, C.semiringInt)
+
+ringNumber :: (String, String)
+ringNumber = (C.prelude, C.ringNumber)
+
+ringInt :: (String, String)
+ringInt = (C.dataInt, C.ringInt)
+
+moduloSemiringNumber :: (String, String)
+moduloSemiringNumber = (C.prelude, C.moduloSemiringNumber)
+
+moduloSemiringInt :: (String, String)
+moduloSemiringInt = (C.dataInt, C.moduloSemiringInt)
+
+eqNumber :: (String, String)
+eqNumber = (C.prelude, C.eqNumber)
+
+eqInt :: (String, String)
+eqInt = (C.dataInt, C.eqInt)
+
+eqString :: (String, String)
+eqString = (C.prelude, C.eqNumber)
+
+eqBoolean :: (String, String)
+eqBoolean = (C.prelude, C.eqNumber)
+
+ordNumber :: (String, String)
+ordNumber = (C.prelude, C.ordNumber)
+
+ordInt :: (String, String)
+ordInt = (C.dataInt, C.ordInt)
+
+semigroupString :: (String, String)
+semigroupString = (C.prelude, C.semigroupString)
+
+boundedBoolean :: (String, String)
+boundedBoolean = (C.prelude, C.boundedBoolean)
+
+latticeBoolean :: (String, String)
+latticeBoolean = (C.prelude, C.latticeBoolean)
+
+complementedLatticeBoolean :: (String, String)
+complementedLatticeBoolean = (C.prelude, C.complementedLatticeBoolean)
+
+semigroupoidArr :: (String, String)
+semigroupoidArr = (C.prelude, C.semigroupoidArr)
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs b/src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs
index 304d1fc..2f57bc8 100644
--- a/src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs
+++ b/src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs
@@ -27,7 +27,7 @@ import Language.PureScript.Names
import Language.PureScript.Options
import qualified Language.PureScript.Constants as C
-magicDo :: Options mode -> JS -> JS
+magicDo :: Options -> JS -> JS
magicDo opts | optionsNoMagicDo opts = id
| otherwise = inlineST . magicDo'
@@ -81,8 +81,8 @@ magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert
isPure (JSApp purePoly [effDict]) | isPurePoly purePoly && isEffDict C.applicativeEffDictionary effDict = True
isPure _ = False
-- Check if an expression represents the polymorphic >>= function
- isBindPoly (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && prop == identToJs (Op (C.>>=))
- isBindPoly (JSIndexer (JSStringLiteral bind) (JSVar prelude)) = prelude == C.prelude && bind == (C.>>=)
+ isBindPoly (JSAccessor prop (JSVar prelude)) = prelude == C.prelude && (prop `elem` map identToJs [Ident C.bind, Op (C.>>=)])
+ isBindPoly (JSIndexer (JSStringLiteral bind) (JSVar prelude)) = prelude == C.prelude && (bind `elem` [C.bind, (C.>>=)])
isBindPoly _ = False
-- Check if an expression represents the polymorphic return function
isRetPoly (JSAccessor returnEscaped (JSVar prelude)) = prelude == C.prelude && returnEscaped == C.returnEscaped
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs b/src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs
index 4fc86fe..52bf06f 100644
--- a/src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs
+++ b/src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs
@@ -15,13 +15,15 @@
module Language.PureScript.CodeGen.JS.Optimizer.TCO (tco) where
+import Data.Monoid
+
import Language.PureScript.Options
import Language.PureScript.CodeGen.JS.AST
-- |
-- Eliminate tail calls
--
-tco :: Options mode -> JS -> JS
+tco :: Options -> JS -> JS
tco opts | optionsNoTco opts = id
| otherwise = tco'
@@ -30,10 +32,13 @@ tco' = everywhereOnJS convert
where
tcoLabel :: String
tcoLabel = "tco"
+
tcoVar :: String -> String
tcoVar arg = "__tco_" ++ arg
+
copyVar :: String -> String
copyVar arg = "__copy_" ++ arg
+
convert :: JS -> JS
convert js@(JSVariableIntroduction name (Just fn@JSFunction {})) =
let
@@ -46,6 +51,7 @@ tco' = everywhereOnJS convert
JSVariableIntroduction name (Just (replace (toLoop name allArgs body')))
| otherwise -> js
convert js = js
+
collectAllFunctionArgs :: [[String]] -> (JS -> JS) -> JS -> ([[String]], JS, JS -> JS)
collectAllFunctionArgs allArgs f (JSFunction ident args (JSBlock (body@(JSReturn _):_))) =
collectAllFunctionArgs (args : allArgs) (\b -> f (JSFunction ident (map copyVar args) (JSBlock [b]))) body
@@ -56,25 +62,35 @@ tco' = everywhereOnJS convert
collectAllFunctionArgs allArgs f (JSReturn (JSFunction ident args body@(JSBlock _))) =
(args : allArgs, body, f . JSReturn . JSFunction ident (map copyVar args))
collectAllFunctionArgs allArgs f body = (allArgs, body, f)
+
isTailCall :: String -> JS -> Bool
isTailCall ident js =
let
numSelfCalls = everythingOnJS (+) countSelfCalls js
numSelfCallsInTailPosition = everythingOnJS (+) countSelfCallsInTailPosition js
numSelfCallsUnderFunctions = everythingOnJS (+) countSelfCallsUnderFunctions js
+ numSelfCallWithFnArgs = everythingOnJS (+) countSelfCallsWithFnArgs js
in
numSelfCalls > 0
&& numSelfCalls == numSelfCallsInTailPosition
&& numSelfCallsUnderFunctions == 0
+ && numSelfCallWithFnArgs == 0
where
countSelfCalls :: JS -> Int
countSelfCalls (JSApp (JSVar ident') _) | ident == ident' = 1
countSelfCalls _ = 0
+
countSelfCallsInTailPosition :: JS -> Int
countSelfCallsInTailPosition (JSReturn ret) | isSelfCall ident ret = 1
countSelfCallsInTailPosition _ = 0
+
+ countSelfCallsUnderFunctions :: JS -> Int
countSelfCallsUnderFunctions (JSFunction _ _ js') = everythingOnJS (+) countSelfCalls js'
countSelfCallsUnderFunctions _ = 0
+
+ countSelfCallsWithFnArgs :: JS -> Int
+ countSelfCallsWithFnArgs ret = if isSelfCallWithFnArgs ident ret [] then 1 else 0
+
toLoop :: String -> [String] -> JS -> JS
toLoop ident allArgs js = JSBlock $
map (\arg -> JSVariableIntroduction arg (Just (JSVar (copyVar arg)))) allArgs ++
@@ -94,10 +110,19 @@ tco' = everywhereOnJS convert
collectSelfCallArgs :: [[JS]] -> JS -> [[JS]]
collectSelfCallArgs allArgumentValues (JSApp fn args') = collectSelfCallArgs (args' : allArgumentValues) fn
collectSelfCallArgs allArgumentValues _ = allArgumentValues
+
isSelfCall :: String -> JS -> Bool
- isSelfCall ident (JSApp (JSVar ident') args) | ident == ident' && not (any isFunction args) = True
- isSelfCall ident (JSApp fn args) | not (any isFunction args) = isSelfCall ident fn
+ isSelfCall ident (JSApp (JSVar ident') _) = ident == ident'
+ isSelfCall ident (JSApp fn _) = isSelfCall ident fn
isSelfCall _ _ = False
- isFunction :: JS -> Bool
- isFunction (JSFunction _ _ _) = True
- isFunction _ = False
+
+ isSelfCallWithFnArgs :: String -> JS -> [JS] -> Bool
+ isSelfCallWithFnArgs ident (JSVar ident') args | ident == ident' && any hasFunction args = True
+ isSelfCallWithFnArgs ident (JSApp fn args) acc = isSelfCallWithFnArgs ident fn (args ++ acc)
+ isSelfCallWithFnArgs _ _ _ = False
+
+ hasFunction :: JS -> Bool
+ hasFunction = getAny . everythingOnJS mappend (Any . isFunction)
+ where
+ isFunction (JSFunction _ _ _) = True
+ isFunction _ = False
diff --git a/src/Language/PureScript/Constants.hs b/src/Language/PureScript/Constants.hs
index 51ba984..d992336 100644
--- a/src/Language/PureScript/Constants.hs
+++ b/src/Language/PureScript/Constants.hs
@@ -15,7 +15,7 @@
module Language.PureScript.Constants where
--- Prelude Operators
+-- Operators
($) :: String
($) = "$"
@@ -65,29 +65,47 @@ module Language.PureScript.Constants where
(/=) :: String
(/=) = "/="
-(.&.) :: String
-(.&.) = ".&."
-
-(.|.) :: String
-(.|.) = ".|."
-
-(.^.) :: String
-(.^.) = ".^."
-
(&&) :: String
(&&) = "&&"
(||) :: String
(||) = "||"
+bind :: String
+bind = "bind"
+
unsafeIndex :: String
unsafeIndex = "unsafeIndex"
--- Prelude Operator Functions
+(.|.) :: String
+(.|.) = ".|."
+
+(.&.) :: String
+(.&.) = ".&."
+
+(.^.) :: String
+(.^.) = ".^."
+
+(<<<) :: String
+(<<<) = "<<<"
+
+-- Functions
negate :: String
negate = "negate"
+not :: String
+not = "not"
+
+sup :: String
+sup = "sup"
+
+inf :: String
+inf = "inf"
+
+mod :: String
+mod = "mod"
+
shl :: String
shl = "shl"
@@ -100,9 +118,6 @@ zshr = "zshr"
complement :: String
complement = "complement"
-not :: String
-not = "not"
-
-- Prelude Values
zero :: String
@@ -111,6 +126,12 @@ zero = "zero"
one :: String
one = "one"
+bottom :: String
+bottom = "bottom"
+
+top :: String
+top = "top"
+
return :: String
return = "return"
@@ -172,32 +193,47 @@ bindEffDictionary = "bindEff"
semiringNumber :: String
semiringNumber = "semiringNumber"
+semiringInt :: String
+semiringInt = "semiringInt"
+
ringNumber :: String
ringNumber = "ringNumber"
+ringInt :: String
+ringInt = "ringInt"
+
moduloSemiringNumber :: String
moduloSemiringNumber = "moduloSemiringNumber"
-numNumber :: String
-numNumber = "numNumber"
+moduloSemiringInt :: String
+moduloSemiringInt = "moduloSemiringInt"
ordNumber :: String
ordNumber = "ordNumber"
+ordInt :: String
+ordInt = "ordInt"
+
eqNumber :: String
eqNumber = "eqNumber"
+eqInt :: String
+eqInt = "eqInt"
+
eqString :: String
eqString = "eqString"
eqBoolean :: String
eqBoolean = "eqBoolean"
-bitsNumber :: String
-bitsNumber = "bitsNumber"
+boundedBoolean :: String
+boundedBoolean = "boundedBoolean"
+
+latticeBoolean :: String
+latticeBoolean = "latticeBoolean"
-boolLikeBoolean :: String
-boolLikeBoolean = "boolLikeBoolean"
+complementedLatticeBoolean :: String
+complementedLatticeBoolean = "complementedLatticeBoolean"
semigroupString :: String
semigroupString = "semigroupString"
@@ -226,8 +262,8 @@ prim = "Prim"
prelude :: String
prelude = "Prelude"
-preludeUnsafe :: String
-preludeUnsafe = "Prelude_Unsafe"
+dataArrayUnsafe :: String
+dataArrayUnsafe = "Data_Array_Unsafe"
eff :: String
eff = "Control_Monad_Eff"
@@ -237,3 +273,9 @@ st = "Control_Monad_ST"
dataFunction :: String
dataFunction = "Data_Function"
+
+dataInt :: String
+dataInt = "Data_Int"
+
+dataIntBits :: String
+dataIntBits = "Data_Int_Bits"
diff --git a/src/Language/PureScript/CoreFn/Desugar.hs b/src/Language/PureScript/CoreFn/Desugar.hs
index 4141352..711c0f9 100644
--- a/src/Language/PureScript/CoreFn/Desugar.hs
+++ b/src/Language/PureScript/CoreFn/Desugar.hs
@@ -83,6 +83,8 @@ moduleToCoreFn env (A.Module coms mn decls (Just exps)) =
Literal (ss, com, ty, Nothing) (NumericLiteral v)
exprToCoreFn ss com ty (A.StringLiteral v) =
Literal (ss, com, ty, Nothing) (StringLiteral v)
+ exprToCoreFn ss com ty (A.CharLiteral v) =
+ Literal (ss, com, ty, Nothing) (CharLiteral v)
exprToCoreFn ss com ty (A.BooleanLiteral v) =
Literal (ss, com, ty, Nothing) (BooleanLiteral v)
exprToCoreFn ss com ty (A.ArrayLiteral vs) =
@@ -100,7 +102,7 @@ moduleToCoreFn env (A.Module coms mn decls (Just exps)) =
exprToCoreFn ss com ty (A.App v1 v2) =
App (ss, com, ty, Nothing) (exprToCoreFn ss [] Nothing v1) (exprToCoreFn ss [] Nothing v2)
exprToCoreFn ss com ty (A.Var ident) =
- Var (ss, com, ty, Nothing) ident
+ Var (ss, com, ty, getValueMeta ident) ident
exprToCoreFn ss com ty (A.IfThenElse v1 v2 v3) =
Case (ss, com, ty, Nothing) [exprToCoreFn ss [] Nothing v1]
[ CaseAlternative [LiteralBinder nullAnn $ BooleanLiteral True]
@@ -147,6 +149,8 @@ moduleToCoreFn env (A.Module coms mn decls (Just exps)) =
LiteralBinder (ss, com, Nothing, Nothing) (BooleanLiteral b)
binderToCoreFn ss com (A.StringBinder s) =
LiteralBinder (ss, com, Nothing, Nothing) (StringLiteral s)
+ binderToCoreFn ss com (A.CharBinder c) =
+ LiteralBinder (ss, com, Nothing, Nothing) (CharLiteral c)
binderToCoreFn ss com (A.NumberBinder n) =
LiteralBinder (ss, com, Nothing, Nothing) (NumericLiteral n)
binderToCoreFn ss com (A.VarBinder name) =
@@ -158,15 +162,21 @@ moduleToCoreFn env (A.Module coms mn decls (Just exps)) =
LiteralBinder (ss, com, Nothing, Nothing) (ObjectLiteral $ map (second (binderToCoreFn ss [])) bs)
binderToCoreFn ss com (A.ArrayBinder bs) =
LiteralBinder (ss, com, Nothing, Nothing) (ArrayLiteral $ map (binderToCoreFn ss []) bs)
- binderToCoreFn ss com (A.ConsBinder b1 b2) =
- let arrCtor = Qualified (Just $ ModuleName [ProperName "Prim"]) (ProperName "Array")
- in ConstructorBinder (ss, com, Nothing, Nothing) arrCtor arrCtor $ map (binderToCoreFn ss []) [b1, b2]
binderToCoreFn ss com (A.NamedBinder name b) =
NamedBinder (ss, com, Nothing, Nothing) name (binderToCoreFn ss [] b)
binderToCoreFn _ com (A.PositionedBinder ss com1 b) =
binderToCoreFn (Just ss) (com ++ com1) b
-- |
+ -- Gets metadata for values.
+ --
+ getValueMeta :: Qualified Ident -> Maybe Meta
+ getValueMeta name =
+ case lookupValue env name of
+ Just (_, External, _) -> Just IsForeign
+ _ -> Nothing
+
+ -- |
-- Gets metadata for data constructors.
--
getConstructorMeta :: Qualified ProperName -> Meta
@@ -197,7 +207,7 @@ findQualModules decls =
fqValues (A.Var (Qualified (Just mn) _)) = [mn]
fqValues (A.Constructor (Qualified (Just mn) _)) = [mn]
fqValues _ = []
-
+
fqBinders :: A.Binder -> [ModuleName]
fqBinders (A.ConstructorBinder (Qualified (Just mn) _) _) = [mn]
fqBinders _ = []
@@ -214,8 +224,8 @@ importToCoreFn _ = Nothing
-- Desugars foreign declarations from AST to CoreFn representation.
--
externToCoreFn :: A.Declaration -> Maybe ForeignDecl
-externToCoreFn (A.ExternDeclaration _ name js ty) = Just (name, js, ty)
-externToCoreFn (A.ExternInstanceDeclaration name _ _ _) = Just (name, Nothing, tyObject)
+externToCoreFn (A.ExternDeclaration name ty) = Just (name, ty)
+externToCoreFn (A.ExternInstanceDeclaration name _ _ _) = Just (name, tyObject)
externToCoreFn (A.PositionedDeclaration _ _ d) = externToCoreFn d
externToCoreFn _ = Nothing
diff --git a/src/Language/PureScript/CoreFn/Literals.hs b/src/Language/PureScript/CoreFn/Literals.hs
index e610566..fed1814 100644
--- a/src/Language/PureScript/CoreFn/Literals.hs
+++ b/src/Language/PureScript/CoreFn/Literals.hs
@@ -33,6 +33,10 @@ data Literal a
--
| StringLiteral String
-- |
+ -- A character literal
+ --
+ | CharLiteral Char
+ -- |
-- A boolean literal
--
| BooleanLiteral Bool
diff --git a/src/Language/PureScript/CoreFn/Meta.hs b/src/Language/PureScript/CoreFn/Meta.hs
index 84859bc..3d21524 100644
--- a/src/Language/PureScript/CoreFn/Meta.hs
+++ b/src/Language/PureScript/CoreFn/Meta.hs
@@ -35,7 +35,11 @@ data Meta
-- |
-- The contained value is a typeclass dictionary constructor
--
- | IsTypeClassConstructor deriving (Show, D.Data, D.Typeable)
+ | IsTypeClassConstructor
+ -- |
+ -- The contained reference is for a foreign member
+ --
+ | IsForeign deriving (Show, D.Data, D.Typeable)
-- |
-- Data constructor metadata
diff --git a/src/Language/PureScript/CoreFn/Module.hs b/src/Language/PureScript/CoreFn/Module.hs
index 0088ee1..b69e169 100644
--- a/src/Language/PureScript/CoreFn/Module.hs
+++ b/src/Language/PureScript/CoreFn/Module.hs
@@ -14,7 +14,6 @@
module Language.PureScript.CoreFn.Module where
-import Language.PureScript.CodeGen.JS.AST
import Language.PureScript.Comments
import Language.PureScript.CoreFn.Expr
import Language.PureScript.Names
@@ -29,4 +28,4 @@ data Module a = Module
, moduleDecls :: [Bind a]
} deriving (Show)
-type ForeignDecl = (Ident, Maybe JS, Type)
+type ForeignDecl = (Ident, Type)
diff --git a/src/Language/PureScript/DeadCodeElimination.hs b/src/Language/PureScript/DeadCodeElimination.hs
deleted file mode 100644
index 7f576cc..0000000
--- a/src/Language/PureScript/DeadCodeElimination.hs
+++ /dev/null
@@ -1,102 +0,0 @@
------------------------------------------------------------------------------
---
--- Module : Language.PureScript.DeadCodeElimination
--- Copyright : (c) 2014 Phil Freeman
--- License : MIT
---
--- Maintainer : Phil Freeman <paf31@cantab.net>
--- Stability : experimental
--- Portability :
---
--- | Dead code elimination.
---
------------------------------------------------------------------------------
-
-module Language.PureScript.DeadCodeElimination (
- eliminateDeadCode
-) where
-
-import Data.Graph
-import Data.List
-import Data.Maybe (mapMaybe)
-
-import Language.PureScript.CoreFn
-import Language.PureScript.Names
-
--- |
--- Eliminate all declarations which are not a transitive dependency of the entry point module
---
-eliminateDeadCode :: [ModuleName] -> [Module a] -> [Module a]
-eliminateDeadCode entryPoints ms = map go ms
- where
- go (Module coms mn imps exps foreigns ds) = Module coms mn imps exps' foreigns' ds'
- where
- ds' = filter (isUsed mn graph vertexFor entryPointVertices) ds
- foreigns' = filter (isUsed' mn graph vertexFor entryPointVertices . foreignIdent) foreigns
- names = concatMap bindIdents ds' ++ map foreignIdent foreigns'
- exps' = filter (`elem` names) exps
- declarations = concatMap declarationsByModule ms
- (graph, _, vertexFor) = graphFromEdges $ map (\(key, deps) -> (key, key, deps)) declarations
- entryPointVertices = mapMaybe (vertexFor . fst) . filter (\((mn, _), _) -> mn `elem` entryPoints) $ declarations
-
--- |
--- Extract declaration names for a binding group.
---
-bindIdents :: Bind a -> [Ident]
-bindIdents (NonRec name _) = [name]
-bindIdents (Rec names) = map fst names
-
--- |
--- Extract the ident for a foreign declaration.
---
-foreignIdent :: ForeignDecl -> Ident
-foreignIdent (name, _, _) = name
-
--- |
--- Key type to use in graph
---
-type Key = (ModuleName, Ident)
-
--- |
--- Find dependencies for each member in a module.
---
-declarationsByModule :: Module a -> [(Key, [Key])]
-declarationsByModule (Module _ mn _ _ fs ds) =
- let fs' = map ((\name -> ((mn, name), [])) . foreignIdent) fs
- in fs' ++ concatMap go ds
- where
- go :: Bind a -> [(Key, [Key])]
- go d@(NonRec name _) = [((mn, name), dependencies d)]
- go d@(Rec names') = map (\(name, _) -> ((mn, name), dependencies d)) names'
-
--- |
--- Find all referenced values within a binding group.
---
-dependencies :: Bind a -> [Key]
-dependencies =
- let (f, _, _, _) = everythingOnValues (++) (const []) values binders (const [])
- in nub . f
- where
- values :: Expr a -> [Key]
- values (Var _ (Qualified (Just mn) ident)) = [(mn, ident)]
- values _ = []
- binders :: Binder a -> [Key]
- binders (ConstructorBinder _ _ (Qualified (Just mn) ident) _) = [(mn, Ident $ runProperName ident)]
- binders _ = []
-
--- |
--- Check whether a binding group is used.
---
-isUsed :: ModuleName -> Graph -> (Key -> Maybe Vertex) -> [Vertex] -> Bind a -> Bool
-isUsed mn graph vertexFor entryPointVertices (NonRec name _) =
- isUsed' mn graph vertexFor entryPointVertices name
-isUsed mn graph vertexFor entryPointVertices (Rec ds) =
- any (isUsed' mn graph vertexFor entryPointVertices . fst) ds
-
--- |
--- Check whether a named declaration is used.
---
-isUsed' :: ModuleName -> Graph -> (Key -> Maybe Vertex) -> [Vertex] -> Ident -> Bool
-isUsed' mn graph vertexFor entryPointVertices name =
- let Just v' = vertexFor (mn, name)
- in any (\v -> path graph v v') entryPointVertices
diff --git a/src/Language/PureScript/Docs.hs b/src/Language/PureScript/Docs.hs
new file mode 100644
index 0000000..837403f
--- /dev/null
+++ b/src/Language/PureScript/Docs.hs
@@ -0,0 +1,14 @@
+
+-- | Data types and functions for rendering generated documentation from
+-- PureScript code, in a variety of formats.
+
+module Language.PureScript.Docs (
+ module Docs
+) where
+
+import Language.PureScript.Docs.Types as Docs
+import Language.PureScript.Docs.RenderedCode.Types as Docs
+import Language.PureScript.Docs.RenderedCode.Render as Docs
+import Language.PureScript.Docs.Convert as Docs
+import Language.PureScript.Docs.Render as Docs
+import Language.PureScript.Docs.ParseAndDesugar as Docs
diff --git a/src/Language/PureScript/Docs/AsMarkdown.hs b/src/Language/PureScript/Docs/AsMarkdown.hs
new file mode 100644
index 0000000..516ea44
--- /dev/null
+++ b/src/Language/PureScript/Docs/AsMarkdown.hs
@@ -0,0 +1,124 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Language.PureScript.Docs.AsMarkdown (
+ renderModulesAsMarkdown
+) where
+
+import Control.Monad.Writer hiding (First)
+import Data.Foldable (for_)
+import Data.List (partition)
+
+import qualified Language.PureScript as P
+
+import Language.PureScript.Docs.Types
+import Language.PureScript.Docs.RenderedCode
+import qualified Language.PureScript.Docs.Convert as Convert
+import qualified Language.PureScript.Docs.Render as Render
+
+-- |
+-- Take a list of modules and render them all in order, returning a single
+-- Markdown-formatted String.
+--
+renderModulesAsMarkdown :: [P.Module] -> String
+renderModulesAsMarkdown =
+ runDocs . modulesAsMarkdown . map Convert.convertModule
+
+modulesAsMarkdown :: [Module] -> Docs
+modulesAsMarkdown = mapM_ moduleAsMarkdown
+
+moduleAsMarkdown :: Module -> Docs
+moduleAsMarkdown Module{..} = do
+ headerLevel 2 $ "Module " ++ modName
+ spacer
+ for_ modComments tell'
+ mapM_ declAsMarkdown modDeclarations
+ spacer
+
+declAsMarkdown :: Declaration -> Docs
+declAsMarkdown decl@Declaration{..} = do
+ headerLevel 4 (ticks declTitle)
+ spacer
+
+ let (instances, children) = partition (isChildInstance . cdeclInfo) declChildren
+ fencedBlock $ do
+ tell' (codeToString $ Render.renderDeclaration decl)
+ zipWithM_ (\f c -> tell' (childToString f c)) (First : repeat NotFirst) children
+ spacer
+
+ for_ declFixity (\fixity -> fixityAsMarkdown fixity >> spacer)
+
+ for_ declComments tell'
+
+ unless (null instances) $ do
+ headerLevel 5 "Instances"
+ fencedBlock $ mapM_ (tell' . childToString NotFirst) instances
+ spacer
+
+ where
+ isChildInstance (ChildInstance _ _) = True
+ isChildInstance _ = False
+
+codeToString :: RenderedCode -> String
+codeToString = outputWith elemAsMarkdown
+ where
+ elemAsMarkdown (Syntax x) = x
+ elemAsMarkdown (Ident x) = x
+ elemAsMarkdown (Ctor x _) = x
+ elemAsMarkdown (Kind x) = x
+ elemAsMarkdown (Keyword x) = x
+ elemAsMarkdown Space = " "
+
+fixityAsMarkdown :: P.Fixity -> Docs
+fixityAsMarkdown (P.Fixity associativity precedence) =
+ tell' $ concat [ "_"
+ , associativityStr
+ , " / precedence "
+ , show precedence
+ , "_"
+ ]
+ where
+ associativityStr = case associativity of
+ P.Infixl -> "left-associative"
+ P.Infixr -> "right-associative"
+ P.Infix -> "non-associative"
+
+childToString :: First -> ChildDeclaration -> String
+childToString f decl@ChildDeclaration{..} =
+ case cdeclInfo of
+ ChildDataConstructor _ ->
+ let c = if f == First then "=" else "|"
+ in " " ++ c ++ " " ++ str
+ ChildTypeClassMember _ ->
+ " " ++ str
+ ChildInstance _ _ ->
+ str
+ where
+ str = codeToString $ Render.renderChildDeclaration decl
+
+data First
+ = First
+ | NotFirst
+ deriving (Show, Eq, Ord)
+
+type Docs = Writer [String] ()
+
+runDocs :: Docs -> String
+runDocs = unlines . execWriter
+
+tell' :: String -> Docs
+tell' = tell . (:[])
+
+spacer :: Docs
+spacer = tell' ""
+
+headerLevel :: Int -> String -> Docs
+headerLevel level hdr = tell' (replicate level '#' ++ ' ' : hdr)
+
+fencedBlock :: Docs -> Docs
+fencedBlock inner = do
+ tell' "``` purescript"
+ inner
+ tell' "```"
+
+ticks :: String -> String
+ticks = ("`" ++) . (++ "`")
diff --git a/src/Language/PureScript/Docs/Convert.hs b/src/Language/PureScript/Docs/Convert.hs
new file mode 100644
index 0000000..0276342
--- /dev/null
+++ b/src/Language/PureScript/Docs/Convert.hs
@@ -0,0 +1,228 @@
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns #-}
+
+-- | Functions for converting PureScript ASTs into values of the data types
+-- from Language.PureScript.Docs.
+
+module Language.PureScript.Docs.Convert
+ ( convertModule
+ , collectBookmarks
+ ) where
+
+import Control.Monad
+import Control.Category ((>>>))
+import Data.Either
+import Data.Maybe (mapMaybe, isNothing)
+import Data.List (nub, isPrefixOf, isSuffixOf)
+
+import qualified Language.PureScript as P
+
+import Language.PureScript.Docs.Types
+
+-- |
+-- Convert a single Module.
+--
+convertModule :: P.Module -> Module
+convertModule m@(P.Module coms moduleName _ _) =
+ Module (show moduleName) comments (declarations m)
+ where
+ comments = convertComments coms
+ declarations =
+ P.exportedDeclarations
+ >>> mapMaybe (\d -> getDeclarationTitle d >>= convertDeclaration d)
+ >>> augmentDeclarations
+ >>> map addDefaultFixity
+
+-- | The data type for an intermediate stage which we go through during
+-- converting.
+--
+-- In the first pass, we take all top level declarations in the module, and
+-- collect other information which will later be used to augment the top level
+-- declarations. These two situation correspond to the Right and Left
+-- constructors, respectively.
+--
+-- In the second pass, we go over all of the Left values and augment the
+-- relevant declarations, leaving only the augmented Right values.
+--
+-- Note that in the Left case, we provide a [String] as well as augment
+-- information. The [String] value should be a list of titles of declarations
+-- that the augmentation should apply to. For example, for a type instance
+-- declaration, that would be any types or type classes mentioned in the
+-- instance. For a fixity declaration, it would be just the relevant operator's
+-- name.
+type IntermediateDeclaration
+ = Either ([String], DeclarationAugment) Declaration
+
+-- | Some data which will be used to augment a Declaration in the
+-- output.
+--
+-- The AugmentChild constructor allows us to move all children under their
+-- respective parents. It is only necessary for type instance declarations,
+-- since they appear at the top level in the AST, and since they might need to
+-- appear as children in two places (for example, if a data type defined in a
+-- module is an instance of a type class also defined in that module).
+--
+-- The AugmentFixity constructor allows us to augment operator definitions
+-- with their associativity and precedence.
+data DeclarationAugment
+ = AugmentChild ChildDeclaration
+ | AugmentFixity P.Fixity
+
+-- | Augment top-level declarations; the second pass. See the comments under
+-- the type synonym IntermediateDeclaration for more information.
+augmentDeclarations :: [IntermediateDeclaration] -> [Declaration]
+augmentDeclarations (partitionEithers -> (augments, toplevels)) =
+ foldl go toplevels augments
+ where
+ go ds (parentTitles, a) =
+ map (\d ->
+ if declTitle d `elem` parentTitles
+ then augmentWith a d
+ else d) ds
+
+ augmentWith a d =
+ case a of
+ AugmentChild child ->
+ d { declChildren = declChildren d ++ [child] }
+ AugmentFixity fixity ->
+ d { declFixity = Just fixity }
+
+-- | Add the default operator fixity for operators which do not have associated
+-- fixity declarations.
+--
+-- TODO: This may no longer be necessary after issue 806 is resolved, hopefully
+-- in 0.8.
+addDefaultFixity :: Declaration -> Declaration
+addDefaultFixity decl@Declaration{..}
+ | isOp declTitle && isNothing declFixity =
+ decl { declFixity = Just defaultFixity }
+ | otherwise =
+ decl
+ where
+ isOp :: String -> Bool
+ isOp str = "(" `isPrefixOf` str && ")" `isSuffixOf` str
+ defaultFixity = P.Fixity P.Infixl (-1)
+
+getDeclarationTitle :: P.Declaration -> Maybe String
+getDeclarationTitle (P.TypeDeclaration name _) = Just (show name)
+getDeclarationTitle (P.ExternDeclaration name _) = Just (show name)
+getDeclarationTitle (P.DataDeclaration _ name _ _) = Just (show name)
+getDeclarationTitle (P.ExternDataDeclaration name _) = Just (show name)
+getDeclarationTitle (P.TypeSynonymDeclaration name _ _) = Just (show name)
+getDeclarationTitle (P.TypeClassDeclaration name _ _ _) = Just (show name)
+getDeclarationTitle (P.TypeInstanceDeclaration name _ _ _ _) = Just (show name)
+getDeclarationTitle (P.FixityDeclaration _ name) = Just ("(" ++ name ++ ")")
+getDeclarationTitle (P.PositionedDeclaration _ _ d) = getDeclarationTitle d
+getDeclarationTitle _ = Nothing
+
+-- | Create a basic Declaration value.
+mkDeclaration :: String -> DeclarationInfo -> Declaration
+mkDeclaration title info =
+ Declaration { declTitle = title
+ , declComments = Nothing
+ , declSourceSpan = Nothing
+ , declChildren = []
+ , declFixity = Nothing
+ , declInfo = info
+ }
+
+basicDeclaration :: String -> DeclarationInfo -> Maybe IntermediateDeclaration
+basicDeclaration title info = Just $ Right $ mkDeclaration title info
+
+convertDeclaration :: P.Declaration -> String -> Maybe IntermediateDeclaration
+convertDeclaration (P.TypeDeclaration _ ty) title =
+ basicDeclaration title (ValueDeclaration ty)
+convertDeclaration (P.ExternDeclaration _ ty) title =
+ basicDeclaration title (ValueDeclaration ty)
+convertDeclaration (P.DataDeclaration dtype _ args ctors) title =
+ Just (Right (mkDeclaration title info) { declChildren = children })
+ where
+ info = DataDeclaration dtype args
+ children = map convertCtor ctors
+ convertCtor (ctor', tys) =
+ ChildDeclaration (show ctor') Nothing Nothing (ChildDataConstructor tys)
+convertDeclaration (P.ExternDataDeclaration _ kind') title =
+ basicDeclaration title (ExternDataDeclaration kind')
+convertDeclaration (P.TypeSynonymDeclaration _ args ty) title =
+ basicDeclaration title (TypeSynonymDeclaration args ty)
+convertDeclaration (P.TypeClassDeclaration _ args implies ds) title = do
+ Just (Right (mkDeclaration title info) { declChildren = children })
+ where
+ info = TypeClassDeclaration args implies
+ children = map convertClassMember ds
+ convertClassMember (P.PositionedDeclaration _ _ d) =
+ convertClassMember d
+ convertClassMember (P.TypeDeclaration ident' ty) =
+ ChildDeclaration (show ident') Nothing Nothing (ChildTypeClassMember ty)
+ convertClassMember _ =
+ error "Invalid argument to convertClassMember."
+convertDeclaration (P.TypeInstanceDeclaration _ constraints className tys _) title = do
+ Just (Left (classNameString : typeNameStrings, AugmentChild childDecl))
+ where
+ classNameString = unQual className
+ typeNameStrings = nub (concatMap (P.everythingOnTypes (++) extractProperNames) tys)
+ unQual x = let (P.Qualified _ y) = x in show y
+
+ extractProperNames (P.TypeConstructor n) = [unQual n]
+ extractProperNames (P.SaturatedTypeSynonym n _) = [unQual n]
+ extractProperNames _ = []
+
+ childDecl = ChildDeclaration title Nothing Nothing (ChildInstance constraints classApp)
+ classApp = foldl P.TypeApp (P.TypeConstructor className) tys
+convertDeclaration (P.FixityDeclaration fixity _) title =
+ Just (Left ([title], AugmentFixity fixity))
+convertDeclaration (P.PositionedDeclaration srcSpan com d') title =
+ fmap (addComments . addSourceSpan) (convertDeclaration d' title)
+ where
+ addComments (Right d) =
+ Right (d { declComments = convertComments com })
+ addComments (Left augment) =
+ Left (withAugmentChild (\d -> d { cdeclComments = convertComments com })
+ augment)
+
+ addSourceSpan (Right d) =
+ Right (d { declSourceSpan = Just srcSpan })
+ addSourceSpan (Left augment) =
+ Left (withAugmentChild (\d -> d { cdeclSourceSpan = Just srcSpan })
+ augment)
+
+ withAugmentChild f (t, a) =
+ case a of
+ AugmentChild d -> (t, AugmentChild (f d))
+ _ -> (t, a)
+convertDeclaration _ _ = Nothing
+
+convertComments :: [P.Comment] -> Maybe String
+convertComments cs = do
+ let raw = concatMap toLines cs
+ guard (all hasPipe raw && not (null raw))
+ return (go raw)
+ where
+ go = unlines . map stripPipes
+
+ toLines (P.LineComment s) = [s]
+ toLines (P.BlockComment s) = lines s
+
+ hasPipe s = case dropWhile (== ' ') s of { ('|':_) -> True; _ -> False }
+
+ stripPipes = dropPipe . dropWhile (== ' ')
+
+ dropPipe ('|':' ':s) = s
+ dropPipe ('|':s) = s
+ dropPipe s = s
+
+-- | Go through a PureScript module and extract a list of Bookmarks; references
+-- to data types or values, to be used as a kind of index. These are used for
+-- generating links in the HTML documentation, for example.
+collectBookmarks :: InPackage P.Module -> [Bookmark]
+collectBookmarks (Local m) = map Local (collectBookmarks' m)
+collectBookmarks (FromDep pkg m) = map (FromDep pkg) (collectBookmarks' m)
+
+collectBookmarks' :: P.Module -> [(P.ModuleName, String)]
+collectBookmarks' m =
+ map (P.getModuleName m, )
+ (mapMaybe getDeclarationTitle
+ (P.exportedDeclarations m))
+
diff --git a/src/Language/PureScript/Docs/ParseAndDesugar.hs b/src/Language/PureScript/Docs/ParseAndDesugar.hs
new file mode 100644
index 0000000..9ad10d2
--- /dev/null
+++ b/src/Language/PureScript/Docs/ParseAndDesugar.hs
@@ -0,0 +1,120 @@
+{-# LANGUAGE TupleSections #-}
+
+module Language.PureScript.Docs.ParseAndDesugar
+ ( parseAndDesugar
+ , ParseDesugarError(..)
+ ) where
+
+import qualified Data.Map as M
+import Control.Arrow (first)
+import Control.Monad
+import Control.Applicative
+
+import Control.Monad.Trans.Except
+import Control.Monad.Error.Class (MonadError(..))
+import Control.Monad.IO.Class (MonadIO(..))
+
+import Web.Bower.PackageMeta (PackageName)
+
+import qualified Language.PureScript as P
+import qualified Language.PureScript.Constants as C
+import Language.PureScript.Docs.Types
+import Language.PureScript.Docs.Convert (collectBookmarks)
+
+data ParseDesugarError
+ = ParseError P.MultipleErrors
+ | SortModulesError P.MultipleErrors
+ | DesugarError P.MultipleErrors
+ deriving (Show)
+
+-- |
+-- Given:
+--
+-- * A list of local source files
+-- * A list of source files from external dependencies, together with their
+-- package names
+-- * A callback, taking a list of bookmarks, and a list of desugared modules
+--
+-- This function does the following:
+--
+-- * Parse all of the input and dependency source files
+-- * Partially desugar all of the resulting modules
+-- * Collect a list of bookmarks from the whole set of source files
+-- * Collect a list of desugared modules from just the input source files (not
+-- dependencies)
+-- * Call the callback with the bookmarks and desugared module list.
+parseAndDesugar ::
+ [FilePath]
+ -> [(PackageName, FilePath)]
+ -> ([Bookmark] -> [P.Module] -> IO a)
+ -> IO (Either ParseDesugarError a)
+parseAndDesugar inputFiles depsFiles callback = do
+ inputFiles' <- mapM (parseAs Local) inputFiles
+ depsFiles' <- mapM (\(pkgName, f) -> parseAs (FromDep pkgName) f) depsFiles
+
+ runExceptT $ do
+ let eParsed = P.parseModulesFromFiles fileInfoToString (inputFiles' ++ depsFiles')
+ ms <- throwLeft ParseError eParsed
+
+ let depsModules = getDepsModuleNames (map (\(fp, m) -> (,m) <$> fp) ms)
+ let eSorted = P.sortModules . map (importPrim . snd) $ ms
+ (ms', _) <- throwLeft SortModulesError eSorted
+
+ modules <- throwLeft DesugarError (desugar ms')
+ let modules' = map (addPackage depsModules) modules
+ bookmarks = concatMap collectBookmarks modules'
+ liftIO (callback bookmarks (takeLocals modules'))
+
+ where
+ throwLeft f = either (throwError . f) return
+
+-- | Specifies whether a PureScript source