summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPhilFreeman <>2016-06-01 00:58:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2016-06-01 00:58:00 (GMT)
commit0f4090890a1b18cff078fbd427318c6848097703 (patch)
tree493724aed4d46ac8ff3ffd4b9fa6cae7229686b6
parent164b1a98130296e0cb0d4eb3b04066ccbfdb2394 (diff)
version 0.9.10.9.1
-rw-r--r--CONTRIBUTORS.md2
-rw-r--r--examples/docs/src/Clash.purs28
-rw-r--r--examples/docs/src/Clash1.purs3
-rw-r--r--examples/docs/src/Clash1a.purs9
-rw-r--r--examples/docs/src/Clash2.purs3
-rw-r--r--examples/docs/src/Clash2a.purs9
-rw-r--r--examples/docs/src/ImportedTwice.purs22
-rw-r--r--examples/docs/src/ImportedTwiceA.purs8
-rw-r--r--examples/docs/src/ImportedTwiceB.purs4
-rw-r--r--examples/docs/src/MultiVirtual.purs21
-rw-r--r--examples/docs/src/MultiVirtual1.purs4
-rw-r--r--examples/docs/src/MultiVirtual2.purs9
-rw-r--r--examples/docs/src/MultiVirtual3.purs4
-rw-r--r--examples/docs/src/NewOperators.purs7
-rw-r--r--examples/docs/src/NewOperators2.purs6
-rw-r--r--examples/docs/src/OldOperators.purs10
-rw-r--r--examples/docs/src/TypeClassWithoutMembers.purs10
-rw-r--r--examples/docs/src/TypeClassWithoutMembersIntermediate.purs5
-rw-r--r--examples/failing/1733.purs9
-rw-r--r--examples/failing/1733/Thingy.purs4
-rw-r--r--examples/failing/1825.purs8
-rw-r--r--examples/failing/1881.purs6
-rw-r--r--examples/failing/2128-class.purs5
-rw-r--r--examples/failing/2128-instance.purs8
-rw-r--r--examples/failing/ArgLengthMismatch.purs7
-rw-r--r--examples/failing/Arrays.purs6
-rw-r--r--examples/failing/ConflictingExports.purs10
-rw-r--r--examples/failing/ConflictingExports/A.purs4
-rw-r--r--examples/failing/ConflictingExports/B.purs4
-rw-r--r--examples/failing/ConflictingImports.purs20
-rw-r--r--examples/failing/ConflictingImports/A.purs4
-rw-r--r--examples/failing/ConflictingImports/B.purs4
-rw-r--r--examples/failing/ConflictingImports2.purs22
-rw-r--r--examples/failing/ConflictingImports2/A.purs4
-rw-r--r--examples/failing/ConflictingImports2/B.purs4
-rw-r--r--examples/failing/ConflictingQualifiedImports.purs16
-rw-r--r--examples/failing/ConflictingQualifiedImports/A.purs4
-rw-r--r--examples/failing/ConflictingQualifiedImports/B.purs4
-rw-r--r--examples/failing/ConflictingQualifiedImports2.purs14
-rw-r--r--examples/failing/ConflictingQualifiedImports2/A.purs4
-rw-r--r--examples/failing/ConflictingQualifiedImports2/B.purs4
-rw-r--r--examples/failing/DeclConflictClassCtor.purs6
-rw-r--r--examples/failing/DeclConflictClassSynonym.purs8
-rw-r--r--examples/failing/DeclConflictClassType.purs6
-rw-r--r--examples/failing/DeclConflictCtorClass.purs6
-rw-r--r--examples/failing/DeclConflictCtorCtor.purs6
-rw-r--r--examples/failing/DeclConflictSynonymClass.purs8
-rw-r--r--examples/failing/DeclConflictSynonymType.purs8
-rw-r--r--examples/failing/DeclConflictTypeClass.purs6
-rw-r--r--examples/failing/DeclConflictTypeSynonym.purs8
-rw-r--r--examples/failing/DeclConflictTypeType.purs6
-rw-r--r--examples/failing/Do.purs4
-rw-r--r--examples/failing/ExportConflictClass.purs5
-rw-r--r--examples/failing/ExportConflictClass/A.purs3
-rw-r--r--examples/failing/ExportConflictClass/B.purs3
-rw-r--r--examples/failing/ExportConflictCtor.purs5
-rw-r--r--examples/failing/ExportConflictCtor/A.purs3
-rw-r--r--examples/failing/ExportConflictCtor/B.purs3
-rw-r--r--examples/failing/ExportConflictType.purs5
-rw-r--r--examples/failing/ExportConflictType/A.purs3
-rw-r--r--examples/failing/ExportConflictType/B.purs3
-rw-r--r--examples/failing/ExportConflictTypeOp.purs5
-rw-r--r--examples/failing/ExportConflictTypeOp/A.purs5
-rw-r--r--examples/failing/ExportConflictTypeOp/B.purs5
-rw-r--r--examples/failing/ExportConflictValue.purs5
-rw-r--r--examples/failing/ExportConflictValue/A.purs4
-rw-r--r--examples/failing/ExportConflictValue/B.purs4
-rw-r--r--examples/failing/ExportConflictValueOp.purs5
-rw-r--r--examples/failing/ExportConflictValueOp/A.purs6
-rw-r--r--examples/failing/ExportConflictValueOp/B.purs6
-rw-r--r--examples/failing/ExportExplicit.purs8
-rw-r--r--examples/failing/ExportExplicit1.purs12
-rw-r--r--examples/failing/ExportExplicit1/M1.purs3
-rw-r--r--examples/failing/ExportExplicit2.purs8
-rw-r--r--examples/failing/ExportExplicit3.purs10
-rw-r--r--examples/failing/ExportExplicit3/M1.purs4
-rw-r--r--examples/failing/ImportExplicit.purs4
-rw-r--r--examples/failing/ImportExplicit/M1.purs3
-rw-r--r--examples/failing/ImportExplicit2.purs4
-rw-r--r--examples/failing/ImportExplicit2/M1.purs3
-rw-r--r--examples/failing/ImportHidingModule.purs14
-rw-r--r--examples/failing/ImportHidingModule/A.purs2
-rw-r--r--examples/failing/ImportHidingModule/B.purs3
-rw-r--r--examples/failing/ImportModule.purs4
-rw-r--r--examples/failing/ImportModule/M2.purs3
-rw-r--r--examples/failing/InstanceExport.purs26
-rw-r--r--examples/failing/InstanceExport/InstanceExport.purs11
-rw-r--r--examples/failing/MissingClassMemberExport.purs2
-rw-r--r--examples/failing/MultipleErrors2.purs4
-rw-r--r--examples/failing/MultipleTypeOpFixities.purs9
-rw-r--r--examples/failing/MultipleValueOpFixities.purs9
-rw-r--r--examples/failing/OrphanInstance.purs19
-rw-r--r--examples/failing/OrphanInstance/Class.purs4
-rw-r--r--examples/failing/OrphanTypeDecl.purs4
-rw-r--r--examples/failing/OverlappingReExport.purs10
-rw-r--r--examples/failing/ProgrammableTypeErrors.purs16
-rw-r--r--examples/failing/RequiredHiddenType.purs9
-rw-r--r--examples/failing/RowConstructors1.purs4
-rw-r--r--examples/failing/RowConstructors2.purs4
-rw-r--r--examples/failing/RowConstructors3.purs4
-rw-r--r--examples/failing/SkolemEscape2.purs2
-rw-r--r--examples/failing/SuggestComposition.purs2
-rw-r--r--examples/failing/Superclasses5.purs3
-rw-r--r--examples/failing/TypeError.purs2
-rw-r--r--examples/failing/TypedBinders.purs6
-rw-r--r--examples/failing/TypedBinders2.purs6
-rw-r--r--examples/failing/TypedBinders3.purs3
-rw-r--r--examples/failing/UnderscoreModuleName.purs4
-rw-r--r--examples/failing/UnknownType.purs2
-rw-r--r--examples/passing/1185.purs4
-rw-r--r--examples/passing/1335.purs26
-rw-r--r--examples/passing/1570.purs4
-rw-r--r--examples/passing/1664.purs2
-rw-r--r--examples/passing/1697.purs3
-rw-r--r--examples/passing/1881.purs19
-rw-r--r--examples/passing/1991.purs6
-rw-r--r--examples/passing/2018.purs13
-rw-r--r--examples/passing/2018/A.purs7
-rw-r--r--examples/passing/2018/B.purs3
-rw-r--r--examples/passing/2049.purs14
-rw-r--r--examples/passing/2138.purs7
-rw-r--r--examples/passing/2138/Lib.purs3
-rw-r--r--examples/passing/2172.js5
-rw-r--r--examples/passing/2172.purs10
-rw-r--r--examples/passing/652.purs3
-rw-r--r--examples/passing/810.purs3
-rw-r--r--examples/passing/Applicative.purs4
-rw-r--r--examples/passing/ArrayType.purs3
-rw-r--r--examples/passing/Auto.purs3
-rw-r--r--examples/passing/AutoPrelude.purs20
-rw-r--r--examples/passing/AutoPrelude2.purs2
-rw-r--r--examples/passing/BindersInFunctions.purs11
-rw-r--r--examples/passing/BindingGroups.purs3
-rw-r--r--examples/passing/BlockString.purs3
-rw-r--r--examples/passing/CaseInDo.purs6
-rw-r--r--examples/passing/CaseMultipleExpressions.purs6
-rw-r--r--examples/passing/CaseStatement.purs3
-rw-r--r--examples/passing/CheckFunction.purs3
-rw-r--r--examples/passing/CheckSynonymBug.purs3
-rw-r--r--examples/passing/CheckTypeClass.purs4
-rw-r--r--examples/passing/Church.purs4
-rw-r--r--examples/passing/ClassRefSyntax.purs14
-rw-r--r--examples/passing/ClassRefSyntax/Lib.purs4
-rw-r--r--examples/passing/Collatz.purs7
-rw-r--r--examples/passing/Comparisons.purs30
-rw-r--r--examples/passing/Conditional.purs4
-rw-r--r--examples/passing/Console.purs6
-rw-r--r--examples/passing/ConstraintInference.purs7
-rw-r--r--examples/passing/ContextSimplification.purs8
-rw-r--r--examples/passing/DataAndType.purs3
-rw-r--r--examples/passing/DctorOperatorAlias.purs10
-rw-r--r--examples/passing/DctorOperatorAlias/List.purs5
-rw-r--r--examples/passing/DeepArrayBinder.purs3
-rw-r--r--examples/passing/DeepCase.purs8
-rw-r--r--examples/passing/Deriving.purs7
-rw-r--r--examples/passing/Do.purs5
-rw-r--r--examples/passing/Dollar.purs10
-rw-r--r--examples/passing/Eff.purs7
-rw-r--r--examples/passing/EmptyDataDecls.purs3
-rw-r--r--examples/passing/EmptyRow.purs3
-rw-r--r--examples/passing/EmptyTypeClass.purs11
-rw-r--r--examples/passing/EqOrd.purs5
-rw-r--r--examples/passing/ExplicitImportReExport.purs27
-rw-r--r--examples/passing/ExplicitImportReExport/Bar.purs3
-rw-r--r--examples/passing/ExplicitImportReExport/Foo.purs4
-rw-r--r--examples/passing/ExplicitOperatorSections.purs3
-rw-r--r--examples/passing/ExportExplicit.purs10
-rw-r--r--examples/passing/ExportExplicit/M1.purs10
-rw-r--r--examples/passing/ExportExplicit2.purs8
-rw-r--r--examples/passing/ExportExplicit2/M1.purs7
-rw-r--r--examples/passing/ExportedInstanceDeclarations.purs45
-rw-r--r--examples/passing/ExtendedInfixOperators.purs7
-rw-r--r--examples/passing/Fib.purs25
-rw-r--r--examples/passing/FieldConsPuns.purs23
-rw-r--r--examples/passing/FieldPuns.purs18
-rw-r--r--examples/passing/FinalTagless.purs5
-rw-r--r--examples/passing/FunctionScope.purs3
-rw-r--r--examples/passing/Functions.purs7
-rw-r--r--examples/passing/Functions2.purs3
-rw-r--r--examples/passing/Generalization1.purs7
-rw-r--r--examples/passing/Guards.purs3
-rw-r--r--examples/passing/IfThenElseMaybe.purs3
-rw-r--r--examples/passing/ImplicitEmptyImport.purs7
-rw-r--r--examples/passing/Import.purs6
-rw-r--r--examples/passing/Import/M1.purs8
-rw-r--r--examples/passing/Import/M2.purs6
-rw-r--r--examples/passing/ImportExplicit.purs10
-rw-r--r--examples/passing/ImportExplicit/M1.purs4
-rw-r--r--examples/passing/ImportHiding.purs5
-rw-r--r--examples/passing/ImportQualified.purs8
-rw-r--r--examples/passing/ImportQualified/M1.purs3
-rw-r--r--examples/passing/InferRecFunWithConstrainedArgument.purs9
-rw-r--r--examples/passing/InstanceBeforeClass.purs3
-rw-r--r--examples/passing/IntAndChar.purs3
-rw-r--r--examples/passing/JSReserved.purs3
-rw-r--r--examples/passing/KindedType.purs3
-rw-r--r--examples/passing/LargeSumType.purs6
-rw-r--r--examples/passing/Let.purs23
-rw-r--r--examples/passing/Let2.purs5
-rw-r--r--examples/passing/LetInInstance.purs3
-rw-r--r--examples/passing/LiberalTypeSynonyms.purs7
-rw-r--r--examples/passing/MPTCs.purs5
-rw-r--r--examples/passing/Match.purs3
-rw-r--r--examples/passing/Module.purs7
-rw-r--r--examples/passing/Module/M1.purs14
-rw-r--r--examples/passing/Module/M2.purs10
-rw-r--r--examples/passing/ModuleDeps.purs6
-rw-r--r--examples/passing/ModuleDeps/M1.purs5
-rw-r--r--examples/passing/ModuleDeps/M2.purs5
-rw-r--r--examples/passing/ModuleDeps/M3.purs3
-rw-r--r--examples/passing/ModuleExport.purs13
-rw-r--r--examples/passing/ModuleExport/A.purs3
-rw-r--r--examples/passing/ModuleExportDupes.purs14
-rw-r--r--examples/passing/ModuleExportDupes/A.purs3
-rw-r--r--examples/passing/ModuleExportDupes/B.purs3
-rw-r--r--examples/passing/ModuleExportDupes/C.purs4
-rw-r--r--examples/passing/ModuleExportExcluded.purs19
-rw-r--r--examples/passing/ModuleExportExcluded/A.purs6
-rw-r--r--examples/passing/ModuleExportQualified.purs14
-rw-r--r--examples/passing/ModuleExportQualified/A.purs3
-rw-r--r--examples/passing/ModuleExportSelf.purs19
-rw-r--r--examples/passing/ModuleExportSelf/A.purs5
-rw-r--r--examples/passing/Monad.purs4
-rw-r--r--examples/passing/MonadState.purs4
-rw-r--r--examples/passing/MultiArgFunctions.purs6
-rw-r--r--examples/passing/MutRec.purs3
-rw-r--r--examples/passing/MutRec2.purs3
-rw-r--r--examples/passing/MutRec3.purs3
-rw-r--r--examples/passing/NamedPatterns.purs5
-rw-r--r--examples/passing/NegativeBinder.purs3
-rw-r--r--examples/passing/NegativeIntInRange.purs3
-rw-r--r--examples/passing/Nested.purs3
-rw-r--r--examples/passing/NestedTypeSynonyms.purs3
-rw-r--r--examples/passing/NestedWhere.purs3
-rw-r--r--examples/passing/Newtype.purs10
-rw-r--r--examples/passing/NewtypeWithRecordUpdate.purs4
-rw-r--r--examples/passing/NonConflictingExports.purs14
-rw-r--r--examples/passing/NonConflictingExports/A.purs4
-rw-r--r--examples/passing/NumberLiterals.purs39
-rw-r--r--examples/passing/ObjectGetter.purs9
-rw-r--r--examples/passing/ObjectSynonym.purs3
-rw-r--r--examples/passing/ObjectUpdate.purs43
-rw-r--r--examples/passing/ObjectUpdate2.purs3
-rw-r--r--examples/passing/ObjectUpdater.purs4
-rw-r--r--examples/passing/ObjectWildcards.purs8
-rw-r--r--examples/passing/Objects.purs5
-rw-r--r--examples/passing/OneConstructor.purs3
-rw-r--r--examples/passing/OperatorAliasElsewhere.purs5
-rw-r--r--examples/passing/OperatorAliasElsewhere/Def.purs4
-rw-r--r--examples/passing/OperatorAssociativity.purs50
-rw-r--r--examples/passing/OperatorInlining.purs45
-rw-r--r--examples/passing/OperatorSections.purs21
-rw-r--r--examples/passing/Operators.purs52
-rw-r--r--examples/passing/Operators/Other.purs7
-rw-r--r--examples/passing/OptimizerBug.purs3
-rw-r--r--examples/passing/OptionalQualified.purs5
-rw-r--r--examples/passing/OverlappingInstances.purs30
-rw-r--r--examples/passing/OverlappingInstances2.purs50
-rw-r--r--examples/passing/OverlappingInstances3.purs36
-rw-r--r--examples/passing/ParensInTypedBinder.purs20
-rw-r--r--examples/passing/PartialFunction.purs6
-rw-r--r--examples/passing/Patterns.purs9
-rw-r--r--examples/passing/PendingConflictingImports.purs19
-rw-r--r--examples/passing/PendingConflictingImports/A.purs4
-rw-r--r--examples/passing/PendingConflictingImports/B.purs4
-rw-r--r--examples/passing/PendingConflictingImports2.purs16
-rw-r--r--examples/passing/PendingConflictingImports2/A.purs4
-rw-r--r--examples/passing/Person.purs5
-rw-r--r--examples/passing/PrimedTypeName.purs20
-rw-r--r--examples/passing/QualifiedNames.purs11
-rw-r--r--examples/passing/QualifiedNames/Either.purs5
-rw-r--r--examples/passing/QualifiedQualifiedImports.purs4
-rw-r--r--examples/passing/Rank2Data.purs59
-rw-r--r--examples/passing/Rank2Object.purs2
-rw-r--r--examples/passing/Rank2TypeSynonym.purs5
-rw-r--r--examples/passing/Rank2Types.purs3
-rw-r--r--examples/passing/ReExportQualified.purs17
-rw-r--r--examples/passing/ReExportQualified/A.purs3
-rw-r--r--examples/passing/ReExportQualified/B.purs3
-rw-r--r--examples/passing/ReExportQualified/C.purs4
-rw-r--r--examples/passing/RebindableSyntax.purs82
-rw-r--r--examples/passing/Recursion.purs3
-rw-r--r--examples/passing/RedefinedFixity.purs6
-rw-r--r--examples/passing/RedefinedFixity/M1.purs6
-rw-r--r--examples/passing/RedefinedFixity/M2.purs5
-rw-r--r--examples/passing/RedefinedFixity/M3.purs6
-rw-r--r--examples/passing/ReservedWords.purs8
-rw-r--r--examples/passing/ResolvableScopeConflict.purs30
-rw-r--r--examples/passing/ResolvableScopeConflict/A.purs4
-rw-r--r--examples/passing/ResolvableScopeConflict/B.purs7
-rw-r--r--examples/passing/ResolvableScopeConflict2.purs27
-rw-r--r--examples/passing/ResolvableScopeConflict2/A.purs7
-rw-r--r--examples/passing/ResolvableScopeConflict3.purs16
-rw-r--r--examples/passing/ResolvableScopeConflict3/A.purs4
-rw-r--r--examples/passing/RowConstructors.purs5
-rw-r--r--examples/passing/RowPolyInstanceContext.purs7
-rw-r--r--examples/passing/RuntimeScopeIssue.purs5
-rw-r--r--examples/passing/ScopedTypeVariables.purs3
-rw-r--r--examples/passing/Sequence.purs3
-rw-r--r--examples/passing/SequenceDesugared.purs9
-rw-r--r--examples/passing/ShadowedModuleName.purs15
-rw-r--r--examples/passing/ShadowedModuleName/Test.purs6
-rw-r--r--examples/passing/ShadowedName.purs11
-rw-r--r--examples/passing/ShadowedTCO.purs39
-rw-r--r--examples/passing/ShadowedTCOLet.purs24
-rw-r--r--examples/passing/SignedNumericLiterals.purs3
-rw-r--r--examples/passing/StringEscapes.purs32
-rw-r--r--examples/passing/Superclasses1.purs5
-rw-r--r--examples/passing/Superclasses3.purs2
-rw-r--r--examples/passing/TCO.purs14
-rw-r--r--examples/passing/TCOCase.purs3
-rw-r--r--examples/passing/TailCall.purs5
-rw-r--r--examples/passing/Tick.purs3
-rw-r--r--examples/passing/TopLevelCase.purs3
-rw-r--r--examples/passing/TransitiveImport.purs9
-rw-r--r--examples/passing/TransitiveImport/Middle.purs5
-rw-r--r--examples/passing/TransitiveImport/Test.purs9
-rw-r--r--examples/passing/TypeClassMemberOrderChange.purs29
-rw-r--r--examples/passing/TypeClasses.purs20
-rw-r--r--examples/passing/TypeClassesInOrder.purs3
-rw-r--r--examples/passing/TypeClassesWithOverlappingTypeVariables.purs5
-rw-r--r--examples/passing/TypeDecl.purs3
-rw-r--r--examples/passing/TypeOperators.purs40
-rw-r--r--examples/passing/TypeOperators/A.purs22
-rw-r--r--examples/passing/TypeSynonymInData.purs3
-rw-r--r--examples/passing/TypeSynonyms.purs3
-rw-r--r--examples/passing/TypeWildcards.purs3
-rw-r--r--examples/passing/TypeWildcardsRecordExtension.purs3
-rw-r--r--examples/passing/TypeWithoutParens.purs18
-rw-r--r--examples/passing/TypeWithoutParens/Lib.purs4
-rw-r--r--examples/passing/TypedBinders.purs15
-rw-r--r--examples/passing/TypedWhere.purs3
-rw-r--r--examples/passing/UTF8Sourcefile.purs18
-rw-r--r--examples/passing/UnderscoreIdent.purs4
-rw-r--r--examples/passing/UnicodeIdentifier.purs4
-rw-r--r--examples/passing/UnicodeOperators.purs4
-rw-r--r--examples/passing/UnicodeType.purs17
-rw-r--r--examples/passing/Unit.purs6
-rw-r--r--examples/passing/UnknownInTypeClassLookup.purs3
-rw-r--r--examples/passing/UntupledConstraints.purs2
-rw-r--r--examples/passing/Where.purs22
-rw-r--r--examples/passing/WildcardType.purs12
-rw-r--r--examples/passing/iota.purs4
-rw-r--r--examples/passing/s.purs3
-rw-r--r--examples/warning/DuplicateExportRef.purs30
-rw-r--r--examples/warning/DuplicateImport.purs10
-rw-r--r--examples/warning/DuplicateImportRef.purs18
-rw-r--r--examples/warning/DuplicateSelectiveImport.purs10
-rw-r--r--examples/warning/HidingImport.purs9
-rw-r--r--examples/warning/ImplicitImport.purs9
-rw-r--r--examples/warning/ImplicitQualifiedImport.purs11
-rw-r--r--examples/warning/MissingTypeDeclaration.purs4
-rw-r--r--examples/warning/OverlappingInstances.purs17
-rw-r--r--examples/warning/OverlappingPattern.purs15
-rw-r--r--examples/warning/ScopeShadowing.purs13
-rw-r--r--examples/warning/ShadowedTypeVar.purs5
-rw-r--r--examples/warning/UnnecessaryFFIModule.js1
-rw-r--r--examples/warning/UnnecessaryFFIModule.purs5
-rw-r--r--examples/warning/UnusedDctorExplicitImport.purs8
-rw-r--r--examples/warning/UnusedDctorImportAll.purs7
-rw-r--r--examples/warning/UnusedDctorImportExplicit.purs7
-rw-r--r--examples/warning/UnusedExplicitImport.purs8
-rw-r--r--examples/warning/UnusedFFIImplementations.js2
-rw-r--r--examples/warning/UnusedFFIImplementations.purs4
-rw-r--r--examples/warning/UnusedImport.purs14
-rw-r--r--examples/warning/UnusedTypeVar.purs5
-rw-r--r--examples/warning/WildcardInferredType.purs23
-rw-r--r--hierarchy/Main.hs5
-rw-r--r--psc-bundle/Main.hs12
-rw-r--r--psc-docs/Main.hs2
-rw-r--r--psc-ide-client/Main.hs2
-rw-r--r--psc-ide-server/Main.hs46
-rw-r--r--psc/Main.hs80
-rw-r--r--psci/Main.hs132
-rw-r--r--psci/PSCi.hs372
-rw-r--r--psci/PSCi/Message.hs53
-rw-r--r--psci/PSCi/Module.hs107
-rw-r--r--psci/PSCi/Option.hs57
-rw-r--r--psci/PSCi/Types.hs218
-rw-r--r--psci/main/Main.hs6
-rw-r--r--purescript.cabal336
-rw-r--r--src/Control/Monad/Logger.hs27
-rw-r--r--src/Control/Monad/Supply.hs23
-rw-r--r--src/Control/Monad/Supply/Class.hs12
-rw-r--r--src/Language/PureScript.hs22
-rw-r--r--src/Language/PureScript/AST/Binders.hs4
-rw-r--r--src/Language/PureScript/AST/Declarations.hs129
-rw-r--r--src/Language/PureScript/AST/Exported.hs27
-rw-r--r--src/Language/PureScript/AST/Literals.hs4
-rw-r--r--src/Language/PureScript/AST/Operators.hs2
-rw-r--r--src/Language/PureScript/AST/SourcePos.hs3
-rw-r--r--src/Language/PureScript/AST/Traversals.hs33
-rw-r--r--src/Language/PureScript/Bundle.hs111
-rw-r--r--src/Language/PureScript/CodeGen.hs28
-rw-r--r--src/Language/PureScript/CodeGen/JS.hs28
-rw-r--r--src/Language/PureScript/CodeGen/JS/AST.hs3
-rw-r--r--src/Language/PureScript/CodeGen/JS/Common.hs3
-rw-r--r--src/Language/PureScript/CodeGen/JS/Optimizer.hs14
-rw-r--r--src/Language/PureScript/CodeGen/JS/Optimizer/Blocks.hs14
-rw-r--r--src/Language/PureScript/CodeGen/JS/Optimizer/Common.hs11
-rw-r--r--src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs211
-rw-r--r--src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs6
-rw-r--r--src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs14
-rw-r--r--src/Language/PureScript/CodeGen/JS/Optimizer/Unused.hs15
-rw-r--r--src/Language/PureScript/Comments.hs2
-rw-r--r--src/Language/PureScript/Constants.hs38
-rw-r--r--src/Language/PureScript/CoreFn.hs2
-rw-r--r--src/Language/PureScript/CoreFn/Ann.hs62
-rw-r--r--src/Language/PureScript/CoreFn/Binders.hs4
-rw-r--r--src/Language/PureScript/CoreFn/Desugar.hs42
-rw-r--r--src/Language/PureScript/CoreFn/Expr.hs6
-rw-r--r--src/Language/PureScript/CoreFn/Meta.hs2
-rw-r--r--src/Language/PureScript/CoreFn/Module.hs19
-rw-r--r--src/Language/PureScript/CoreFn/Traversals.hs4
-rw-r--r--src/Language/PureScript/Crash.hs20
-rw-r--r--src/Language/PureScript/Docs.hs8
-rw-r--r--src/Language/PureScript/Docs/AsMarkdown.hs40
-rw-r--r--src/Language/PureScript/Docs/Convert.hs24
-rw-r--r--src/Language/PureScript/Docs/Convert/ReExports.hs148
-rw-r--r--src/Language/PureScript/Docs/Convert/Single.hs68
-rw-r--r--src/Language/PureScript/Docs/ParseAndBookmark.hs16
-rw-r--r--src/Language/PureScript/Docs/Render.hs45
-rw-r--r--src/Language/PureScript/Docs/RenderedCode.hs19
-rw-r--r--src/Language/PureScript/Docs/RenderedCode/Render.hs57
-rw-r--r--src/Language/PureScript/Docs/RenderedCode/Types.hs6
-rw-r--r--src/Language/PureScript/Docs/Types.hs50
-rw-r--r--src/Language/PureScript/Environment.hs37
-rw-r--r--src/Language/PureScript/Errors.hs757
-rw-r--r--src/Language/PureScript/Errors/JSON.hs37
-rw-r--r--src/Language/PureScript/Externs.hs60
-rw-r--r--src/Language/PureScript/Ide.hs32
-rw-r--r--src/Language/PureScript/Ide/CaseSplit.hs6
-rw-r--r--src/Language/PureScript/Ide/Command.hs118
-rw-r--r--src/Language/PureScript/Ide/Error.hs1
-rw-r--r--src/Language/PureScript/Ide/Externs.hs59
-rw-r--r--src/Language/PureScript/Ide/Filter.hs1
-rw-r--r--src/Language/PureScript/Ide/Imports.hs38
-rw-r--r--src/Language/PureScript/Ide/Matcher.hs1
-rw-r--r--src/Language/PureScript/Ide/Pursuit.hs1
-rw-r--r--src/Language/PureScript/Ide/Rebuild.hs151
-rw-r--r--src/Language/PureScript/Ide/Reexports.hs2
-rw-r--r--src/Language/PureScript/Ide/SourceFile.hs8
-rw-r--r--src/Language/PureScript/Ide/State.hs159
-rw-r--r--src/Language/PureScript/Ide/Types.hs13
-rw-r--r--src/Language/PureScript/Ide/Util.hs38
-rw-r--r--src/Language/PureScript/Ide/Watcher.hs48
-rw-r--r--src/Language/PureScript/Interactive.hs283
-rw-r--r--src/Language/PureScript/Interactive/Completion.hs (renamed from psci/PSCi/Completion.hs)156
-rw-r--r--src/Language/PureScript/Interactive/Directive.hs (renamed from psci/PSCi/Directive.hs)23
-rw-r--r--src/Language/PureScript/Interactive/IO.hs (renamed from psci/PSCi/IO.hs)35
-rw-r--r--src/Language/PureScript/Interactive/Message.hs52
-rw-r--r--src/Language/PureScript/Interactive/Module.hs99
-rw-r--r--src/Language/PureScript/Interactive/Parser.hs (renamed from psci/PSCi/Parser.hs)36
-rw-r--r--src/Language/PureScript/Interactive/Printer.hs (renamed from psci/PSCi/Printer.hs)23
-rw-r--r--src/Language/PureScript/Interactive/Types.hs146
-rw-r--r--src/Language/PureScript/Kinds.hs27
-rw-r--r--src/Language/PureScript/Linter.hs29
-rw-r--r--src/Language/PureScript/Linter/Exhaustive.hs187
-rw-r--r--src/Language/PureScript/Linter/Imports.hs323
-rw-r--r--src/Language/PureScript/Make.hs152
-rw-r--r--src/Language/PureScript/ModuleDependencies.hs28
-rw-r--r--src/Language/PureScript/Names.hs94
-rw-r--r--src/Language/PureScript/Options.hs19
-rw-r--r--src/Language/PureScript/Parser.hs59
-rw-r--r--src/Language/PureScript/Parser/Common.hs34
-rw-r--r--src/Language/PureScript/Parser/Declarations.hs232
-rw-r--r--src/Language/PureScript/Parser/JS.hs60
-rw-r--r--src/Language/PureScript/Parser/Kinds.hs22
-rw-r--r--src/Language/PureScript/Parser/Lexer.hs76
-rw-r--r--src/Language/PureScript/Parser/State.hs16
-rw-r--r--src/Language/PureScript/Parser/Types.hs40
-rw-r--r--src/Language/PureScript/Pretty.hs16
-rw-r--r--src/Language/PureScript/Pretty/Common.hs24
-rw-r--r--src/Language/PureScript/Pretty/JS.hs35
-rw-r--r--src/Language/PureScript/Pretty/Kinds.hs29
-rw-r--r--src/Language/PureScript/Pretty/Types.hs35
-rw-r--r--src/Language/PureScript/Pretty/Values.hs25
-rw-r--r--src/Language/PureScript/Publish.hs51
-rw-r--r--src/Language/PureScript/Publish/BoxesHelpers.hs3
-rw-r--r--src/Language/PureScript/Publish/ErrorsWarnings.hs58
-rw-r--r--src/Language/PureScript/Publish/Utils.hs79
-rw-r--r--src/Language/PureScript/Renamer.hs6
-rw-r--r--src/Language/PureScript/Sugar.hs43
-rw-r--r--src/Language/PureScript/Sugar/BindingGroups.hs44
-rw-r--r--src/Language/PureScript/Sugar/CaseDeclarations.hs37
-rw-r--r--src/Language/PureScript/Sugar/DoNotation.hs30
-rw-r--r--src/Language/PureScript/Sugar/Names.hs284
-rw-r--r--src/Language/PureScript/Sugar/Names/Common.hs68
-rw-r--r--src/Language/PureScript/Sugar/Names/Env.hs287
-rw-r--r--src/Language/PureScript/Sugar/Names/Exports.hs310
-rw-r--r--src/Language/PureScript/Sugar/Names/Imports.hs268
-rw-r--r--src/Language/PureScript/Sugar/ObjectWildcards.hs17
-rw-r--r--src/Language/PureScript/Sugar/Operators.hs339
-rw-r--r--src/Language/PureScript/Sugar/Operators/Binders.hs9
-rw-r--r--src/Language/PureScript/Sugar/Operators/Common.hs27
-rw-r--r--src/Language/PureScript/Sugar/Operators/Expr.hs16
-rw-r--r--src/Language/PureScript/Sugar/Operators/Types.hs9
-rw-r--r--src/Language/PureScript/Sugar/TypeClasses.hs26
-rwxr-xr-xsrc/Language/PureScript/Sugar/TypeClasses/Deriving.hs73
-rw-r--r--src/Language/PureScript/Sugar/TypeDeclarations.hs66
-rw-r--r--src/Language/PureScript/Traversals.hs69
-rw-r--r--src/Language/PureScript/TypeChecker.hs157
-rw-r--r--src/Language/PureScript/TypeChecker/Entailment.hs41
-rw-r--r--src/Language/PureScript/TypeChecker/Kinds.hs20
-rw-r--r--src/Language/PureScript/TypeChecker/Monad.hs12
-rw-r--r--src/Language/PureScript/TypeChecker/Rows.hs31
-rw-r--r--src/Language/PureScript/TypeChecker/Skolems.hs43
-rw-r--r--src/Language/PureScript/TypeChecker/Subsumption.hs34
-rw-r--r--src/Language/PureScript/TypeChecker/Synonyms.hs32
-rw-r--r--src/Language/PureScript/TypeChecker/Types.hs78
-rw-r--r--src/Language/PureScript/TypeChecker/Unify.hs76
-rw-r--r--src/Language/PureScript/TypeClassDictionaries.hs2
-rw-r--r--src/Language/PureScript/Types.hs135
-rw-r--r--src/System/IO/UTF8.hs4
-rw-r--r--stack-lts-5.yaml7
-rw-r--r--stack-nightly.yaml6
-rw-r--r--stack.yaml1
-rw-r--r--tests/Language/PureScript/Ide/FilterSpec.hs2
-rw-r--r--tests/Language/PureScript/Ide/Imports/IntegrationSpec.hs17
-rw-r--r--tests/Language/PureScript/Ide/ImportsSpec.hs11
-rw-r--r--tests/Language/PureScript/Ide/Integration.hs81
-rw-r--r--tests/Language/PureScript/Ide/MatcherSpec.hs26
-rw-r--r--tests/Language/PureScript/Ide/RebuildSpec.hs25
-rw-r--r--tests/Language/PureScript/Ide/ReexportsSpec.hs9
-rw-r--r--tests/Language/PureScript/IdeSpec.hs2
-rw-r--r--tests/Main.hs5
-rw-r--r--tests/TestCompiler.hs282
-rw-r--r--tests/TestDocs.hs11
-rw-r--r--tests/TestPscIde.hs11
-rw-r--r--tests/TestPscPublish.hs2
-rw-r--r--tests/TestPsci.hs70
-rw-r--r--tests/TestUtils.hs61
-rw-r--r--tests/support/bower.json13
-rw-r--r--tests/support/flattened/Control-Monad-Eff-Class.purs24
-rw-r--r--tests/support/flattened/Control-Monad-Eff-Console.js18
-rw-r--r--tests/support/flattened/Control-Monad-Eff-Console.purs18
-rw-r--r--tests/support/flattened/Control-Monad-Eff-Unsafe.js8
-rw-r--r--tests/support/flattened/Control-Monad-Eff-Unsafe.purs10
-rw-r--r--tests/support/flattened/Control-Monad-Eff.js62
-rw-r--r--tests/support/flattened/Control-Monad-Eff.purs67
-rw-r--r--tests/support/flattened/Control-Monad-ST.js38
-rw-r--r--tests/support/flattened/Control-Monad-ST.purs42
-rw-r--r--tests/support/flattened/Data-Function.js233
-rw-r--r--tests/support/flattened/Data-Function.purs113
-rw-r--r--tests/support/flattened/Prelude.js228
-rw-r--r--tests/support/flattened/Prelude.purs872
-rw-r--r--tests/support/flattened/Test-Assert.js27
-rw-r--r--tests/support/flattened/Test-Assert.purs46
-rw-r--r--tests/support/package.json3
-rw-r--r--tests/support/prelude/LICENSE20
-rw-r--r--tests/support/prelude/bower.json23
-rw-r--r--tests/support/prelude/src/Prelude.js228
-rw-r--r--tests/support/prelude/src/Prelude.purs872
-rw-r--r--tests/support/pscide/src/RebuildSpecWithHiddenIdent.purs6
-rw-r--r--tests/support/setup.js22
555 files changed, 7281 insertions, 9339 deletions
diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md
index 0120af5..057000d 100644
--- a/CONTRIBUTORS.md
+++ b/CONTRIBUTORS.md
@@ -31,6 +31,7 @@ This file lists the contributors to the PureScript compiler project, and the ter
- [@jacereda](https://github.com/jacereda) (Jorge Acereda) My existing contributions and all future contributions until further notice are Copyright Jorge Acereda, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
- [@japesinator](https://github.com/japesinator) (JP Smith) My existing contributions and all future contributions until further notice are Copyright JP Smith, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
- [@joneshf](https://github.com/joneshf) (Hardy Jones) - My existing contributions and all future contributions until further notice are Copyright Hardy Jones, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
+- [@kika](https://github.com/kika) (Kirill Pertsev) - My existing contributions and all future contributions until further notice are Copyright Kirill Pertsev, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
- [@kRITZCREEK](https://github.com/kRITZCREEK) (Christoph Hegemann) - My existing contributions and all future contributions until further notice are Copyright Christoph Hegemann, and are licensed to the owners and users of the PureScript compiler project under the terms of the MIT license.
- [@L8D](https://github.com/L8D) (Tenor Biel) My existing contributions and all future contributions until further notice are Copyright Tenor Biel, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
- [@leighman](http://github.com/leighman) (Jack Leigh) My existing contributions and all future contributions until further notice are Copyright Jack Leigh, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
@@ -70,6 +71,7 @@ This file lists the contributors to the PureScript compiler project, and the ter
- [@zudov](https://github.com/zudov) (Konstantin Zudov) My existing contributions and all future contributions until further notice are Copyright Konstantin Zudov, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
- [@LiamGoodacre](https://github.com/LiamGoodacre) (Liam Goodacre) My existing contributions and all future contributions until further notice are Copyright Liam Goodacre, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
- [@bsermons](https://github.com/bsermons) (Brian Sermons) My existing contributions and all future contributions until further notice are Copyright Brian Sermons, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
+- [@bmjames](https://github.com/bmjames) (Ben James) My existing contributions and all future contributions until further notice are Copyright Ben James, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT).
### Companies
diff --git a/examples/docs/src/Clash.purs b/examples/docs/src/Clash.purs
index 6da44ee..a2fef87 100644
--- a/examples/docs/src/Clash.purs
+++ b/examples/docs/src/Clash.purs
@@ -2,31 +2,3 @@ module Clash (module Clash1) where
import Clash1 as Clash1
import Clash2 as Clash2
-
-module Clash1 (module Clash1a) where
-
-import Clash1a
-
-module Clash1a where
-
-value :: Int
-value = 0
-
-type Type = Int
-
-class TypeClass a where
- typeClassMember :: a
-
-module Clash2 (module Clash2a) where
-
-import Clash2a
-
-module Clash2a where
-
-value :: String
-value = "hello"
-
-type Type = String
-
-class TypeClass a b where
- typeClassMember :: a -> b
diff --git a/examples/docs/src/Clash1.purs b/examples/docs/src/Clash1.purs
new file mode 100644
index 0000000..b3fc771
--- /dev/null
+++ b/examples/docs/src/Clash1.purs
@@ -0,0 +1,3 @@
+module Clash1 (module Clash1a) where
+
+import Clash1a
diff --git a/examples/docs/src/Clash1a.purs b/examples/docs/src/Clash1a.purs
new file mode 100644
index 0000000..c21260f
--- /dev/null
+++ b/examples/docs/src/Clash1a.purs
@@ -0,0 +1,9 @@
+module Clash1a where
+
+value :: Int
+value = 0
+
+type Type = Int
+
+class TypeClass a where
+ typeClassMember :: a
diff --git a/examples/docs/src/Clash2.purs b/examples/docs/src/Clash2.purs
new file mode 100644
index 0000000..9c531ea
--- /dev/null
+++ b/examples/docs/src/Clash2.purs
@@ -0,0 +1,3 @@
+module Clash2 (module Clash2a) where
+
+import Clash2a
diff --git a/examples/docs/src/Clash2a.purs b/examples/docs/src/Clash2a.purs
new file mode 100644
index 0000000..5405daf
--- /dev/null
+++ b/examples/docs/src/Clash2a.purs
@@ -0,0 +1,9 @@
+module Clash2a where
+
+value :: String
+value = "hello"
+
+type Type = String
+
+class TypeClass a b where
+ typeClassMember :: a -> b
diff --git a/examples/docs/src/ImportedTwice.purs b/examples/docs/src/ImportedTwice.purs
index fc13545..c8b297d 100644
--- a/examples/docs/src/ImportedTwice.purs
+++ b/examples/docs/src/ImportedTwice.purs
@@ -4,24 +4,10 @@
-- re-exports it from Control.Monad.Trans).
module ImportedTwice
- ( module A
- , module B
+ ( module ImportedTwiceA
+ , module ImportedTwiceB
)
where
-import A
-import B
-
-module A
- ( module B )
- where
-
-import B
-
-bar :: Int
-bar = 1
-
-module B where
-
-foo :: Int
-foo = 0
+import ImportedTwiceA
+import ImportedTwiceB
diff --git a/examples/docs/src/ImportedTwiceA.purs b/examples/docs/src/ImportedTwiceA.purs
new file mode 100644
index 0000000..9acf57e
--- /dev/null
+++ b/examples/docs/src/ImportedTwiceA.purs
@@ -0,0 +1,8 @@
+module ImportedTwiceA
+ ( module ImportedTwiceB )
+ where
+
+import ImportedTwiceB
+
+bar :: Int
+bar = 1
diff --git a/examples/docs/src/ImportedTwiceB.purs b/examples/docs/src/ImportedTwiceB.purs
new file mode 100644
index 0000000..6212793
--- /dev/null
+++ b/examples/docs/src/ImportedTwiceB.purs
@@ -0,0 +1,4 @@
+module ImportedTwiceB where
+
+foo :: Int
+foo = 0
diff --git a/examples/docs/src/MultiVirtual.purs b/examples/docs/src/MultiVirtual.purs
index 61ef6f8..19b766f 100644
--- a/examples/docs/src/MultiVirtual.purs
+++ b/examples/docs/src/MultiVirtual.purs
@@ -4,24 +4,3 @@ module MultiVirtual
import MultiVirtual1 as X
import MultiVirtual2 as X
-
-
-module MultiVirtual1 where
-
-foo :: Int
-foo = 1
-
-module MultiVirtual2
- ( module MultiVirtual2
- , module MultiVirtual3
- ) where
-
-import MultiVirtual3
-
-bar :: Int
-bar = 2
-
-module MultiVirtual3 where
-
-baz :: Int
-baz = 3
diff --git a/examples/docs/src/MultiVirtual1.purs b/examples/docs/src/MultiVirtual1.purs
new file mode 100644
index 0000000..eb756c0
--- /dev/null
+++ b/examples/docs/src/MultiVirtual1.purs
@@ -0,0 +1,4 @@
+module MultiVirtual1 where
+
+foo :: Int
+foo = 1
diff --git a/examples/docs/src/MultiVirtual2.purs b/examples/docs/src/MultiVirtual2.purs
new file mode 100644
index 0000000..1d1dcd7
--- /dev/null
+++ b/examples/docs/src/MultiVirtual2.purs
@@ -0,0 +1,9 @@
+module MultiVirtual2
+ ( module MultiVirtual2
+ , module MultiVirtual3
+ ) where
+
+import MultiVirtual3
+
+bar :: Int
+bar = 2
diff --git a/examples/docs/src/MultiVirtual3.purs b/examples/docs/src/MultiVirtual3.purs
new file mode 100644
index 0000000..9da3b75
--- /dev/null
+++ b/examples/docs/src/MultiVirtual3.purs
@@ -0,0 +1,4 @@
+module MultiVirtual3 where
+
+baz :: Int
+baz = 3
diff --git a/examples/docs/src/NewOperators.purs b/examples/docs/src/NewOperators.purs
index b8c20c4..61c0a7b 100644
--- a/examples/docs/src/NewOperators.purs
+++ b/examples/docs/src/NewOperators.purs
@@ -3,10 +3,3 @@ module NewOperators
where
import NewOperators2
-
-module NewOperators2 where
-
-infixl 8 _compose as >>>
-
-_compose :: forall a b c. (b -> c) -> (a -> b) -> (a -> c)
-_compose f g x = f (g x)
diff --git a/examples/docs/src/NewOperators2.purs b/examples/docs/src/NewOperators2.purs
new file mode 100644
index 0000000..67cc46c
--- /dev/null
+++ b/examples/docs/src/NewOperators2.purs
@@ -0,0 +1,6 @@
+module NewOperators2 where
+
+infixl 8 _compose as >>>
+
+_compose :: forall a b c. (b -> c) -> (a -> b) -> (a -> c)
+_compose f g x = f (g x)
diff --git a/examples/docs/src/OldOperators.purs b/examples/docs/src/OldOperators.purs
deleted file mode 100644
index 6a69323..0000000
--- a/examples/docs/src/OldOperators.purs
+++ /dev/null
@@ -1,10 +0,0 @@
-
--- Remove this after 0.9.
-module OldOperators (module OldOperators2) where
-
-import OldOperators2
-
-module OldOperators2 where
-
-(>>) :: forall a. a -> a -> a
-(>>) a b = b
diff --git a/examples/docs/src/TypeClassWithoutMembers.purs b/examples/docs/src/TypeClassWithoutMembers.purs
index fb926cf..fd06102 100644
--- a/examples/docs/src/TypeClassWithoutMembers.purs
+++ b/examples/docs/src/TypeClassWithoutMembers.purs
@@ -1,11 +1,5 @@
module TypeClassWithoutMembers
- ( module Intermediate )
+ ( module TypeClassWithoutMembersIntermediate )
where
-import Intermediate
-
-module Intermediate
- ( module SomeTypeClass )
- where
-
-import SomeTypeClass (SomeClass)
+import TypeClassWithoutMembersIntermediate
diff --git a/examples/docs/src/TypeClassWithoutMembersIntermediate.purs b/examples/docs/src/TypeClassWithoutMembersIntermediate.purs
new file mode 100644
index 0000000..5aefd35
--- /dev/null
+++ b/examples/docs/src/TypeClassWithoutMembersIntermediate.purs
@@ -0,0 +1,5 @@
+module TypeClassWithoutMembersIntermediate
+ ( module SomeTypeClass )
+ where
+
+import SomeTypeClass (class SomeClass)
diff --git a/examples/failing/1733.purs b/examples/failing/1733.purs
index 8dfbf18..683bb4b 100644
--- a/examples/failing/1733.purs
+++ b/examples/failing/1733.purs
@@ -1,13 +1,6 @@
--- @shouldFailWith UnknownValue
-
+-- @shouldFailWith UnknownName
module Main where
import Thingy as Thing
main = Thing.doesntExist "hi"
-
-module Thingy where
-
-foo :: Int
-foo = 1
-
diff --git a/examples/failing/1733/Thingy.purs b/examples/failing/1733/Thingy.purs
new file mode 100644
index 0000000..1803a5f
--- /dev/null
+++ b/examples/failing/1733/Thingy.purs
@@ -0,0 +1,4 @@
+module Thingy where
+
+foo :: Int
+foo = 1
diff --git a/examples/failing/1825.purs b/examples/failing/1825.purs
index 0ffc5f2..5641ecc 100644
--- a/examples/failing/1825.purs
+++ b/examples/failing/1825.purs
@@ -1,9 +1,9 @@
--- @shouldFailWith UnknownValue
+-- @shouldFailWith UnknownName
module Main where
data W = X | Y | Z
-bad X a = a
-bad Y _ = a
-bad Z a = a
+bad X a = a
+bad Y _ = a
+bad Z a = a
diff --git a/examples/failing/1881.purs b/examples/failing/1881.purs
new file mode 100644
index 0000000..aee7bd5
--- /dev/null
+++ b/examples/failing/1881.purs
@@ -0,0 +1,6 @@
+-- @shouldFailWith ErrorParsingModule
+module Main where
+
+foo =
+bar :: Int
+bar = 3
diff --git a/examples/failing/2128-class.purs b/examples/failing/2128-class.purs
new file mode 100644
index 0000000..a46135b
--- /dev/null
+++ b/examples/failing/2128-class.purs
@@ -0,0 +1,5 @@
+-- @shouldFailWith ErrorParsingModule
+module Main where
+
+class Foo a where
+ foo :: a -> !!!
diff --git a/examples/failing/2128-instance.purs b/examples/failing/2128-instance.purs
new file mode 100644
index 0000000..9ec9758
--- /dev/null
+++ b/examples/failing/2128-instance.purs
@@ -0,0 +1,8 @@
+-- @shouldFailWith ErrorParsingModule
+module Main where
+
+class Foo a where
+ foo :: a
+
+instance fooInt :: Foo Int where
+ foo = !!!
diff --git a/examples/failing/ArgLengthMismatch.purs b/examples/failing/ArgLengthMismatch.purs
new file mode 100644
index 0000000..847e293
--- /dev/null
+++ b/examples/failing/ArgLengthMismatch.purs
@@ -0,0 +1,7 @@
+-- @shouldFailWith ArgListLengthsDiffer
+module ArgLengthMismatch where
+
+import Prelude
+
+f x y = true
+f = false
diff --git a/examples/failing/Arrays.purs b/examples/failing/Arrays.purs
index 479b351..cb02616 100644
--- a/examples/failing/Arrays.purs
+++ b/examples/failing/Arrays.purs
@@ -1,8 +1,6 @@
-- @shouldFailWith TypesDoNotUnify
module Main where
-import Prelude
+foreign import ix :: forall a. Array a -> Int -> a
-foreign import (!!) :: forall a. Array a -> Int -> a
-
-test = \arr -> arr !! (0 !! 0)
+test = \arr -> arr `ix` (0 `ix` 0)
diff --git a/examples/failing/ConflictingExports.purs b/examples/failing/ConflictingExports.purs
index 1aef23b..9ef5d67 100644
--- a/examples/failing/ConflictingExports.purs
+++ b/examples/failing/ConflictingExports.purs
@@ -1,14 +1,4 @@
-- @shouldFailWith ScopeConflict
-module A where
-
- thing :: Int
- thing = 1
-
-module B where
-
- thing :: Int
- thing = 2
-
-- Fails here because re-exporting forces any scope conflicts to be resolved
module Main (module A, module B) where
diff --git a/examples/failing/ConflictingExports/A.purs b/examples/failing/ConflictingExports/A.purs
new file mode 100644
index 0000000..302b032
--- /dev/null
+++ b/examples/failing/ConflictingExports/A.purs
@@ -0,0 +1,4 @@
+module A where
+
+thing :: Int
+thing = 1
diff --git a/examples/failing/ConflictingExports/B.purs b/examples/failing/ConflictingExports/B.purs
new file mode 100644
index 0000000..076bf7e
--- /dev/null
+++ b/examples/failing/ConflictingExports/B.purs
@@ -0,0 +1,4 @@
+module B where
+
+thing :: Int
+thing = 2
diff --git a/examples/failing/ConflictingImports.purs b/examples/failing/ConflictingImports.purs
index 64eb1cc..00b2b3c 100644
--- a/examples/failing/ConflictingImports.purs
+++ b/examples/failing/ConflictingImports.purs
@@ -1,19 +1,9 @@
-- @shouldFailWith ScopeConflict
-module A where
-
- thing :: Int
- thing = 1
-
-module B where
-
- thing :: Int
- thing = 2
-
module Main where
- import A
- import B
+import A
+import B
- -- Error due to referencing `thing` which is in scope as A.thing and B.thing
- what :: Int
- what = thing
+-- Error due to referencing `thing` which is in scope as A.thing and B.thing
+what :: Int
+what = thing
diff --git a/examples/failing/ConflictingImports/A.purs b/examples/failing/ConflictingImports/A.purs
new file mode 100644
index 0000000..302b032
--- /dev/null
+++ b/examples/failing/ConflictingImports/A.purs
@@ -0,0 +1,4 @@
+module A where
+
+thing :: Int
+thing = 1
diff --git a/examples/failing/ConflictingImports/B.purs b/examples/failing/ConflictingImports/B.purs
new file mode 100644
index 0000000..076bf7e
--- /dev/null
+++ b/examples/failing/ConflictingImports/B.purs
@@ -0,0 +1,4 @@
+module B where
+
+thing :: Int
+thing = 2
diff --git a/examples/failing/ConflictingImports2.purs b/examples/failing/ConflictingImports2.purs
index 02a21b6..e716da1 100644
--- a/examples/failing/ConflictingImports2.purs
+++ b/examples/failing/ConflictingImports2.purs
@@ -1,20 +1,10 @@
-- @shouldFailWith ScopeConflict
-module A where
-
- thing :: Int
- thing = 1
-
-module B where
-
- thing :: Int
- thing = 2
-
module Main where
- import A (thing)
- import B (thing)
+import A (thing)
+import B (thing)
- -- Error due to referencing `thing` which is explicitly in scope as A.thing
- -- and B.thing
- what :: Int
- what = thing
+-- Error due to referencing `thing` which is explicitly in scope as A.thing
+-- and B.thing
+what :: Int
+what = thing
diff --git a/examples/failing/ConflictingImports2/A.purs b/examples/failing/ConflictingImports2/A.purs
new file mode 100644
index 0000000..302b032
--- /dev/null
+++ b/examples/failing/ConflictingImports2/A.purs
@@ -0,0 +1,4 @@
+module A where
+
+thing :: Int
+thing = 1
diff --git a/examples/failing/ConflictingImports2/B.purs b/examples/failing/ConflictingImports2/B.purs
new file mode 100644
index 0000000..076bf7e
--- /dev/null
+++ b/examples/failing/ConflictingImports2/B.purs
@@ -0,0 +1,4 @@
+module B where
+
+thing :: Int
+thing = 2
diff --git a/examples/failing/ConflictingQualifiedImports.purs b/examples/failing/ConflictingQualifiedImports.purs
index a85aa60..9089cae 100644
--- a/examples/failing/ConflictingQualifiedImports.purs
+++ b/examples/failing/ConflictingQualifiedImports.purs
@@ -1,17 +1,7 @@
-- @shouldFailWith ScopeConflict
-module A where
-
- thing :: Int
- thing = 1
-
-module B where
-
- thing :: Int
- thing = 2
-
module Main where
- import A as X
- import B as X
+import A as X
+import B as X
- foo = X.thing
+foo = X.thing
diff --git a/examples/failing/ConflictingQualifiedImports/A.purs b/examples/failing/ConflictingQualifiedImports/A.purs
new file mode 100644
index 0000000..302b032
--- /dev/null
+++ b/examples/failing/ConflictingQualifiedImports/A.purs
@@ -0,0 +1,4 @@
+module A where
+
+thing :: Int
+thing = 1
diff --git a/examples/failing/ConflictingQualifiedImports/B.purs b/examples/failing/ConflictingQualifiedImports/B.purs
new file mode 100644
index 0000000..076bf7e
--- /dev/null
+++ b/examples/failing/ConflictingQualifiedImports/B.purs
@@ -0,0 +1,4 @@
+module B where
+
+thing :: Int
+thing = 2
diff --git a/examples/failing/ConflictingQualifiedImports2.purs b/examples/failing/ConflictingQualifiedImports2.purs
index fd5efa5..11b150e 100644
--- a/examples/failing/ConflictingQualifiedImports2.purs
+++ b/examples/failing/ConflictingQualifiedImports2.purs
@@ -1,15 +1,5 @@
-- @shouldFailWith ScopeConflict
-module A where
-
- thing :: Int
- thing = 1
-
-module B where
-
- thing :: Int
- thing = 2
-
module Main (module X) where
- import A as X
- import B as X
+import A as X
+import B as X
diff --git a/examples/failing/ConflictingQualifiedImports2/A.purs b/examples/failing/ConflictingQualifiedImports2/A.purs
new file mode 100644
index 0000000..302b032
--- /dev/null
+++ b/examples/failing/ConflictingQualifiedImports2/A.purs
@@ -0,0 +1,4 @@
+module A where
+
+thing :: Int
+thing = 1
diff --git a/examples/failing/ConflictingQualifiedImports2/B.purs b/examples/failing/ConflictingQualifiedImports2/B.purs
new file mode 100644
index 0000000..076bf7e
--- /dev/null
+++ b/examples/failing/ConflictingQualifiedImports2/B.purs
@@ -0,0 +1,4 @@
+module B where
+
+thing :: Int
+thing = 2
diff --git a/examples/failing/DeclConflictClassCtor.purs b/examples/failing/DeclConflictClassCtor.purs
new file mode 100644
index 0000000..28e5a6e
--- /dev/null
+++ b/examples/failing/DeclConflictClassCtor.purs
@@ -0,0 +1,6 @@
+-- @shouldFailWith DeclConflict
+module Main where
+
+data T = Fail
+
+class Fail
diff --git a/examples/failing/DeclConflictClassSynonym.purs b/examples/failing/DeclConflictClassSynonym.purs
new file mode 100644
index 0000000..319fa44
--- /dev/null
+++ b/examples/failing/DeclConflictClassSynonym.purs
@@ -0,0 +1,8 @@
+-- @shouldFailWith DeclConflict
+module Main where
+
+import Prelude
+
+type Fail = Unit
+
+class Fail
diff --git a/examples/failing/DeclConflictClassType.purs b/examples/failing/DeclConflictClassType.purs
new file mode 100644
index 0000000..322265c
--- /dev/null
+++ b/examples/failing/DeclConflictClassType.purs
@@ -0,0 +1,6 @@
+-- @shouldFailWith DeclConflict
+module Main where
+
+class Fail
+
+data Fail
diff --git a/examples/failing/DeclConflictCtorClass.purs b/examples/failing/DeclConflictCtorClass.purs
new file mode 100644
index 0000000..03c052c
--- /dev/null
+++ b/examples/failing/DeclConflictCtorClass.purs
@@ -0,0 +1,6 @@
+-- @shouldFailWith DeclConflict
+module Main where
+
+class Fail
+
+data T = Fail
diff --git a/examples/failing/DeclConflictCtorCtor.purs b/examples/failing/DeclConflictCtorCtor.purs
new file mode 100644
index 0000000..a99d8e9
--- /dev/null
+++ b/examples/failing/DeclConflictCtorCtor.purs
@@ -0,0 +1,6 @@
+-- @shouldFailWith DeclConflict
+module Main where
+
+data T1 = Fail
+
+data T2 = Fail
diff --git a/examples/failing/DeclConflictSynonymClass.purs b/examples/failing/DeclConflictSynonymClass.purs
new file mode 100644
index 0000000..6524dc0
--- /dev/null
+++ b/examples/failing/DeclConflictSynonymClass.purs
@@ -0,0 +1,8 @@
+-- @shouldFailWith DeclConflict
+module Main where
+
+import Prelude
+
+class Fail
+
+type Fail = Unit
diff --git a/examples/failing/DeclConflictSynonymType.purs b/examples/failing/DeclConflictSynonymType.purs
new file mode 100644
index 0000000..f9a6f4d
--- /dev/null
+++ b/examples/failing/DeclConflictSynonymType.purs
@@ -0,0 +1,8 @@
+-- @shouldFailWith DeclConflict
+module Main where
+
+import Prelude
+
+data Fail
+
+type Fail = Unit
diff --git a/examples/failing/DeclConflictTypeClass.purs b/examples/failing/DeclConflictTypeClass.purs
new file mode 100644
index 0000000..322265c
--- /dev/null
+++ b/examples/failing/DeclConflictTypeClass.purs
@@ -0,0 +1,6 @@
+-- @shouldFailWith DeclConflict
+module Main where
+
+class Fail
+
+data Fail
diff --git a/examples/failing/DeclConflictTypeSynonym.purs b/examples/failing/DeclConflictTypeSynonym.purs
new file mode 100644
index 0000000..81a7cae
--- /dev/null
+++ b/examples/failing/DeclConflictTypeSynonym.purs
@@ -0,0 +1,8 @@
+-- @shouldFailWith DeclConflict
+module Main where
+
+import Prelude
+
+type Fail = Unit
+
+data Fail
diff --git a/examples/failing/DeclConflictTypeType.purs b/examples/failing/DeclConflictTypeType.purs
new file mode 100644
index 0000000..2815e84
--- /dev/null
+++ b/examples/failing/DeclConflictTypeType.purs
@@ -0,0 +1,6 @@
+-- @shouldFailWith DeclConflict
+module Main where
+
+data Fail
+
+data Fail
diff --git a/examples/failing/Do.purs b/examples/failing/Do.purs
index 7d648c2..a0140bc 100644
--- a/examples/failing/Do.purs
+++ b/examples/failing/Do.purs
@@ -8,5 +8,5 @@ test1 = do let x = 1
test2 y = do x <- y
-test3 = do return 1
- return 2
+test3 = do pure 1
+ pure 2
diff --git a/examples/failing/ExportConflictClass.purs b/examples/failing/ExportConflictClass.purs
new file mode 100644
index 0000000..fa6e746
--- /dev/null
+++ b/examples/failing/ExportConflictClass.purs
@@ -0,0 +1,5 @@
+-- @shouldFailWith ExportConflict
+module C (module A, module B) where
+
+import A as A
+import B as B
diff --git a/examples/failing/ExportConflictClass/A.purs b/examples/failing/ExportConflictClass/A.purs
new file mode 100644
index 0000000..48354f7
--- /dev/null
+++ b/examples/failing/ExportConflictClass/A.purs
@@ -0,0 +1,3 @@
+module A where
+
+class X
diff --git a/examples/failing/ExportConflictClass/B.purs b/examples/failing/ExportConflictClass/B.purs
new file mode 100644
index 0000000..f9d4b53
--- /dev/null
+++ b/examples/failing/ExportConflictClass/B.purs
@@ -0,0 +1,3 @@
+module B where
+
+class X
diff --git a/examples/failing/ExportConflictCtor.purs b/examples/failing/ExportConflictCtor.purs
new file mode 100644
index 0000000..fa6e746
--- /dev/null
+++ b/examples/failing/ExportConflictCtor.purs
@@ -0,0 +1,5 @@
+-- @shouldFailWith ExportConflict
+module C (module A, module B) where
+
+import A as A
+import B as B
diff --git a/examples/failing/ExportConflictCtor/A.purs b/examples/failing/ExportConflictCtor/A.purs
new file mode 100644
index 0000000..c3fadf0
--- /dev/null
+++ b/examples/failing/ExportConflictCtor/A.purs
@@ -0,0 +1,3 @@
+module A where
+
+data T1 = X
diff --git a/examples/failing/ExportConflictCtor/B.purs b/examples/failing/ExportConflictCtor/B.purs
new file mode 100644
index 0000000..092d2ae
--- /dev/null
+++ b/examples/failing/ExportConflictCtor/B.purs
@@ -0,0 +1,3 @@
+module B where
+
+data T2 = X
diff --git a/examples/failing/ExportConflictType.purs b/examples/failing/ExportConflictType.purs
new file mode 100644
index 0000000..fa6e746
--- /dev/null
+++ b/examples/failing/ExportConflictType.purs
@@ -0,0 +1,5 @@
+-- @shouldFailWith ExportConflict
+module C (module A, module B) where
+
+import A as A
+import B as B
diff --git a/examples/failing/ExportConflictType/A.purs b/examples/failing/ExportConflictType/A.purs
new file mode 100644
index 0000000..6530830
--- /dev/null
+++ b/examples/failing/ExportConflictType/A.purs
@@ -0,0 +1,3 @@
+module A where
+
+data T
diff --git a/examples/failing/ExportConflictType/B.purs b/examples/failing/ExportConflictType/B.purs
new file mode 100644
index 0000000..9d77277
--- /dev/null
+++ b/examples/failing/ExportConflictType/B.purs
@@ -0,0 +1,3 @@
+module B where
+
+data T
diff --git a/examples/failing/ExportConflictTypeOp.purs b/examples/failing/ExportConflictTypeOp.purs
new file mode 100644
index 0000000..fa6e746
--- /dev/null
+++ b/examples/failing/ExportConflictTypeOp.purs
@@ -0,0 +1,5 @@
+-- @shouldFailWith ExportConflict
+module C (module A, module B) where
+
+import A as A
+import B as B
diff --git a/examples/failing/ExportConflictTypeOp/A.purs b/examples/failing/ExportConflictTypeOp/A.purs
new file mode 100644
index 0000000..b0cb6dd
--- /dev/null
+++ b/examples/failing/ExportConflictTypeOp/A.purs
@@ -0,0 +1,5 @@
+module A where
+
+type T1 a b = a -> b
+
+infixr 4 type T1 as ??
diff --git a/examples/failing/ExportConflictTypeOp/B.purs b/examples/failing/ExportConflictTypeOp/B.purs
new file mode 100644
index 0000000..3e3338d
--- /dev/null
+++ b/examples/failing/ExportConflictTypeOp/B.purs
@@ -0,0 +1,5 @@
+module B where
+
+type T2 a b = a -> b
+
+infixr 4 type T2 as ??
diff --git a/examples/failing/ExportConflictValue.purs b/examples/failing/ExportConflictValue.purs
new file mode 100644
index 0000000..fa6e746
--- /dev/null
+++ b/examples/failing/ExportConflictValue.purs
@@ -0,0 +1,5 @@
+-- @shouldFailWith ExportConflict
+module C (module A, module B) where
+
+import A as A
+import B as B
diff --git a/examples/failing/ExportConflictValue/A.purs b/examples/failing/ExportConflictValue/A.purs
new file mode 100644
index 0000000..48a3687
--- /dev/null
+++ b/examples/failing/ExportConflictValue/A.purs
@@ -0,0 +1,4 @@
+module A where
+
+x :: Boolean
+x = true
diff --git a/examples/failing/ExportConflictValue/B.purs b/examples/failing/ExportConflictValue/B.purs
new file mode 100644
index 0000000..b5f75b0
--- /dev/null
+++ b/examples/failing/ExportConflictValue/B.purs
@@ -0,0 +1,4 @@
+module B where
+
+x :: Boolean
+x = false
diff --git a/examples/failing/ExportConflictValueOp.purs b/examples/failing/ExportConflictValueOp.purs
new file mode 100644
index 0000000..fa6e746
--- /dev/null
+++ b/examples/failing/ExportConflictValueOp.purs
@@ -0,0 +1,5 @@
+-- @shouldFailWith ExportConflict
+module C (module A, module B) where
+
+import A as A
+import B as B
diff --git a/examples/failing/ExportConflictValueOp/A.purs b/examples/failing/ExportConflictValueOp/A.purs
new file mode 100644
index 0000000..3c78f2a
--- /dev/null
+++ b/examples/failing/ExportConflictValueOp/A.purs
@@ -0,0 +1,6 @@
+module A where
+
+f1 :: forall a b. a -> b -> a
+f1 x _ = x
+
+infix 0 f1 as !!
diff --git a/examples/failing/ExportConflictValueOp/B.purs b/examples/failing/ExportConflictValueOp/B.purs
new file mode 100644
index 0000000..8447dd3
--- /dev/null
+++ b/examples/failing/ExportConflictValueOp/B.purs
@@ -0,0 +1,6 @@
+module B where
+
+f2 :: forall a b. a -> b -> a
+f2 x _ = x
+
+infix 0 f2 as !!
diff --git a/examples/failing/ExportExplicit.purs b/examples/failing/ExportExplicit.purs
new file mode 100644
index 0000000..20bdf00
--- /dev/null
+++ b/examples/failing/ExportExplicit.purs
@@ -0,0 +1,8 @@
+-- @shouldFailWith UnknownExport
+-- should fail as z does not exist in the module
+module M1 (x, y, z) where
+
+import Prelude
+
+x = 1
+y = 2
diff --git a/examples/failing/ExportExplicit1.purs b/examples/failing/ExportExplicit1.purs
new file mode 100644
index 0000000..f99e824
--- /dev/null
+++ b/examples/failing/ExportExplicit1.purs
@@ -0,0 +1,12 @@
+-- @shouldFailWith UnknownName
+module Main where
+
+import M1
+import Control.Monad.Eff.Console (log)
+
+testX = X
+
+-- should fail as Y constructor is not exported from M1
+testY = Y
+
+main = log "Done"
diff --git a/examples/failing/ExportExplicit1/M1.purs b/examples/failing/ExportExplicit1/M1.purs
new file mode 100644
index 0000000..9bc4f16
--- /dev/null
+++ b/examples/failing/ExportExplicit1/M1.purs
@@ -0,0 +1,3 @@
+module M1 (X(X)) where
+
+data X = X | Y
diff --git a/examples/failing/ExportExplicit2.purs b/examples/failing/ExportExplicit2.purs
new file mode 100644
index 0000000..e105bff
--- /dev/null
+++ b/examples/failing/ExportExplicit2.purs
@@ -0,0 +1,8 @@
+-- @shouldFailWith UnknownExportDataConstructor
+-- should fail as Y is not a data constructor for X
+module M1 (X(Y)) where
+
+import Prelude
+
+data X = X
+data Y = Y
diff --git a/examples/failing/ExportExplicit3.purs b/examples/failing/ExportExplicit3.purs
new file mode 100644
index 0000000..e4cbe54
--- /dev/null
+++ b/examples/failing/ExportExplicit3.purs
@@ -0,0 +1,10 @@
+-- @shouldFailWith UnknownName
+module Main where
+
+import M1 as M
+import Control.Monad.Eff.Console (log)
+
+-- should fail as Z is not exported from M1
+testZ = M.Z
+
+main = log "Done"
diff --git a/examples/failing/ExportExplicit3/M1.purs b/examples/failing/ExportExplicit3/M1.purs
new file mode 100644
index 0000000..32dd667
--- /dev/null
+++ b/examples/failing/ExportExplicit3/M1.purs
@@ -0,0 +1,4 @@
+module M1 (X(..)) where
+
+data X = X | Y
+data Z = Z
diff --git a/examples/failing/ImportExplicit.purs b/examples/failing/ImportExplicit.purs
new file mode 100644
index 0000000..d42df77
--- /dev/null
+++ b/examples/failing/ImportExplicit.purs
@@ -0,0 +1,4 @@
+-- @shouldFailWith UnknownImport
+module Main where
+
+import M1 (X(..))
diff --git a/examples/failing/ImportExplicit/M1.purs b/examples/failing/ImportExplicit/M1.purs
new file mode 100644
index 0000000..f3155b8
--- /dev/null
+++ b/examples/failing/ImportExplicit/M1.purs
@@ -0,0 +1,3 @@
+module M1 where
+
+foo = "foo"
diff --git a/examples/failing/ImportExplicit2.purs b/examples/failing/ImportExplicit2.purs
new file mode 100644
index 0000000..e1b43c6
--- /dev/null
+++ b/examples/failing/ImportExplicit2.purs
@@ -0,0 +1,4 @@
+-- @shouldFailWith UnknownImportDataConstructor
+module Main where
+
+import M1 (X(Z, Q))
diff --git a/examples/failing/ImportExplicit2/M1.purs b/examples/failing/ImportExplicit2/M1.purs
new file mode 100644
index 0000000..35fd17c
--- /dev/null
+++ b/examples/failing/ImportExplicit2/M1.purs
@@ -0,0 +1,3 @@
+module M1 where
+
+data X = Y
diff --git a/examples/failing/ImportHidingModule.purs b/examples/failing/ImportHidingModule.purs
index 4d91014..5fa1025 100644
--- a/examples/failing/ImportHidingModule.purs
+++ b/examples/failing/ImportHidingModule.purs
@@ -1,10 +1,4 @@
--- @shouldFailWith ImportHidingModule
-module A where
- x = 1
-
-module B (module B, module A) where
- import A
- y = 1
-
-module C where
- import B hiding (module A)
+-- @shouldFailWith ImportHidingModule
+module Main where
+
+import B hiding (module A)
diff --git a/examples/failing/ImportHidingModule/A.purs b/examples/failing/ImportHidingModule/A.purs
new file mode 100644
index 0000000..e741925
--- /dev/null
+++ b/examples/failing/ImportHidingModule/A.purs
@@ -0,0 +1,2 @@
+module A where
+x = 1
diff --git a/examples/failing/ImportHidingModule/B.purs b/examples/failing/ImportHidingModule/B.purs
new file mode 100644
index 0000000..e714878
--- /dev/null
+++ b/examples/failing/ImportHidingModule/B.purs
@@ -0,0 +1,3 @@
+module B (module B, module A) where
+import A
+y = 1
diff --git a/examples/failing/ImportModule.purs b/examples/failing/ImportModule.purs
new file mode 100644
index 0000000..ba3da26
--- /dev/null
+++ b/examples/failing/ImportModule.purs
@@ -0,0 +1,4 @@
+-- @shouldFailWith UnknownName
+module Main where
+
+import M1
diff --git a/examples/failing/ImportModule/M2.purs b/examples/failing/ImportModule/M2.purs
new file mode 100644
index 0000000..c1a472f
--- /dev/null
+++ b/examples/failing/ImportModule/M2.purs
@@ -0,0 +1,3 @@
+module M2 where
+
+data X = X
diff --git a/examples/failing/InstanceExport.purs b/examples/failing/InstanceExport.purs
index f787aff..a87b881 100644
--- a/examples/failing/InstanceExport.purs
+++ b/examples/failing/InstanceExport.purs
@@ -1,19 +1,7 @@
--- @shouldFailWith TransitiveExportError
-module InstanceExport (S(..), f) where
-
-import Prelude
-
-newtype S = S String
-
-class F a where
- f :: a -> String
-
-instance fs :: F S where
- f (S s) = s
-
-module Test where
-
-import InstanceExport
-import Prelude
-
-test = f $ S "Test"
+-- @shouldFailWith TransitiveExportError
+module Test where
+
+import InstanceExport
+import Prelude
+
+test = f $ S "Test"
diff --git a/examples/failing/InstanceExport/InstanceExport.purs b/examples/failing/InstanceExport/InstanceExport.purs
new file mode 100644
index 0000000..4770857
--- /dev/null
+++ b/examples/failing/InstanceExport/InstanceExport.purs
@@ -0,0 +1,11 @@
+module InstanceExport (S(..), f) where
+
+import Prelude
+
+newtype S = S String
+
+class F a where
+ f :: a -> String
+
+instance fs :: F S where
+ f (S s) = s
diff --git a/examples/failing/MissingClassMemberExport.purs b/examples/failing/MissingClassMemberExport.purs
index cb6dec8..11ae9b8 100644
--- a/examples/failing/MissingClassMemberExport.purs
+++ b/examples/failing/MissingClassMemberExport.purs
@@ -1,5 +1,5 @@
-- @shouldFailWith TransitiveExportError
-module Test (Foo) where
+module Test (class Foo) where
import Prelude
diff --git a/examples/failing/MultipleErrors2.purs b/examples/failing/MultipleErrors2.purs
index 31e007c..d85439e 100644
--- a/examples/failing/MultipleErrors2.purs
+++ b/examples/failing/MultipleErrors2.purs
@@ -1,5 +1,5 @@
--- @shouldFailWith UnknownValue
--- @shouldFailWith UnknownValue
+-- @shouldFailWith UnknownName
+-- @shouldFailWith UnknownName
module MultipleErrors2 where
import Prelude
diff --git a/examples/failing/MultipleTypeOpFixities.purs b/examples/failing/MultipleTypeOpFixities.purs
new file mode 100644
index 0000000..b231e54
--- /dev/null
+++ b/examples/failing/MultipleTypeOpFixities.purs
@@ -0,0 +1,9 @@
+-- @shouldFailWith MultipleTypeOpFixities
+module MultipleTypeOpFixities where
+
+import Prelude
+
+type Op x y = Op x y
+
+infix 2 type Op as !?
+infix 2 type Op as !?
diff --git a/examples/failing/MultipleValueOpFixities.purs b/examples/failing/MultipleValueOpFixities.purs
new file mode 100644
index 0000000..ac8bfa9
--- /dev/null
+++ b/examples/failing/MultipleValueOpFixities.purs
@@ -0,0 +1,9 @@
+-- @shouldFailWith MultipleValueOpFixities
+module MultipleValueOpFixities where
+
+import Prelude
+
+add x y = x + y
+
+infix 2 add as !?
+infix 2 add as !?
diff --git a/examples/failing/OrphanInstance.purs b/examples/failing/OrphanInstance.purs
index 878c82a..fa7703d 100644
--- a/examples/failing/OrphanInstance.purs
+++ b/examples/failing/OrphanInstance.purs
@@ -1,12 +1,7 @@
--- @shouldFailWith OrphanInstance
-module Class where
-
- class C a where
- op :: a -> a
-
-module Test where
-
- import Class
-
- instance cBoolean :: C Boolean where
- op a = a
+-- @shouldFailWith OrphanInstance
+module Test where
+
+import Class
+
+instance cBoolean :: C Boolean where
+ op a = a
diff --git a/examples/failing/OrphanInstance/Class.purs b/examples/failing/OrphanInstance/Class.purs
new file mode 100644
index 0000000..6f7d61f
--- /dev/null
+++ b/examples/failing/OrphanInstance/Class.purs
@@ -0,0 +1,4 @@
+module Class where
+
+class C a where
+ op :: a -> a
diff --git a/examples/failing/OrphanTypeDecl.purs b/examples/failing/OrphanTypeDecl.purs
new file mode 100644
index 0000000..b5f1531
--- /dev/null
+++ b/examples/failing/OrphanTypeDecl.purs
@@ -0,0 +1,4 @@
+-- @shouldFailWith OrphanTypeDeclaration
+module OrphanTypeDecl where
+
+fn :: Number -> Boolean
diff --git a/examples/failing/OverlappingReExport.purs b/examples/failing/OverlappingReExport.purs
deleted file mode 100644
index af85a5a..0000000
--- a/examples/failing/OverlappingReExport.purs
+++ /dev/null
@@ -1,10 +0,0 @@
--- @shouldFailWith DuplicateValueExport
-module A where
- x = true
-
-module B where
- x = false
-
-module C (module A, module M2) where
- import A
- import qualified B as M2
diff --git a/examples/failing/ProgrammableTypeErrors.purs b/examples/failing/ProgrammableTypeErrors.purs
new file mode 100644
index 0000000..72d51ef
--- /dev/null
+++ b/examples/failing/ProgrammableTypeErrors.purs
@@ -0,0 +1,16 @@
+-- @shouldFailWith NoInstanceFound
+
+module Main where
+
+import Prelude
+import Control.Monad.Eff (Eff)
+import Control.Monad.Eff.Console (log)
+
+class MyShow a where
+ myShow :: a -> String
+
+instance cannotShowFunctions :: Fail "Cannot show functions" => MyShow (a -> b) where
+ myShow _ = "unreachable"
+
+main :: Eff _ _
+main = log (myShow (_ + 1))
diff --git a/examples/failing/RequiredHiddenType.purs b/examples/failing/RequiredHiddenType.purs
new file mode 100644
index 0000000..a849ab0
--- /dev/null
+++ b/examples/failing/RequiredHiddenType.purs
@@ -0,0 +1,9 @@
+-- @shouldFailWith TransitiveExportError
+-- exporting `a` should fail as `A` is hidden
+module Foo (B(..), a, b) where
+
+data A = A
+data B = B
+
+a = A
+b = B
diff --git a/examples/failing/RowConstructors1.purs b/examples/failing/RowConstructors1.purs
index 64e0b65..533773c 100644
--- a/examples/failing/RowConstructors1.purs
+++ b/examples/failing/RowConstructors1.purs
@@ -1,9 +1,9 @@
-- @shouldFailWith KindsDoNotUnify
module Main where
-import Prelude
+import Control.Monad.Eff.Console (log)
data Foo = Bar
type Baz = { | Foo }
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/failing/RowConstructors2.purs b/examples/failing/RowConstructors2.purs
index dae6a44..1ab8236 100644
--- a/examples/failing/RowConstructors2.purs
+++ b/examples/failing/RowConstructors2.purs
@@ -1,9 +1,9 @@
-- @shouldFailWith KindsDoNotUnify
module Main where
-import Prelude
+import Control.Monad.Eff.Console (log)
type Foo r = (x :: Number | r)
type Bar = { | Foo }
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/failing/RowConstructors3.purs b/examples/failing/RowConstructors3.purs
index 1a04e42..60e3950 100644
--- a/examples/failing/RowConstructors3.purs
+++ b/examples/failing/RowConstructors3.purs
@@ -1,9 +1,9 @@
-- @shouldFailWith KindsDoNotUnify
module Main where
-import Prelude
+import Control.Monad.Eff.Console (log)
type Foo = { x :: Number }
type Bar = { | Foo }
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/failing/SkolemEscape2.purs b/examples/failing/SkolemEscape2.purs
index 6df2afe..38d64cc 100644
--- a/examples/failing/SkolemEscape2.purs
+++ b/examples/failing/SkolemEscape2.purs
@@ -7,4 +7,4 @@ import Control.Monad.ST
test _ = do
r <- runST (newSTRef 0)
- return 0
+ pure 0
diff --git a/examples/failing/SuggestComposition.purs b/examples/failing/SuggestComposition.purs
index b4196c2..4fd84b4 100644
--- a/examples/failing/SuggestComposition.purs
+++ b/examples/failing/SuggestComposition.purs
@@ -4,4 +4,4 @@ module SuggestComposition where
import Prelude
-f = g . g where g = (+1)
+f = g . g where g = (_ + 1)
diff --git a/examples/failing/Superclasses5.purs b/examples/failing/Superclasses5.purs
index b93c5f4..0de8d4b 100644
--- a/examples/failing/Superclasses5.purs
+++ b/examples/failing/Superclasses5.purs
@@ -3,6 +3,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (logShow)
class Su a where
su :: a -> a
@@ -22,4 +23,4 @@ instance clNumber :: Cl Number where
test :: forall a. (Cl a) => a -> Array a
test x = su [cl x x]
-main = Control.Monad.Eff.Console.print $ test 10.0
+main = logShow $ test 10.0
diff --git a/examples/failing/TypeError.purs b/examples/failing/TypeError.purs
index 8e028b3..1c5c980 100644
--- a/examples/failing/TypeError.purs
+++ b/examples/failing/TypeError.purs
@@ -3,4 +3,4 @@ module Main where
import Prelude
-test = 1 ++ "A"
+test = 1 <> "A"
diff --git a/examples/failing/TypedBinders.purs b/examples/failing/TypedBinders.purs
index bbe1ce6..756f275 100644
--- a/examples/failing/TypedBinders.purs
+++ b/examples/failing/TypedBinders.purs
@@ -1,10 +1,10 @@
--- @shouldFailWith ErrorParsingModule
+-- @shouldFailWith ErrorParsingModule
module Main where
-import Prelude
+import Control.Monad.Eff.Console (log)
test = (\f :: Int -> Int -> f 10) id
main = do
let t1 = test
- Control.Monad.Eff.Console.log "Done" \ No newline at end of file
+ log "Done"
diff --git a/examples/failing/TypedBinders2.purs b/examples/failing/TypedBinders2.purs
index 21b5caf..f23c1a1 100644
--- a/examples/failing/TypedBinders2.purs
+++ b/examples/failing/TypedBinders2.purs
@@ -2,8 +2,8 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
main = do
- s :: String <- Control.Monad.Eff.Console.log "Foo"
- Control.Monad.Eff.Console.log "Done"
-
+ s :: String <- log "Foo"
+ log "Done"
diff --git a/examples/failing/TypedBinders3.purs b/examples/failing/TypedBinders3.purs
index 14987bc..8a25264 100644
--- a/examples/failing/TypedBinders3.purs
+++ b/examples/failing/TypedBinders3.purs
@@ -2,6 +2,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
test = case 1 of
(0 :: String) -> true
@@ -9,4 +10,4 @@ test = case 1 of
main = do
let t = test
- Control.Monad.Eff.Console.log "Done"
+ log "Done"
diff --git a/examples/failing/UnderscoreModuleName.purs b/examples/failing/UnderscoreModuleName.purs
index 1514622..a7d3f04 100644
--- a/examples/failing/UnderscoreModuleName.purs
+++ b/examples/failing/UnderscoreModuleName.purs
@@ -1,6 +1,6 @@
-- @shouldFailWith ErrorParsingModule
module Bad_Module where
-import Prelude
+import Control.Monad.Eff.Console (log)
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/failing/UnknownType.purs b/examples/failing/UnknownType.purs
index 0b7645d..d77ccb6 100644
--- a/examples/failing/UnknownType.purs
+++ b/examples/failing/UnknownType.purs
@@ -1,4 +1,4 @@
--- @shouldFailWith UnknownType
+-- @shouldFailWith UnknownName
module Main where
import Prelude
diff --git a/examples/passing/1185.purs b/examples/passing/1185.purs
index eddb589..f4ba728 100644
--- a/examples/passing/1185.purs
+++ b/examples/passing/1185.purs
@@ -1,5 +1,7 @@
module Main where
+import Control.Monad.Eff.Console (log)
+
data Person = Person String Boolean
getName :: Person -> String
@@ -10,4 +12,4 @@ getName p = case p of
name :: String
name = getName (Person "John Smith" true)
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/1335.purs b/examples/passing/1335.purs
index e2a7347..6b31a7f 100644
--- a/examples/passing/1335.purs
+++ b/examples/passing/1335.purs
@@ -1,12 +1,14 @@
-module Main where
-
-import Prelude
-import Control.Monad.Eff.Console (log)
-
-x :: forall a. a -> String
-x a = y "Done"
- where
- y :: forall a. (Show a) => a -> String
- y a = show (a :: a)
-
-main = log (x 0)
+module Main where
+
+import Prelude
+import Control.Monad.Eff.Console (log)
+
+x :: forall a. a -> String
+x a = y "Test"
+ where
+ y :: forall a. (Show a) => a -> String
+ y a = show (a :: a)
+
+main = do
+ log (x 0)
+ log "Done"
diff --git a/examples/passing/1570.purs b/examples/passing/1570.purs
index 258e4e5..1bd0172 100644
--- a/examples/passing/1570.purs
+++ b/examples/passing/1570.purs
@@ -1,6 +1,8 @@
module Main where
+import Control.Monad.Eff.Console (log)
+
test :: forall a. a -> a
test = \(x :: a) -> x
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/1664.purs b/examples/passing/1664.purs
index 40260c7..35a17ed 100644
--- a/examples/passing/1664.purs
+++ b/examples/passing/1664.purs
@@ -11,6 +11,6 @@ newtype IdentityEff e a = IdentityEff (Eff e (Identity a))
test :: forall e a. IdentityEff e a -> IdentityEff e Unit
test (IdentityEff action) = IdentityEff $ do
(Identity x :: Identity _) <- action
- return $ Identity unit
+ pure $ Identity unit
main = log "Done"
diff --git a/examples/passing/1697.purs b/examples/passing/1697.purs
index 44f4289..4c9570b 100644
--- a/examples/passing/1697.purs
+++ b/examples/passing/1697.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
_2 :: forall a. a -> a
_2 a = a
@@ -21,4 +22,4 @@ wtf = do
let tmp = _2 1
pure unit
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/1881.purs b/examples/passing/1881.purs
new file mode 100644
index 0000000..b4351cb
--- /dev/null
+++ b/examples/passing/1881.purs
@@ -0,0 +1,19 @@
+module Main where
+
+import Control.Monad.Eff.Console (log)
+
+foo =
+ 1
+
+bar
+ = 2
+
+baz
+ =
+ 3
+
+qux
+ =
+ 3
+
+main = log "Done"
diff --git a/examples/passing/1991.purs b/examples/passing/1991.purs
index 96738fa..c0f5ff2 100644
--- a/examples/passing/1991.purs
+++ b/examples/passing/1991.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
singleton :: forall a. a -> Array a
singleton x = [x]
@@ -10,11 +11,12 @@ empty = []
foldMap :: forall a m. (Semigroup m) => (a -> m) -> Array a -> m
foldMap f [a, b, c, d, e] = f a <> f b <> f c <> f d <> f e
+foldMap f xs = foldMap f xs -- spin, not used
regression :: Array Int
regression =
let as = [1,2,3,4,5]
as' = foldMap (\x -> if 1 < x && x < 4 then singleton x else empty) as
in as'
-
-main = Control.Monad.Eff.Console.log "Done"
+
+main = log "Done"
diff --git a/examples/passing/2018.purs b/examples/passing/2018.purs
index 2a0eef6..e09f482 100644
--- a/examples/passing/2018.purs
+++ b/examples/passing/2018.purs
@@ -1,15 +1,3 @@
-module B where
-
- data Foo = X | Y
-
-module A where
-
- import B as Main
-
- -- Prior to the 2018 fix this would be detected as a cycle between A and Main.
- foo ∷ Main.Foo → Main.Foo
- foo x = x
-
module Main where
import Prelude
@@ -22,4 +10,3 @@ main :: forall e. Eff (console :: CONSOLE | e) Unit
main = do
let tmp = foo X
log "Done"
-
diff --git a/examples/passing/2018/A.purs b/examples/passing/2018/A.purs
new file mode 100644
index 0000000..bff4cd0
--- /dev/null
+++ b/examples/passing/2018/A.purs
@@ -0,0 +1,7 @@
+module A where
+
+import B as Main
+
+-- Prior to the 2018 fix this would be detected as a cycle between A and Main.
+foo ∷ Main.Foo → Main.Foo
+foo x = x
diff --git a/examples/passing/2018/B.purs b/examples/passing/2018/B.purs
new file mode 100644
index 0000000..c87647d
--- /dev/null
+++ b/examples/passing/2018/B.purs
@@ -0,0 +1,3 @@
+module B where
+
+data Foo = X | Y
diff --git a/examples/passing/2049.purs b/examples/passing/2049.purs
new file mode 100644
index 0000000..2e44907
--- /dev/null
+++ b/examples/passing/2049.purs
@@ -0,0 +1,14 @@
+module Main where
+
+import Prelude
+import Control.Monad.Eff.Console (log)
+
+data List a = Cons a (List a) | Nil
+
+infixr 6 Cons as :
+
+f :: List { x :: Int, y :: Int } -> Int
+f ( r@{ x } : _) = x + r.y
+f _ = 0
+
+main = log "Done"
diff --git a/examples/passing/2138.purs b/examples/passing/2138.purs
new file mode 100644
index 0000000..1c05373
--- /dev/null
+++ b/examples/passing/2138.purs
@@ -0,0 +1,7 @@
+module Main where
+
+import Control.Monad.Eff.Console (log)
+
+import Lib (A(B,C))
+
+main = log "Done"
diff --git a/examples/passing/2138/Lib.purs b/examples/passing/2138/Lib.purs
new file mode 100644
index 0000000..3c433e0
--- /dev/null
+++ b/examples/passing/2138/Lib.purs
@@ -0,0 +1,3 @@
+module Lib (A(..), A) where
+
+data A = B | C
diff --git a/examples/passing/2172.js b/examples/passing/2172.js
new file mode 100644
index 0000000..34d232e
--- /dev/null
+++ b/examples/passing/2172.js
@@ -0,0 +1,5 @@
+exports['a\''] = 0;
+exports["\x62\x27"] = 1;
+// NOTE: I wanted to use "\c'" here, but langauge-javascript doesn't support it...
+exports["c'"] = 2;
+exports["\u0064\u0027"] = 3;
diff --git a/examples/passing/2172.purs b/examples/passing/2172.purs
new file mode 100644
index 0000000..087301e
--- /dev/null
+++ b/examples/passing/2172.purs
@@ -0,0 +1,10 @@
+module Main where
+
+import Control.Monad.Eff.Console (log)
+
+foreign import a' :: Number
+foreign import b' :: Number
+foreign import c' :: Number
+foreign import d' :: Number
+
+main = log "Done"
diff --git a/examples/passing/652.purs b/examples/passing/652.purs
index 43e49ad..79995a7 100644
--- a/examples/passing/652.purs
+++ b/examples/passing/652.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
class Foo a b
@@ -14,4 +15,4 @@ instance bar :: Bar (a -> b) b
instance baz :: (Eq a) => Baz (a -> b) a b
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/810.purs b/examples/passing/810.purs
index 256d2c6..4e32d10 100644
--- a/examples/passing/810.purs
+++ b/examples/passing/810.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
data Maybe a = Nothing | Just a
@@ -10,4 +11,4 @@ test m = o.x
o = case m of Nothing -> { x : Nothing }
Just a -> { x : Just a }
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/Applicative.purs b/examples/passing/Applicative.purs
index fa47117..d78e2aa 100644
--- a/examples/passing/Applicative.purs
+++ b/examples/passing/Applicative.purs
@@ -1,6 +1,6 @@
module Main where
-import Prelude ()
+import Control.Monad.Eff.Console (log)
class Applicative f where
pure :: forall a. a -> f a
@@ -13,4 +13,4 @@ instance applicativeMaybe :: Applicative Maybe where
apply (Just f) (Just a) = Just (f a)
apply _ _ = Nothing
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/ArrayType.purs b/examples/passing/ArrayType.purs
index 889fcd3..a3530a5 100644
--- a/examples/passing/ArrayType.purs
+++ b/examples/passing/ArrayType.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
class Pointed p where
point :: forall a. a -> p a
@@ -8,4 +9,4 @@ class Pointed p where
instance pointedArray :: Pointed Array where
point a = [a]
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/Auto.purs b/examples/passing/Auto.purs
index c3500eb..34b7858 100644
--- a/examples/passing/Auto.purs
+++ b/examples/passing/Auto.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
data Auto s i o = Auto { state :: s, step :: s -> i -> o }
@@ -12,4 +13,4 @@ exists = \state step f -> f (Auto { state: state, step: step })
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 = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/AutoPrelude.purs b/examples/passing/AutoPrelude.purs
index a69b485..27fa41c 100644
--- a/examples/passing/AutoPrelude.purs
+++ b/examples/passing/AutoPrelude.purs
@@ -1,9 +1,11 @@
-module Main where
-
-import Prelude
-import Control.Monad.Eff.Console
-
-f x = x * 10.0
-g y = y - 10.0
-
-main = log $ show $ (f <<< g) 100.0
+module Main where
+
+import Prelude
+import Control.Monad.Eff.Console (log)
+
+f x = x * 10.0
+g y = y - 10.0
+
+main = do
+ log $ show $ (f <<< g) 100.0
+ log "Done"
diff --git a/examples/passing/AutoPrelude2.purs b/examples/passing/AutoPrelude2.purs
index 373c380..4db3aaf 100644
--- a/examples/passing/AutoPrelude2.purs
+++ b/examples/passing/AutoPrelude2.purs
@@ -1,7 +1,7 @@
module Main where
import Prelude
-import qualified Prelude as P
+import Prelude as P
import Control.Monad.Eff.Console
f :: forall a. a -> a
diff --git a/examples/passing/BindersInFunctions.purs b/examples/passing/BindersInFunctions.purs
index d1a504b..ee9c5dd 100644
--- a/examples/passing/BindersInFunctions.purs
+++ b/examples/passing/BindersInFunctions.purs
@@ -1,11 +1,16 @@
module Main where
import Prelude
-import Test.Assert
+import Partial.Unsafe (unsafePartial)
+import Test.Assert (assert')
+import Control.Monad.Eff (Eff)
+import Control.Monad.Eff.Console (log)
+snd :: forall a. Partial => Array a -> a
snd = \[_, y] -> y
+main :: Eff _ _
main = do
- let ts = snd [1.0, 2.0]
+ let ts = unsafePartial (snd [1.0, 2.0])
assert' "Incorrect result from 'snd'." (ts == 2.0)
- Control.Monad.Eff.Console.log "Done"
+ log "Done"
diff --git a/examples/passing/BindingGroups.purs b/examples/passing/BindingGroups.purs
index fb7ceb2..0e112d2 100644
--- a/examples/passing/BindingGroups.purs
+++ b/examples/passing/BindingGroups.purs
@@ -1,10 +1,11 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
foo = bar
where bar r = r + 1.0
r = foo 2.0
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/BlockString.purs b/examples/passing/BlockString.purs
index 23f039e..2ffa526 100644
--- a/examples/passing/BlockString.purs
+++ b/examples/passing/BlockString.purs
@@ -1,8 +1,9 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
foo :: String
foo = """foo"""
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/CaseInDo.purs b/examples/passing/CaseInDo.purs
index 574b694..48716f4 100644
--- a/examples/passing/CaseInDo.purs
+++ b/examples/passing/CaseInDo.purs
@@ -1,19 +1,21 @@
module Main where
import Prelude
+import Partial.Unsafe (unsafeCrashWith)
import Control.Monad.Eff.Console
import Control.Monad.Eff
doIt :: forall eff. Eff eff Boolean
-doIt = return true
+doIt = pure true
set = do
log "Testing..."
case 0 of
0 -> doIt
- _ -> return false
+ _ -> pure false
main = do
b <- set
case b of
true -> log "Done"
+ false -> unsafeCrashWith "Failed"
diff --git a/examples/passing/CaseMultipleExpressions.purs b/examples/passing/CaseMultipleExpressions.purs
index 763a425..d434e56 100644
--- a/examples/passing/CaseMultipleExpressions.purs
+++ b/examples/passing/CaseMultipleExpressions.purs
@@ -1,19 +1,21 @@
module Main where
import Prelude
+import Partial.Unsafe (unsafeCrashWith)
import Control.Monad.Eff.Console
import Control.Monad.Eff
doIt :: forall eff. Eff eff Boolean
-doIt = return true
+doIt = pure true
set = do
log "Testing..."
case 42, 10 of
42, 10 -> doIt
- _ , _ -> return false
+ _ , _ -> pure false
main = do
b <- set
case b of
true -> log "Done"
+ false -> unsafeCrashWith "Failed"
diff --git a/examples/passing/CaseStatement.purs b/examples/passing/CaseStatement.purs
index 6ed9346..324282d 100644
--- a/examples/passing/CaseStatement.purs
+++ b/examples/passing/CaseStatement.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
data A = A | B | C
@@ -18,4 +19,4 @@ h f N a = a
h f a N = a
h f (J a) (J b) = J (f a b)
-main = Control.Monad.Eff.Console.log $ f "Done" "Failed" A
+main = log $ f "Done" "Failed" A
diff --git a/examples/passing/CheckFunction.purs b/examples/passing/CheckFunction.purs
index 187c577..cde7d4b 100644
--- a/examples/passing/CheckFunction.purs
+++ b/examples/passing/CheckFunction.purs
@@ -1,7 +1,8 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
test = ((\x -> x+1.0) >>> (\x -> x*2.0)) 4.0
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/CheckSynonymBug.purs b/examples/passing/CheckSynonymBug.purs
index 3f565c2..cd06f63 100644
--- a/examples/passing/CheckSynonymBug.purs
+++ b/examples/passing/CheckSynonymBug.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
length :: forall a. Array a -> Int
length _ = 0
@@ -9,4 +10,4 @@ type Foo a = Array a
foo _ = length ([] :: Foo Number)
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/CheckTypeClass.purs b/examples/passing/CheckTypeClass.purs
index 81e86a1..c26b2d0 100644
--- a/examples/passing/CheckTypeClass.purs
+++ b/examples/passing/CheckTypeClass.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
data Bar a = Bar
data Baz
@@ -14,5 +15,4 @@ foo_ x = foo ((mkBar :: forall a. (Foo a) => a -> Bar a) x)
mkBar :: forall a. a -> Bar a
mkBar _ = Bar
-main = Control.Monad.Eff.Console.log "Done"
-
+main = log "Done"
diff --git a/examples/passing/Church.purs b/examples/passing/Church.purs
index fd9cde8..3745805 100644
--- a/examples/passing/Church.purs
+++ b/examples/passing/Church.purs
@@ -1,6 +1,6 @@
module Main where
-import Prelude ()
+import Control.Monad.Eff.Console (log)
type List a = forall r. r -> (a -> r -> r) -> r
@@ -15,4 +15,4 @@ append = \l1 l2 r f -> l2 (l1 r f) f
test = append (cons 1 empty) (cons 2 empty)
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/ClassRefSyntax.purs b/examples/passing/ClassRefSyntax.purs
index b4a187d..8601125 100644
--- a/examples/passing/ClassRefSyntax.purs
+++ b/examples/passing/ClassRefSyntax.purs
@@ -1,13 +1,9 @@
-module Lib (class X, go) where
-
- class X a where
- go :: a -> a
-
module Main where
- import Lib (class X, go)
+import Lib (class X, go)
+import Control.Monad.Eff.Console (log)
- go' :: forall a. (X a) => a -> a
- go' = go
+go' :: forall a. (X a) => a -> a
+go' = go
- main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/ClassRefSyntax/Lib.purs b/examples/passing/ClassRefSyntax/Lib.purs
new file mode 100644
index 0000000..345491f
--- /dev/null
+++ b/examples/passing/ClassRefSyntax/Lib.purs
@@ -0,0 +1,4 @@
+module Lib (class X, go) where
+
+class X a where
+ go :: a -> a
diff --git a/examples/passing/Collatz.purs b/examples/passing/Collatz.purs
index 80a3d1e..6cdb363 100644
--- a/examples/passing/Collatz.purs
+++ b/examples/passing/Collatz.purs
@@ -3,6 +3,7 @@ module Main where
import Prelude
import Control.Monad.Eff
import Control.Monad.ST
+import Control.Monad.Eff.Console (log, logShow)
collatz :: Int -> Int
collatz n = runPure (runST (do
@@ -12,7 +13,9 @@ collatz n = runPure (runST (do
modifySTRef count $ (+) 1
m <- readSTRef r
writeSTRef r $ if m `mod` 2 == 0 then m / 2 else 3 * m + 1
- return $ m == 1
+ pure $ m == 1
readSTRef count))
-main = Control.Monad.Eff.Console.print $ collatz 1000
+main = do
+ logShow $ collatz 1000
+ log "Done"
diff --git a/examples/passing/Comparisons.purs b/examples/passing/Comparisons.purs
index f98dca0..375098d 100644
--- a/examples/passing/Comparisons.purs
+++ b/examples/passing/Comparisons.purs
@@ -1,15 +1,15 @@
-module Main where
-
-import Prelude
-import Control.Monad.Eff
-import Control.Monad.Eff.Console
-import Test.Assert
-
-main = do
- assert (1.0 < 2.0)
- assert (2.0 == 2.0)
- assert (3.0 > 1.0)
- assert ("a" < "b")
- assert ("a" == "a")
- assert ("z" > "a")
- log "Done!"
+module Main where
+
+import Prelude
+import Control.Monad.Eff
+import Control.Monad.Eff.Console
+import Test.Assert
+
+main = do
+ assert (1.0 < 2.0)
+ assert (2.0 == 2.0)
+ assert (3.0 > 1.0)
+ assert ("a" < "b")
+ assert ("a" == "a")
+ assert ("z" > "a")
+ log "Done"
diff --git a/examples/passing/Conditional.purs b/examples/passing/Conditional.purs
index 303f5a6..a3d2052 100644
--- a/examples/passing/Conditional.purs
+++ b/examples/passing/Conditional.purs
@@ -1,9 +1,9 @@
module Main where
-import Prelude ()
+import Control.Monad.Eff.Console (log)
fns = \f -> if f true then f else \x -> x
not = \x -> if x then false else true
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/Console.purs b/examples/passing/Console.purs
index a828773..2f442ae 100644
--- a/examples/passing/Console.purs
+++ b/examples/passing/Console.purs
@@ -5,9 +5,11 @@ import Control.Monad.Eff
import Control.Monad.Eff.Console
replicateM_ :: forall m a. (Monad m) => Number -> m a -> m {}
-replicateM_ 0.0 _ = return {}
+replicateM_ 0.0 _ = pure {}
replicateM_ n act = do
act
replicateM_ (n - 1.0) act
-main = replicateM_ 10.0 (log "Hello World!")
+main = do
+ replicateM_ 10.0 (log "Hello World!")
+ log "Done"
diff --git a/examples/passing/ConstraintInference.purs b/examples/passing/ConstraintInference.purs
index 1c97c66..05f9a21 100644
--- a/examples/passing/ConstraintInference.purs
+++ b/examples/passing/ConstraintInference.purs
@@ -1,7 +1,10 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
-shout = Control.Monad.Eff.Console.log <<< (<> "!") <<< show
+shout = log <<< (_ <> "!") <<< show
-main = shout "Done"
+main = do
+ shout "Test"
+ log "Done"
diff --git a/examples/passing/ContextSimplification.purs b/examples/passing/ContextSimplification.purs
index 88c5835..349dcfb 100644
--- a/examples/passing/ContextSimplification.purs
+++ b/examples/passing/ContextSimplification.purs
@@ -3,11 +3,13 @@ module Main where
import Prelude
import Control.Monad.Eff.Console
-shout = log <<< (<> "!") <<< show
+shout = log <<< (_ <> "!") <<< show
-- Here, we should simplify the context so that only one Show
-- constraint is added.
usesShowTwice true = shout
-usesShowTwice false = print
+usesShowTwice false = logShow
-main = usesShowTwice true "Done"
+main = do
+ usesShowTwice true "Test"
+ log "Done"
diff --git a/examples/passing/DataAndType.purs b/examples/passing/DataAndType.purs
index 4ce7527..3d35ce1 100644
--- a/examples/passing/DataAndType.purs
+++ b/examples/passing/DataAndType.purs
@@ -1,9 +1,10 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
data A = A B
type B = A
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/DctorOperatorAlias.purs b/examples/passing/DctorOperatorAlias.purs
index 863133d..c07fe95 100644
--- a/examples/passing/DctorOperatorAlias.purs
+++ b/examples/passing/DctorOperatorAlias.purs
@@ -1,17 +1,11 @@
-module Data.List where
-
- data List a = Cons a (List a) | Nil
-
- infixr 6 Cons as :
-
module Main where
import Prelude (Unit, bind, (==))
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Test.Assert (ASSERT, assert')
- import Data.List (List(..), (:))
- import Data.List as L
+ import List (List(..), (:))
+ import List as L
-- unqualified
infixl 6 Cons as !
diff --git a/examples/passing/DctorOperatorAlias/List.purs b/examples/passing/DctorOperatorAlias/List.purs
new file mode 100644
index 0000000..a428343
--- /dev/null
+++ b/examples/passing/DctorOperatorAlias/List.purs
@@ -0,0 +1,5 @@
+module List where
+
+data List a = Cons a (List a) | Nil
+
+infixr 6 Cons as :
diff --git a/examples/passing/DeepArrayBinder.purs b/examples/passing/DeepArrayBinder.purs
index d34bfaa..399b2a4 100644
--- a/examples/passing/DeepArrayBinder.purs
+++ b/examples/passing/DeepArrayBinder.purs
@@ -2,6 +2,7 @@ module Main where
import Prelude
import Control.Monad.Eff
+import Control.Monad.Eff.Console (log)
import Test.Assert
data List a = Cons a (List a) | Nil
@@ -13,4 +14,4 @@ match2 _ = 0.0
main = do
let result = match2 (Cons 1.0 (Cons 2.0 (Cons 3.0 (Cons 4.0 (Cons 5.0 (Cons 6.0 (Cons 7.0 (Cons 8.0 (Cons 9.0 Nil)))))))))
assert' "Incorrect result!" (result == 100.0)
- Control.Monad.Eff.Console.log "Done"
+ log "Done"
diff --git a/examples/passing/DeepCase.purs b/examples/passing/DeepCase.purs
index dce5f23..e19f0e8 100644
--- a/examples/passing/DeepCase.purs
+++ b/examples/passing/DeepCase.purs
@@ -1,9 +1,7 @@
module Main where
import Prelude
-import Control.Monad.Eff.Console
-import Control.Monad.Eff
-import Control.Monad.ST
+import Control.Monad.Eff.Console (log, logShow)
f x y =
let
@@ -12,4 +10,6 @@ f x y =
x -> 1.0 + x * x
in g + x + y
-main = print $ f 1.0 10.0
+main = do
+ logShow $ f 1.0 10.0
+ log "Done"
diff --git a/examples/passing/Deriving.purs b/examples/passing/Deriving.purs
index fb1b65e..2609cf3 100644
--- a/examples/passing/Deriving.purs
+++ b/examples/passing/Deriving.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
import Test.Assert
data V
@@ -27,5 +28,7 @@ main = do
assert $ X 0 < X 1
assert $ X 0 < Y "Foo"
assert $ Y "Bar" < Y "Baz"
- assert $ z == z where
- z = Z { left: X 0, right: Y "Foo" }
+ assert $ z == z
+ log "Done"
+ where
+ z = Z { left: X 0, right: Y "Foo" }
diff --git a/examples/passing/Do.purs b/examples/passing/Do.purs
index 08c559d..3cfa9e4 100644
--- a/examples/passing/Do.purs
+++ b/examples/passing/Do.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
data Maybe a = Nothing | Just a
@@ -19,7 +20,7 @@ instance bindMaybe :: Bind Maybe where
bind Nothing _ = Nothing
bind (Just a) f = f a
-instance monadMaybe :: Prelude.Monad Maybe
+instance monadMaybe :: Monad Maybe
test1 = \_ -> do
Just "abc"
@@ -64,4 +65,4 @@ test10 _ = do
g x = f x / 2.0
Just (f 10.0)
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/Dollar.purs b/examples/passing/Dollar.purs
index 88be68f..3c0d4d4 100644
--- a/examples/passing/Dollar.purs
+++ b/examples/passing/Dollar.purs
@@ -1,11 +1,11 @@
module Main where
-import Prelude ()
+import Control.Monad.Eff.Console (log)
-($) :: forall a b. (a -> b) -> a -> b
-($) f x = f x
+applyFn :: forall a b. (a -> b) -> a -> b
+applyFn f x = f x
-infixr 1000 $
+infixr 1000 applyFn as $
id x = x
@@ -13,4 +13,4 @@ test1 x = id $ id $ id $ id $ x
test2 x = id id $ id x
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/Eff.purs b/examples/passing/Eff.purs
index 3d7c2cd..f0b1ea8 100644
--- a/examples/passing/Eff.purs
+++ b/examples/passing/Eff.purs
@@ -3,7 +3,7 @@ module Main where
import Prelude
import Control.Monad.Eff
import Control.Monad.ST
-import Control.Monad.Eff.Console
+import Control.Monad.Eff.Console (log, logShow)
test1 = do
log "Line 1"
@@ -21,5 +21,6 @@ test3 = pureST (do
main = do
test1
- Control.Monad.Eff.Console.print test2
- Control.Monad.Eff.Console.print test3
+ logShow test2
+ logShow test3
+ log "Done"
diff --git a/examples/passing/EmptyDataDecls.purs b/examples/passing/EmptyDataDecls.purs
index 40d77ee..6c143cd 100644
--- a/examples/passing/EmptyDataDecls.purs
+++ b/examples/passing/EmptyDataDecls.purs
@@ -2,6 +2,7 @@ module Main where
import Prelude
import Test.Assert
+import Control.Monad.Eff.Console (log)
data Z
data S n
@@ -15,5 +16,5 @@ cons' :: forall a n. a -> ArrayBox n a -> ArrayBox (S n) a
cons' x (ArrayBox xs) = ArrayBox $ append [x] xs
main = case cons' 1 $ cons' 2 $ cons' 3 nil of
- ArrayBox [1, 2, 3] -> Control.Monad.Eff.Console.log "Done"
+ ArrayBox [1, 2, 3] -> log "Done"
_ -> assert' "Failed" false
diff --git a/examples/passing/EmptyRow.purs b/examples/passing/EmptyRow.purs
index 9f738fb..b6c0fc2 100644
--- a/examples/passing/EmptyRow.purs
+++ b/examples/passing/EmptyRow.purs
@@ -1,10 +1,11 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
data Foo r = Foo { | r }
test :: Foo ()
test = Foo {}
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/EmptyTypeClass.purs b/examples/passing/EmptyTypeClass.purs
index 065a829..8818049 100644
--- a/examples/passing/EmptyTypeClass.purs
+++ b/examples/passing/EmptyTypeClass.purs
@@ -1,12 +1,11 @@
module Main where
import Prelude
+import Control.Monad.Eff
+import Control.Monad.Eff.Console
-class PartialP
-
-head :: forall a. (PartialP) => Array a -> a
+head :: forall a. Partial => Array a -> a
head [x] = x
-instance allowPartials :: PartialP
-
-main = Control.Monad.Eff.Console.log $ head ["Done"]
+main :: Eff _ _
+main = log "Done"
diff --git a/examples/passing/EqOrd.purs b/examples/passing/EqOrd.purs
index 9ed10b2..3d214a5 100644
--- a/examples/passing/EqOrd.purs
+++ b/examples/passing/EqOrd.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log, logShow)
data Pair a b = Pair a b
@@ -12,4 +13,6 @@ instance ordPair :: (Ord a, Ord b) => Ord (Pair a b) where
instance eqPair :: (Eq a, Eq b) => Eq (Pair a b) where
eq (Pair a1 b1) (Pair a2 b2) = a1 == a2 && b1 == b2
-main = Control.Monad.Eff.Console.print $ Pair 1.0 2.0 == Pair 1.0 2.0
+main = do
+ logShow $ Pair 1.0 2.0 == Pair 1.0 2.0
+ log "Done"
diff --git a/examples/passing/ExplicitImportReExport.purs b/examples/passing/ExplicitImportReExport.purs
index 3c7dd2b..3c01ca8 100644
--- a/examples/passing/ExplicitImportReExport.purs
+++ b/examples/passing/ExplicitImportReExport.purs
@@ -1,16 +1,11 @@
--- from #1244
-module Foo where
-
- foo :: Int
- foo = 3
-
-module Bar (module Foo) where
-
- import Foo
-
-module Baz where
-
- import Bar (foo)
-
- baz :: Int
- baz = foo
+-- from #1244
+module Main where
+
+import Prelude
+import Control.Monad.Eff.Console (log)
+import Bar (foo)
+
+baz :: Int
+baz = foo
+
+main = log "Done"
diff --git a/examples/passing/ExplicitImportReExport/Bar.purs b/examples/passing/ExplicitImportReExport/Bar.purs
new file mode 100644
index 0000000..4b1d3d6
--- /dev/null
+++ b/examples/passing/ExplicitImportReExport/Bar.purs
@@ -0,0 +1,3 @@
+module Bar (module Foo) where
+
+import Foo
diff --git a/examples/passing/ExplicitImportReExport/Foo.purs b/examples/passing/ExplicitImportReExport/Foo.purs
new file mode 100644
index 0000000..69ccbb1
--- /dev/null
+++ b/examples/passing/ExplicitImportReExport/Foo.purs
@@ -0,0 +1,4 @@
+module Foo where
+
+foo :: Int
+foo = 3
diff --git a/examples/passing/ExplicitOperatorSections.purs b/examples/passing/ExplicitOperatorSections.purs
index b8e6fbf..2f3f0be 100644
--- a/examples/passing/ExplicitOperatorSections.purs
+++ b/examples/passing/ExplicitOperatorSections.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
subtractOne :: Int -> Int
subtractOne = (_ - 1)
@@ -11,4 +12,4 @@ addOne = (1 + _)
named :: Int -> Int
named = (_ `sub` 1)
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/ExportExplicit.purs b/examples/passing/ExportExplicit.purs
new file mode 100644
index 0000000..8443d4f
--- /dev/null
+++ b/examples/passing/ExportExplicit.purs
@@ -0,0 +1,10 @@
+module Main where
+
+import M1
+import Control.Monad.Eff.Console (log)
+
+testX = X
+testZ = Z
+testFoo = foo
+
+main = log "Done"
diff --git a/examples/passing/ExportExplicit/M1.purs b/examples/passing/ExportExplicit/M1.purs
new file mode 100644
index 0000000..09d8b4b
--- /dev/null
+++ b/examples/passing/ExportExplicit/M1.purs
@@ -0,0 +1,10 @@
+module M1 (X(X), Z(..), foo) where
+
+data X = X | Y
+data Z = Z
+
+foo :: Int
+foo = 0
+
+bar :: Int
+bar = 1
diff --git a/examples/passing/ExportExplicit2.purs b/examples/passing/ExportExplicit2.purs
new file mode 100644
index 0000000..a8803e5
--- /dev/null
+++ b/examples/passing/ExportExplicit2.purs
@@ -0,0 +1,8 @@
+module Main where
+
+import M1
+import Control.Monad.Eff.Console (log)
+
+testBar = bar
+
+main = log "Done"
diff --git a/examples/passing/ExportExplicit2/M1.purs b/examples/passing/ExportExplicit2/M1.purs
new file mode 100644
index 0000000..16c27e1
--- /dev/null
+++ b/examples/passing/ExportExplicit2/M1.purs
@@ -0,0 +1,7 @@
+module M1 (bar) where
+
+foo :: Int
+foo = 0
+
+bar :: Int
+bar = foo
diff --git a/examples/passing/ExportedInstanceDeclarations.purs b/examples/passing/ExportedInstanceDeclarations.purs
new file mode 100644
index 0000000..ee3dd92
--- /dev/null
+++ b/examples/passing/ExportedInstanceDeclarations.purs
@@ -0,0 +1,45 @@
+-- Tests that instances for non-exported classes / types do not appear in the
+-- result of `exportedDeclarations`.
+module Main
+ ( Const(..)
+ , class Foo
+ , foo
+ , main
+ ) where
+
+import Prelude
+import Control.Monad.Eff.Console (log)
+
+data Const a b = Const a
+
+class Foo a where
+ foo :: a
+
+data NonexportedType = NonexportedType
+
+class NonexportedClass a where
+ notExported :: a
+
+-- There are three places that a nonexported type or type class can occur,
+-- leading an instance to count as non-exported:
+-- * Constraints
+-- * The type class itself
+-- * The instance types
+
+-- Case 1: constraints
+instance nonExportedFoo :: (NonexportedClass a) => Foo a where
+ foo = notExported
+
+-- Another instance of case 1:
+instance nonExportedFoo2 :: (Foo NonexportedType) => Foo (a -> a) where
+ foo = id
+
+-- Case 2: type class
+instance nonExportedNonexportedType :: NonexportedClass (Const Int a) where
+ notExported = Const 0
+
+-- Case 3: instance types
+instance constFoo :: Foo (Const NonexportedType b) where
+ foo = Const NonexportedType
+
+main = log "Done"
diff --git a/examples/passing/ExtendedInfixOperators.purs b/examples/passing/ExtendedInfixOperators.purs
index 276d7d9..34481c0 100644
--- a/examples/passing/ExtendedInfixOperators.purs
+++ b/examples/passing/ExtendedInfixOperators.purs
@@ -1,9 +1,11 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log, logShow)
+import Data.Function (on)
comparing :: forall a b. (Ord b) => (a -> b) -> a -> a -> Ordering
-comparing f = compare `Data.Function.on` f
+comparing f = compare `on` f
null [] = true
null _ = false
@@ -11,4 +13,5 @@ null _ = false
test = [1.0, 2.0, 3.0] `comparing null` [4.0, 5.0, 6.0]
main = do
- Control.Monad.Eff.Console.print test
+ logShow test
+ log "Done"
diff --git a/examples/passing/Fib.purs b/examples/passing/Fib.purs
index bf6d522..83220aa 100644
--- a/examples/passing/Fib.purs
+++ b/examples/passing/Fib.purs
@@ -1,15 +1,18 @@
module Main where
import Prelude
-import Control.Monad.Eff
-import Control.Monad.ST
+import Control.Monad.Eff (whileE)
+import Control.Monad.Eff.Console (log, logShow)
+import Control.Monad.ST (runST, newSTRef, readSTRef, writeSTRef)
-main = runST (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'
- writeSTRef n1 n2'
- Control.Monad.Eff.Console.print n2')
+main = do
+ runST 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'
+ writeSTRef n1 n2'
+ logShow n2'
+ log "Done"
diff --git a/examples/passing/FieldConsPuns.purs b/examples/passing/FieldConsPuns.purs
index 9a775e0..1449ad8 100644
--- a/examples/passing/FieldConsPuns.purs
+++ b/examples/passing/FieldConsPuns.purs
@@ -1,10 +1,13 @@
-module Main where
-
-import Prelude
-import Control.Monad.Eff.Console
-
-greet { greeting, name } = log $ greeting <> ", " <> name <> "."
-
-main = greet { greeting, name} where
- greeting = "Hello"
- name = "World"
+module Main where
+
+import Prelude
+import Control.Monad.Eff.Console (log, logShow)
+
+greet { greeting, name } = log $ greeting <> ", " <> name <> "."
+
+main = do
+ greet { greeting, name }
+ log "Done"
+ where
+ greeting = "Hello"
+ name = "World"
diff --git a/examples/passing/FieldPuns.purs b/examples/passing/FieldPuns.purs
index d30444a..5bd00fc 100644
--- a/examples/passing/FieldPuns.purs
+++ b/examples/passing/FieldPuns.purs
@@ -1,8 +1,10 @@
-module Main where
-
-import Prelude
-import Control.Monad.Eff.Console
-
-greet { greeting, name } = log $ greeting <> ", " <> name <> "."
-
-main = greet { greeting: "Hello", name: "World" }
+module Main where
+
+import Prelude
+import Control.Monad.Eff.Console
+
+greet { greeting, name } = log $ greeting <> ", " <> name <> "."
+
+main = do
+ greet { greeting: "Hello", name: "World" }
+ log "Done"
diff --git a/examples/passing/FinalTagless.purs b/examples/passing/FinalTagless.purs
index 5347153..be7f04b 100644
--- a/examples/passing/FinalTagless.purs
+++ b/examples/passing/FinalTagless.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude hiding (add)
+import Control.Monad.Eff.Console (log, logShow)
class E e where
num :: Number -> e Number
@@ -19,4 +20,6 @@ runId (Id a) = a
three :: Expr Number
three = add (num 1.0) (num 2.0)
-main = Control.Monad.Eff.Console.print $ runId three
+main = do
+ logShow $ runId three
+ log "Done"
diff --git a/examples/passing/FunctionScope.purs b/examples/passing/FunctionScope.purs
index 3506153..3212d44 100644
--- a/examples/passing/FunctionScope.purs
+++ b/examples/passing/FunctionScope.purs
@@ -2,6 +2,7 @@ module Main where
import Prelude
import Test.Assert
+import Control.Monad.Eff.Console (log)
mkValue :: Number -> Number
mkValue id = id
@@ -9,4 +10,4 @@ mkValue id = id
main = do
let value = mkValue 1.0
assert $ value == 1.0
- Control.Monad.Eff.Console.log "Done"
+ log "Done"
diff --git a/examples/passing/Functions.purs b/examples/passing/Functions.purs
index f0e3162..b6da679 100644
--- a/examples/passing/Functions.purs
+++ b/examples/passing/Functions.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
test1 = \_ -> 0.0
@@ -8,8 +9,4 @@ test2 = \a b -> a + b + 1.0
test3 = \a -> a
-test4 = \(%%) -> 1.0 %% 2.0
-
-test5 = \(+++) (***) -> 1.0 +++ 2.0 *** 3.0
-
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/Functions2.purs b/examples/passing/Functions2.purs
index e43d88e..1a658ab 100644
--- a/examples/passing/Functions2.purs
+++ b/examples/passing/Functions2.purs
@@ -2,6 +2,7 @@ module Main where
import Prelude
import Test.Assert
+import Control.Monad.Eff.Console (log)
test :: forall a b. a -> b -> a
test = \const _ -> const
@@ -9,4 +10,4 @@ test = \const _ -> const
main = do
let value = test "Done" {}
assert' "Not done" $ value == "Done"
- Control.Monad.Eff.Console.log "Done"
+ log "Done"
diff --git a/examples/passing/Generalization1.purs b/examples/passing/Generalization1.purs
index a956ab6..e168268 100644
--- a/examples/passing/Generalization1.purs
+++ b/examples/passing/Generalization1.purs
@@ -1,10 +1,11 @@
module Main where
import Prelude
-import Control.Monad.Eff.Console (print)
+import Control.Monad.Eff.Console (logShow, log)
main = do
- print (sum 1.0 2.0)
- print (sum 1 2)
+ logShow (sum 1.0 2.0)
+ logShow (sum 1 2)
+ log "Done"
sum x y = x + y
diff --git a/examples/passing/Guards.purs b/examples/passing/Guards.purs
index 81fdc2e..ddc7678 100644
--- a/examples/passing/Guards.purs
+++ b/examples/passing/Guards.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
collatz = \x -> case x of
y | y `mod` 2.0 == 0.0 -> y / 2.0
@@ -26,4 +27,4 @@ testIndentation x y | x > 0.0
| otherwise
= y - x
-main = Control.Monad.Eff.Console.log $ min "Done" "ZZZZ"
+main = log $ min "Done" "ZZZZ"
diff --git a/examples/passing/IfThenElseMaybe.purs b/examples/passing/IfThenElseMaybe.purs
index 77da023..80c83cc 100644
--- a/examples/passing/IfThenElseMaybe.purs
+++ b/examples/passing/IfThenElseMaybe.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
data Maybe a = Nothing | Just a
@@ -8,4 +9,4 @@ test1 = if true then Just 10 else Nothing
test2 = if true then Nothing else Just 10
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/ImplicitEmptyImport.purs b/examples/passing/ImplicitEmptyImport.purs
index 82261f7..6265490 100644
--- a/examples/passing/ImplicitEmptyImport.purs
+++ b/examples/passing/ImplicitEmptyImport.purs
@@ -1,8 +1,9 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
main = do
- Control.Monad.Eff.Console.log "Hello"
- Control.Monad.Eff.Console.log "Goodbye"
- Control.Monad.Eff.Console.log "Done"
+ log "Hello"
+ log "Goodbye"
+ log "Done"
diff --git a/examples/passing/Import.purs b/examples/passing/Import.purs
new file mode 100644
index 0000000..75c2d14
--- /dev/null
+++ b/examples/passing/Import.purs
@@ -0,0 +1,6 @@
+module Main where
+
+import M2
+import Control.Monad.Eff.Console (log)
+
+main = log "Done"
diff --git a/examples/passing/Import/M1.purs b/examples/passing/Import/M1.purs
new file mode 100644
index 0000000..144ecdb
--- /dev/null
+++ b/examples/passing/Import/M1.purs
@@ -0,0 +1,8 @@
+module M1 where
+
+import Prelude ()
+
+id :: forall a. a -> a
+id = \x -> x
+
+foo = id
diff --git a/examples/passing/Import/M2.purs b/examples/passing/Import/M2.purs
new file mode 100644
index 0000000..eba01c6
--- /dev/null
+++ b/examples/passing/Import/M2.purs
@@ -0,0 +1,6 @@
+module M2 where
+
+import Prelude ()
+import M1
+
+main = \_ -> foo 42
diff --git a/examples/passing/ImportExplicit.purs b/examples/passing/ImportExplicit.purs
new file mode 100644
index 0000000..92d5ee6
--- /dev/null
+++ b/examples/passing/ImportExplicit.purs
@@ -0,0 +1,10 @@
+module Main where
+
+import M1 (X(..))
+import Control.Monad.Eff.Console (log)
+
+testX :: X
+testX = X
+testY = Y
+
+main = log "Done"
diff --git a/examples/passing/ImportExplicit/M1.purs b/examples/passing/ImportExplicit/M1.purs
new file mode 100644
index 0000000..189ba7c
--- /dev/null
+++ b/examples/passing/ImportExplicit/M1.purs
@@ -0,0 +1,4 @@
+module M1 where
+
+data X = X | Y
+data Z = Z
diff --git a/examples/passing/ImportHiding.purs b/examples/passing/ImportHiding.purs
index 4abac7a..8808ea3 100644
--- a/examples/passing/ImportHiding.purs
+++ b/examples/passing/ImportHiding.purs
@@ -3,7 +3,7 @@ module Main where
import Control.Monad.Eff.Console
import Prelude hiding (
show, -- a value
- Show, -- a type class
+ class Show, -- a type class
Unit(..) -- a constructor
)
@@ -15,4 +15,5 @@ class Show a where
data Unit = X | Y
main = do
- print show
+ logShow show
+ log "Done"
diff --git a/examples/passing/ImportQualified.purs b/examples/passing/ImportQualified.purs
new file mode 100644
index 0000000..303f6e1
--- /dev/null
+++ b/examples/passing/ImportQualified.purs
@@ -0,0 +1,8 @@
+module Main where
+
+import Prelude
+import Control.Monad.Eff
+import M1
+import Control.Monad.Eff.Console as C
+
+main = C.log (log "Done")
diff --git a/examples/passing/ImportQualified/M1.purs b/examples/passing/ImportQualified/M1.purs
new file mode 100644
index 0000000..6c423fb
--- /dev/null
+++ b/examples/passing/ImportQualified/M1.purs
@@ -0,0 +1,3 @@
+module M1 where
+
+log x = x
diff --git a/examples/passing/InferRecFunWithConstrainedArgument.purs b/examples/passing/InferRecFunWithConstrainedArgument.purs
index 2a10977..cd78e9b 100644
--- a/examples/passing/InferRecFunWithConstrainedArgument.purs
+++ b/examples/passing/InferRecFunWithConstrainedArgument.purs
@@ -1,8 +1,11 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log, logShow)
-test 100.0 = 100.0
-test n = test(1.0 + n)
+test 100 = 100
+test n = test(1 + n)
-main = Control.Monad.Eff.Console.print $ test 0.0
+main = do
+ logShow (test 0)
+ log "Done"
diff --git a/examples/passing/InstanceBeforeClass.purs b/examples/passing/InstanceBeforeClass.purs
index 80690e9..d187655 100644
--- a/examples/passing/InstanceBeforeClass.purs
+++ b/examples/passing/InstanceBeforeClass.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
instance fooNumber :: Foo Number where
foo = 0.0
@@ -8,4 +9,4 @@ instance fooNumber :: Foo Number where
class Foo a where
foo :: a
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/IntAndChar.purs b/examples/passing/IntAndChar.purs
index aac7edd..366cfcd 100644
--- a/examples/passing/IntAndChar.purs
+++ b/examples/passing/IntAndChar.purs
@@ -2,6 +2,7 @@ module Main where
import Prelude
import Control.Monad.Eff
+import Control.Monad.Eff.Console (log)
import Test.Assert
f 1 = 1
@@ -15,4 +16,4 @@ main = do
assert $ f 0 == 0
assert $ g 'a' == 'a'
assert $ g 'b' == 'b'
- Control.Monad.Eff.Console.log "Done"
+ log "Done"
diff --git a/examples/passing/JSReserved.purs b/examples/passing/JSReserved.purs
index ee552ca..26bde69 100644
--- a/examples/passing/JSReserved.purs
+++ b/examples/passing/JSReserved.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
yield = 0
member = 1
@@ -9,4 +10,4 @@ public = \return -> return
this catch = catch
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/KindedType.purs b/examples/passing/KindedType.purs
index adff8bb..2a4959b 100644
--- a/examples/passing/KindedType.purs
+++ b/examples/passing/KindedType.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
type Star2Star f = f :: * -> *
@@ -30,4 +31,4 @@ class Clazz (a :: *) where
instance clazzString :: Clazz String where
def = "test"
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/LargeSumType.purs b/examples/passing/LargeSumType.purs
index 1cc8ff0..d833e8a 100644
--- a/examples/passing/LargeSumType.purs
+++ b/examples/passing/LargeSumType.purs
@@ -1,5 +1,7 @@
module Main where
-
+
+import Control.Monad.Eff.Console (log)
+
data Large = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z
explode A A = "A"
@@ -30,4 +32,4 @@ explode Y Y = "Y"
explode Z Z = "Z"
explode _ _ = ""
-main = Control.Monad.Eff.Console.log "Done" \ No newline at end of file
+main = log "Done"
diff --git a/examples/passing/Let.purs b/examples/passing/Let.purs
index d1aac9d..793dac0 100644
--- a/examples/passing/Let.purs
+++ b/examples/passing/Let.purs
@@ -1,7 +1,9 @@
module Main where
import Prelude
+import Partial.Unsafe (unsafePartial)
import Control.Monad.Eff
+import Control.Monad.Eff.Console (log, logShow)
import Control.Monad.ST
test1 x = let
@@ -17,8 +19,9 @@ test2 x y =
test3 = let f x y z = x + y + z in
f 1.0 2.0 3.0
-test4 = let f x [y, z] = x y z in
- f (+) [1.0, 2.0]
+test4 = let
+ f x [y, z] = x y z
+ in f (+) [1.0, 2.0]
test5 = let
f x | x > 0.0 = g (x / 2.0) + 1.0
@@ -43,11 +46,13 @@ test10 _ =
g x = f x / 2.0
in f 10.0
+main :: Eff _ _
main = do
- Control.Monad.Eff.Console.print (test1 1.0)
- Control.Monad.Eff.Console.print (test2 1.0 2.0)
- Control.Monad.Eff.Console.print test3
- Control.Monad.Eff.Console.print test4
- Control.Monad.Eff.Console.print test5
- Control.Monad.Eff.Console.print test7
- Control.Monad.Eff.Console.print (test8 100.0)
+ logShow (test1 1.0)
+ logShow (test2 1.0 2.0)
+ logShow test3
+ unsafePartial (logShow test4)
+ logShow test5
+ logShow test7
+ logShow (test8 100.0)
+ log "Done"
diff --git a/examples/passing/Let2.purs b/examples/passing/Let2.purs
index 8da1344..51fc251 100644
--- a/examples/passing/Let2.purs
+++ b/examples/passing/Let2.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log, logShow)
test =
let f :: Number -> Boolean
@@ -14,4 +15,6 @@ test =
x = f 1.0
in not x
-main = Control.Monad.Eff.Console.print test
+main = do
+ logShow test
+ log "Done"
diff --git a/examples/passing/LetInInstance.purs b/examples/passing/LetInInstance.purs
index d3e71bf..9915485 100644
--- a/examples/passing/LetInInstance.purs
+++ b/examples/passing/LetInInstance.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
class Foo a where
foo :: a -> String
@@ -11,4 +12,4 @@ instance fooString :: Foo String where
go :: String -> String
go s = s
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/LiberalTypeSynonyms.purs b/examples/passing/LiberalTypeSynonyms.purs
index 61f2ebf..b388af6 100644
--- a/examples/passing/LiberalTypeSynonyms.purs
+++ b/examples/passing/LiberalTypeSynonyms.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
type Reader = (->) String
@@ -9,13 +10,13 @@ foo s = s
type AndFoo r = (foo :: String | r)
-getFoo :: forall r. Prim.Object (AndFoo r) -> String
+getFoo :: forall r. Prim.Record (AndFoo r) -> String
getFoo o = o.foo
type F r = { | r } -> { | r }
f :: (forall r. F r) -> String
f g = case g { x: "Hello" } of
- { x = x } -> x
+ { x: x } -> x
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/MPTCs.purs b/examples/passing/MPTCs.purs
index 8b2fef2..195d3dc 100644
--- a/examples/passing/MPTCs.purs
+++ b/examples/passing/MPTCs.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
class NullaryTypeClass where
greeting :: String
@@ -14,7 +15,7 @@ class Coerce a b where
instance coerceRefl :: Coerce a a where
coerce a = a
-instance coerceShow :: (Prelude.Show a) => Coerce a String where
+instance coerceShow :: Show a => Coerce a String where
coerce = show
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/Match.purs b/examples/passing/Match.purs
index 6df2a18..50244bb 100644
--- a/examples/passing/Match.purs
+++ b/examples/passing/Match.purs
@@ -1,9 +1,10 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
data Foo a = Foo
foo = \f -> case f of Foo -> "foo"
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/Module.purs b/examples/passing/Module.purs
new file mode 100644
index 0000000..e8d5f06
--- /dev/null
+++ b/examples/passing/Module.purs
@@ -0,0 +1,7 @@
+module Main where
+
+import M1
+import M2
+import Control.Monad.Eff.Console (log)
+
+main = log "Done"
diff --git a/examples/passing/Module/M1.purs b/examples/passing/Module/M1.purs
new file mode 100644
index 0000000..d276f7a
--- /dev/null
+++ b/examples/passing/Module/M1.purs
@@ -0,0 +1,14 @@
+module M1 where
+
+import Prelude
+
+data Foo = Foo String
+
+foo :: Foo -> String
+foo = \f -> case f of Foo s -> s <> "foo"
+
+bar :: Foo -> String
+bar = foo
+
+incr :: Int -> Int
+incr x = x + 1
diff --git a/examples/passing/Module/M2.purs b/examples/passing/Module/M2.purs
new file mode 100644
index 0000000..b2c8b86
--- /dev/null
+++ b/examples/passing/Module/M2.purs
@@ -0,0 +1,10 @@
+module M2 where
+
+import Prelude
+import M1 as M1
+
+baz :: M1.Foo -> String
+baz = M1.foo
+
+match :: M1.Foo -> String
+match = \f -> case f of M1.Foo s -> s <> "foo"
diff --git a/examples/passing/ModuleDeps.purs b/examples/passing/ModuleDeps.purs
new file mode 100644
index 0000000..5736a97
--- /dev/null
+++ b/examples/passing/ModuleDeps.purs
@@ -0,0 +1,6 @@
+module Main where
+
+import M1
+import Control.Monad.Eff.Console (log)
+
+main = log "Done"
diff --git a/examples/passing/ModuleDeps/M1.purs b/examples/passing/ModuleDeps/M1.purs
new file mode 100644
index 0000000..5618b41
--- /dev/null
+++ b/examples/passing/ModuleDeps/M1.purs
@@ -0,0 +1,5 @@
+module M1 where
+
+import M2 as M2
+
+foo = M2.bar
diff --git a/examples/passing/ModuleDeps/M2.purs b/examples/passing/ModuleDeps/M2.purs
new file mode 100644
index 0000000..c6cc008
--- /dev/null
+++ b/examples/passing/ModuleDeps/M2.purs
@@ -0,0 +1,5 @@
+module M2 where
+
+import M3 as M3
+
+bar = M3.baz
diff --git a/examples/passing/ModuleDeps/M3.purs b/examples/passing/ModuleDeps/M3.purs
new file mode 100644
index 0000000..d9b7633
--- /dev/null
+++ b/examples/passing/ModuleDeps/M3.purs
@@ -0,0 +1,3 @@
+module M3 where
+
+baz = 1
diff --git a/examples/passing/ModuleExport.purs b/examples/passing/ModuleExport.purs
index 6c283e9..0ce2e51 100644
--- a/examples/passing/ModuleExport.purs
+++ b/examples/passing/ModuleExport.purs
@@ -1,9 +1,8 @@
-module A (module Prelude) where
- import Prelude
-
module Main where
- import Control.Monad.Eff.Console
- import A
- main = do
- print (show 1.0)
+import Control.Monad.Eff.Console (log, logShow)
+import A
+
+main = do
+ logShow (show 1.0)
+ log "Done"
diff --git a/examples/passing/ModuleExport/A.purs b/examples/passing/ModuleExport/A.purs
new file mode 100644
index 0000000..4c11122
--- /dev/null
+++ b/examples/passing/ModuleExport/A.purs
@@ -0,0 +1,3 @@
+module A (module Prelude) where
+
+import Prelude
diff --git a/examples/passing/ModuleExportDupes.purs b/examples/passing/ModuleExportDupes.purs
index 72f807b..6a354a7 100644
--- a/examples/passing/ModuleExportDupes.purs
+++ b/examples/passing/ModuleExportDupes.purs
@@ -1,14 +1,5 @@
-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 Control.Monad.Eff.Console
import A
import B
@@ -16,4 +7,5 @@ module Main where
import Prelude
main = do
- print (show 1.0)
+ logShow (show 1.0)
+ log "Done"
diff --git a/examples/passing/ModuleExportDupes/A.purs b/examples/passing/ModuleExportDupes/A.purs
new file mode 100644
index 0000000..4c11122
--- /dev/null
+++ b/examples/passing/ModuleExportDupes/A.purs
@@ -0,0 +1,3 @@
+module A (module Prelude) where
+
+import Prelude
diff --git a/examples/passing/ModuleExportDupes/B.purs b/examples/passing/ModuleExportDupes/B.purs
new file mode 100644
index 0000000..c4ed60d
--- /dev/null
+++ b/examples/passing/ModuleExportDupes/B.purs
@@ -0,0 +1,3 @@
+module B (module Prelude) where
+
+import Prelude
diff --git a/examples/passing/ModuleExportDupes/C.purs b/examples/passing/ModuleExportDupes/C.purs
new file mode 100644
index 0000000..b92340f
--- /dev/null
+++ b/examples/passing/ModuleExportDupes/C.purs
@@ -0,0 +1,4 @@
+module C (module Prelude, module A) where
+
+import Prelude
+import A
diff --git a/examples/passing/ModuleExportExcluded.purs b/examples/passing/ModuleExportExcluded.purs
index fd0130a..c5b425d 100644
--- a/examples/passing/ModuleExportExcluded.purs
+++ b/examples/passing/ModuleExportExcluded.purs
@@ -1,14 +1,11 @@
-module A (module Prelude, foo) where
- import Prelude
-
- foo :: Number -> Number
- foo _ = 0.0
-
module Main where
- import Control.Monad.Eff.Console
- import A (foo)
- otherwise = false
+import Prelude
+import Control.Monad.Eff.Console (log, logShow)
+import A (foo)
+
+otherwise = false
- main = do
- print "1.0"
+main = do
+ logShow "1.0"
+ log "Done"
diff --git a/examples/passing/ModuleExportExcluded/A.purs b/examples/passing/ModuleExportExcluded/A.purs
new file mode 100644
index 0000000..fe4e91e
--- /dev/null
+++ b/examples/passing/ModuleExportExcluded/A.purs
@@ -0,0 +1,6 @@
+module A (module Prelude, foo) where
+
+import Prelude
+
+foo :: Number -> Number
+foo _ = 0.0
diff --git a/examples/passing/ModuleExportQualified.purs b/examples/passing/ModuleExportQualified.purs
index 88fa20e..a8e8c6e 100644
--- a/examples/passing/ModuleExportQualified.purs
+++ b/examples/passing/ModuleExportQualified.purs
@@ -1,9 +1,9 @@
-module A (module Prelude) where
- import Prelude
-
module Main where
- import Control.Monad.Eff.Console
- import qualified A as B
- main = do
- print (B.show 1.0)
+import Prelude
+import Control.Monad.Eff.Console (log, logShow)
+import A as B
+
+main = do
+ logShow (B.show 1.0)
+ log "Done"
diff --git a/examples/passing/ModuleExportQualified/A.purs b/examples/passing/ModuleExportQualified/A.purs
new file mode 100644
index 0000000..4c11122
--- /dev/null
+++ b/examples/passing/ModuleExportQualified/A.purs
@@ -0,0 +1,3 @@
+module A (module Prelude) where
+
+import Prelude
diff --git a/examples/passing/ModuleExportSelf.purs b/examples/passing/ModuleExportSelf.purs
index cc2a001..5063d2b 100644
--- a/examples/passing/ModuleExportSelf.purs
+++ b/examples/passing/ModuleExportSelf.purs
@@ -1,14 +1,11 @@
-module A (module A, module Prelude) where
- import Prelude
-
- type Foo = Boolean
-
module Main where
- import Control.Monad.Eff.Console
- import A
- bar :: Foo
- bar = true
+import Control.Monad.Eff.Console
+import A
+
+bar :: Foo
+bar = true
- main = do
- print (show bar)
+main = do
+ logShow (show bar)
+ log "Done"
diff --git a/examples/passing/ModuleExportSelf/A.purs b/examples/passing/ModuleExportSelf/A.purs
new file mode 100644
index 0000000..f6c2ecf
--- /dev/null
+++ b/examples/passing/ModuleExportSelf/A.purs
@@ -0,0 +1,5 @@
+module A (module A, module Prelude) where
+
+import Prelude
+
+type Foo = Boolean
diff --git a/examples/passing/Monad.purs b/examples/passing/Monad.purs
index 96b2afd..a1f5120 100644
--- a/examples/passing/Monad.purs
+++ b/examples/passing/Monad.purs
@@ -1,6 +1,6 @@
module Main where
-import Prelude ()
+import Control.Monad.Eff.Console (log)
type Monad m = { return :: forall a. a -> m a
, bind :: forall a b. m a -> (a -> m b) -> m b }
@@ -29,4 +29,4 @@ test1 = test id
test2 = test maybe
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/MonadState.purs b/examples/passing/MonadState.purs
index 8d64394..46b2aaa 100644
--- a/examples/passing/MonadState.purs
+++ b/examples/passing/MonadState.purs
@@ -58,4 +58,6 @@ modify f =
same :: forall a. (a -> a) -> (a -> a)
same = id
-main = print $ runState 0 (modify (+ 1))
+main = do
+ logShow $ runState 0 (modify (_ + 1))
+ log "Done"
diff --git a/examples/passing/MultiArgFunctions.purs b/examples/passing/MultiArgFunctions.purs
index 999d527..ed92392 100644
--- a/examples/passing/MultiArgFunctions.purs
+++ b/examples/passing/MultiArgFunctions.purs
@@ -1,7 +1,7 @@
module Main where
import Prelude
-import Data.Function
+import Data.Function.Uncurried
import Control.Monad.Eff
import Control.Monad.Eff.Console
@@ -23,5 +23,5 @@ main = do
runFn8 (mkFn8 $ \a b c d e f g h -> log $ show [a, b, c, d, e, f, g, h]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
runFn9 (mkFn9 $ \a b c d e f g h i -> log $ show [a, b, c, d, e, f, g, h, i]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
runFn10 (mkFn10 $ \a b c d e f g h i j-> log $ show [a, b, c, d, e, f, g, h, i, j]) 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0
- print $ runFn2 g 0.0 0.0
- log "Done!"
+ logShow $ runFn2 g 0.0 0.0
+ log "Done"
diff --git a/examples/passing/MutRec.purs b/examples/passing/MutRec.purs
index afee9cd..c800b4c 100644
--- a/examples/passing/MutRec.purs
+++ b/examples/passing/MutRec.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
f 0.0 = 0.0
f x = g x + 0.0
@@ -16,4 +17,4 @@ evenToNumber (Even n) = oddToNumber n + 0.0
oddToNumber (Odd n) = evenToNumber n + 0.0
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/MutRec2.purs b/examples/passing/MutRec2.purs
index 762c676..844f9fe 100644
--- a/examples/passing/MutRec2.purs
+++ b/examples/passing/MutRec2.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
data A = A B
@@ -16,4 +17,4 @@ g b = case b of B a -> f a
showN :: A -> S
showN a = f a
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/MutRec3.purs b/examples/passing/MutRec3.purs
index a22ac5d..82a710f 100644
--- a/examples/passing/MutRec3.purs
+++ b/examples/passing/MutRec3.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
data A = A B
@@ -16,4 +17,4 @@ g b = case b of B a -> f a
showN :: A -> S
showN a = f a
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/NamedPatterns.purs b/examples/passing/NamedPatterns.purs
index 3e0d557..d6f4377 100644
--- a/examples/passing/NamedPatterns.purs
+++ b/examples/passing/NamedPatterns.purs
@@ -1,9 +1,10 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
foo = \x -> case x of
- y@{ foo = "Foo" } -> y
+ y@{ foo: "Foo" } -> y
y -> y
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/NegativeBinder.purs b/examples/passing/NegativeBinder.purs
index 63ba76a..1c73e70 100644
--- a/examples/passing/NegativeBinder.purs
+++ b/examples/passing/NegativeBinder.purs
@@ -1,9 +1,10 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
test :: Number -> Boolean
test -1.0 = false
test _ = true
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/NegativeIntInRange.purs b/examples/passing/NegativeIntInRange.purs
index 734d4a1..57a60d0 100644
--- a/examples/passing/NegativeIntInRange.purs
+++ b/examples/passing/NegativeIntInRange.purs
@@ -1,8 +1,9 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
n :: Int
n = -2147483648
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/Nested.purs b/examples/passing/Nested.purs
index 0f19014..b29554a 100644
--- a/examples/passing/Nested.purs
+++ b/examples/passing/Nested.purs
@@ -1,9 +1,10 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
data Extend r a = Extend { prev :: r a, next :: a }
data Matrix r a = Square (r (r a)) | Bigger (Matrix (Extend r) a)
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/NestedTypeSynonyms.purs b/examples/passing/NestedTypeSynonyms.purs
index abb9ea7..3ae9327 100644
--- a/examples/passing/NestedTypeSynonyms.purs
+++ b/examples/passing/NestedTypeSynonyms.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
type X = String
type Y = X -> X
@@ -8,4 +9,4 @@ type Y = X -> X
fn :: Y
fn a = a
-main = Control.Monad.Eff.Console.print (fn "Done")
+main = log (fn "Done")
diff --git a/examples/passing/NestedWhere.purs b/examples/passing/NestedWhere.purs
index 4867ae8..3f098a5 100644
--- a/examples/passing/NestedWhere.purs
+++ b/examples/passing/NestedWhere.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
f x = g x
where
@@ -9,4 +10,4 @@ f x = g x
go x = go1 (x - 1.0)
go1 x = go x
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/Newtype.purs b/examples/passing/Newtype.purs
index c9edbda..43016b2 100644
--- a/examples/passing/Newtype.purs
+++ b/examples/passing/Newtype.purs
@@ -7,17 +7,17 @@ import Control.Monad.Eff.Console
newtype Thing = Thing String
instance showThing :: Show Thing where
- show (Thing x) = "Thing " ++ show x
+ show (Thing x) = "Thing " <> show x
newtype Box a = Box a
instance showBox :: (Show a) => Show (Box a) where
- show (Box x) = "Box " ++ show x
+ show (Box x) = "Box " <> show x
apply f x = f x
main = do
- print $ Thing "hello"
- print $ Box 42.0
- print $ apply Box 9000.0
+ logShow $ Thing "hello"
+ logShow $ Box 42.0
+ logShow $ apply Box 9000.0
log "Done"
diff --git a/examples/passing/NewtypeWithRecordUpdate.purs b/examples/passing/NewtypeWithRecordUpdate.purs
index 1a68534..83bb139 100644
--- a/examples/passing/NewtypeWithRecordUpdate.purs
+++ b/examples/passing/NewtypeWithRecordUpdate.purs
@@ -5,9 +5,9 @@ module Main where
import Prelude
import Control.Monad.Eff.Console
-newtype NewType a = NewType (Object a)
+newtype NewType a = NewType (Record a)
-rec1 :: Object (a :: Number, b :: Number, c:: Number)
+rec1 :: Record (a :: Number, b :: Number, c:: Number)
rec1 = { a: 0.0, b: 0.0, c: 0.0 }
rec2 :: NewType (a :: Number, b :: Number, c :: Number)
diff --git a/examples/passing/NonConflictingExports.purs b/examples/passing/NonConflictingExports.purs
index 9dff502..157d996 100644
--- a/examples/passing/NonConflictingExports.purs
+++ b/examples/passing/NonConflictingExports.purs
@@ -1,14 +1,10 @@
-module A where
-
- thing :: Int
- thing = 1
-
-- No failure here as the export `thing` only refers to Main.thing
module Main (thing, main) where
- import A
+import A
+import Control.Monad.Eff.Console (log)
- thing :: Int
- thing = 2
+thing :: Int
+thing = 2
- main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/NonConflictingExports/A.purs b/examples/passing/NonConflictingExports/A.purs
new file mode 100644
index 0000000..302b032
--- /dev/null
+++ b/examples/passing/NonConflictingExports/A.purs
@@ -0,0 +1,4 @@
+module A where
+
+thing :: Int
+thing = 1
diff --git a/examples/passing/NumberLiterals.purs b/examples/passing/NumberLiterals.purs
new file mode 100644
index 0000000..46b789d
--- /dev/null
+++ b/examples/passing/NumberLiterals.purs
@@ -0,0 +1,39 @@
+module Main where
+
+-- See issue #2115.
+
+import Prelude
+import Test.Assert (assert')
+import Control.Monad.Eff.Console (log)
+
+main = do
+ test "0.17" 0.17
+ test "0.25996181067141905" 0.25996181067141905
+ test "0.3572019862807257" 0.3572019862807257
+ test "0.46817723004874223" 0.46817723004874223
+ test "0.9640035681058178" 0.9640035681058178
+ test "4.23808622486133" 4.23808622486133
+ test "4.540362294799751" 4.540362294799751
+ test "5.212384849884261" 5.212384849884261
+ test "13.958257048123212" 13.958257048123212
+ test "32.96176575630599" 32.96176575630599
+ test "38.47735512322269" 38.47735512322269
+
+ test "10000000000" 1e10
+ test "10000000000" 1.0e10
+ test "0.00001" 1e-5
+ test "0.00001" 1.0e-5
+ test "1.5339794352098402e-118" 1.5339794352098402e-118
+ test "2.108934760892056e-59" 2.108934760892056e-59
+ test "2.250634744599241e-19" 2.250634744599241e-19
+ test "5.960464477539063e-8" 5.960464477539063e-8
+ test "5e-324" 5e-324
+ test "5e-324" 5.0e-324
+
+ log "Done"
+
+test str num =
+ if (show num == str)
+ then pure unit
+ else flip assert' false $
+ "Expected " <> show str <> ", got " <> show (show num) <> "."
diff --git a/examples/passing/ObjectGetter.purs b/examples/passing/ObjectGetter.purs
index addb57f..d2a50c7 100644
--- a/examples/passing/ObjectGetter.purs
+++ b/examples/passing/ObjectGetter.purs
@@ -1,13 +1,14 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log, logShow)
getX = _.x
point = { x: 1.0, y: 0.0 }
main = do
- Control.Monad.Eff.Console.print $ getX point
- Control.Monad.Eff.Console.log $ _." 123 string Prop Name " { " 123 string Prop Name ": "OK" }
- Control.Monad.Eff.Console.log $ (_.x >>> _.y) { x: { y: "Nested" } }
- Control.Monad.Eff.Console.log $ _.value { value: "Done!" }
+ logShow $ getX point
+ log $ _." 123 string Prop Name " { " 123 string Prop Name ": "OK" }
+ log $ (_.x >>> _.y) { x: { y: "Nested" } }
+ log $ _.value { value: "Done" }
diff --git a/examples/passing/ObjectSynonym.purs b/examples/passing/ObjectSynonym.purs
index 34fb7fa..3b82ebf 100644
--- a/examples/passing/ObjectSynonym.purs
+++ b/examples/passing/ObjectSynonym.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
type Inner = Number
@@ -12,4 +13,4 @@ type Outer = { inner :: Inner }
outer :: Outer
outer = { inner: inner }
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/ObjectUpdate.purs b/examples/passing/ObjectUpdate.purs
index de6f358..f17f658 100644
--- a/examples/passing/ObjectUpdate.purs
+++ b/examples/passing/ObjectUpdate.purs
@@ -1,20 +1,23 @@
-module Main where
-
-import Prelude
-
-update1 = \o -> o { foo = "Foo" }
-
-update2 :: forall r. { foo :: String | r } -> { foo :: String | r }
-update2 = \o -> o { foo = "Foo" }
-
-replace = \o -> case o of
- { foo = "Foo" } -> o { foo = "Bar" }
- { foo = "Bar" } -> o { bar = "Baz" }
- o -> o
-
-polyUpdate :: forall a r. { foo :: a | r } -> { foo :: String | r }
-polyUpdate = \o -> o { foo = "Foo" }
-
-inferPolyUpdate = \o -> o { foo = "Foo" }
-
-main = Control.Monad.Eff.Console.log ((update1 {foo: ""}).foo)
+module Main where
+
+import Prelude
+import Control.Monad.Eff.Console (log)
+
+update1 = \o -> o { foo = "Foo" }
+
+update2 :: forall r. { foo :: String | r } -> { foo :: String | r }
+update2 = \o -> o { foo = "Foo" }
+
+replace = \o -> case o of
+ { foo: "Foo" } -> o { foo = "Bar" }
+ { foo: "Bar" } -> o { bar = "Baz" }
+ o -> o
+
+polyUpdate :: forall a r. { foo :: a | r } -> { foo :: String | r }
+polyUpdate = \o -> o { foo = "Foo" }
+
+inferPolyUpdate = \o -> o { foo = "Foo" }
+
+main = do
+ log ((update1 {foo: ""}).foo)
+ log "Done"
diff --git a/examples/passing/ObjectUpdate2.purs b/examples/passing/ObjectUpdate2.purs
index da2bf11..6d10409 100644
--- a/examples/passing/ObjectUpdate2.purs
+++ b/examples/passing/ObjectUpdate2.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
type X r = { | r }
@@ -14,4 +15,4 @@ test = blah x
{ baz = "blah"
}
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/ObjectUpdater.purs b/examples/passing/ObjectUpdater.purs
index 17246c6..a09c42c 100644
--- a/examples/passing/ObjectUpdater.purs
+++ b/examples/passing/ObjectUpdater.purs
@@ -6,7 +6,7 @@ import Control.Monad.Eff.Console
import Test.Assert
getValue :: forall e. Eff (| e) Boolean
-getValue = return true
+getValue = pure true
main = do
let record = { value: false }
@@ -22,3 +22,5 @@ main = do
let record2 = (_ { x = _ }) { x: 0.0 } 10.0
assert $ record2.x == 10.0
+
+ log "Done"
diff --git a/examples/passing/ObjectWildcards.purs b/examples/passing/ObjectWildcards.purs
index 5a0d4c8..aae90ad 100644
--- a/examples/passing/ObjectWildcards.purs
+++ b/examples/passing/ObjectWildcards.purs
@@ -8,13 +8,13 @@ import Test.Assert
mkRecord = { foo: _, bar: _, baz: "baz" }
getValue :: forall e. Eff (| e) Boolean
-getValue = return true
+getValue = pure true
main = do
obj <- { value: _ } <$> getValue
- print obj.value
+ logShow obj.value
let x = 1.0
- point <- { x: _, y: x } <$> return 2.0
+ point <- { x: _, y: x } <$> pure 2.0
assert $ point.x == 2.0
assert $ point.y == 1.0
- log (mkRecord 1.0 "Done!").bar
+ log (mkRecord 1.0 "Done").bar
diff --git a/examples/passing/Objects.purs b/examples/passing/Objects.purs
index 810dc80..f320372 100644
--- a/examples/passing/Objects.purs
+++ b/examples/passing/Objects.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude hiding (append)
+import Control.Monad.Eff.Console (log)
test = \x -> x.foo + x.bar + 1.0
@@ -25,11 +26,11 @@ test4 = test2 weirdObj
weirdObj = { "!@#": 1.0 }
test5 = case { "***": 1.0 } of
- { "***" = n } -> n
+ { "***": n } -> n
test6 = case { "***": 1.0 } of
{ "***": n } -> n
test7 {a: snoog , b : blah } = blah
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/OneConstructor.purs b/examples/passing/OneConstructor.purs
index 149e1e2..8f3fcf2 100644
--- a/examples/passing/OneConstructor.purs
+++ b/examples/passing/OneConstructor.purs
@@ -1,9 +1,10 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
data One a = One a
one' (One a) = a
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/OperatorAliasElsewhere.purs b/examples/passing/OperatorAliasElsewhere.purs
index 952fa83..34d294a 100644
--- a/examples/passing/OperatorAliasElsewhere.purs
+++ b/examples/passing/OperatorAliasElsewhere.purs
@@ -1,8 +1,3 @@
-module Def where
-
-what :: forall a b. a -> b -> a
-what a _ = a
-
module Main where
import Prelude
diff --git a/examples/passing/OperatorAliasElsewhere/Def.purs b/examples/passing/OperatorAliasElsewhere/Def.purs
new file mode 100644
index 0000000..85194c6
--- /dev/null
+++ b/examples/passing/OperatorAliasElsewhere/Def.purs
@@ -0,0 +1,4 @@
+module Def where
+
+what :: forall a b. a -> b -> a
+what a _ = a
diff --git a/examples/passing/OperatorAssociativity.purs b/examples/passing/OperatorAssociativity.purs
index 7ee50e6..137fb4d 100644
--- a/examples/passing/OperatorAssociativity.purs
+++ b/examples/passing/OperatorAssociativity.purs
@@ -1,25 +1,25 @@
-module Main where
-
-import Prelude
-import Control.Monad.Eff
-import Control.Monad.Eff.Console
-import Test.Assert
-
-bug :: Number -> Number -> Number
-bug a b = 0.0 - (a - b)
-
-main = do
- 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)
- log "Success!"
+module Main where
+
+import Prelude
+import Control.Monad.Eff
+import Control.Monad.Eff.Console
+import Test.Assert
+
+bug :: Number -> Number -> Number
+bug a b = 0.0 - (a - b)
+
+main = do
+ 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)
+ log "Done"
diff --git a/examples/passing/OperatorInlining.purs b/examples/passing/OperatorInlining.purs
index 172babd..d632cb1 100644
--- a/examples/passing/OperatorInlining.purs
+++ b/examples/passing/OperatorInlining.purs
@@ -1,47 +1,48 @@
module Main where
import Prelude
-import Control.Monad.Eff.Console
+import Control.Monad.Eff.Console (logShow, log)
main = do
-- semiringNumber
- print (1.0 + 2.0)
- print (1.0 * 2.0)
+ logShow (1.0 + 2.0)
+ logShow (1.0 * 2.0)
-- ringNumber
- print (1.0 - 2.0)
- print (negate 1.0)
+ logShow (1.0 - 2.0)
+ logShow (negate 1.0)
-- moduleSemiringNumber
- print (1.0 / 2.0)
+ logShow (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)
+ logShow (1.0 > 2.0)
+ logShow (1.0 < 2.0)
+ logShow (1.0 <= 2.0)
+ logShow (1.0 >= 2.0)
+ logShow (1.0 == 2.0)
-- eqNumber
- print (1.0 == 2.0)
- print (1.0 /= 2.0)
+ logShow (1.0 == 2.0)
+ logShow (1.0 /= 2.0)
-- eqString
- print ("foo" == "bar")
- print ("foo" /= "bar")
+ logShow ("foo" == "bar")
+ logShow ("foo" /= "bar")
-- eqBoolean
- print (true == false)
- print (true /= false)
+ logShow (true == false)
+ logShow (true /= false)
-- semigroupString
- print ("foo" ++ "bar")
- print ("foo" <> "bar")
+ logShow ("foo" <> "bar")
-- latticeBoolean
- print (top && true)
- print (bottom || false)
+ logShow (top && true)
+ logShow (bottom || false)
-- complementedLatticeBoolean
- print (not true)
+ logShow (not true)
+
+ log "Done"
diff --git a/examples/passing/OperatorSections.purs b/examples/passing/OperatorSections.purs
index 0143d34..8b032c5 100644
--- a/examples/passing/OperatorSections.purs
+++ b/examples/passing/OperatorSections.purs
@@ -1,17 +1,18 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
import Test.Assert
main = do
- 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
+ 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
let foo = { x: 2.0 }
- assert $ (/ foo.x) 4.0 == 2.0
- assert $ (foo.x /) 4.0 == 0.5
- let (//) x y = x.x / y.x
- assert $ (// foo { x = 4.0 }) { x: 4.0 } == 1.0
- assert $ (foo { x = 4.0 } //) { x: 4.0 } == 1.0
- Control.Monad.Eff.Console.log "Done!"
+ assert $ (_ / foo.x) 4.0 == 2.0
+ assert $ (foo.x / _) 4.0 == 0.5
+ let div x y = x.x / y.x
+ assert $ (_ `div` foo { x = 4.0 }) { x: 4.0 } == 1.0
+ assert $ (foo { x = 4.0 } `div` _) { x: 4.0 } == 1.0
+ log "Done"
diff --git a/examples/passing/Operators.purs b/examples/passing/Operators.purs
index 0d6d86f..835584a 100644
--- a/examples/passing/Operators.purs
+++ b/examples/passing/Operators.purs
@@ -1,16 +1,17 @@
module Main where
import Prelude
+import Other (foo)
+import Other as Other
import Control.Monad.Eff
import Control.Monad.Eff.Console
-(?!) :: forall a. a -> a -> a
-(?!) x _ = x
+op1 :: forall a. a -> a -> a
+op1 x _ = x
-bar :: String -> String -> String
-bar = \s1 s2 -> s1 ++ s2
+infix 4 op1 as ?!
-test1 :: forall n. (Num n) => n -> n -> (n -> n -> n) -> n
+test1 :: forall n. (Semiring n) => n -> n -> (n -> n -> n) -> n
test1 x y z = x * y + z x y
test2 = (\x -> x.foo false) { foo : \_ -> 1.0 }
@@ -21,40 +22,39 @@ k = \x -> \y -> x
test4 = 1 `k` 2
-infixl 5 %%
+op2 :: Number -> Number -> Number
+op2 x y = x * y + y
-(%%) :: Number -> Number -> Number
-(%%) x y = x * y + y
+infixl 5 op2 as %%
test5 = 1.0 %% 2.0 %% 3.0
test6 = ((\x -> x) `k` 2.0) 3.0
-(<+>) :: String -> String -> String
-(<+>) = \s1 s2 -> s1 ++ s2
+op3 :: String -> String -> String
+op3 = \s1 s2 -> s1 <> s2
+
+infix 4 op3 as <+>
test7 = "Hello" <+> "World!"
-(@@) :: forall a b. (a -> b) -> a -> b
-(@@) = \f x -> f x
+op4 :: forall a b. (a -> b) -> a -> b
+op4 = \f x -> f x
-foo :: String -> String
-foo = \s -> s
+infix 4 op4 as @@
test8 = foo @@ "Hello World"
-test9 = Main.foo @@ "Hello World"
-
-test10 = "Hello" `Main.bar` "World"
+test9 = Other.foo @@ "Hello World"
-(...) :: forall a. Array a -> Array a -> Array a
-(...) = \as -> \bs -> as
+test10 = "Hello" `Other.baz` "World"
-test11 = [1.0, 2.0, 0.0] ... [4.0, 5.0, 6.0]
+op5 :: forall a. Array a -> Array a -> Array a
+op5 = \as -> \bs -> as
-test12 (<%>) a b = a <%> b
+infix 4 op5 as ...
-test13 = \(<%>) a b -> a <%> b
+test11 = [1.0, 2.0, 0.0] ... [4.0, 5.0, 6.0]
test14 :: Number -> Number -> Boolean
test14 a b = a < b
@@ -71,11 +71,6 @@ test18 = negate $ negate 1.0
test19 :: Number
test19 = negate $ negate (-1.0)
-test20 :: Number
-test20 = 1.0 @ 2.0
- where
- (@) x y = x + y * y
-
main = do
let t1 = test1 1.0 2.0 (\x y -> x + y)
let t2 = test2
@@ -88,12 +83,9 @@ main = do
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
log "Done"
diff --git a/examples/passing/Operators/Other.purs b/examples/passing/Operators/Other.purs
new file mode 100644
index 0000000..052a689
--- /dev/null
+++ b/examples/passing/Operators/Other.purs
@@ -0,0 +1,7 @@
+module Other where
+
+foo :: String -> String
+foo s = s
+
+baz :: String -> String -> String
+baz s _ = s
diff --git a/examples/passing/OptimizerBug.purs b/examples/passing/OptimizerBug.purs
index ea371de..0e4c0f9 100644
--- a/examples/passing/OptimizerBug.purs
+++ b/examples/passing/OptimizerBug.purs
@@ -1,9 +1,10 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
x a = 1.0 + y a
y a = x a
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/OptionalQualified.purs b/examples/passing/OptionalQualified.purs
index fccfd7a..76c5bea 100644
--- a/examples/passing/OptionalQualified.purs
+++ b/examples/passing/OptionalQualified.purs
@@ -1,7 +1,6 @@
module Main where
--- qualified import with the "qualified" keyword
-import qualified Prelude as P
+import Prelude as P
-- qualified import without the "qualified" keyword
import Control.Monad.Eff.Console as Console
@@ -9,5 +8,5 @@ import Control.Monad.Eff.Console as Console
bind = P.bind
main = do
- message <- P.return "success!"
+ message <- P.pure "Done"
Console.log message
diff --git a/examples/passing/OverlappingInstances.purs b/examples/passing/OverlappingInstances.purs
index 94b2aa5..9e981e0 100644
--- a/examples/passing/OverlappingInstances.purs
+++ b/examples/passing/OverlappingInstances.purs
@@ -1,13 +1,17 @@
-module Main where
-
-import Prelude
-
-data A = A
-
-instance showA1 :: Show A where
- show A = "Instance 1"
-
-instance showA2 :: Show A where
- show A = "Instance 2"
-
-main = Test.Assert.assert $ show A == "Instance 1"
+module Main where
+
+import Prelude
+import Control.Monad.Eff.Console (log)
+import Test.Assert (assert)
+
+data A = A
+
+instance showA1 :: Show A where
+ show A = "Instance 1"
+
+instance showA2 :: Show A where
+ show A = "Instance 2"
+
+main = do
+ assert $ show A == "Instance 1"
+ log "Done"
diff --git a/examples/passing/OverlappingInstances2.purs b/examples/passing/OverlappingInstances2.purs
index 76012ca..9694cfa 100644
--- a/examples/passing/OverlappingInstances2.purs
+++ b/examples/passing/OverlappingInstances2.purs
@@ -1,23 +1,27 @@
-module Main where
-
-import Prelude
-
-data A = A | B
-
-instance eqA1 :: Eq A where
- eq A A = true
- eq B B = true
- eq _ _ = false
-
-instance eqA2 :: Eq A where
- eq _ _ = true
-
-instance ordA :: Ord A where
- compare A B = LT
- compare B A = GT
- compare _ _ = EQ
-
-test :: forall a. (Ord a) => a -> a -> String
-test x y = show $ x == y
-
-main = Test.Assert.assert $ test A B == "false"
+module Main where
+
+import Prelude
+import Control.Monad.Eff.Console (log)
+import Test.Assert (assert)
+
+data A = A | B
+
+instance eqA1 :: Eq A where
+ eq A A = true
+ eq B B = true
+ eq _ _ = false
+
+instance eqA2 :: Eq A where
+ eq _ _ = true
+
+instance ordA :: Ord A where
+ compare A B = LT
+ compare B A = GT
+ compare _ _ = EQ
+
+test :: forall a. (Ord a) => a -> a -> String
+test x y = show $ x == y
+
+main = do
+ assert $ test A B == "false"
+ log "Done"
diff --git a/examples/passing/OverlappingInstances3.purs b/examples/passing/OverlappingInstances3.purs
index 4c6b354..14d9561 100644
--- a/examples/passing/OverlappingInstances3.purs
+++ b/examples/passing/OverlappingInstances3.purs
@@ -1,16 +1,20 @@
-module Main where
-
-import Prelude
-
-class Foo a
-
-instance foo1 :: Foo Number
-
-instance foo2 :: Foo Number
-
-test :: forall a. (Foo a) => a -> a
-test a = a
-
-test1 = test 0.0
-
-main = Test.Assert.assert (test1 == 0.0)
+module Main where
+
+import Prelude
+import Control.Monad.Eff.Console (log)
+import Test.Assert (assert)
+
+class Foo a
+
+instance foo1 :: Foo Number
+
+instance foo2 :: Foo Number
+
+test :: forall a. (Foo a) => a -> a
+test a = a
+
+test1 = test 0.0
+
+main = do
+ assert (test1 == 0.0)
+ log "Done"
diff --git a/examples/passing/ParensInTypedBinder.purs b/examples/passing/ParensInTypedBinder.purs
new file mode 100644
index 0000000..468f3ec
--- /dev/null
+++ b/examples/passing/ParensInTypedBinder.purs
@@ -0,0 +1,20 @@
+module Main where
+
+import Prelude
+import Control.Monad.Eff (Eff)
+import Control.Monad.Eff.Console (CONSOLE, log)
+
+foo :: Array Int
+foo = do
+ xss :: Array (Array Int) <- [[[1,2,3], [4, 5]], [[6]]]
+ xs :: Array Int <- xss
+ xs
+
+main ::
+ forall eff.
+ Eff
+ ( console :: CONSOLE
+ | eff
+ )
+ Unit
+main = log "Done"
diff --git a/examples/passing/PartialFunction.purs b/examples/passing/PartialFunction.purs
index ab95b36..00a1f02 100644
--- a/examples/passing/PartialFunction.purs
+++ b/examples/passing/PartialFunction.purs
@@ -1,9 +1,11 @@
module Main where
import Prelude
-import Test.Assert
+import Control.Monad.Eff
+import Control.Monad.Eff.Console
+fn :: Partial => Number -> Number
fn 0.0 = 0.0
fn 1.0 = 2.0
-main = assertThrows $ \_ -> fn 2.0
+main = log "Done"
diff --git a/examples/passing/Patterns.purs b/examples/passing/Patterns.purs
index 9606afa..b715ec9 100644
--- a/examples/passing/Patterns.purs
+++ b/examples/passing/Patterns.purs
@@ -1,14 +1,15 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
test = \x -> case x of
- { str = "Foo", bool = true } -> true
- { str = "Bar", bool = b } -> b
+ { str: "Foo", bool: true } -> true
+ { str: "Bar", bool: b } -> b
_ -> false
f = \o -> case o of
- { foo = "Foo" } -> o.bar
+ { foo: "Foo" } -> o.bar
_ -> 0
h = \o -> case o of
@@ -19,4 +20,4 @@ isDesc :: Array Number -> Boolean
isDesc [x, y] | x > y = true
isDesc _ = false
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/PendingConflictingImports.purs b/examples/passing/PendingConflictingImports.purs
index 942ed42..87c1ad8 100644
--- a/examples/passing/PendingConflictingImports.purs
+++ b/examples/passing/PendingConflictingImports.purs
@@ -1,17 +1,8 @@
-module A where
-
- thing :: Int
- thing = 1
-
-module B where
-
- thing :: Int
- thing = 2
-
module Main where
- -- No error as we never force `thing` to be resolved in `Main`
- import A
- import B
+-- No error as we never force `thing` to be resolved in `Main`
+import A
+import B
+import Control.Monad.Eff.Console (log)
- main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/PendingConflictingImports/A.purs b/examples/passing/PendingConflictingImports/A.purs
new file mode 100644
index 0000000..302b032
--- /dev/null
+++ b/examples/passing/PendingConflictingImports/A.purs
@@ -0,0 +1,4 @@
+module A where
+
+thing :: Int
+thing = 1
diff --git a/examples/passing/PendingConflictingImports/B.purs b/examples/passing/PendingConflictingImports/B.purs
new file mode 100644
index 0000000..076bf7e
--- /dev/null
+++ b/examples/passing/PendingConflictingImports/B.purs
@@ -0,0 +1,4 @@
+module B where
+
+thing :: Int
+thing = 2
diff --git a/examples/passing/PendingConflictingImports2.purs b/examples/passing/PendingConflictingImports2.purs
index f578dde..0041adc 100644
--- a/examples/passing/PendingConflictingImports2.purs
+++ b/examples/passing/PendingConflictingImports2.purs
@@ -1,14 +1,10 @@
-module A where
-
- thing :: Int
- thing = 1
-
module Main where
- import A
+import A
+import Control.Monad.Eff.Console (log)
- -- No error as we never force `thing` to be resolved in `Main`
- thing :: Int
- thing = 2
+-- No error as we never force `thing` to be resolved in `Main`
+thing :: Int
+thing = 2
- main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/PendingConflictingImports2/A.purs b/examples/passing/PendingConflictingImports2/A.purs
new file mode 100644
index 0000000..302b032
--- /dev/null
+++ b/examples/passing/PendingConflictingImports2/A.purs
@@ -0,0 +1,4 @@
+module A where
+
+thing :: Int
+thing = 1
diff --git a/examples/passing/Person.purs b/examples/passing/Person.purs
index fa3384e..fd0e4f9 100644
--- a/examples/passing/Person.purs
+++ b/examples/passing/Person.purs
@@ -1,11 +1,12 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
data Person = Person { name :: String, age :: Number }
showPerson :: Person -> String
showPerson = \p -> case p of
- Person o -> o.name ++ ", aged " ++ show o.age
+ Person o -> o.name <> ", aged " <> show o.age
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/PrimedTypeName.purs b/examples/passing/PrimedTypeName.purs
new file mode 100644
index 0000000..5241c16
--- /dev/null
+++ b/examples/passing/PrimedTypeName.purs
@@ -0,0 +1,20 @@
+module Main (T, T', T'', T''', main) where
+
+import Prelude
+import Control.Monad.Eff.Console (log)
+
+data T a = T
+type T' = T Unit
+
+data T'' = TP
+
+foreign import data T''' ∷ *
+
+instance eqT ∷ Eq T'' where
+ eq _ _ = true
+
+type A' a b = b → a
+
+infixr 4 type A' as ↫
+
+main = log "Done"
diff --git a/examples/passing/QualifiedNames.purs b/examples/passing/QualifiedNames.purs
new file mode 100644
index 0000000..0dcda36
--- /dev/null
+++ b/examples/passing/QualifiedNames.purs
@@ -0,0 +1,11 @@
+module Main where
+
+import Prelude
+import Either as Either
+import Control.Monad.Eff.Console (log)
+
+either :: forall a b c. (a -> c) -> (b -> c) -> Either.Either a b -> c
+either f _ (Either.Left x) = f x
+either _ g (Either.Right y) = g y
+
+main = log (either id id (Either.Left "Done"))
diff --git a/examples/passing/QualifiedNames/Either.purs b/examples/passing/QualifiedNames/Either.purs
new file mode 100644
index 0000000..9fc8a3b
--- /dev/null
+++ b/examples/passing/QualifiedNames/Either.purs
@@ -0,0 +1,5 @@
+module Either where
+
+import Prelude
+
+data Either a b = Left a | Right b
diff --git a/examples/passing/QualifiedQualifiedImports.purs b/examples/passing/QualifiedQualifiedImports.purs
index 91c188c..384bb7e 100644
--- a/examples/passing/QualifiedQualifiedImports.purs
+++ b/examples/passing/QualifiedQualifiedImports.purs
@@ -1,6 +1,6 @@
module Main where
-- qualified import with qualified imported names
-import qualified Control.Monad.Eff.Console (log) as Console
+import Control.Monad.Eff.Console (log) as Console
-main = Console.log "Success!"
+main = Console.log "Done"
diff --git a/examples/passing/Rank2Data.purs b/examples/passing/Rank2Data.purs
index 0f67803..8833a43 100644
--- a/examples/passing/Rank2Data.purs
+++ b/examples/passing/Rank2Data.purs
@@ -1,29 +1,30 @@
-module Main where
-
-import Prelude hiding (add)
-
-data Id = Id forall a. a -> a
-
-runId = \id a -> case id of
- Id f -> f a
-
-data Nat = Nat forall r. r -> (r -> r) -> r
-
-runNat = \nat -> case nat of
- Nat f -> f 0.0 (\n -> n + 1.0)
-
-zero' = Nat (\zero' _ -> zero')
-
-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)
-
-one' = succ zero'
-two = succ zero'
-four = add two two
-fourNumber = runNat four
-
-main = Control.Monad.Eff.Console.log "Done'"
+module Main where
+
+import Prelude hiding (add)
+import Control.Monad.Eff.Console (log)
+
+data Id = Id forall a. a -> a
+
+runId = \id a -> case id of
+ Id f -> f a
+
+data Nat = Nat forall r. r -> (r -> r) -> r
+
+runNat = \nat -> case nat of
+ Nat f -> f 0.0 (\n -> n + 1.0)
+
+zero' = Nat (\zero' _ -> zero')
+
+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)
+
+one' = succ zero'
+two = succ zero'
+four = add two two
+fourNumber = runNat four
+
+main = log "Done"
diff --git a/examples/passing/Rank2Object.purs b/examples/passing/Rank2Object.purs
index c9651e6..2460b4f 100644
--- a/examples/passing/Rank2Object.purs
+++ b/examples/passing/Rank2Object.purs
@@ -6,6 +6,6 @@ import Control.Monad.Eff.Console
data Foo = Foo { id :: forall a. a -> a }
foo :: Foo -> Number
-foo (Foo { id = f }) = f 0.0
+foo (Foo { id: f }) = f 0.0
main = log "Done"
diff --git a/examples/passing/Rank2TypeSynonym.purs b/examples/passing/Rank2TypeSynonym.purs
index a1977da..e4b8ffe 100644
--- a/examples/passing/Rank2TypeSynonym.purs
+++ b/examples/passing/Rank2TypeSynonym.purs
@@ -1,7 +1,7 @@
module Main where
import Prelude
-import Control.Monad.Eff
+import Control.Monad.Eff.Console (log, logShow)
type Foo a = forall f. (Monad f) => f a
@@ -13,4 +13,5 @@ bar = foo 3.0
main = do
x <- bar
- Control.Monad.Eff.Console.print x
+ logShow x
+ log "Done"
diff --git a/examples/passing/Rank2Types.purs b/examples/passing/Rank2Types.purs
index 7af12ae..fccea0c 100644
--- a/examples/passing/Rank2Types.purs
+++ b/examples/passing/Rank2Types.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
test1 :: (forall a. (a -> a)) -> Number
test1 = \f -> f 0.0
@@ -8,4 +9,4 @@ 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
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/ReExportQualified.purs b/examples/passing/ReExportQualified.purs
index cf1c037..98a1a57 100644
--- a/examples/passing/ReExportQualified.purs
+++ b/examples/passing/ReExportQualified.purs
@@ -1,16 +1,7 @@
-module A where
- x = "Do"
-
-module B where
- y = "ne"
-
-module C (module A, module M2) where
- import A
- import qualified B as M2
-
module Main where
- import Prelude
- import C
+import Prelude
+import C
+import Control.Monad.Eff.Console (log)
- main = Control.Monad.Eff.Console.log (x ++ y)
+main = log (x <> y)
diff --git a/examples/passing/ReExportQualified/A.purs b/examples/passing/ReExportQualified/A.purs
new file mode 100644
index 0000000..ae23128
--- /dev/null
+++ b/examples/passing/ReExportQualified/A.purs
@@ -0,0 +1,3 @@
+module A where
+
+x = "Do"
diff --git a/examples/passing/ReExportQualified/B.purs b/examples/passing/ReExportQualified/B.purs
new file mode 100644
index 0000000..2e14922
--- /dev/null
+++ b/examples/passing/ReExportQualified/B.purs
@@ -0,0 +1,3 @@
+module B where
+
+y = "ne"
diff --git a/examples/passing/ReExportQualified/C.purs b/examples/passing/ReExportQualified/C.purs
new file mode 100644
index 0000000..589f37b
--- /dev/null
+++ b/examples/passing/ReExportQualified/C.purs
@@ -0,0 +1,4 @@
+module C (module A, module M2) where
+
+import A
+import B as M2
diff --git a/examples/passing/RebindableSyntax.purs b/examples/passing/RebindableSyntax.purs
index df00ce1..95303a8 100644
--- a/examples/passing/RebindableSyntax.purs
+++ b/examples/passing/RebindableSyntax.purs
@@ -1,39 +1,43 @@
-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
- map _ (Const a) = Const a
-
-instance applyConst :: (Semigroup a) => Apply (Const a) where
- apply (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
- Control.Monad.Eff.Console.log example1
- Control.Monad.Eff.Console.log $ runConst example2
+module Main where
+
+import Prelude
+import Control.Monad.Eff.Console (log)
+
+example1 :: String
+example1 = do
+ "Do"
+ " notation"
+ " for"
+ " Semigroup"
+ where
+ bind x f = x <> f unit
+
+applySecond :: forall f a b. (Apply f) => f a -> f b -> f b
+applySecond fa fb = const id <$> fa <*> fb
+
+infixl 4 applySecond as *>
+
+newtype Const a b = Const a
+
+runConst :: forall a b. Const a b -> a
+runConst (Const a) = a
+
+instance functorConst :: Functor (Const a) where
+ map _ (Const a) = Const a
+
+instance applyConst :: (Semigroup a) => Apply (Const a) where
+ apply (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
+ log example1
+ log $ runConst example2
+ log "Done"
diff --git a/examples/passing/Recursion.purs b/examples/passing/Recursion.purs
index 67d3094..f9798f9 100644
--- a/examples/passing/Recursion.purs
+++ b/examples/passing/Recursion.purs
@@ -1,10 +1,11 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
fib = \n -> case n of
0.0 -> 1.0
1.0 -> 1.0
n -> fib (n - 1.0) + fib (n - 2.0)
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/RedefinedFixity.purs b/examples/passing/RedefinedFixity.purs
new file mode 100644
index 0000000..48f147b
--- /dev/null
+++ b/examples/passing/RedefinedFixity.purs
@@ -0,0 +1,6 @@
+module Main where
+
+import M3
+import Control.Monad.Eff.Console (log)
+
+main = log "Done"
diff --git a/examples/passing/RedefinedFixity/M1.purs b/examples/passing/RedefinedFixity/M1.purs
new file mode 100644
index 0000000..13f7f11
--- /dev/null
+++ b/examples/passing/RedefinedFixity/M1.purs
@@ -0,0 +1,6 @@
+module M1 where
+
+applyFn :: forall a b. (forall c d. c -> d) -> a -> b
+applyFn f a = f a
+
+infixr 1000 applyFn as $
diff --git a/examples/passing/RedefinedFixity/M2.purs b/examples/passing/RedefinedFixity/M2.purs
new file mode 100644
index 0000000..cc5c199
--- /dev/null
+++ b/examples/passing/RedefinedFixity/M2.purs
@@ -0,0 +1,5 @@
+module M2 where
+
+import Prelude ()
+
+import M1
diff --git a/examples/passing/RedefinedFixity/M3.purs b/examples/passing/RedefinedFixity/M3.purs
new file mode 100644
index 0000000..a7b0f39
--- /dev/null
+++ b/examples/passing/RedefinedFixity/M3.purs
@@ -0,0 +1,6 @@
+module M3 where
+
+import Prelude ()
+
+import M1
+import M2
diff --git a/examples/passing/ReservedWords.purs b/examples/passing/ReservedWords.purs
index ff233bf..e96a643 100644
--- a/examples/passing/ReservedWords.purs
+++ b/examples/passing/ReservedWords.purs
@@ -2,6 +2,8 @@
module Main where
import Prelude
+import Control.Monad.Eff
+import Control.Monad.Eff.Console (log)
o :: { type :: String }
o = { type: "o" }
@@ -10,6 +12,8 @@ p :: { type :: String }
p = o { type = "p" }
f :: forall r. { type :: String | r } -> String
-f { type = "p" } = "Done"
+f { type: "p" } = "Done"
+f _ = "Fail"
-main = Control.Monad.Eff.Console.log $ f { type: p.type, foo: "bar" }
+main :: Eff _ _
+main = log $ f { type: p.type, foo: "bar" }
diff --git a/examples/passing/ResolvableScopeConflict.purs b/examples/passing/ResolvableScopeConflict.purs
index c187806..4f63802 100644
--- a/examples/passing/ResolvableScopeConflict.purs
+++ b/examples/passing/ResolvableScopeConflict.purs
@@ -1,25 +1,13 @@
-module A where
-
- thing :: Int
- thing = 1
-
-module B where
-
- thing :: Int
- thing = 2
-
- zing :: Int
- zing = 3
-
module Main where
- import A (thing)
- import B
+import A (thing)
+import B
+import Control.Monad.Eff.Console (log)
- -- Not an error as although we have `thing` in scope from both A and B, it is
- -- imported explicitly from A, giving it a resolvable solution.
- what :: Boolean -> Int
- what true = thing
- what false = zing
+-- Not an error as although we have `thing` in scope from both A and B, it is
+-- imported explicitly from A, giving it a resolvable solution.
+what :: Boolean -> Int
+what true = thing
+what false = zing
- main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/ResolvableScopeConflict/A.purs b/examples/passing/ResolvableScopeConflict/A.purs
new file mode 100644
index 0000000..302b032
--- /dev/null
+++ b/examples/passing/ResolvableScopeConflict/A.purs
@@ -0,0 +1,4 @@
+module A where
+
+thing :: Int
+thing = 1
diff --git a/examples/passing/ResolvableScopeConflict/B.purs b/examples/passing/ResolvableScopeConflict/B.purs
new file mode 100644
index 0000000..4ad4bb6
--- /dev/null
+++ b/examples/passing/ResolvableScopeConflict/B.purs
@@ -0,0 +1,7 @@
+module B where
+
+thing :: Int
+thing = 2
+
+zing :: Int
+zing = 3
diff --git a/examples/passing/ResolvableScopeConflict2.purs b/examples/passing/ResolvableScopeConflict2.purs
index 971e51b..7101c95 100644
--- a/examples/passing/ResolvableScopeConflict2.purs
+++ b/examples/passing/ResolvableScopeConflict2.purs
@@ -1,22 +1,15 @@
-module A where
-
- thing :: Int
- thing = 2
-
- zing :: Int
- zing = 3
-
module Main where
- import A
+import A
+import Control.Monad.Eff.Console (log)
- thing :: Int
- thing = 1
+thing :: Int
+thing = 1
- -- Not an error as although we have `thing` in scope from both Main and A,
- -- as the local declaration takes precedence over the implicit import
- what :: Boolean -> Int
- what true = thing
- what false = zing
+-- Not an error as although we have `thing` in scope from both Main and A,
+-- as the local declaration takes precedence over the implicit import
+what :: Boolean -> Int
+what true = thing
+what false = zing
- main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/ResolvableScopeConflict2/A.purs b/examples/passing/ResolvableScopeConflict2/A.purs
new file mode 100644
index 0000000..943011c
--- /dev/null
+++ b/examples/passing/ResolvableScopeConflict2/A.purs
@@ -0,0 +1,7 @@
+module A where
+
+thing :: Int
+thing = 2
+
+zing :: Int
+zing = 3
diff --git a/examples/passing/ResolvableScopeConflict3.purs b/examples/passing/ResolvableScopeConflict3.purs
index 86a996b..396b8cc 100644
--- a/examples/passing/ResolvableScopeConflict3.purs
+++ b/examples/passing/ResolvableScopeConflict3.purs
@@ -1,15 +1,9 @@
-module A where
-
- thing :: Int
- thing = 1
-
module Main (thing, main, module A) where
- import A
-
- thing :: Int
- thing = 2
-
- main = Control.Monad.Eff.Console.log "Done"
+import A
+import Control.Monad.Eff.Console (log)
+thing :: Int
+thing = 2
+main = log "Done"
diff --git a/examples/passing/ResolvableScopeConflict3/A.purs b/examples/passing/ResolvableScopeConflict3/A.purs
new file mode 100644
index 0000000..302b032
--- /dev/null
+++ b/examples/passing/ResolvableScopeConflict3/A.purs
@@ -0,0 +1,4 @@
+module A where
+
+thing :: Int
+thing = 1
diff --git a/examples/passing/RowConstructors.purs b/examples/passing/RowConstructors.purs
index 593d94c..53e7b8e 100644
--- a/examples/passing/RowConstructors.purs
+++ b/examples/passing/RowConstructors.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
type Foo = (x :: Number | (y :: Number | (z :: Number)))
type Bar = (x :: Number, y :: Number, z :: Number)
@@ -12,7 +13,7 @@ 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' :: Record Foo -> Record Bar
id' = id
foo' :: { | Foo }
@@ -39,4 +40,4 @@ wildcard { w: w } = { x: w, y: w, z: w, w: w }
wildcard' :: { | Quux _ } -> Number
wildcard' { q: q } = q
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/RowPolyInstanceContext.purs b/examples/passing/RowPolyInstanceContext.purs
index f0543af..0641de0 100644
--- a/examples/passing/RowPolyInstanceContext.purs
+++ b/examples/passing/RowPolyInstanceContext.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
class T s m where
state :: (s -> s) -> m Unit
@@ -11,12 +12,12 @@ instance st :: T s (S s) where
state f = S $ \s -> { new: f s, ret: unit }
test1 :: forall r . S { foo :: String | r } Unit
-test1 = state $ \o -> o { foo = o.foo ++ "!" }
+test1 = state $ \o -> o { foo = o.foo <> "!" }
test2 :: forall m r . (T { foo :: String | r } m) => m Unit
-test2 = state $ \o -> o { foo = o.foo ++ "!" }
+test2 = state $ \o -> o { foo = o.foo <> "!" }
main = do
let t1 = test1
let t2 = test2
- Control.Monad.Eff.Console.log "Done"
+ log "Done"
diff --git a/examples/passing/RuntimeScopeIssue.purs b/examples/passing/RuntimeScopeIssue.purs
index f6800c8..2b1b7f9 100644
--- a/examples/passing/RuntimeScopeIssue.purs
+++ b/examples/passing/RuntimeScopeIssue.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log, logShow)
class A a where
a :: a -> Boolean
@@ -16,4 +17,6 @@ instance bNumber :: B Number where
b 0.0 = false
b n = a (n - 1.0)
-main = Control.Monad.Eff.Console.print $ a 10.0
+main = do
+ logShow $ a 10.0
+ log "Done"
diff --git a/examples/passing/ScopedTypeVariables.purs b/examples/passing/ScopedTypeVariables.purs
index 5526059..862d821 100644
--- a/examples/passing/ScopedTypeVariables.purs
+++ b/examples/passing/ScopedTypeVariables.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
test1 :: forall a. (a -> a) -> a -> a
test1 f x = g (g x)
@@ -33,4 +34,4 @@ test4 = h
j x = x
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/Sequence.purs b/examples/passing/Sequence.purs
index 692fbd0..c6ba367 100644
--- a/examples/passing/Sequence.purs
+++ b/examples/passing/Sequence.purs
@@ -2,6 +2,7 @@ module Main where
import Prelude
import Control.Monad.Eff
+import Control.Monad.Eff.Console (log)
data List a = Cons a (List a) | Nil
@@ -12,4 +13,4 @@ instance sequenceList :: Sequence List where
sequence Nil = pure Nil
sequence (Cons x xs) = Cons <$> x <*> sequence xs
-main = sequence $ Cons (Control.Monad.Eff.Console.log "Done") Nil
+main = sequence $ Cons (log "Done") Nil
diff --git a/examples/passing/SequenceDesugared.purs b/examples/passing/SequenceDesugared.purs
index 622f1c3..f4ea3d1 100644
--- a/examples/passing/SequenceDesugared.purs
+++ b/examples/passing/SequenceDesugared.purs
@@ -2,6 +2,7 @@ module Main where
import Prelude
import Control.Monad.Eff
+import Control.Monad.Eff.Console (log)
data List a = Cons a (List a) | Nil
@@ -31,7 +32,7 @@ sequenceList''' = Sequence ((\val -> case val of
Cons x xs -> Cons <$> x <*> sequence sequenceList''' xs) :: forall m a. (Monad m) => List (m a) -> m (List a))
main = do
- sequence sequenceList $ Cons (Control.Monad.Eff.Console.log "Done") Nil
- sequence sequenceList' $ Cons (Control.Monad.Eff.Console.log "Done") Nil
- sequence sequenceList'' $ Cons (Control.Monad.Eff.Console.log "Done") Nil
- sequence sequenceList''' $ Cons (Control.Monad.Eff.Console.log "Done") Nil
+ sequence sequenceList $ Cons (log "Done") Nil
+ sequence sequenceList' $ Cons (log "Done") Nil
+ sequence sequenceList'' $ Cons (log "Done") Nil
+ sequence sequenceList''' $ Cons (log "Done") Nil
diff --git a/examples/passing/ShadowedModuleName.purs b/examples/passing/ShadowedModuleName.purs
index 3b30390..764b8c5 100644
--- a/examples/passing/ShadowedModuleName.purs
+++ b/examples/passing/ShadowedModuleName.purs
@@ -1,15 +1,8 @@
-module Test where
-
- data Z = Z String
-
- runZ :: Z -> String
- runZ (Z s) = s
-
module Main where
- import Test
- import Control.Monad.Eff.Console
+import Test
+import Control.Monad.Eff.Console
- data Test = Test
+data Test = Test
- main = log (runZ (Z "done"))
+main = log (runZ (Z "Done"))
diff --git a/examples/passing/ShadowedModuleName/Test.purs b/examples/passing/ShadowedModuleName/Test.purs
new file mode 100644
index 0000000..b30eb2d
--- /dev/null
+++ b/examples/passing/ShadowedModuleName/Test.purs
@@ -0,0 +1,6 @@
+module Test where
+
+data Z = Z String
+
+runZ :: Z -> String
+runZ (Z s) = s
diff --git a/examples/passing/ShadowedName.purs b/examples/passing/ShadowedName.purs
new file mode 100644
index 0000000..6098249
--- /dev/null
+++ b/examples/passing/ShadowedName.purs
@@ -0,0 +1,11 @@
+module Main where
+
+import Prelude
+import Control.Monad.Eff.Console
+import Control.Monad.Eff.Console (log)
+
+done :: String
+done = let str = "Not yet done" in
+ let str = "Done" in str
+
+main = log done
diff --git a/examples/passing/ShadowedTCO.purs b/examples/passing/ShadowedTCO.purs
index fa7e34d..47d222d 100644
--- a/examples/passing/ShadowedTCO.purs
+++ b/examples/passing/ShadowedTCO.purs
@@ -1,18 +1,21 @@
-module Main where
-
-import Prelude hiding (add)
-
-runNat f = f 0.0 (\n -> n + 1.0)
-
-zero' z _ = z
-
-succ f zero' succ = succ (f zero' succ)
-
-add f g zero' succ = g (f zero' succ) succ
-
-one' = succ zero'
-two = succ one'
-four = add two two
-fourNumber = runNat four
-
-main = Control.Monad.Eff.Console.log $ show fourNumber
+module Main where
+
+import Prelude hiding (add)
+import Control.Monad.Eff.Console (log)
+
+runNat f = f 0.0 (\n -> n + 1.0)
+
+zero' z _ = z
+
+succ f zero' succ = succ (f zero' succ)
+
+add f g zero' succ = g (f zero' succ) succ
+
+one' = succ zero'
+two = succ one'
+four = add two two
+fourNumber = runNat four
+
+main = do
+ log $ show fourNumber
+ log "Done"
diff --git a/examples/passing/ShadowedTCOLet.purs b/examples/passing/ShadowedTCOLet.purs
index e3c1c7e..3b04ec6 100644
--- a/examples/passing/ShadowedTCOLet.purs
+++ b/examples/passing/ShadowedTCOLet.purs
@@ -1,9 +1,15 @@
-module Main where
-
-import Prelude
-
-f x y z =
- let f 1.0 2.0 3.0 = 1.0
- in f x z y
-
-main = Control.Monad.Eff.Console.log $ show $ f 1.0 3.0 2.0
+module Main where
+
+import Prelude
+import Partial.Unsafe (unsafePartial)
+import Control.Monad.Eff
+import Control.Monad.Eff.Console (log)
+
+f x y z =
+ let f 1.0 2.0 3.0 = 1.0
+ in f x z y
+
+main :: Eff _ _
+main = do
+ log $ show $ unsafePartial f 1.0 3.0 2.0
+ log "Done"
diff --git a/examples/passing/SignedNumericLiterals.purs b/examples/passing/SignedNumericLiterals.purs
index 12937db..1ebcdb4 100644
--- a/examples/passing/SignedNumericLiterals.purs
+++ b/examples/passing/SignedNumericLiterals.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
p = 0.5
q = 1.0
@@ -14,4 +15,4 @@ f x = -x
test1 = 2.0 - 1.0
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/StringEscapes.purs b/examples/passing/StringEscapes.purs
index 2d97744..5867819 100644
--- a/examples/passing/StringEscapes.purs
+++ b/examples/passing/StringEscapes.purs
@@ -1,15 +1,17 @@
-module Main where
-
-import Prelude ((==), bind)
-import Test.Assert (assert)
-
-singleCharacter = "\0\b\t\n\v\f\r\"\\" == "\x0\x8\x9\xA\xB\xC\xD\x22\x5C"
-hex = "\x1D306\x2603\x3C6\xE0\x0" == "𝌆☃φà\0"
-decimal = "\119558\9731\966\224\0" == "𝌆☃φà\0"
-surrogatePair = "\xD834\xDF06" == "\x1D306"
-
-main = do
- assert singleCharacter
- assert hex
- assert decimal
- assert surrogatePair
+module Main where
+
+import Prelude ((==), bind)
+import Test.Assert (assert)
+import Control.Monad.Eff.Console (log)
+
+singleCharacter = "\0\b\t\n\v\f\r\"\\" == "\x0\x8\x9\xA\xB\xC\xD\x22\x5C"
+hex = "\x1D306\x2603\x3C6\xE0\x0" == "𝌆☃φà\0"
+decimal = "\119558\9731\966\224\0" == "𝌆☃φà\0"
+surrogatePair = "\xD834\xDF06" == "\x1D306"
+
+main = do
+ assert singleCharacter
+ assert hex
+ assert decimal
+ assert surrogatePair
+ log "Done"
diff --git a/examples/passing/Superclasses1.purs b/examples/passing/Superclasses1.purs
index cdf075f..342f9ac 100644
--- a/examples/passing/Superclasses1.purs
+++ b/examples/passing/Superclasses1.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log, logShow)
class Su a where
su :: a -> a
@@ -17,4 +18,6 @@ instance clNumber :: Cl Number where
test :: forall a. (Cl a) => a -> a
test a = su (cl a a)
-main = Control.Monad.Eff.Console.print $ test 10.0
+main = do
+ logShow $ test 10.0
+ log "Done"
diff --git a/examples/passing/Superclasses3.purs b/examples/passing/Superclasses3.purs
index d1135a0..1419864 100644
--- a/examples/passing/Superclasses3.purs
+++ b/examples/passing/Superclasses3.purs
@@ -28,7 +28,7 @@ instance applyMTrace :: Apply MTrace where
apply = ap
instance applicativeMTrace :: Applicative MTrace where
- pure = MTrace <<< return
+ pure = MTrace <<< pure
instance bindMTrace :: Bind MTrace where
bind m f = MTrace (runMTrace m >>= (runMTrace <<< f))
diff --git a/examples/passing/TCO.purs b/examples/passing/TCO.purs
index 8567178..dc55311 100644
--- a/examples/passing/TCO.purs
+++ b/examples/passing/TCO.purs
@@ -1,20 +1,20 @@
module Main where
import Prelude
-import Control.Monad.Eff.Console (print)
+import Control.Monad.Eff.Console (log, logShow)
main = do
let f x = x + 1
let v = 0
- print (applyN 0 f v)
- print (applyN 1 f v)
- print (applyN 2 f v)
- print (applyN 3 f v)
- print (applyN 4 f v)
+ logShow (applyN 0 f v)
+ logShow (applyN 1 f v)
+ logShow (applyN 2 f v)
+ logShow (applyN 3 f v)
+ logShow (applyN 4 f v)
+ log "Done"
applyN :: forall a. Int -> (a -> a) -> a -> a
applyN = go id
where
go f n _ | n <= 0 = f
go f n g = go (f >>> g) (n - 1) g
-
diff --git a/examples/passing/TCOCase.purs b/examples/passing/TCOCase.purs
index 654aa53..45cde9f 100644
--- a/examples/passing/TCOCase.purs
+++ b/examples/passing/TCOCase.purs
@@ -1,10 +1,11 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
data Data = One | More Data
-main = Control.Monad.Eff.Console.log (from (to 10000.0 One))
+main = log (from (to 10000.0 One))
where
to 0.0 a = a
to n a = to (n - 1.0) (More a)
diff --git a/examples/passing/TailCall.purs b/examples/passing/TailCall.purs
index 1fad423..83d199e 100644
--- a/examples/passing/TailCall.purs
+++ b/examples/passing/TailCall.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log, logShow)
data L a = C a (L a) | N
@@ -14,4 +15,6 @@ loop x = loop (x + 1.0)
notATailCall = \x ->
(\notATailCall -> notATailCall x) (\x -> x)
-main = Control.Monad.Eff.Console.print (test 0.0 (1.0 `C` (2.0 `C` (3.0 `C` N))))
+main = do
+ logShow (test 0.0 (1.0 `C` (2.0 `C` (3.0 `C` N))))
+ log "Done"
diff --git a/examples/passing/Tick.purs b/examples/passing/Tick.purs
index 6b8f19e..4e655e6 100644
--- a/examples/passing/Tick.purs
+++ b/examples/passing/Tick.purs
@@ -1,7 +1,8 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
test' x = x
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/TopLevelCase.purs b/examples/passing/TopLevelCase.purs
index 1e11b7d..c43bc65 100644
--- a/examples/passing/TopLevelCase.purs
+++ b/examples/passing/TopLevelCase.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
gcd :: Number -> Number -> Number
gcd 0.0 x = x
@@ -15,4 +16,4 @@ data A = A
parseTest A 0.0 = 0.0
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/TransitiveImport.purs b/examples/passing/TransitiveImport.purs
new file mode 100644
index 0000000..04e00d3
--- /dev/null
+++ b/examples/passing/TransitiveImport.purs
@@ -0,0 +1,9 @@
+module Main where
+
+ import Prelude
+ import Middle
+ import Control.Monad.Eff.Console
+
+ main = do
+ logShow (middle unit)
+ log "Done"
diff --git a/examples/passing/TransitiveImport/Middle.purs b/examples/passing/TransitiveImport/Middle.purs
new file mode 100644
index 0000000..c4b5282
--- /dev/null
+++ b/examples/passing/TransitiveImport/Middle.purs
@@ -0,0 +1,5 @@
+module Middle where
+
+import Test (test)
+
+middle = test
diff --git a/examples/passing/TransitiveImport/Test.purs b/examples/passing/TransitiveImport/Test.purs
new file mode 100644
index 0000000..cd06ec2
--- /dev/null
+++ b/examples/passing/TransitiveImport/Test.purs
@@ -0,0 +1,9 @@
+module Test where
+
+import Prelude
+
+class TestCls a where
+ test :: a -> a
+
+instance unitTestCls :: TestCls Unit where
+ test _ = unit
diff --git a/examples/passing/TypeClassMemberOrderChange.purs b/examples/passing/TypeClassMemberOrderChange.purs
index 2e38b7d..5ad8dcb 100644
--- a/examples/passing/TypeClassMemberOrderChange.purs
+++ b/examples/passing/TypeClassMemberOrderChange.purs
@@ -1,13 +1,16 @@
-module Main where
-
-import Prelude
-
-class Test a where
- fn :: a -> a -> a
- val :: a
-
-instance testBoolean :: Test Boolean where
- val = true
- fn x y = y
-
-main = Control.Monad.Eff.Console.log (show (fn true val))
+module Main where
+
+import Prelude
+import Control.Monad.Eff.Console (log)
+
+class Test a where
+ fn :: a -> a -> a
+ val :: a
+
+instance testBoolean :: Test Boolean where
+ val = true
+ fn x y = y
+
+main = do
+ log (show (fn true val))
+ log "Done"
diff --git a/examples/passing/TypeClasses.purs b/examples/passing/TypeClasses.purs
index 1dfdf51..b65d93d 100644
--- a/examples/passing/TypeClasses.purs
+++ b/examples/passing/TypeClasses.purs
@@ -1,23 +1,24 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
test1 = \_ -> show "testing"
-f :: forall a. (Prelude.Show a) => a -> String
+f :: forall a. (Show a) => a -> String
f x = show x
test2 = \_ -> f "testing"
-test7 :: forall a. (Prelude.Show a) => a -> String
+test7 :: forall a. (Show a) => a -> String
test7 = show
test8 = \_ -> show $ "testing"
data Data a = Data a
-instance showData :: (Prelude.Show a) => Prelude.Show (Data a) where
- show (Data a) = "Data (" ++ show a ++ ")"
+instance showData :: (Show a) => Show (Data a) where
+ show (Data a) = "Data (" <> show a <> ")"
test3 = \_ -> show (Data "testing")
@@ -53,9 +54,9 @@ instance bindMaybe :: Bind Maybe where
instance monadMaybe :: Monad Maybe
test4 :: forall a m. (Monad m) => a -> m Number
-test4 = \_ -> return 1.0
+test4 = \_ -> pure 1.0
-test5 = \_ -> Just 1.0 >>= \n -> return (n + 1.0)
+test5 = \_ -> Just 1.0 >>= \n -> pure (n + 1.0)
ask r = r
@@ -63,7 +64,8 @@ runReader r f = f r
test9 _ = runReader 0.0 $ do
n <- ask
- return $ n + 1.0
-
-main = Control.Monad.Eff.Console.log (test7 "Done")
+ pure $ n + 1.0
+main = do
+ log (test7 "Hello")
+ log "Done"
diff --git a/examples/passing/TypeClassesInOrder.purs b/examples/passing/TypeClassesInOrder.purs
index a34db92..f02c037 100644
--- a/examples/passing/TypeClassesInOrder.purs
+++ b/examples/passing/TypeClassesInOrder.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
class Foo a where
foo :: a -> String
@@ -8,4 +9,4 @@ class Foo a where
instance fooString :: Foo String where
foo s = s
-main = Control.Monad.Eff.Console.log $ foo "Done"
+main = log $ foo "Done"
diff --git a/examples/passing/TypeClassesWithOverlappingTypeVariables.purs b/examples/passing/TypeClassesWithOverlappingTypeVariables.purs
index 9b5c6a9..281e7af 100644
--- a/examples/passing/TypeClassesWithOverlappingTypeVariables.purs
+++ b/examples/passing/TypeClassesWithOverlappingTypeVariables.purs
@@ -1,11 +1,12 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
data Either a b = Left a | Right b
-instance functorEither :: Prelude.Functor (Either a) where
+instance functorEither :: Functor (Either a) where
map _ (Left x) = Left x
map f (Right y) = Right (f y)
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/TypeDecl.purs b/examples/passing/TypeDecl.purs
index 76b32c4..6cecb57 100644
--- a/examples/passing/TypeDecl.purs
+++ b/examples/passing/TypeDecl.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
k :: String -> Number -> String
k x y = x
@@ -9,4 +10,4 @@ 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 = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/TypeOperators.purs b/examples/passing/TypeOperators.purs
index 72bd70b..fbbc723 100644
--- a/examples/passing/TypeOperators.purs
+++ b/examples/passing/TypeOperators.purs
@@ -1,34 +1,20 @@
-module A
- ( Tuple(..)
- , type (/\)
- , (/\)
- , Natural
- , type (~>)
- ) where
-
- data Tuple a b = Tuple a b
-
- infixl 6 Tuple as /\
- infixl 6 type Tuple as /\
-
- type Natural f g = ∀ a. f a → g a
-
- infixr 0 type Natural as ~>
+module Main where
- tup ∷ ∀ a b. a → b → b /\ a
- tup a b = b /\ a
+import A (type (~>), type (/\), (/\))
+import Control.Monad.Eff.Console (log)
- tupX ∷ ∀ a b c. a /\ b /\ c → c
- tupX (a /\ b /\ c) = c
+natty ∷ ∀ f. f ~> f
+natty x = x
-module Main where
+data Compose f g a = Compose (f (g a))
- import A (type (~>), type (/\), (/\))
+testPrecedence1 ∷ ∀ f g. Compose f g ~> Compose f g
+testPrecedence1 x = x
- natty ∷ ∀ f. f ~> f
- natty x = x
+testPrecedence2 ∷ ∀ f g. f ~> g → f ~> g
+testPrecedence2 nat fx = nat fx
- swap ∷ ∀ a b. a /\ b → b /\ a
- swap (a /\ b) = b /\ a
+swap ∷ ∀ a b. a /\ b → b /\ a
+swap (a /\ b) = b /\ a
- main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/TypeOperators/A.purs b/examples/passing/TypeOperators/A.purs
new file mode 100644
index 0000000..1c1fe8b
--- /dev/null
+++ b/examples/passing/TypeOperators/A.purs
@@ -0,0 +1,22 @@
+module A
+( Tuple(..)
+, type (/\)
+, (/\)
+, Natural
+, type (~>)
+) where
+
+data Tuple a b = Tuple a b
+
+infixl 6 Tuple as /\
+infixl 6 type Tuple as /\
+
+type Natural f g = ∀ a. f a → g a
+
+infixr 0 type Natural as ~>
+
+tup ∷ ∀ a b. a → b → b /\ a
+tup a b = b /\ a
+
+tupX ∷ ∀ a b c. a /\ b /\ c → c
+tupX (a /\ b /\ c) = c
diff --git a/examples/passing/TypeSynonymInData.purs b/examples/passing/TypeSynonymInData.purs
index 62da487..198d6f7 100644
--- a/examples/passing/TypeSynonymInData.purs
+++ b/examples/passing/TypeSynonymInData.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
type A a = Array a
@@ -8,4 +9,4 @@ data Foo a = Foo (A a) | Bar
foo (Foo []) = Bar
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/TypeSynonyms.purs b/examples/passing/TypeSynonyms.purs
index 3cc4cf9..0ca7984 100644
--- a/examples/passing/TypeSynonyms.purs
+++ b/examples/passing/TypeSynonyms.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
type Lens a b =
{ get :: a -> b
@@ -24,4 +25,4 @@ fst =
test1 :: forall a b c. Lens (Pair (Pair a b) c) a
test1 = composeLenses fst fst
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/TypeWildcards.purs b/examples/passing/TypeWildcards.purs
index f6f3da2..df9e3fd 100644
--- a/examples/passing/TypeWildcards.purs
+++ b/examples/passing/TypeWildcards.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
testTopLevel :: _ -> _
testTopLevel n = n + 1.0
@@ -12,4 +13,4 @@ test f a = go (f a) a
go a1 a2 | a1 == a2 = a1
go a1 _ = go (f a1) a1
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/TypeWildcardsRecordExtension.purs b/examples/passing/TypeWildcardsRecordExtension.purs
index 615fe9e..fe21b47 100644
--- a/examples/passing/TypeWildcardsRecordExtension.purs
+++ b/examples/passing/TypeWildcardsRecordExtension.purs
@@ -1,8 +1,9 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
foo :: forall a. {b :: Number | a} -> {b :: Number | _}
foo f = f
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/TypeWithoutParens.purs b/examples/passing/TypeWithoutParens.purs
index 4aca413..729016f 100644
--- a/examples/passing/TypeWithoutParens.purs
+++ b/examples/passing/TypeWithoutParens.purs
@@ -1,16 +1,12 @@
-module Lib (X, Y) where
-
- data X = X
- type Y = X
-
module Main where
- import Lib (X, Y)
+import Lib (X, Y)
+import Control.Monad.Eff.Console (log)
- idX :: X -> X
- idX x = x
+idX :: X -> X
+idX x = x
- idY :: Y -> Y
- idY y = y
+idY :: Y -> Y
+idY y = y
- main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/TypeWithoutParens/Lib.purs b/examples/passing/TypeWithoutParens/Lib.purs
new file mode 100644
index 0000000..95b9a09
--- /dev/null
+++ b/examples/passing/TypeWithoutParens/Lib.purs
@@ -0,0 +1,4 @@
+module Lib (X, Y) where
+
+data X = X
+type Y = X
diff --git a/examples/passing/TypedBinders.purs b/examples/passing/TypedBinders.purs
index 6f8ca7b..2d3da7c 100644
--- a/examples/passing/TypedBinders.purs
+++ b/examples/passing/TypedBinders.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
data Tuple a b = Tuple a b
@@ -31,27 +32,27 @@ instance monadStateState :: MonadState s (State s) where
get = State (\s -> Tuple s s)
put s = State (\_ -> Tuple s {})
-modify :: forall m s. (Prelude.Monad m, MonadState s m) => (s -> s) -> m {}
+modify :: forall m s. (Monad m, MonadState s m) => (s -> s) -> m {}
modify f = do
s <- get
put (f s)
test :: Tuple String String
test = runState "" $ do
- modify $ (++) "World!"
- modify $ (++) "Hello, "
+ modify $ (<>) "World!"
+ modify $ (<>) "Hello, "
str :: String <- get
- return str
+ pure str
test2 :: (Int -> Int) -> Int
test2 = (\(f :: Int -> Int) -> f 10)
-test3 :: Int -> Boolean
+test3 :: Int -> Boolean
test3 n = case n of
(0 :: Int) -> true
_ -> false
-test4 :: Tuple Int Int -> Tuple Int Int
+test4 :: Tuple Int Int -> Tuple Int Int
test4 = (\(Tuple a b :: Tuple Int Int) -> Tuple b a)
type Int1 = Int
@@ -64,4 +65,4 @@ main = do
t2 = test2 id
t3 = test3 1
t4 = test4 (Tuple 1 0)
- Control.Monad.Eff.Console.log "Done"
+ log "Done"
diff --git a/examples/passing/TypedWhere.purs b/examples/passing/TypedWhere.purs
index 1773696..d9c489a 100644
--- a/examples/passing/TypedWhere.purs
+++ b/examples/passing/TypedWhere.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
data E a b = L a | R b
@@ -14,4 +15,4 @@ lefts = go N
go ls (C (L a) rest) = go (C a ls) rest
go ls (C _ rest) = go ls rest
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/UTF8Sourcefile.purs b/examples/passing/UTF8Sourcefile.purs
index da102a3..1dbc2cb 100644
--- a/examples/passing/UTF8Sourcefile.purs
+++ b/examples/passing/UTF8Sourcefile.purs
@@ -1,10 +1,8 @@
-module Main where
-
-import Control.Monad.Eff.Console
-
--- '→' is multibyte sequence \u2192.
-utf8multibyte = "Hello λ→ world!!"
-
-main = do
- log "done"
-
+module Main where
+
+import Control.Monad.Eff.Console
+
+-- '→' is multibyte sequence \u2192.
+utf8multibyte = "Hello λ→ world!!"
+
+main = log "Done"
diff --git a/examples/passing/UnderscoreIdent.purs b/examples/passing/UnderscoreIdent.purs
index 318bda3..0a02edc 100644
--- a/examples/passing/UnderscoreIdent.purs
+++ b/examples/passing/UnderscoreIdent.purs
@@ -1,11 +1,13 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
data Data_type = Con_Structor | Con_2 String
type Type_name = Data_type
done (Con_2 s) = s
+done _ = "Failed"
-main = Control.Monad.Eff.Console.log (done (Con_2 "Done"))
+main = log (done (Con_2 "Done"))
diff --git a/examples/passing/UnicodeIdentifier.purs b/examples/passing/UnicodeIdentifier.purs
index 0be0e3e..9041a4f 100644
--- a/examples/passing/UnicodeIdentifier.purs
+++ b/examples/passing/UnicodeIdentifier.purs
@@ -1,5 +1,7 @@
module Main where
+import Control.Monad.Eff.Console (log)
+
f asgård = asgård
-main = Control.Monad.Eff.Console.log (f "Done")
+main = log (f "Done")
diff --git a/examples/passing/UnicodeOperators.purs b/examples/passing/UnicodeOperators.purs
index 3fa3347..f93584f 100644
--- a/examples/passing/UnicodeOperators.purs
+++ b/examples/passing/UnicodeOperators.purs
@@ -1,5 +1,7 @@
module Main where
+import Control.Monad.Eff.Console (log)
+
compose :: forall a b c. (b -> c) -> (a -> b) -> a -> c
compose f g a = f (g a)
@@ -17,4 +19,4 @@ emptySet _ = true
test2 = 1 ∈ emptySet
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/UnicodeType.purs b/examples/passing/UnicodeType.purs
index 7e4ecb9..59e732f 100644
--- a/examples/passing/UnicodeType.purs
+++ b/examples/passing/UnicodeType.purs
@@ -1,23 +1,22 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
-class (Monad m) ⇐ Monad1 m where
+class Monad m ⇐ Monad1 m where
f1 :: Int
-class (Monad m) <= Monad2 m where
+class Monad m <= Monad2 m where
f2 :: Int
f ∷ ∀ m. Monad m ⇒ Int → m Int
f n = do
- n' ← return n
- return n'
+ n' ← pure n
+ pure n'
f' :: forall m. Monad m => Int -> m Int
f' n = do
- n' <- return n
- return n'
+ n' <- pure n
+ pure n'
-(←→) a b = a ←→ b
-
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/Unit.purs b/examples/passing/Unit.purs
index 5e55528..1449d72 100644
--- a/examples/passing/Unit.purs
+++ b/examples/passing/Unit.purs
@@ -1,6 +1,8 @@
module Main where
import Prelude
-import Control.Monad.Eff.Console
+import Control.Monad.Eff.Console (logShow, log)
-main = print (const unit $ "Hello world")
+main = do
+ logShow (const unit $ "Hello world")
+ log "Done"
diff --git a/examples/passing/UnknownInTypeClassLookup.purs b/examples/passing/UnknownInTypeClassLookup.purs
index 94f929f..7ba6806 100644
--- a/examples/passing/UnknownInTypeClassLookup.purs
+++ b/examples/passing/UnknownInTypeClassLookup.purs
@@ -1,6 +1,7 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
class EQ a b
@@ -11,4 +12,4 @@ test _ _ = "Done"
runTest a = test a a
-main = Control.Monad.Eff.Console.log $ runTest 0.0
+main = log $ runTest 0.0
diff --git a/examples/passing/UntupledConstraints.purs b/examples/passing/UntupledConstraints.purs
index 55cff87..4850794 100644
--- a/examples/passing/UntupledConstraints.purs
+++ b/examples/passing/UntupledConstraints.purs
@@ -1,7 +1,7 @@
module Main where
import Prelude
-import Control.Monad.Eff.Console
+import Control.Monad.Eff.Console (log)
class Show a <= Nonsense a where
method :: a -> a
diff --git a/examples/passing/Where.purs b/examples/passing/Where.purs
index 942255f..fa9169d 100644
--- a/examples/passing/Where.purs
+++ b/examples/passing/Where.purs
@@ -1,8 +1,9 @@
module Main where
import Prelude
+import Partial.Unsafe (unsafePartial)
import Control.Monad.Eff
-import Control.Monad.ST
+import Control.Monad.Eff.Console (logShow, log)
test1 x = y
where
@@ -14,15 +15,12 @@ test2 x y = x' + y'
x' = x + 1.0
y' = y + 1.0
-
test3 = f 1.0 2.0 3.0
where f x y z = x + y + z
-
test4 = f (+) [1.0, 2.0]
where f x [y, z] = x y z
-
test5 = g 10.0
where
f x | x > 0.0 = g (x / 2.0) + 1.0
@@ -39,11 +37,13 @@ test7 x = go x
go y | (x - 0.1 < y * y) && (y * y < x + 0.1) = y
go y = go $ (y + x / y) / 2.0
+main :: Eff _ _
main = do
- Control.Monad.Eff.Console.print (test1 1.0)
- Control.Monad.Eff.Console.print (test2 1.0 2.0)
- Control.Monad.Eff.Console.print test3
- Control.Monad.Eff.Console.print test4
- Control.Monad.Eff.Console.print test5
- Control.Monad.Eff.Console.print test6
- Control.Monad.Eff.Console.print (test7 100.0)
+ logShow (test1 1.0)
+ logShow (test2 1.0 2.0)
+ logShow test3
+ unsafePartial (logShow test4)
+ logShow test5
+ logShow test6
+ logShow (test7 100.0)
+ log "Done"
diff --git a/examples/passing/WildcardType.purs b/examples/passing/WildcardType.purs
new file mode 100644
index 0000000..b661aca
--- /dev/null
+++ b/examples/passing/WildcardType.purs
@@ -0,0 +1,12 @@
+module Main where
+
+import Prelude
+import Control.Monad.Eff.Console (log)
+
+f1 :: (_ -> _) -> _
+f1 g = g 1
+
+f2 :: _ -> _
+f2 _ = "Done"
+
+main = log $ f1 f2
diff --git a/examples/passing/iota.purs b/examples/passing/iota.purs
index be0430e..a261eb5 100644
--- a/examples/passing/iota.purs
+++ b/examples/passing/iota.purs
@@ -1,9 +1,11 @@
module Main where
+import Control.Monad.Eff.Console (log)
+
s = \x -> \y -> \z -> x z (y z)
k = \x -> \y -> x
iota = \x -> x s k
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/passing/s.purs b/examples/passing/s.purs
index 041b125..a161491 100644
--- a/examples/passing/s.purs
+++ b/examples/passing/s.purs
@@ -1,7 +1,8 @@
module Main where
import Prelude
+import Control.Monad.Eff.Console (log)
s = \x y z -> x z (y z)
-main = Control.Monad.Eff.Console.log "Done"
+main = log "Done"
diff --git a/examples/warning/DuplicateExportRef.purs b/examples/warning/DuplicateExportRef.purs
new file mode 100644
index 0000000..aa70f7a
--- /dev/null
+++ b/examples/warning/DuplicateExportRef.purs
@@ -0,0 +1,30 @@
+-- @shouldWarnWith DuplicateExportRef
+-- @shouldWarnWith DuplicateExportRef
+-- @shouldWarnWith DuplicateExportRef
+-- @shouldWarnWith DuplicateExportRef
+-- @shouldWarnWith DuplicateExportRef
+-- @shouldWarnWith DuplicateExportRef
+-- @shouldWarnWith DuplicateExportRef
+module Main
+ ( X(X, X), X
+ , fn, fn
+ , (!), (!)
+ , class Y, class Y
+ , Natural, type (~>), type (~>)
+ , module Prelude, module Prelude
+ ) where
+
+import Prelude (Unit)
+
+data X = X
+
+fn :: X -> X -> X
+fn _ _ = X
+
+infix 2 fn as !
+
+class Y a
+
+type Natural f g = forall a. f a -> g a
+
+infixl 1 type Natural as ~>
diff --git a/examples/warning/DuplicateImport.purs b/examples/warning/DuplicateImport.purs
new file mode 100644
index 0000000..ff92cbe
--- /dev/null
+++ b/examples/warning/DuplicateImport.purs
@@ -0,0 +1,10 @@
+-- @shouldWarnWith DuplicateImport
+module Main where
+
+import Prelude (Unit, unit, pure)
+import Prelude (Unit, unit, pure)
+
+import Control.Monad.Eff (Eff)
+
+main :: Eff () Unit
+main = pure unit
diff --git a/examples/warning/DuplicateImportRef.purs b/examples/warning/DuplicateImportRef.purs
new file mode 100644
index 0000000..e082bd4
--- /dev/null
+++ b/examples/warning/DuplicateImportRef.purs
@@ -0,0 +1,18 @@
+-- @shouldWarnWith DuplicateImportRef
+-- @shouldWarnWith DuplicateImportRef
+-- @shouldWarnWith DuplicateImportRef
+-- @shouldWarnWith DuplicateImportRef
+module Main where
+
+import Prelude
+ ( Unit, Unit
+ , unit, unit
+ , class Functor, class Functor
+ , (<>), (<>)
+ )
+
+u :: Unit
+u = unit <> unit
+
+fid :: forall f a. Functor f => f a -> f a
+fid fa = fa
diff --git a/examples/warning/DuplicateSelectiveImport.purs b/examples/warning/DuplicateSelectiveImport.purs
new file mode 100644
index 0000000..848b21d
--- /dev/null
+++ b/examples/warning/DuplicateSelectiveImport.purs
@@ -0,0 +1,10 @@
+-- @shouldWarnWith DuplicateSelectiveImport
+module Main where
+
+import Prelude (Unit, unit)
+import Prelude (pure)
+
+import Control.Monad.Eff (Eff)
+
+main :: Eff () Unit
+main = pure unit
diff --git a/examples/warning/HidingImport.purs b/examples/warning/HidingImport.purs
new file mode 100644
index 0000000..a45bfb9
--- /dev/null
+++ b/examples/warning/HidingImport.purs
@@ -0,0 +1,9 @@
+-- @shouldWarnWith HidingImport
+-- @shouldWarnWith HidingImport
+module Main where
+
+import Prelude hiding (one)
+import Control.Monad.Eff hiding (runPure)
+
+main :: Eff () Unit
+main = pure unit
diff --git a/examples/warning/ImplicitImport.purs b/examples/warning/ImplicitImport.purs
new file mode 100644
index 0000000..bca2996
--- /dev/null
+++ b/examples/warning/ImplicitImport.purs
@@ -0,0 +1,9 @@
+-- @shouldWarnWith ImplicitImport
+-- @shouldWarnWith ImplicitImport
+module Main where
+
+import Prelude
+import Control.Monad.Eff
+
+main :: Eff () Unit
+main = pure unit
diff --git a/examples/warning/ImplicitQualifiedImport.purs b/examples/warning/ImplicitQualifiedImport.purs
new file mode 100644
index 0000000..36f69d6
--- /dev/null
+++ b/examples/warning/ImplicitQualifiedImport.purs
@@ -0,0 +1,11 @@
+-- @shouldWarnWith ImplicitQualifiedImport
+-- @shouldWarnWith ImplicitQualifiedImport
+module Main where
+
+import Data.Unit
+
+import Control.Monad.Eff as E
+import Control.Monad.Eff.Console as E
+
+main :: E.Eff (console :: E.CONSOLE) Unit
+main = E.log "test"
diff --git a/examples/warning/MissingTypeDeclaration.purs b/examples/warning/MissingTypeDeclaration.purs
new file mode 100644
index 0000000..a5b8466
--- /dev/null
+++ b/examples/warning/MissingTypeDeclaration.purs
@@ -0,0 +1,4 @@
+-- @shouldWarnWith MissingTypeDeclaration
+module Main where
+
+x = 0
diff --git a/examples/warning/OverlappingInstances.purs b/examples/warning/OverlappingInstances.purs
new file mode 100644
index 0000000..b5d9323
--- /dev/null
+++ b/examples/warning/OverlappingInstances.purs
@@ -0,0 +1,17 @@
+-- @shouldWarnWith OverlappingInstances
+module Main where
+
+class Test a where
+ test :: a -> a
+
+instance testRefl :: Test a where
+ test x = x
+
+instance testInt :: Test Int where
+ test _ = 0
+
+-- The OverlappingInstances instances warning only arises when there are two
+-- choices for a dictionary, not when the instances are defined. So without
+-- `value` this module would not raise a warning.
+value :: Int
+value = test 1
diff --git a/examples/warning/OverlappingPattern.purs b/examples/warning/OverlappingPattern.purs
new file mode 100644
index 0000000..d667eb3
--- /dev/null
+++ b/examples/warning/OverlappingPattern.purs
@@ -0,0 +1,15 @@
+-- @shouldWarnWith OverlappingPattern
+-- @shouldWarnWith OverlappingPattern
+module Main where
+
+data X = A | B
+
+pat1 :: X -> Boolean
+pat1 A = true
+pat1 A = true
+pat1 B = false
+
+pat2 :: X -> Boolean
+pat2 A = true
+pat2 _ = false
+pat2 B = false
diff --git a/examples/warning/ScopeShadowing.purs b/examples/warning/ScopeShadowing.purs
new file mode 100644
index 0000000..380a4ee
--- /dev/null
+++ b/examples/warning/ScopeShadowing.purs
@@ -0,0 +1,13 @@
+-- @shouldWarnWith ScopeShadowing
+module Main where
+
+import Prelude
+
+-- No warning at the definition, only when the name is later resolved
+data Unit = Unit
+
+-- This is only a warning as the `Prelude` import is implicit. If `Unit` was
+-- named explicitly in an import list, then this refernce to `Unit`
+-- would be a `ScopeConflict` error instead.
+test :: Unit
+test = const Unit unit
diff --git a/examples/warning/ShadowedTypeVar.purs b/examples/warning/ShadowedTypeVar.purs
new file mode 100644
index 0000000..89813e7
--- /dev/null
+++ b/examples/warning/ShadowedTypeVar.purs
@@ -0,0 +1,5 @@
+-- @shouldWarnWith ShadowedTypeVar
+module Main where
+
+f :: forall a. (forall a. a -> a) -> a -> a
+f g x = g x
diff --git a/examples/warning/UnnecessaryFFIModule.js b/examples/warning/UnnecessaryFFIModule.js
new file mode 100644
index 0000000..346c8e9
--- /dev/null
+++ b/examples/warning/UnnecessaryFFIModule.js
@@ -0,0 +1 @@
+exports.out = null;
diff --git a/examples/warning/UnnecessaryFFIModule.purs b/examples/warning/UnnecessaryFFIModule.purs
new file mode 100644
index 0000000..947aef9
--- /dev/null
+++ b/examples/warning/UnnecessaryFFIModule.purs
@@ -0,0 +1,5 @@
+-- @shouldWarnWith UnnecessaryFFIModule
+module Main where
+
+t :: Boolean
+t = true
diff --git a/examples/warning/UnusedDctorExplicitImport.purs b/examples/warning/UnusedDctorExplicitImport.purs
new file mode 100644
index 0000000..35040ef
--- /dev/null
+++ b/examples/warning/UnusedDctorExplicitImport.purs
@@ -0,0 +1,8 @@
+-- @shouldWarnWith UnusedDctorExplicitImport
+module Main where
+
+import Data.Ordering (Ordering(EQ, LT))
+
+f :: Ordering -> Ordering
+f EQ = EQ
+f x = x
diff --git a/examples/warning/UnusedDctorImportAll.purs b/examples/warning/UnusedDctorImportAll.purs
new file mode 100644
index 0000000..807302f
--- /dev/null
+++ b/examples/warning/UnusedDctorImportAll.purs
@@ -0,0 +1,7 @@
+-- @shouldWarnWith UnusedDctorImport
+module Main where
+
+import Data.Ordering (Ordering(..))
+
+f :: Ordering -> Ordering
+f x = x
diff --git a/examples/warning/UnusedDctorImportExplicit.purs b/examples/warning/UnusedDctorImportExplicit.purs
new file mode 100644
index 0000000..11dc2d6
--- /dev/null
+++ b/examples/warning/UnusedDctorImportExplicit.purs
@@ -0,0 +1,7 @@
+-- @shouldWarnWith UnusedDctorImport
+module Main where
+
+import Data.Ordering (Ordering(EQ))
+
+f :: Ordering -> Ordering
+f x = x
diff --git a/examples/warning/UnusedExplicitImport.purs b/examples/warning/UnusedExplicitImport.purs
new file mode 100644
index 0000000..a6705e3
--- /dev/null
+++ b/examples/warning/UnusedExplicitImport.purs
@@ -0,0 +1,8 @@
+-- @shouldWarnWith UnusedExplicitImport
+module Main where
+
+import Prelude (Unit, unit, pure, bind)
+import Control.Monad.Eff (Eff)
+
+main :: Eff () Unit
+main = pure unit
diff --git a/examples/warning/UnusedFFIImplementations.js b/examples/warning/UnusedFFIImplementations.js
new file mode 100644
index 0000000..d50f2e6
--- /dev/null
+++ b/examples/warning/UnusedFFIImplementations.js
@@ -0,0 +1,2 @@
+exports.yes = true;
+exports.no = false;
diff --git a/examples/warning/UnusedFFIImplementations.purs b/examples/warning/UnusedFFIImplementations.purs
new file mode 100644
index 0000000..6e263bf
--- /dev/null
+++ b/examples/warning/UnusedFFIImplementations.purs
@@ -0,0 +1,4 @@
+-- @shouldWarnWith UnusedFFIImplementations
+module Main where
+
+foreign import yes :: Boolean
diff --git a/examples/warning/UnusedImport.purs b/examples/warning/UnusedImport.purs
new file mode 100644
index 0000000..d13840b
--- /dev/null
+++ b/examples/warning/UnusedImport.purs
@@ -0,0 +1,14 @@
+-- @shouldWarnWith UnusedImport
+-- @shouldWarnWith UnusedImport
+-- @shouldWarnWith UnusedImport
+module Main where
+
+import Data.Unit (Unit, unit)
+
+-- All of the below are unused
+import Control.Monad.Eff
+import Control.Monad.Eff.Console as Console
+import Test.Assert ()
+
+main :: Unit
+main = unit
diff --git a/examples/warning/UnusedTypeVar.purs b/examples/warning/UnusedTypeVar.purs
new file mode 100644
index 0000000..03a6410
--- /dev/null
+++ b/examples/warning/UnusedTypeVar.purs
@@ -0,0 +1,5 @@
+-- @shouldWarnWith UnusedTypeVar
+module Main where
+
+f :: forall a b. a -> a
+f x = x
diff --git a/examples/warning/WildcardInferredType.purs b/examples/warning/WildcardInferredType.purs
new file mode 100644
index 0000000..3662384
--- /dev/null
+++ b/examples/warning/WildcardInferredType.purs
@@ -0,0 +1,23 @@
+-- @shouldWarnWith WildcardInferredType
+-- @shouldWarnWith WildcardInferredType
+-- @shouldWarnWith WildcardInferredType
+-- @shouldWarnWith WildcardInferredType
+module Main where
+
+x :: Int
+x = 0 :: _
+
+y :: _
+y = 0
+
+z :: Int
+z =
+ let n :: _
+ n = 0
+ in n
+
+w :: Int
+w = n
+ where
+ n :: _
+ n = 0
diff --git a/hierarchy/Main.hs b/hierarchy/Main.hs
index adc3de0..a6d7b07 100644
--- a/hierarchy/Main.hs
+++ b/hierarchy/Main.hs
@@ -65,7 +65,7 @@ compile (HierarchyOptions inputGlob mOutput) = do
input <- glob inputGlob
modules <- readInput input
case modules of
- Left errs -> hPutStr stderr (P.prettyPrintMultipleErrors False errs) >> exitFailure
+ Left errs -> hPutStr stderr (P.prettyPrintMultipleErrors P.defaultPPEOptions errs) >> exitFailure
Right ms -> do
for_ ms $ \(P.Module _ _ moduleName decls _) ->
let name = runModuleName moduleName
@@ -84,7 +84,7 @@ compile (HierarchyOptions inputGlob mOutput) = do
superClasses :: P.Declaration -> [SuperMap]
superClasses (P.TypeClassDeclaration sub _ supers@(_:_) _) =
- fmap (\(P.Qualified _ super, _) -> SuperMap (Right (super, sub))) supers
+ fmap (\(P.Constraint (P.Qualified _ super) _ _) -> SuperMap (Right (super, sub))) supers
superClasses (P.TypeClassDeclaration sub _ _ _) = [SuperMap (Left sub)]
superClasses (P.PositionedDeclaration _ _ decl) = superClasses decl
superClasses _ = []
@@ -113,4 +113,3 @@ main = execParser opts >>= compile
infoModList = fullDesc <> headerInfo <> footerInfo
headerInfo = header "hierarchy - Creates a GraphViz directed graph of PureScript TypeClasses"
footerInfo = footer $ "hierarchy " ++ showVersion Paths.version
-
diff --git a/psc-bundle/Main.hs b/psc-bundle/Main.hs
index a1051ca..5e21484 100644
--- a/psc-bundle/Main.hs
+++ b/psc-bundle/Main.hs
@@ -6,7 +6,6 @@
-- | Bundles compiled PureScript modules for the browser.
module Main (main) where
-import Data.Maybe
import Data.Traversable (for)
import Data.Version (showVersion)
@@ -36,7 +35,6 @@ data Options = Options
, optionsEntryPoints :: [String]
, optionsMainModule :: Maybe String
, optionsNamespace :: String
- , optionsRequirePath :: Maybe FilePath
} deriving Show
-- | Given a filename, assuming it is in the correct place on disk, infer a ModuleIdentifier.
@@ -63,7 +61,7 @@ app Options{..} = do
let entryIds = map (`ModuleIdentifier` Regular) optionsEntryPoints
- bundle input entryIds optionsMainModule optionsNamespace optionsRequirePath
+ bundle input entryIds optionsMainModule optionsNamespace
-- | Command line options parser.
options :: Parser Options
@@ -72,7 +70,6 @@ options = Options <$> some inputFile
<*> many entryPoint
<*> optional mainModule
<*> namespace
- <*> optional requirePath
where
inputFile :: Parser FilePath
inputFile = strArgument $
@@ -104,19 +101,12 @@ options = Options <$> some inputFile
<> showDefault
<> help "Specify the namespace that PureScript modules will be exported to when running in the browser."
- requirePath :: Parser FilePath
- requirePath = strOption $
- short 'r'
- <> long "require-path"
- <> help "The path prefix used in require() calls in the generated JavaScript [deprecated]"
-
-- | Make it go.
main :: IO ()
main = do
hSetEncoding stdout utf8
hSetEncoding stderr utf8
opts <- execParser (info (version <*> helper <*> options) infoModList)
- when (isJust (optionsRequirePath opts)) $ hPutStrLn stderr "The require-path option is deprecated and will be removed in PureScript 0.9."
output <- runExceptT (app opts)
case output of
Left err -> do
diff --git a/psc-docs/Main.hs b/psc-docs/Main.hs
index d7528e3..63d0f31 100644
--- a/psc-docs/Main.hs
+++ b/psc-docs/Main.hs
@@ -95,7 +95,7 @@ docgen (PSCDocsOptions fmt inputGlob output) = do
Right x ->
return x
Left err -> do
- hPutStrLn stderr $ P.prettyPrintMultipleErrors False err
+ hPutStrLn stderr $ P.prettyPrintMultipleErrors P.defaultPPEOptions err
exitFailure
takeByName = takeModulesByName D.modName
diff --git a/psc-ide-client/Main.hs b/psc-ide-client/Main.hs
index 17c0596..79532e5 100644
--- a/psc-ide-client/Main.hs
+++ b/psc-ide-client/Main.hs
@@ -35,7 +35,7 @@ main = do
client :: PortID -> IO ()
client port = do
h <-
- connectTo "localhost" port `catch`
+ connectTo "127.0.0.1" port `catch`
(\(SomeException e) ->
putStrLn
("Couldn't connect to psc-ide-server on port: " ++
diff --git a/psc-ide-server/Main.hs b/psc-ide-server/Main.hs
index c19c7ca..e7fbdca 100644
--- a/psc-ide-server/Main.hs
+++ b/psc-ide-server/Main.hs
@@ -12,7 +12,6 @@
-- The server accepting commands for psc-ide
-----------------------------------------------------------------------------
-{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -40,10 +39,10 @@ import Language.PureScript.Ide.Util
import Language.PureScript.Ide.Error
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.Watcher
-import Network hiding (socketPort)
+import Network hiding (socketPort, accept)
import Network.BSD (getProtocolNumber)
import Network.Socket hiding (PortNumber, Type,
- accept, sClose)
+ sClose)
import Options.Applicative
import System.Directory
import System.FilePath
@@ -73,12 +72,13 @@ data Options = Options
{ optionsDirectory :: Maybe FilePath
, optionsOutputPath :: FilePath
, optionsPort :: PortID
+ , optionsNoWatch :: Bool
, optionsDebug :: Bool
}
main :: IO ()
main = do
- Options dir outputPath port debug <- execParser opts
+ Options dir outputPath port noWatch debug <- execParser opts
maybe (pure ()) setCurrentDirectory dir
serverState <- newTVarIO emptyPscIdeState
cwd <- getCurrentDirectory
@@ -89,31 +89,23 @@ main = do
(do putStrLn ("Your output directory didn't exist. I'll create it at: " <> fullOutputPath)
createDirectory fullOutputPath
putStrLn "This usually means you didn't compile your project yet."
- putStrLn "psc-ide needs you to compile your project (for example by running pulp build)"
- )
+ putStrLn "psc-ide needs you to compile your project (for example by running pulp build)")
- _ <- forkFinally (watcher serverState fullOutputPath) print
- let conf =
- Configuration
- {
- confDebug = debug
- , confOutputPath = outputPath
- }
- let env =
- PscIdeEnvironment
- {
- envStateVar = serverState
- , envConfiguration = conf
- }
+ unless noWatch $
+ void (forkFinally (watcher serverState fullOutputPath) print)
+
+ let conf = Configuration {confDebug = debug, confOutputPath = outputPath}
+ env = PscIdeEnvironment {envStateVar = serverState, envConfiguration = conf}
startServer port env
where
parser =
- Options <$>
- optional (strOption (long "directory" <> short 'd')) <*>
- strOption (long "output-directory" <> value "output/") <*>
- (PortNumber . fromIntegral <$>
- option auto (long "port" <> short 'p' <> value (4242 :: Integer))) <*>
- switch (long "debug")
+ Options
+ <$> optional (strOption (long "directory" <> short 'd'))
+ <*> strOption (long "output-directory" <> value "output/")
+ <*> (PortNumber . fromIntegral <$>
+ option auto (long "port" <> short 'p' <> value (4242 :: Integer)))
+ <*> switch (long "no-watch")
+ <*> switch (long "debug")
opts = info (version <*> helper <*> parser) mempty
version = abortOption
(InfoMsg (showVersion Paths.version))
@@ -167,7 +159,9 @@ acceptCommand sock = do
pure (cmd, h)
where
acceptConnection = liftIO $ do
- (h,_,_) <- accept sock
+ -- Use low level accept to prevent accidental reverse name resolution
+ (s,_) <- accept sock
+ h <- socketToHandle s ReadWriteMode
hSetEncoding h utf8
hSetBuffering h LineBuffering
pure h
diff --git a/psc/Main.hs b/psc/Main.hs
index 91a6f45..e99c13e 100644
--- a/psc/Main.hs
+++ b/psc/Main.hs
@@ -1,56 +1,54 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Main where
-import Control.Applicative
-import Control.Monad
-import Control.Monad.Error.Class (MonadError(..))
-import Control.Monad.Writer.Strict
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Writer.Strict
-import Data.List (isSuffixOf, partition)
-import Data.Version (showVersion)
-import qualified Data.Map as M
import qualified Data.Aeson as A
+import Data.Bool (bool)
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.UTF8 as BU8
+import qualified Data.Map as M
+import Data.Version (showVersion)
-import Options.Applicative as Opts
+import qualified Language.PureScript as P
+import Language.PureScript.Errors.JSON
+import Language.PureScript.Make
-import System.Exit (exitSuccess, exitFailure)
-import System.IO (hSetEncoding, hPutStrLn, stdout, stderr, utf8)
-import System.IO.UTF8
-import System.FilePath.Glob (glob)
+import Options.Applicative as Opts
-import qualified Language.PureScript as P
import qualified Paths_purescript as Paths
-import Language.PureScript.Make
-import Language.PureScript.Errors.JSON
+import qualified System.Console.ANSI as ANSI
+import System.Exit (exitSuccess, exitFailure)
+import System.FilePath.Glob (glob)
+import System.IO (hSetEncoding, hPutStrLn, stdout, stderr, utf8)
+import System.IO.UTF8
data PSCMakeOptions = PSCMakeOptions
{ pscmInput :: [FilePath]
- , pscmForeignInput :: [FilePath]
, pscmOutputDir :: FilePath
, pscmOpts :: P.Options
, pscmUsePrefix :: Bool
, pscmJSONErrors :: Bool
}
-data InputOptions = InputOptions
- { ioInputFiles :: [FilePath]
- }
-
-- | Argumnets: verbose, use JSON, warnings, errors
printWarningsAndErrors :: Bool -> Bool -> P.MultipleErrors -> Either P.MultipleErrors a -> IO ()
printWarningsAndErrors verbose False warnings errors = do
+ cc <- bool Nothing (Just P.defaultCodeColor) <$> ANSI.hSupportsANSI stderr
+ let ppeOpts = P.defaultPPEOptions { P.ppeCodeColor = cc, P.ppeFull = verbose }
when (P.nonEmpty warnings) $
- hPutStrLn stderr (P.prettyPrintMultipleWarnings verbose warnings)
+ hPutStrLn stderr (P.prettyPrintMultipleWarnings ppeOpts warnings)
case errors of
Left errs -> do
- hPutStrLn stderr (P.prettyPrintMultipleErrors verbose errs)
+ hPutStrLn stderr (P.prettyPrintMultipleErrors ppeOpts errs)
exitFailure
Right _ -> return ()
printWarningsAndErrors verbose True warnings errors = do
@@ -65,14 +63,12 @@ compile PSCMakeOptions{..} = do
when (null input && not pscmJSONErrors) $ do
hPutStrLn stderr "psc: No input files."
exitFailure
- let (jsFiles, pursFiles) = partition (isSuffixOf ".js") input
- moduleFiles <- readInput (InputOptions pursFiles)
- inputForeign <- globWarningOnMisses (unless pscmJSONErrors . warnFileTypeNotFound) pscmForeignInput
- foreignFiles <- forM (inputForeign ++ jsFiles) (\inFile -> (inFile,) <$> readUTF8File inFile)
+ moduleFiles <- readInput input
(makeErrors, makeWarnings) <- runMake pscmOpts $ do
- (ms, foreigns) <- parseInputs moduleFiles foreignFiles
- let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, fp)) ms
- makeActions = buildMakeActions pscmOutputDir filePathMap foreigns pscmUsePrefix
+ ms <- P.parseModulesFromFiles id moduleFiles
+ let filePathMap = M.fromList $ map (\(fp, P.Module _ _ mn _ _) -> (mn, Right fp)) ms
+ foreigns <- inferForeignModules filePathMap
+ let makeActions = buildMakeActions pscmOutputDir filePathMap foreigns pscmUsePrefix
P.make makeActions (map snd ms)
printWarningsAndErrors (P.optionsVerboseErrors pscmOpts) pscmJSONErrors makeWarnings makeErrors
exitSuccess
@@ -89,28 +85,14 @@ globWarningOnMisses warn = concatMapM globWithWarning
return paths
concatMapM f = liftM concat . mapM f
-readInput :: InputOptions -> IO [(Either P.RebuildPolicy FilePath, String)]
-readInput InputOptions{..} = forM ioInputFiles $ \inFile -> (Right inFile, ) <$> readUTF8File inFile
-
-parseInputs :: (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)
-parseInputs modules foreigns =
- (,) <$> P.parseModulesFromFiles (either (const "") id) modules
- <*> P.parseForeignModulesFromFiles foreigns
+readInput :: [FilePath] -> IO [(FilePath, String)]
+readInput inputFiles = forM inputFiles $ \inFile -> (inFile, ) <$> readUTF8File inFile
inputFile :: Parser FilePath
inputFile = strArgument $
metavar "FILE"
<> help "The input .purs file(s)"
-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'
@@ -119,12 +101,6 @@ outputDirectory = strOption $
<> 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 [deprecated]"
-
noTco :: Parser Bool
noTco = switch $
long "no-tco"
@@ -175,12 +151,10 @@ options = P.Options <$> noTco
<*> noOpts
<*> verboseErrors
<*> (not <$> comments)
- <*> requirePath
<*> sourceMaps
pscMakeOptions :: Parser PSCMakeOptions
pscMakeOptions = PSCMakeOptions <$> many inputFile
- <*> many inputForeignFile
<*> outputDirectory
<*> options
<*> (not <$> noPrefix)
diff --git a/psci/Main.hs b/psci/Main.hs
new file mode 100644
index 0000000..e41723e
--- /dev/null
+++ b/psci/Main.hs
@@ -0,0 +1,132 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DoAndIfThenElse #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+
+module Main (main) where
+
+import Prelude ()
+import Prelude.Compat
+
+import Data.Monoid ((<>))
+import Data.Version (showVersion)
+
+import Control.Applicative (many)
+import Control.Monad
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Except (ExceptT(..), runExceptT)
+import Control.Monad.Trans.State.Strict (StateT, evalStateT)
+import Control.Monad.Trans.Reader (ReaderT, runReaderT)
+
+import qualified Language.PureScript as P
+import Language.PureScript.Interactive
+
+import qualified Options.Applicative as Opts
+
+import qualified Paths_purescript as Paths
+
+import System.Console.Haskeline
+import System.Exit
+import System.FilePath.Glob (glob)
+
+-- | Command line options
+data PSCiOptions = PSCiOptions
+ { psciMultiLineMode :: Bool
+ , psciInputFile :: [FilePath]
+ , psciInputNodeFlags :: [String]
+ }
+
+multiLineMode :: Opts.Parser Bool
+multiLineMode = Opts.switch $
+ Opts.long "multi-line-mode"
+ <> Opts.short 'm'
+ <> Opts.help "Run in multi-line mode (use ^D to terminate commands)"
+
+inputFile :: Opts.Parser FilePath
+inputFile = Opts.strArgument $
+ Opts.metavar "FILE"
+ <> Opts.help "Optional .purs files to load on start"
+
+nodeFlagsFlag :: Opts.Parser [String]
+nodeFlagsFlag = Opts.option parser $
+ Opts.long "node-opts"
+ <> Opts.metavar "NODE_OPTS"
+ <> Opts.value []
+ <> Opts.help "Flags to pass to node, separated by spaces"
+ where
+ parser = words <$> Opts.str
+
+psciOptions :: Opts.Parser PSCiOptions
+psciOptions = PSCiOptions <$> multiLineMode
+ <*> many inputFile
+ <*> nodeFlagsFlag
+
+version :: Opts.Parser (a -> a)
+version = Opts.abortOption (Opts.InfoMsg (showVersion Paths.version)) $
+ Opts.long "version" <>
+ Opts.help "Show the version number" <>
+ Opts.hidden
+
+getOpt :: IO PSCiOptions
+getOpt = Opts.execParser opts
+ where
+ opts = Opts.info (version <*> Opts.helper <*> psciOptions) infoModList
+ infoModList = Opts.fullDesc <> headerInfo <> footerInfo
+ headerInfo = Opts.header "psci - Interactive mode for PureScript"
+ footerInfo = Opts.footer $ "psci " ++ showVersion Paths.version
+
+-- | Parses the input and returns either a command, or an error as a 'String'.
+getCommand :: forall m. MonadException m => Bool -> InputT m (Either String (Maybe Command))
+getCommand singleLineMode = handleInterrupt (return (Right Nothing)) $ do
+ firstLine <- withInterrupt $ getInputLine "> "
+ case firstLine of
+ Nothing -> return (Right (Just QuitPSCi)) -- Ctrl-D when input is empty
+ Just "" -> return (Right Nothing)
+ Just s | singleLineMode || head s == ':' -> return . fmap Just $ parseCommand s
+ Just s -> fmap Just . parseCommand <$> go [s]
+ where
+ go :: [String] -> InputT m String
+ go ls = maybe (return . unlines $ reverse ls) (go . (:ls)) =<< getInputLine " "
+
+-- | Get command line options and drop into the REPL
+main :: IO ()
+main = getOpt >>= loop
+ where
+ loop :: PSCiOptions -> IO ()
+ loop PSCiOptions{..} = do
+ inputFiles <- concat <$> traverse glob psciInputFile
+ e <- runExceptT $ do
+ modules <- ExceptT (loadAllModules inputFiles)
+ unless (supportModuleIsDefined (map snd modules)) . liftIO $ do
+ putStrLn supportModuleMessage
+ exitFailure
+ (externs, env) <- ExceptT . runMake . make $ modules
+ return (modules, externs, env)
+ case e of
+ Left errs -> putStrLn (P.prettyPrintMultipleErrors P.defaultPPEOptions errs) >> exitFailure
+ Right (modules, externs, env) -> do
+ historyFilename <- getHistoryFilename
+ let settings = defaultSettings { historyFile = Just historyFilename }
+ initialState = PSCiState [] [] (zip (map snd modules) externs)
+ config = PSCiConfig inputFiles psciInputNodeFlags env
+ runner = flip runReaderT config
+ . flip evalStateT initialState
+ . runInputT (setComplete completion settings)
+ putStrLn prologueMessage
+ runner go
+ where
+ go :: InputT (StateT PSCiState (ReaderT PSCiConfig 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') -> do
+ handleInterrupt (outputStrLn "Interrupted.")
+ (withInterrupt (lift (handleCommand c')))
+ go
diff --git a/psci/PSCi.hs b/psci/PSCi.hs
deleted file mode 100644
index fc9f695..0000000
--- a/psci/PSCi.hs
+++ /dev/null
@@ -1,372 +0,0 @@
-{-# LANGUAGE DoAndIfThenElse #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE DataKinds #-}
-
--- |
--- PureScript Compiler Interactive.
---
-module PSCi (runPSCi) where
-
-import Prelude ()
-import Prelude.Compat
-
-import Data.Foldable (traverse_)
-import Data.List (intercalate, nub, sort, find)
-import Data.Tuple (swap)
-import qualified Data.Map as M
-
-import Control.Arrow (first)
-import Control.Monad
-import Control.Monad.Error.Class (MonadError(..))
-import Control.Monad.Trans.Class
-import Control.Monad.Trans.Except (ExceptT(), runExceptT)
-import Control.Monad.Trans.State.Strict
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Writer.Strict (Writer(), runWriter)
-
-import System.Console.Haskeline
-import System.Directory (doesFileExist, getHomeDirectory, getCurrentDirectory)
-import System.Exit
-import System.FilePath ((</>))
-import System.FilePath.Glob (glob)
-import System.Process (readProcessWithExitCode)
-import System.IO.Error (tryIOError)
-import System.IO.UTF8 (readUTF8File)
-
-import qualified Language.PureScript as P
-import qualified Language.PureScript.Names as N
-
-import PSCi.Completion (completion)
-import PSCi.Parser (parseCommand)
-import PSCi.Option
-import PSCi.Types
-import PSCi.Message
-import PSCi.IO
-import PSCi.Printer
-import PSCi.Module
-
--- |
--- 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
-
--- |
--- The runner
---
-runPSCi :: IO ()
-runPSCi = getOpt >>= loop
-
--- |
--- The PSCI main loop.
---
-loop :: PSCiOptions -> IO ()
-loop PSCiOptions{..} = do
- config <- loadUserConfig
- inputFiles <- concat <$> traverse glob psciInputFile
- foreignFiles <- concat <$> traverse 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.ErrorMessage [] $ P.CannotReadFile inFile)) (readUTF8File inFile))
- P.parseForeignModulesFromFiles foreignFilesContent
- case foreignsOrError of
- Left errs -> putStrLn (P.prettyPrintMultipleErrors False errs) >> exitFailure
- Right foreigns ->
- flip evalStateT (mkPSCiState [] modules foreigns [] psciInputNodeFlags) . runInputT (setComplete completion settings) $ do
- outputStrLn prologueMessage
- traverse_ (traverse_ (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') -> do
- handleInterrupt (outputStrLn "Interrupted.")
- (withInterrupt (runPSCI (loadAllImportedModules >> handleCommand c')))
- go
-
--- Compile the module
-
--- |
--- 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 -> PSCI $ printErrors errs
- Right modules -> PSCI . lift . modify $ updateModules modules
-
--- | This is different than the runMake in 'Language.PureScript.Make' in that it specifies the
--- options and ignores the warning messages.
-runMake :: P.Make a -> IO (Either P.MultipleErrors a)
-runMake mk = fst <$> P.runMake P.defaultOptions mk
-
-makeIO :: (IOError -> P.ErrorMessage) -> IO a -> P.Make a
-makeIO f io = do
- e <- liftIO $ tryIOError io
- either (throwError . P.singleError . f) return e
-
-make :: PSCiState -> [P.Module] -> P.Make P.Environment
-make st@PSCiState{..} ms = P.make actions' (map snd loadedModules ++ ms)
- where
- filePathMap = M.fromList $ (first P.getModuleName . swap) `map` allModules
- actions = P.buildMakeActions modulesDir filePathMap psciForeignFiles False
- actions' = actions { P.progress = const (return ()) }
- loadedModules = psciLoadedModules st
- allModules = map (first Right) loadedModules ++ map (Left P.RebuildAlways,) ms
-
-
--- 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 = handleInterrupt (return (Right Nothing)) $ do
- firstLine <- withInterrupt $ getInputLine "> "
- case firstLine of
- Nothing -> return (Right (Just QuitPSCi)) -- Ctrl-D when input is empty
- Just "" -> return (Right Nothing)
- Just s | singleLineMode || head s == ':' -> return .fmap Just $ parseCommand s
- Just s -> fmap 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) = handleExpression val
-handleCommand ShowHelp = PSCI $ outputStrLn helpMessage
-handleCommand (Import im) = handleImport im
-handleCommand (Decls l) = handleDecls l
-handleCommand (LoadFile filePath) = PSCI $ whenFileExists filePath $ \absPath -> do
- m <- lift . lift $ loadModule absPath
- case m of
- Left err -> outputStrLn err
- Right mods -> lift $ modify (updateModules (map (absPath,) mods))
-handleCommand (LoadForeign filePath) = PSCI $ whenFileExists filePath $ \absPath -> do
- foreignsOrError <- lift . lift . runMake $ do
- foreignFile <- makeIO (const (P.ErrorMessage [] $ P.CannotReadFile absPath)) (readUTF8File absPath)
- P.parseForeignModulesFromFiles [(absPath, foreignFile)]
- case foreignsOrError of
- Left err -> outputStrLn $ P.prettyPrintMultipleErrors False err
- Right foreigns -> lift $ modify (updateForeignFiles foreigns)
-handleCommand ResetState = do
- PSCI . lift . modify $ \st ->
- st { 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 = P.internalError "`handleCommand QuitPSCi` was called. This is a bug."
-
-
--- |
--- Takes a value expression and evaluates it with the current state.
---
-handleExpression :: P.Expr -> PSCI ()
-handleExpression val = do
- st <- PSCI $ lift get
- let m = createTemporaryModule True st val
- let nodeArgs = psciNodeFlags st ++ [indexFile]
- e <- psciIO . runMake $ make st [supportModule, m]
- case e of
- Left errs -> PSCI $ 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.Literal (P.ObjectLiteral []))
- e <- psciIO . runMake $ make st' [m]
- case e of
- Left err -> PSCI $ printErrors err
- Right _ -> PSCI $ lift (put st')
-
--- |
--- Show actual loaded modules in psci.
---
-handleShowLoadedModules :: PSCI ()
-handleShowLoadedModules = do
- loadedModules <- PSCI $ lift $ gets psciLoadedModules
- 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 " ++ N.runModuleName mn ++ showDeclType declType ++
- foldMap (\mn' -> " as " ++ N.runModuleName mn') asQ
-
- 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) = N.runProperName pn ++ "(" ++ maybe ".." (commaList . map N.runProperName) dctors ++ ")"
- showRef (P.TypeOpRef ident) = "type (" ++ N.runIdent ident ++ ")"
- showRef (P.ValueRef ident) = N.runIdent ident
- showRef (P.TypeClassRef pn) = "class " ++ N.runProperName pn
- showRef (P.ProperRef pn) = pn
- showRef (P.TypeInstanceRef ident) = N.runIdent ident
- showRef (P.ModuleRef name) = "module " ++ N.runModuleName 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 [m]
- case e of
- Left errs -> PSCI $ 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 [m]
- case e of
- Left errs -> PSCI $ 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"
-
--- |
--- 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 -> PSCI $ printErrors errs
- Right env' ->
- if isModInEnv moduleName st
- then PSCI $ printModuleSignatures moduleName env'
- else case lookupUnQualifiedModName moduleName st of
- Just unQualifiedName ->
- if isModInEnv unQualifiedName st
- then PSCI $ printModuleSignatures unQualifiedName env'
- else failNotInEnv moduleName
- Nothing ->
- failNotInEnv moduleName
- where
- isModInEnv modName =
- any ((== modName) . P.getModuleName . snd) . psciLoadedModules
- failNotInEnv modName =
- PSCI $ outputStrLn $ "Module '" ++ N.runModuleName modName ++ "' is not valid."
- lookupUnQualifiedModName quaModName st =
- (\(modName,_,_) -> modName) <$> find ( \(_, _, mayQuaName) -> mayQuaName == Just quaModName) (psciImportedModules st)
-
--- |
--- 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 [m]
- case e of
- Left errs -> PSCI $ printErrors errs
- Right env' ->
- case M.lookup (P.Qualified (Just mName) $ P.ProperName "IT") (P.typeSynonyms env') of
- Just (_, typ') -> do
- let chk = (P.emptyCheckState env') { P.checkCurrentModule = Just mName }
- k = check (P.kindOf typ') chk
-
- check :: StateT P.CheckState (ExceptT P.MultipleErrors (Writer P.MultipleErrors)) a -> P.CheckState -> Either P.MultipleErrors (a, P.CheckState)
- check sew = fst . runWriter . runExceptT . runStateT sew
- 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"
-
--- Misc
-
--- |
--- Attempts to read initial commands from '.psci' in the present working
--- directory then the user's home
---
-loadUserConfig :: IO (Maybe [Command])
-loadUserConfig = onFirstFileMatching readCommands pathGetters
- where
- pathGetters = [getCurrentDirectory, getHomeDirectory]
- readCommands :: IO FilePath -> IO (Maybe [Command])
- readCommands path = do
- configFile <- (</> ".psci") <$> path
- exists <- doesFileExist configFile
- if exists
- then do
- ls <- lines <$> readUTF8File configFile
- case traverse 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)
diff --git a/psci/PSCi/Message.hs b/psci/PSCi/Message.hs
deleted file mode 100644
index bd20b48..0000000
--- a/psci/PSCi/Message.hs
+++ /dev/null
@@ -1,53 +0,0 @@
-module PSCi.Message where
-
-
-import Data.List (intercalate)
-import qualified PSCi.Directive as D
-import PSCi.Types
-
--- 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!"
-
diff --git a/psci/PSCi/Module.hs b/psci/PSCi/Module.hs
deleted file mode 100644
index bda5116..0000000
--- a/psci/PSCi/Module.hs
+++ /dev/null
@@ -1,107 +0,0 @@
-module PSCi.Module where
-
-import Prelude ()
-import Prelude.Compat
-
-import qualified Language.PureScript as P
-import PSCi.Types
-import System.FilePath (pathSeparator)
-import System.IO.UTF8 (readUTF8File)
-import Control.Monad
-
--- | 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 ss cs _ ds exps)] -> P.Module ss cs supportModuleName ds exps
- _ -> P.internalError "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"
- ]
-
--- Module Management
-
--- |
--- Loads a file for use with imports.
---
-loadModule :: FilePath -> IO (Either String [P.Module])
-loadModule filename = do
- content <- readUTF8File filename
- return $ either (Left . P.prettyPrintMultipleErrors False) (Right . map snd) $ P.parseModulesFromFiles id [(filename, content)]
-
--- |
--- Load all modules.
---
-loadAllModules :: [FilePath] -> IO (Either P.MultipleErrors [(FilePath, P.Module)])
-loadAllModules files = do
- filesAndContent <- forM files $ \filename -> do
- content <- readUTF8File filename
- return (filename, content)
- return $ P.parseModulesFromFiles id filesAndContent
-
-
--- |
--- 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 (P.internalModuleSourceSpan "<internal>") [] 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, psciLetBindings = lets} typ =
- let
- moduleName = P.ModuleName [P.ProperName "$PSCI"]
- itDecl = P.TypeSynonymDeclaration (P.ProperName "IT") [] typ
- in
- P.Module (P.internalModuleSourceSpan "<internal>") [] moduleName ((importDecl `map` imports) ++ lets ++ [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 (P.internalModuleSourceSpan "<internal>") [] moduleName (importDecl `map` imports) Nothing
-
-importDecl :: ImportedModule -> P.Declaration
-importDecl (mn, declType, asQ) = P.ImportDeclaration mn declType asQ False
-
-indexFile :: FilePath
-indexFile = ".psci_modules" ++ pathSeparator : "index.js"
-
-modulesDir :: FilePath
-modulesDir = ".psci_modules" ++ pathSeparator : "node_modules"
diff --git a/psci/PSCi/Option.hs b/psci/PSCi/Option.hs
deleted file mode 100644
index 1b75001..0000000
--- a/psci/PSCi/Option.hs
+++ /dev/null
@@ -1,57 +0,0 @@
-module PSCi.Option (
- getOpt
-) where
-
-import Prelude ()
-import Prelude.Compat
-
-import Options.Applicative as Opts
-import Data.Version (showVersion)
-
-import PSCi.Types
-import qualified Paths_purescript as Paths
-
--- Parse Command line option
-
-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
-
-version :: Parser (a -> a)
-version = abortOption (InfoMsg (showVersion Paths.version)) $ long "version" <> Opts.help "Show the version number" <> hidden
-
-getOpt :: IO PSCiOptions
-getOpt = execParser opts
- where
- opts = info (version <*> helper <*> psciOptions) infoModList
- infoModList = fullDesc <> headerInfo <> footerInfo
- headerInfo = header "psci - Interactive mode for PureScript"
- footerInfo = footer $ "psci " ++ showVersion Paths.version
diff --git a/psci/PSCi/Types.hs b/psci/PSCi/Types.hs
deleted file mode 100644
index 3627d41..0000000
--- a/psci/PSCi/Types.hs
+++ /dev/null
@@ -1,218 +0,0 @@
------------------------------------------------------------------------------
---
--- 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 PSCi.Types where
-
-import Prelude ()
-import Prelude.Compat
-
-import Control.Arrow (second)
-import Data.Map (Map)
-import qualified Data.Map as Map
-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
- { psciImportedModules :: [ImportedModule]
- , _psciLoadedModules :: Map FilePath [P.Module]
- , psciForeignFiles :: Map P.ModuleName FilePath
- , psciLetBindings :: [P.Declaration]
- , psciNodeFlags :: [String]
- }
-
-initialPSCiState :: PSCiState
-initialPSCiState =
- PSCiState [] Map.empty Map.empty [] []
-
-mkPSCiState :: [ImportedModule]
- -> [(FilePath, P.Module)]
- -> Map P.ModuleName FilePath
- -> [P.Declaration]
- -> [String]
- -> PSCiState
-mkPSCiState imported loaded foreigns lets nodeFlags =
- (initialPSCiState
- |> each imported updateImportedModules
- |> updateModules loaded)
- { psciForeignFiles = foreigns
- , psciLetBindings = lets
- , psciNodeFlags = nodeFlags
- }
- where
- x |> f = f x
- each xs f st = foldl (flip f) st xs
-
--- Public psci state accessors
-
--- | Get the imported filenames as a list.
-psciImportedFilenames :: PSCiState -> [FilePath]
-psciImportedFilenames = Map.keys . _psciLoadedModules
-
--- | Get the loaded modules as a list.
-psciLoadedModules :: PSCiState -> [(FilePath, P.Module)]
-psciLoadedModules = collect . Map.toList . _psciLoadedModules
- where
- collect :: [(k, [v])] -> [(k, v)]
- collect vss = [ (k, v) | (k, vs) <- vss, v <- vs ]
-
--- | 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.
---
-updateImportedModules :: ImportedModule -> PSCiState -> PSCiState
-updateImportedModules im st = st { psciImportedModules = im : psciImportedModules st }
-
--- |
--- Updates the state to have more loaded modules (available for import, but
--- not necessarily imported).
---
-updateModules :: [(FilePath, P.Module)] -> PSCiState -> PSCiState
-updateModules modules st =
- st { _psciLoadedModules = Map.union (go modules) (_psciLoadedModules st) }
- where
- go = Map.fromListWith (++) . map (second (:[]))
-
--- |
--- 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 :: Map P.ModuleName FilePath -> PSCiState -> PSCiState
-updateForeignFiles fs st = st { psciForeignFiles = psciForeignFiles st `Map.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
deleted file mode 100644
index e430648..0000000
--- a/psci/main/Main.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-module Main where
-
-import PSCi
-
-main :: IO ()
-main = runPSCi
diff --git a/purescript.cabal b/purescript.cabal
index cf82b2e..eceddd6 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,5 +1,5 @@
name: purescript
-version: 0.8.5.0
+version: 0.9.1
cabal-version: >=1.8
build-type: Simple
license: MIT
@@ -20,27 +20,73 @@ author: Phil Freeman <paf31@cantab.net>,
tested-with: GHC==7.10.3
extra-source-files: examples/passing/*.purs
+ , examples/passing/*.js
+ , examples/passing/2018/*.purs
+ , examples/passing/2138/*.purs
+ , examples/passing/ClassRefSyntax/*.purs
+ , examples/passing/DctorOperatorAlias/*.purs
+ , examples/passing/ExplicitImportReExport/*.purs
+ , examples/passing/ExportExplicit/*.purs
+ , examples/passing/ExportExplicit2/*.purs
+ , examples/passing/Import/*.purs
+ , examples/passing/ImportExplicit/*.purs
+ , examples/passing/ImportQualified/*.purs
+ , examples/passing/Module/*.purs
+ , examples/passing/ModuleDeps/*.purs
+ , examples/passing/ModuleExport/*.purs
+ , examples/passing/ModuleExportDupes/*.purs
+ , examples/passing/ModuleExportExcluded/*.purs
+ , examples/passing/ModuleExportQualified/*.purs
+ , examples/passing/ModuleExportSelf/*.purs
+ , examples/passing/NonConflictingExports/*.purs
+ , examples/passing/OperatorAliasElsewhere/*.purs
+ , examples/passing/Operators/*.purs
+ , examples/passing/PendingConflictingImports/*.purs
+ , examples/passing/PendingConflictingImports2/*.purs
+ , examples/passing/QualifiedNames/*.purs
+ , examples/passing/RedefinedFixity/*.purs
+ , examples/passing/ReExportQualified/*.purs
+ , examples/passing/ResolvableScopeConflict/*.purs
+ , examples/passing/ResolvableScopeConflict2/*.purs
+ , examples/passing/ResolvableScopeConflict3/*.purs
+ , examples/passing/ShadowedModuleName/*.purs
+ , examples/passing/TransitiveImport/*.purs
+ , examples/passing/TypeOperators/*.purs
+ , examples/passing/TypeWithoutParens/*.purs
, examples/failing/*.purs
+ , examples/failing/1733/*.purs
+ , examples/failing/ConflictingExports/*.purs
+ , examples/failing/ConflictingImports/*.purs
+ , examples/failing/ConflictingImports2/*.purs
+ , examples/failing/ConflictingQualifiedImports/*.purs
+ , examples/failing/ConflictingQualifiedImports2/*.purs
+ , examples/failing/ExportConflictClass/*.purs
+ , examples/failing/ExportConflictCtor/*.purs
+ , examples/failing/ExportConflictType/*.purs
+ , examples/failing/ExportConflictTypeOp/*.purs
+ , examples/failing/ExportConflictValue/*.purs
+ , examples/failing/ExportConflictValueOp/*.purs
+ , examples/failing/ExportExplicit1/*.purs
+ , examples/failing/ExportExplicit3/*.purs
+ , examples/failing/ImportExplicit/*.purs
+ , examples/failing/ImportExplicit2/*.purs
+ , examples/failing/ImportHidingModule/*.purs
+ , examples/failing/ImportModule/*.purs
+ , examples/failing/InstanceExport/*.purs
+ , examples/failing/OrphanInstance/*.purs
+ , examples/warning/*.purs
+ , examples/warning/*.js
, examples/docs/bower_components/purescript-prelude/src/*.purs
, examples/docs/bower.json
, examples/docs/src/*.purs
- , tests/support/setup.js
, tests/support/package.json
- , tests/support/prelude/bower.json
- , tests/support/prelude/src/*.purs
- , tests/support/prelude/src/*.js
- , tests/support/prelude/LICENSE
, tests/support/bower.json
, tests/support/setup-win.cmd
- , tests/support/flattened/*.purs
- , tests/support/flattened/*.js
, tests/support/psci/*.purs
, tests/support/pscide/src/*.purs
, tests/support/pscide/src/*.js
, tests/support/pscide/src/*.fail
, stack.yaml
- , stack-lts-5.yaml
- , stack-nightly.yaml
, README.md
, INSTALL.md
, CONTRIBUTORS.md
@@ -52,47 +98,49 @@ source-repository head
library
build-depends: base >=4.8 && <5,
+ aeson >= 0.8 && < 0.12,
+ aeson-better-errors >= 0.8,
+ ansi-terminal >= 0.6.2 && < 0.7,
base-compat >=0.6.0,
- lifted-base >= 0.2.3 && < 0.2.4,
- monad-control >= 1.0.0.0 && < 1.1,
- transformers-base >= 0.4.0 && < 0.5,
+ bower-json >= 0.8,
+ boxes >= 0.1.4 && < 0.2.0,
+ bytestring -any,
containers -any,
- unordered-containers -any,
- dlist -any,
directory >= 1.2,
+ dlist -any,
+ edit-distance -any,
filepath -any,
+ fsnotify >= 0.2.1,
+ Glob >= 0.7 && < 0.8,
+ haskeline >= 0.7.0.0,
+ http-types -any,
+ language-javascript == 0.6.*,
+ lifted-base >= 0.2.3 && < 0.2.4,
+ monad-control >= 1.0.0.0 && < 1.1,
+ monad-logger >= 0.3 && < 0.4,
mtl >= 2.1.0 && < 2.3.0,
- parsec -any,
- transformers >= 0.3.0 && < 0.6,
- transformers-compat >= 0.3.0,
- utf8-string >= 1 && < 2,
+ parallel >= 3.2 && < 3.3,
+ parsec >=3.1.10,
pattern-arrows >= 0.0.2 && < 0.1,
- time -any,
- boxes >= 0.1.4 && < 0.2.0,
- aeson >= 0.8 && < 0.12,
- vector -any,
- bower-json >= 0.8,
- aeson-better-errors >= 0.8,
- bytestring -any,
- text -any,
- split -any,
- language-javascript == 0.6.*,
- syb -any,
- Glob >= 0.7 && < 0.8,
+ pipes >= 4.0.0 && < 4.2.0,
+ pipes-http -any,
process >= 1.2.0 && < 1.5,
+ regex-tdfa -any,
safe >= 0.3.9 && < 0.4,
semigroups >= 0.16.2 && < 0.19,
- parallel >= 3.2 && < 3.3,
sourcemap >= 0.1.6,
+ spdx == 0.2.*,
+ split -any,
stm >= 0.2.4.0,
- regex-tdfa -any,
- edit-distance -any,
- fsnotify >= 0.2.1,
- monad-logger >= 0.3 && < 0.4,
- pipes >= 4.0.0 && < 4.2.0 ,
- pipes-http -any,
- http-types -any,
- spdx == 0.2.*
+ syb -any,
+ text -any,
+ time -any,
+ transformers >= 0.3.0 && < 0.6,
+ transformers-base >= 0.4.0 && < 0.5,
+ transformers-compat >= 0.3.0,
+ unordered-containers -any,
+ utf8-string >= 1 && < 2,
+ vector -any
exposed-modules: Language.PureScript
Language.PureScript.AST
@@ -142,7 +190,6 @@ 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
@@ -158,9 +205,10 @@ library
Language.PureScript.Sugar.CaseDeclarations
Language.PureScript.Sugar.DoNotation
Language.PureScript.Sugar.Names
+ Language.PureScript.Sugar.Names.Common
Language.PureScript.Sugar.Names.Env
- Language.PureScript.Sugar.Names.Imports
Language.PureScript.Sugar.Names.Exports
+ Language.PureScript.Sugar.Names.Imports
Language.PureScript.Sugar.ObjectWildcards
Language.PureScript.Sugar.Operators
Language.PureScript.Sugar.Operators.Common
@@ -220,13 +268,38 @@ library
Language.PureScript.Ide.Util
Language.PureScript.Ide.Rebuild
+ Language.PureScript.Interactive
+ Language.PureScript.Interactive.Types
+ Language.PureScript.Interactive.Parser
+ Language.PureScript.Interactive.Directive
+ Language.PureScript.Interactive.Completion
+ Language.PureScript.Interactive.IO
+ Language.PureScript.Interactive.Message
+ Language.PureScript.Interactive.Module
+ Language.PureScript.Interactive.Printer
+
Control.Monad.Logger
Control.Monad.Supply
Control.Monad.Supply.Class
System.IO.UTF8
- extensions: DataKinds
+ extensions: ConstraintKinds
+ DataKinds
+ DeriveFunctor
+ EmptyDataDecls
+ FlexibleContexts
+ KindSignatures
+ LambdaCase
+ MultiParamTypeClasses
+ NoImplicitPrelude
+ PatternGuards
+ PatternSynonyms
+ RankNTypes
+ RecordWildCards
+ ScopedTypeVariables
+ TupleSections
+ ViewPatterns
exposed: True
buildable: True
hs-source-dirs: src
@@ -234,11 +307,23 @@ library
ghc-options: -Wall -O2
executable psc
- build-depends: base >=4 && <5, base-compat >=0.6.0,
- containers -any, directory -any, filepath -any,
- mtl -any, optparse-applicative >= 0.12.1, parsec -any, purescript -any,
- time -any, transformers -any, transformers-compat -any, Glob >= 0.7 && < 0.8,
- aeson >= 0.8 && < 0.12, bytestring -any, utf8-string >= 1 && < 2
+ build-depends: base >=4 && <5,
+ purescript -any,
+ aeson >= 0.8 && < 0.12,
+ ansi-terminal >= 0.6.2 && < 0.7,
+ base-compat >=0.6.0,
+ bytestring -any,
+ containers -any,
+ directory -any,
+ filepath -any,
+ Glob >= 0.7 && < 0.8,
+ mtl -any,
+ optparse-applicative >= 0.12.1,
+ parsec -any,
+ time -any,
+ transformers -any,
+ transformers-compat -any,
+ utf8-string >= 1 && < 2
main-is: Main.hs
buildable: True
hs-source-dirs: psc
@@ -246,33 +331,40 @@ executable psc
ghc-options: -Wall -O2 -fno-warn-unused-do-bind -threaded -rtsopts "-with-rtsopts=-N"
executable psci
- build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,
- mtl -any, optparse-applicative >= 0.12.1, parsec -any,
- haskeline >= 0.7.0.0, purescript -any, transformers -any,
- transformers-compat -any, process -any, time -any, Glob -any, base-compat >=0.6.0,
- boxes >= 0.1.4 && < 0.2.0
-
+ build-depends: base >=4 && <5,
+ purescript -any,
+ base-compat >=0.6.0,
+ boxes >= 0.1.4 && < 0.2.0,
+ containers -any,
+ directory -any,
+ filepath -any,
+ Glob -any,
+ haskeline >= 0.7.0.0,
+ mtl -any,
+ optparse-applicative >= 0.12.1,
+ parsec -any,
+ process -any,
+ time -any,
+ transformers -any,
+ transformers-compat -any
main-is: Main.hs
buildable: True
- hs-source-dirs: psci psci/main
- other-modules: PSCi
- PSCi.Types
- PSCi.Parser
- PSCi.Directive
- PSCi.Completion
- PSCi.IO
- PSCi.Message
- PSCi.Option
- PSCi.Module
- PSCi.Printer
- Paths_purescript
+ hs-source-dirs: psci
+ other-modules: Paths_purescript
ghc-options: -Wall -O2
executable psc-docs
- build-depends: base >=4 && <5, purescript -any,
- optparse-applicative >= 0.12.1, process -any, mtl -any,
- split -any, ansi-wl-pprint -any, directory -any,
- filepath -any, Glob -any, transformers -any,
+ build-depends: base >=4 && <5,
+ purescript -any,
+ ansi-wl-pprint -any,
+ directory -any,
+ filepath -any,
+ Glob -any,
+ mtl -any,
+ optparse-applicative >= 0.12.1,
+ process -any,
+ split -any,
+ transformers -any,
transformers-compat -any
main-is: Main.hs
other-modules: Paths_purescript
@@ -284,7 +376,11 @@ executable psc-docs
ghc-options: -Wall -O2
executable psc-publish
- build-depends: base >=4 && <5, purescript -any, bytestring -any, aeson -any, optparse-applicative -any
+ build-depends: base >=4 && <5,
+ purescript -any,
+ aeson -any,
+ bytestring -any,
+ optparse-applicative -any
main-is: Main.hs
other-modules: Paths_purescript
buildable: True
@@ -292,9 +388,15 @@ executable psc-publish
ghc-options: -Wall -O2
executable psc-hierarchy
- build-depends: base >=4 && <5, purescript -any, optparse-applicative >= 0.12.1,
- process -any, mtl -any, parsec -any, filepath -any, directory -any,
- Glob -any
+ build-depends: base >=4 && <5,
+ purescript -any,
+ directory -any,
+ filepath -any,
+ Glob -any,
+ mtl -any,
+ optparse-applicative >= 0.12.1,
+ parsec -any,
+ process -any
main-is: Main.hs
other-modules: Paths_purescript
buildable: True
@@ -308,13 +410,13 @@ executable psc-bundle
other-extensions:
build-depends: base >=4 && <5,
purescript -any,
- filepath -any,
directory -any,
+ filepath -any,
+ Glob -any,
mtl -any,
- transformers -any,
- transformers-compat -any,
optparse-applicative >= 0.12.1,
- Glob -any
+ transformers -any,
+ transformers-compat -any
ghc-options: -Wall -O2
hs-source-dirs: psc-bundle
@@ -322,19 +424,19 @@ executable psc-ide-server
main-is: Main.hs
other-modules: Paths_purescript
other-extensions:
- build-depends: base >=4 && <5
- , purescript -any
- , directory -any
- , filepath -any
- , monad-logger -any
- , mtl -any
- , transformers -any
- , transformers-compat -any
- , network -any
- , optparse-applicative >= 0.12.1
- , stm -any
- , text -any
- , base-compat >=0.6.0
+ build-depends: base >=4 && <5,
+ purescript -any,
+ base-compat >=0.6.0,
+ directory -any,
+ filepath -any,
+ monad-logger -any,
+ mtl -any,
+ network -any,
+ optparse-applicative >= 0.12.1,
+ stm -any,
+ text -any,
+ transformers -any,
+ transformers-compat -any
ghc-options: -Wall -O2 -threaded
hs-source-dirs: psc-ide-server
@@ -342,23 +444,43 @@ executable psc-ide-client
main-is: Main.hs
other-modules: Paths_purescript
other-extensions:
- build-depends: base >=4 && <5
- , mtl -any
- , text -any
- , optparse-applicative >= 0.12.1
- , network -any
- , base-compat >=0.6.0
+ build-depends: base >=4 && <5,
+ base-compat >=0.6.0,
+ mtl -any,
+ network -any,
+ optparse-applicative >= 0.12.1,
+ text -any
ghc-options: -Wall -O2
hs-source-dirs: psc-ide-client
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-compat -any, time -any,
- Glob -any, aeson-better-errors -any, bytestring -any, aeson -any,
- base-compat -any, haskeline >= 0.7.0.0, optparse-applicative -any,
- boxes -any, HUnit -any, hspec -any, hspec-discover -any, stm -any, text -any,
- vector -any, utf8-string -any
+ build-depends: base >=4 && <5,
+ purescript -any,
+ aeson -any,
+ aeson-better-errors -any,
+ base-compat -any,
+ boxes -any,
+ bytestring -any,
+ containers -any,
+ directory -any,
+ filepath -any,
+ Glob -any,
+ haskeline >= 0.7.0.0,
+ hspec -any,
+ hspec-discover -any,
+ HUnit -any,
+ mtl -any,
+ optparse-applicative -any,
+ parsec -any,
+ process -any,
+ silently -any,
+ stm -any,
+ text -any,
+ time -any,
+ transformers -any,
+ transformers-compat -any,
+ utf8-string -any,
+ vector -any
ghc-options: -Wall
type: exitcode-stdio-1.0
main-is: Main.hs
@@ -377,9 +499,5 @@ test-suite tests
Language.PureScript.Ide.RebuildSpec
Language.PureScript.Ide.ReexportsSpec
Language.PureScript.IdeSpec
- PSCi.Completion
- PSCi.Directive
- PSCi.Module
- PSCi.Types
buildable: True
- hs-source-dirs: tests psci
+ hs-source-dirs: tests
diff --git a/src/Control/Monad/Logger.hs b/src/Control/Monad/Logger.hs
index f8e8e7c..c4969d8 100644
--- a/src/Control/Monad/Logger.hs
+++ b/src/Control/Monad/Logger.hs
@@ -1,33 +1,20 @@
------------------------------------------------------------------------------
---
--- Module : Control.Monad.Logger
--- Author : Phil Freeman
--- License : MIT (http://opensource.org/licenses/MIT)
---
--- Maintainer : Phil Freeman <paf31@cantab.net>
--- Stability : experimental
--- Portability :
---
--- | A replacement for WriterT IO which uses mutable references.
---
------------------------------------------------------------------------------
-
{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
+-- |
+-- A replacement for WriterT IO which uses mutable references.
+--
module Control.Monad.Logger where
-import Prelude ()
import Prelude.Compat
-import Data.IORef
-
import Control.Monad (ap)
-import Control.Monad.IO.Class
-import Control.Monad.Writer.Class
import Control.Monad.Base (MonadBase(..))
+import Control.Monad.IO.Class
import Control.Monad.Trans.Control (MonadBaseControl(..))
+import Control.Monad.Writer.Class
+
+import Data.IORef
-- | A replacement for WriterT IO which uses mutable references.
newtype Logger w a = Logger { runLogger :: IORef w -> IO a }
diff --git a/src/Control/Monad/Supply.hs b/src/Control/Monad/Supply.hs
index 0b002e4..2fa7aaa 100644
--- a/src/Control/Monad/Supply.hs
+++ b/src/Control/Monad/Supply.hs
@@ -1,32 +1,19 @@
------------------------------------------------------------------------------
---
--- Module : Control.Monad.Supply
--- Copyright : (c) Phil Freeman 2014
--- License : MIT
---
--- Maintainer : Phil Freeman <paf31@cantab.net>
--- Stability : experimental
--- Portability :
---
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
-- |
-- Fresh variable supply
--
------------------------------------------------------------------------------
-
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
module Control.Monad.Supply where
-import Prelude ()
import Prelude.Compat
-import Data.Functor.Identity
-
-import Control.Monad.State
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.Reader
+import Control.Monad.State
import Control.Monad.Writer
+import Data.Functor.Identity
+
newtype SupplyT m a = SupplyT { unSupplyT :: StateT Integer m a }
deriving (Functor, Applicative, Monad, MonadTrans, MonadError e, MonadWriter w, MonadReader r)
diff --git a/src/Control/Monad/Supply/Class.hs b/src/Control/Monad/Supply/Class.hs
index 8621e2e..524225c 100644
--- a/src/Control/Monad/Supply/Class.hs
+++ b/src/Control/Monad/Supply/Class.hs
@@ -1,24 +1,24 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
-
-- |
-- A class for monads supporting a supply of fresh names
--
module Control.Monad.Supply.Class where
+import Prelude.Compat
+
import Control.Monad.Supply
import Control.Monad.State
-class (Monad m) => MonadSupply m where
+class Monad m => MonadSupply m where
fresh :: m Integer
-instance (Monad m) => MonadSupply (SupplyT m) where
+instance Monad m => MonadSupply (SupplyT m) where
fresh = SupplyT $ do
n <- get
put (n + 1)
return n
-instance (MonadSupply m) => MonadSupply (StateT s m) where
+instance MonadSupply m => MonadSupply (StateT s m) where
fresh = lift fresh
-freshName :: (MonadSupply m) => m String
+freshName :: MonadSupply m => m String
freshName = fmap (('$' :) . show) fresh
diff --git a/src/Language/PureScript.hs b/src/Language/PureScript.hs
index 21ecd64..a2c7554 100644
--- a/src/Language/PureScript.hs
+++ b/src/Language/PureScript.hs
@@ -1,33 +1,22 @@
------------------------------------------------------------------------------
---
--- Module : Language.PureScript
--- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
--- License : MIT
---
--- Maintainer : Phil Freeman <paf31@cantab.net>
--- Stability : experimental
--- Portability :
---
-- |
-- The main compiler module
--
------------------------------------------------------------------------------
-
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
module Language.PureScript
( module P
, version
) where
+
+import Control.Monad.Supply as P
+
import Data.Version (Version)
import Language.PureScript.AST as P
-import Language.PureScript.Crash as P
import Language.PureScript.Comments as P
+import Language.PureScript.Crash as P
import Language.PureScript.Environment as P
import Language.PureScript.Errors as P hiding (indent)
+import Language.PureScript.Externs as P
import Language.PureScript.Kinds as P
import Language.PureScript.Linter as P
import Language.PureScript.Make as P
@@ -38,7 +27,6 @@ import Language.PureScript.Parser as P
import Language.PureScript.Pretty as P
import Language.PureScript.Renamer as P
import Language.PureScript.Sugar as P
-import Control.Monad.Supply as P
import Language.PureScript.TypeChecker as P
import Language.PureScript.Types as P
diff --git a/src/Language/PureScript/AST/Binders.hs b/src/Language/PureScript/AST/Binders.hs
index 21ef3ca..756c726 100644
--- a/src/Language/PureScript/AST/Binders.hs
+++ b/src/Language/PureScript/AST/Binders.hs
@@ -3,6 +3,8 @@
--
module Language.PureScript.AST.Binders where
+import Prelude.Compat
+
import Language.PureScript.AST.SourcePos
import Language.PureScript.AST.Literals
import Language.PureScript.Names
@@ -33,7 +35,7 @@ data Binder
-- A operator alias binder. During the rebracketing phase of desugaring,
-- this data constructor will be removed.
--
- | OpBinder (Qualified Ident)
+ | OpBinder (Qualified (OpName 'ValueOpName))
-- |
-- Binary operator application. During the rebracketing phase of desugaring,
-- this data constructor will be removed.
diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs
index 32e217e..0f6df99 100644
--- a/src/Language/PureScript/AST/Declarations.hs
+++ b/src/Language/PureScript/AST/Declarations.hs
@@ -1,23 +1,17 @@
-{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE LambdaCase #-}
-- |
-- Data types for modules and declarations
--
module Language.PureScript.AST.Declarations where
-import Prelude ()
import Prelude.Compat
-import Data.Aeson.TH
-import Data.List (nub, (\\))
-import Data.Maybe (mapMaybe)
+import Control.Monad.Identity
+import Data.Aeson.TH
import qualified Data.Map as M
-import Control.Monad.Identity
-
import Language.PureScript.AST.Binders
import Language.PureScript.AST.Literals
import Language.PureScript.AST.Operators
@@ -47,9 +41,9 @@ getModuleName (Module _ _ name _ _) = name
addDefaultImport :: ModuleName -> Module -> Module
addDefaultImport toImport m@(Module ss coms mn decls exps) =
if isExistingImport `any` decls || mn == toImport then m
- else Module ss coms mn (ImportDeclaration toImport Implicit Nothing False : decls) exps
+ else Module ss coms mn (ImportDeclaration toImport Implicit Nothing : decls) exps
where
- isExistingImport (ImportDeclaration mn' _ _ _) | mn' == toImport = True
+ isExistingImport (ImportDeclaration mn' _ _) | mn' == toImport = True
isExistingImport (PositionedDeclaration _ _ d) = isExistingImport d
isExistingImport _ = False
@@ -64,16 +58,20 @@ data DeclarationRef
-- |
-- A type operator
--
- | TypeOpRef Ident
+ | TypeOpRef (OpName 'TypeOpName)
-- |
-- A value
--
| ValueRef Ident
-- |
+ -- A value-level operator
+ --
+ | ValueOpRef (OpName 'ValueOpName)
+ -- |
-- A type class
--
| TypeClassRef (ProperName 'ClassName)
- -- |
+ -- |
-- A type class instance, created during typeclass desugaring (name, class name, instance types)
--
| TypeInstanceRef Ident
@@ -82,10 +80,6 @@ data DeclarationRef
--
| ModuleRef ModuleName
-- |
- -- An unspecified ProperName ref. This will be replaced with a TypeClassRef
- -- or TypeRef during name desugaring.
- | ProperRef String
- -- |
-- A declaration reference with source position information
--
| PositionedDeclarationRef SourceSpan [Comment] DeclarationRef
@@ -95,42 +89,45 @@ instance Eq DeclarationRef where
(TypeRef name dctors) == (TypeRef name' dctors') = name == name' && dctors == dctors'
(TypeOpRef name) == (TypeOpRef name') = name == name'
(ValueRef name) == (ValueRef name') = name == name'
+ (ValueOpRef name) == (ValueOpRef name') = name == name'
(TypeClassRef name) == (TypeClassRef name') = name == name'
(TypeInstanceRef name) == (TypeInstanceRef name') = name == name'
(ModuleRef name) == (ModuleRef name') = name == name'
- (ProperRef name) == (ProperRef name') = name == name'
(PositionedDeclarationRef _ _ r) == r' = r == r'
r == (PositionedDeclarationRef _ _ r') = r == r'
_ == _ = False
+getTypeRef :: DeclarationRef -> Maybe (ProperName 'TypeName, Maybe [ProperName 'ConstructorName])
+getTypeRef (TypeRef name dctors) = Just (name, dctors)
+getTypeRef (PositionedDeclarationRef _ _ r) = getTypeRef r
+getTypeRef _ = Nothing
+
+getTypeOpRef :: DeclarationRef -> Maybe (OpName 'TypeOpName)
+getTypeOpRef (TypeOpRef op) = Just op
+getTypeOpRef (PositionedDeclarationRef _ _ r) = getTypeOpRef r
+getTypeOpRef _ = Nothing
+
+getValueRef :: DeclarationRef -> Maybe Ident
+getValueRef (ValueRef name) = Just name
+getValueRef (PositionedDeclarationRef _ _ r) = getValueRef r
+getValueRef _ = Nothing
+
+getValueOpRef :: DeclarationRef -> Maybe (OpName 'ValueOpName)
+getValueOpRef (ValueOpRef op) = Just op
+getValueOpRef (PositionedDeclarationRef _ _ r) = getValueOpRef r
+getValueOpRef _ = Nothing
+
+getTypeClassRef :: DeclarationRef -> Maybe (ProperName 'ClassName)
+getTypeClassRef (TypeClassRef name) = Just name
+getTypeClassRef (PositionedDeclarationRef _ _ r) = getTypeClassRef r
+getTypeClassRef _ = Nothing
+
isModuleRef :: DeclarationRef -> Bool
isModuleRef (PositionedDeclarationRef _ _ r) = isModuleRef r
isModuleRef (ModuleRef _) = True
isModuleRef _ = False
-- |
--- Finds duplicate values in a list of declaration refs. The returned values
--- are the duplicate refs with data constructors elided, and then a separate
--- list of duplicate data constructors.
---
-findDuplicateRefs :: [DeclarationRef] -> ([DeclarationRef], [ProperName 'ConstructorName])
-findDuplicateRefs refs =
- let positionless = stripPosInfo `map` refs
- simplified = simplifyTypeRefs `map` positionless
- dupeRefs = nub $ simplified \\ nub simplified
- dupeCtors = concat $ flip mapMaybe positionless $ \case
- TypeRef _ (Just dctors) ->
- let dupes = dctors \\ nub dctors
- in if null dupes then Nothing else Just dupes
- _ -> Nothing
- in (dupeRefs, dupeCtors)
- where
- stripPosInfo (PositionedDeclarationRef _ _ ref) = stripPosInfo ref
- stripPosInfo other = other
- simplifyTypeRefs (TypeRef pn _) = TypeRef pn Nothing
- simplifyTypeRefs other = other
-
--- |
-- The data type which specifies type of import declaration
--
data ImportDeclarationType
@@ -193,14 +190,13 @@ data Declaration
--
| ExternDataDeclaration (ProperName 'TypeName) Kind
-- |
- -- A fixity declaration (fixity data, operator name, value the operator is an alias for)
+ -- A fixity declaration
--
- | FixityDeclaration Fixity String (Maybe (Qualified FixityAlias))
+ | FixityDeclaration (Either ValueFixity TypeFixity)
-- |
-- A module import (module name, qualified/unqualified/hiding, optional "qualified as" name)
- -- TODO: also a boolean specifying whether the old `qualified` syntax was used, so a warning can be raised in desugaring (remove for 0.9)
--
- | ImportDeclaration ModuleName ImportDeclarationType (Maybe ModuleName) Bool
+ | ImportDeclaration ModuleName ImportDeclarationType (Maybe ModuleName)
-- |
-- A type class declaration (name, argument, implies, member declarations)
--
@@ -216,30 +212,14 @@ data Declaration
| PositionedDeclaration SourceSpan [Comment] Declaration
deriving (Show, Read)
-data FixityAlias
- = AliasValue Ident
- | AliasConstructor (ProperName 'ConstructorName)
- | AliasType (ProperName 'TypeName)
+data ValueFixity = ValueFixity Fixity (Qualified (Either Ident (ProperName 'ConstructorName))) (OpName 'ValueOpName)
deriving (Eq, Ord, Show, Read)
-foldFixityAlias
- :: (Ident -> a)
- -> (ProperName 'ConstructorName -> a)
- -> (ProperName 'TypeName -> a)
- -> FixityAlias
- -> a
-foldFixityAlias f _ _ (AliasValue name) = f name
-foldFixityAlias _ g _ (AliasConstructor name) = g name
-foldFixityAlias _ _ h (AliasType name) = h name
-
-getValueAlias :: FixityAlias -> Maybe (Either Ident (ProperName 'ConstructorName))
-getValueAlias (AliasValue name) = Just $ Left name
-getValueAlias (AliasConstructor name) = Just $ Right name
-getValueAlias _ = Nothing
-
-getTypeAlias :: FixityAlias -> Maybe (ProperName 'TypeName)
-getTypeAlias (AliasType name) = Just name
-getTypeAlias _ = Nothing
+data TypeFixity = TypeFixity Fixity (Qualified (ProperName 'TypeName)) (OpName 'TypeOpName)
+ deriving (Eq, Ord, Show, Read)
+
+pattern ValueFixityDeclaration fixity name op = FixityDeclaration (Left (ValueFixity fixity name op))
+pattern TypeFixityDeclaration fixity name op = FixityDeclaration (Right (TypeFixity fixity name op))
-- | The members of a type class instance declaration
data TypeInstanceBody
@@ -298,6 +278,11 @@ isFixityDecl FixityDeclaration{} = True
isFixityDecl (PositionedDeclaration _ _ d) = isFixityDecl d
isFixityDecl _ = False
+getFixityDecl :: Declaration -> Maybe (Either ValueFixity TypeFixity)
+getFixityDecl (FixityDeclaration fixity) = Just fixity
+getFixityDecl (PositionedDeclaration _ _ d) = getFixityDecl d
+getFixityDecl _ = Nothing
+
-- |
-- Test if a declaration is a foreign import
--
@@ -361,12 +346,8 @@ data Expr
--
| Parens Expr
-- |
- -- Operator section. This will be removed during desugaring and replaced with lambda.
- --
- | OperatorSection Expr (Either Expr Expr)
- -- |
- -- An object property getter (e.g. `_.x`). This will be removed during
- -- desugaring and expanded into a lambda that reads a property from an object.
+ -- A record property getter (e.g. `_.x`). This will be removed during
+ -- desugaring and expanded into a lambda that reads a property from a record.
--
| ObjectGetter String
-- |
@@ -390,6 +371,11 @@ data Expr
--
| Var (Qualified Ident)
-- |
+ -- An operator. This will be desugared into a function during the "operators"
+ -- phase of desugaring.
+ --
+ | Op (Qualified (OpName 'ValueOpName))
+ -- |
-- Conditional (if-then-else expression)
--
| IfThenElse Expr Expr Expr
@@ -487,4 +473,3 @@ data DoNotationElement
$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''DeclarationRef)
$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ImportDeclarationType)
-$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''FixityAlias)
diff --git a/src/Language/PureScript/AST/Exported.hs b/src/Language/PureScript/AST/Exported.hs
index dce1de9..93e9585 100644
--- a/src/Language/PureScript/AST/Exported.hs
+++ b/src/Language/PureScript/AST/Exported.hs
@@ -3,7 +3,10 @@ module Language.PureScript.AST.Exported
, isExported
) where
+import Prelude.Compat
+
import Control.Category ((>>>))
+
import Data.Maybe (mapMaybe)
import Language.PureScript.AST.Declarations
@@ -99,7 +102,7 @@ typeInstanceConstituents (TypeInstanceDeclaration _ constraints className tys _)
Left className : (concatMap fromConstraint constraints ++ concatMap fromType tys)
where
- fromConstraint (name, tys') = Left name : concatMap fromType tys'
+ fromConstraint c = Left (constraintClass c) : concatMap fromType (constraintArgs c)
fromType = everythingOnTypes (++) go
-- Note that type synonyms are disallowed in instance declarations, so
@@ -124,21 +127,15 @@ 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 (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 (DataDeclaration _ ident _ _) (ProperRef ident') = runProperName ident == ident'
- matches (TypeClassDeclaration ident _ _ _) (ProperRef ident') = runProperName ident == ident'
-
- matches (FixityDeclaration _ name (Just (Qualified _ (AliasValue _)))) (ValueRef ident') = name == runIdent ident'
- matches (FixityDeclaration _ name (Just (Qualified _ (AliasConstructor _)))) (ValueRef ident') = name == runIdent ident'
- matches (FixityDeclaration _ name (Just (Qualified _ (AliasType _)))) (TypeOpRef ident') = name == runIdent ident'
-
+ matches (ValueFixityDeclaration _ _ op) (ValueOpRef op') = op == op'
+ matches (TypeFixityDeclaration _ _ op) (TypeOpRef op') = op == op'
matches (PositionedDeclaration _ _ d) r = d `matches` r
matches d (PositionedDeclarationRef _ _ r) = d `matches` r
matches _ _ = False
diff --git a/src/Language/PureScript/AST/Literals.hs b/src/Language/PureScript/AST/Literals.hs
index d14a36b..fae56ee 100644
--- a/src/Language/PureScript/AST/Literals.hs
+++ b/src/Language/PureScript/AST/Literals.hs
@@ -1,10 +1,10 @@
-{-# LANGUAGE DeriveFunctor #-}
-
-- |
-- The core functional representation for literal values.
--
module Language.PureScript.AST.Literals where
+import Prelude.Compat
+
-- |
-- Data type for literal values. Parameterised so it can be used for Exprs and
-- Binders.
diff --git a/src/Language/PureScript/AST/Operators.hs b/src/Language/PureScript/AST/Operators.hs
index 241f6c4..5ba0e15 100644
--- a/src/Language/PureScript/AST/Operators.hs
+++ b/src/Language/PureScript/AST/Operators.hs
@@ -5,6 +5,8 @@
--
module Language.PureScript.AST.Operators where
+import Prelude.Compat
+
import Data.Aeson ((.=))
import qualified Data.Aeson as A
diff --git a/src/Language/PureScript/AST/SourcePos.hs b/src/Language/PureScript/AST/SourcePos.hs
index 35d5903..328c955 100644
--- a/src/Language/PureScript/AST/SourcePos.hs
+++ b/src/Language/PureScript/AST/SourcePos.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
-- |
@@ -7,7 +5,6 @@
--
module Language.PureScript.AST.SourcePos where
-import Prelude ()
import Prelude.Compat
import Data.Aeson ((.=), (.:))
diff --git a/src/Language/PureScript/AST/Traversals.hs b/src/Language/PureScript/AST/Traversals.hs
index 4a75f9a..801883a 100644
--- a/src/Language/PureScript/AST/Traversals.hs
+++ b/src/Language/PureScript/AST/Traversals.hs
@@ -1,21 +1,18 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-
-- |
-- AST traversal helpers
--
module Language.PureScript.AST.Traversals where
-import Prelude ()
import Prelude.Compat
-import Data.Maybe (mapMaybe)
-import Data.List (mapAccumL)
-import Data.Foldable (fold)
-import qualified Data.Set as S
-
import Control.Monad
import Control.Arrow ((***), (+++))
+import Data.Foldable (fold)
+import Data.List (mapAccumL)
+import Data.Maybe (mapMaybe)
+import qualified Data.Set as S
+
import Language.PureScript.AST.Binders
import Language.PureScript.AST.Literals
import Language.PureScript.AST.Declarations
@@ -47,8 +44,6 @@ everywhereOnValues f g h = (f', g', h')
g' (UnaryMinus v) = g (UnaryMinus (g' v))
g' (BinaryNoParens op v1 v2) = g (BinaryNoParens (g' op) (g' v1) (g' v2))
g' (Parens v) = g (Parens (g' v))
- g' (OperatorSection op (Left v)) = g (OperatorSection (g' op) (Left $ g' v))
- g' (OperatorSection op (Right v)) = g (OperatorSection (g' op) (Right $ g' v))
g' (TypeClassDictionaryConstructorApp name v) = g (TypeClassDictionaryConstructorApp name (g' v))
g' (Accessor prop v) = g (Accessor prop (g' v))
g' (ObjectUpdate obj vs) = g (ObjectUpdate (g' obj) (map (fmap g') vs))
@@ -116,8 +111,6 @@ everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)
g' (UnaryMinus v) = UnaryMinus <$> (g v >>= g')
g' (BinaryNoParens op v1 v2) = BinaryNoParens <$> (g op >>= g') <*> (g v1 >>= g') <*> (g v2 >>= g')
g' (Parens v) = Parens <$> (g v >>= g')
- g' (OperatorSection op (Left v)) = OperatorSection <$> (g op >>= g') <*> (Left <$> (g v >>= g'))
- g' (OperatorSection op (Right v)) = OperatorSection <$> (g op >>= g') <*> (Right <$> (g v >>= g'))
g' (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> (g v >>= g')
g' (Accessor prop v) = Accessor prop <$> (g v >>= g')
g' (ObjectUpdate obj vs) = ObjectUpdate <$> (g obj >>= g') <*> traverse (sndM (g' <=< g)) vs
@@ -185,8 +178,6 @@ everywhereOnValuesM f g h = (f', g', h')
g' (UnaryMinus v) = (UnaryMinus <$> g' v) >>= g
g' (BinaryNoParens op v1 v2) = (BinaryNoParens <$> g' op <*> g' v1 <*> g' v2) >>= g
g' (Parens v) = (Parens <$> g' v) >>= g
- g' (OperatorSection op (Left v)) = (OperatorSection <$> g' op <*> (Left <$> g' v)) >>= g
- g' (OperatorSection op (Right v)) = (OperatorSection <$> g' op <*> (Right <$> g' v)) >>= g
g' (TypeClassDictionaryConstructorApp name v) = (TypeClassDictionaryConstructorApp name <$> g' v) >>= g
g' (Accessor prop v) = (Accessor prop <$> g' v) >>= g
g' (ObjectUpdate obj vs) = (ObjectUpdate <$> g' obj <*> traverse (sndM g') vs) >>= g
@@ -259,8 +250,6 @@ everythingOnValues (<>) f g h i j = (f', g', h', i', j')
g' v@(UnaryMinus v1) = g v <> g' v1
g' v@(BinaryNoParens op v1 v2) = g v <> g' op <> g' v1 <> g' v2
g' v@(Parens v1) = g v <> g' v1
- g' v@(OperatorSection op (Left v1)) = g v <> g' op <> g' v1
- g' v@(OperatorSection op (Right v1)) = g v <> g' op <> g' v1
g' v@(TypeClassDictionaryConstructorApp _ v1) = g v <> g' v1
g' v@(Accessor _ v1) = g v <> g' v1
g' v@(ObjectUpdate obj vs) = foldl (<>) (g v <> g' obj) (map (g' . snd) vs)
@@ -338,8 +327,6 @@ everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'
g' s (UnaryMinus v1) = g'' s v1
g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2
g' s (Parens v1) = g'' s v1
- g' s (OperatorSection op (Left v)) = g'' s op <> g'' s v
- g' s (OperatorSection op (Right v)) = g'' s op <> g'' s v
g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1
g' s (Accessor _ v1) = g'' s v1
g' s (ObjectUpdate obj vs) = foldl (<>) (g'' s obj) (map (g'' s . snd) vs)
@@ -419,8 +406,6 @@ everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j
g' s (UnaryMinus v) = UnaryMinus <$> g'' s v
g' s (BinaryNoParens op v1 v2) = BinaryNoParens <$> g'' s op <*> g'' s v1 <*> g'' s v2
g' s (Parens v) = Parens <$> g'' s v
- g' s (OperatorSection op (Left v)) = OperatorSection <$> g'' s op <*> (Left <$> g'' s v)
- g' s (OperatorSection op (Right v)) = OperatorSection <$> g'' s op <*> (Right <$> g'' s v)
g' s (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> g'' s v
g' s (Accessor prop v) = Accessor prop <$> g'' s v
g' s (ObjectUpdate obj vs) = ObjectUpdate <$> g'' s obj <*> traverse (sndM (g'' s)) vs
@@ -510,8 +495,6 @@ everythingWithScope f g h i j = (f'', g'', h'', i'', \s -> snd . j'' s)
g' s (UnaryMinus v1) = g'' s v1
g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2
g' s (Parens v1) = g'' s v1
- g' s (OperatorSection op (Left v)) = g'' s op <> g'' s v
- g' s (OperatorSection op (Right v)) = g'' s op <> g'' s v
g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1
g' s (Accessor _ v1) = g'' s v1
g' s (ObjectUpdate obj vs) = g'' s obj <> foldMap (g'' s . snd) vs
@@ -593,13 +576,13 @@ accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (con
where
forDecls (DataDeclaration _ _ _ dctors) = mconcat (concatMap (map f . snd) dctors)
forDecls (ExternDeclaration _ ty) = f ty
- forDecls (TypeClassDeclaration _ _ implies _) = mconcat (concatMap (map f . snd) implies)
- forDecls (TypeInstanceDeclaration _ cs _ tys _) = mconcat (concatMap (map f . snd) cs) `mappend` mconcat (map f tys)
+ forDecls (TypeClassDeclaration _ _ implies _) = mconcat (concatMap (map f . constraintArgs) implies)
+ forDecls (TypeInstanceDeclaration _ cs _ tys _) = mconcat (concatMap (map f . constraintArgs) cs) `mappend` mconcat (map f tys)
forDecls (TypeSynonymDeclaration _ _ ty) = f ty
forDecls (TypeDeclaration _ ty) = f ty
forDecls _ = mempty
- forValues (TypeClassDictionary (_, cs) _) = mconcat (map f cs)
+ forValues (TypeClassDictionary c _) = mconcat (map f (constraintArgs c))
forValues (SuperClassDictionary _ tys) = mconcat (map f tys)
forValues (TypedValue _ _ ty) = f ty
forValues _ = mempty
diff --git a/src/Language/PureScript/Bundle.hs b/src/Language/PureScript/Bundle.hs
index 13f6605..316652c 100644
--- a/src/Language/PureScript/Bundle.hs
+++ b/src/Language/PureScript/Bundle.hs
@@ -1,48 +1,32 @@
------------------------------------------------------------------------------
---
--- 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.
+-- |
+-- Bundles compiled PureScript modules for the browser.
--
-- This module takes as input the individual generated modules from 'Language.PureScript.Make' and
-- performs dead code elimination, filters empty modules,
-- and generates the final Javascript bundle.
------------------------------------------------------------------------------
-
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
-
-module Language.PureScript.Bundle (
- bundle
- , ModuleIdentifier(..)
- , moduleName
- , ModuleType(..)
- , ErrorMessage(..)
- , printErrorMessage
- , getExportedIdentifiers
-) where
-
-import Prelude ()
+module Language.PureScript.Bundle
+ ( bundle
+ , ModuleIdentifier(..)
+ , moduleName
+ , ModuleType(..)
+ , ErrorMessage(..)
+ , printErrorMessage
+ , getExportedIdentifiers
+ ) where
+
import Prelude.Compat
-import Data.List (nub, stripPrefix)
-import Data.Maybe (mapMaybe, catMaybes, fromMaybe)
+import Control.Monad
+import Control.Monad.Error.Class
+
+import Data.Char (chr, digitToInt)
import Data.Generics (everything, everywhere, mkQ, mkT)
import Data.Graph
+import Data.List (nub, stripPrefix)
+import Data.Maybe (mapMaybe, catMaybes)
import Data.Version (showVersion)
-
import qualified Data.Set as S
-import Control.Monad
-import Control.Monad.Error.Class
import Language.JavaScript.Parser
import Language.JavaScript.Parser.AST
@@ -134,13 +118,13 @@ printErrorMessage (ErrorInModule mid e) =
name ++ " (" ++ showModuleType ty ++ ")"
-- | Calculate the ModuleIdentifier which a require(...) statement imports.
-checkImportPath :: Maybe FilePath -> String -> ModuleIdentifier -> S.Set String -> Either String ModuleIdentifier
-checkImportPath _ "./foreign" m _ =
+checkImportPath :: String -> ModuleIdentifier -> S.Set String -> Either String ModuleIdentifier
+checkImportPath "./foreign" m _ =
Right (ModuleIdentifier (moduleName m) Foreign)
-checkImportPath requirePath name _ names
- | Just name' <- stripPrefix (fromMaybe "../" requirePath) name
+checkImportPath name _ names
+ | Just name' <- stripPrefix "../" name
, name' `S.member` names = Right (ModuleIdentifier name' Regular)
-checkImportPath _ name _ _ = Left name
+checkImportPath name _ _ = Left name
-- | Compute the dependencies of all elements in a module, and add them to the tree.
--
@@ -203,11 +187,34 @@ withDeps (Module modulePath es) = Module modulePath (map expandDeps es)
-- String literals include the quote chars
fromStringLiteral :: JSExpression -> Maybe String
-fromStringLiteral (JSStringLiteral _ str) = Just $ trimStringQuotes str
+fromStringLiteral (JSStringLiteral _ str) = Just $ strValue str
fromStringLiteral _ = Nothing
-trimStringQuotes :: String -> String
-trimStringQuotes str = reverse $ drop 1 $ reverse $ drop 1 $ str
+strValue :: String -> String
+strValue str = go $ drop 1 str
+ where
+ go ('\\' : 'b' : xs) = '\b' : go xs
+ go ('\\' : 'f' : xs) = '\f' : go xs
+ go ('\\' : 'n' : xs) = '\n' : go xs
+ go ('\\' : 'r' : xs) = '\r' : go xs
+ go ('\\' : 't' : xs) = '\t' : go xs
+ go ('\\' : 'v' : xs) = '\v' : go xs
+ go ('\\' : '0' : xs) = '\0' : go xs
+ go ('\\' : 'x' : a : b : xs) = chr (a' + b') : go xs
+ where
+ a' = 16 * digitToInt a
+ b' = digitToInt b
+ go ('\\' : 'u' : a : b : c : d : xs) = chr (a' + b' + c' + d') : go xs
+ where
+ a' = 16 * 16 * 16 * digitToInt a
+ b' = 16 * 16 * digitToInt b
+ c' = 16 * digitToInt c
+ d' = digitToInt d
+ go ('\\' : x : xs) = x : go xs
+ go "\"" = ""
+ go "'" = ""
+ go (x : xs) = x : go xs
+ go "" = ""
commaList :: JSCommaList a -> [a]
commaList JSLNil = []
@@ -222,8 +229,8 @@ trailingCommaList (JSCTLNone l) = commaList l
--
-- Each type of module element is matched using pattern guards, and everything else is bundled into the
-- Other constructor.
-toModule :: forall m. (MonadError ErrorMessage m) => Maybe FilePath -> S.Set String -> ModuleIdentifier -> JSAST -> m Module
-toModule requirePath mids mid top
+toModule :: forall m. (MonadError ErrorMessage m) => S.Set String -> ModuleIdentifier -> JSAST -> m Module
+toModule mids mid top
| JSAstProgram smts _ <- top = Module mid <$> traverse toModuleElement smts
| otherwise = err InvalidTopLevel
where
@@ -231,7 +238,7 @@ toModule requirePath mids mid top
toModuleElement :: JSStatement -> m ModuleElement
toModuleElement stmt
- | Just (importName, importPath) <- matchRequire requirePath mids mid stmt
+ | Just (importName, importPath) <- matchRequire mids mid stmt
= pure (Require stmt importName importPath)
toModuleElement stmt
| Just (exported, name, decl) <- matchMember stmt
@@ -291,12 +298,11 @@ getExportedIdentifiers mname top
-- Matches JS statements like this:
-- var ModuleName = require("file");
-matchRequire :: Maybe FilePath
- -> S.Set String
+matchRequire :: S.Set String
-> ModuleIdentifier
-> JSStatement
-> Maybe (String, Either String ModuleIdentifier)
-matchRequire requirePath mids mid stmt
+matchRequire mids mid stmt
| JSVariable _ jsInit _ <- stmt
, [JSVarInitExpression var varInit] <- commaList jsInit
, JSIdentifier _ importName <- var
@@ -304,7 +310,7 @@ matchRequire requirePath mids mid stmt
, JSMemberExpression req _ argsE _ <- jsInitEx
, JSIdentifier _ "require" <- req
, [ Just importPath ] <- map fromStringLiteral (commaList argsE)
- , importPath' <- checkImportPath requirePath importPath mid mids
+ , importPath' <- checkImportPath importPath mid mids
= Just (importName, importPath')
| otherwise
= Nothing
@@ -350,7 +356,7 @@ matchExportsAssignment stmt
= Nothing
extractLabel :: JSPropertyName -> Maybe String
-extractLabel (JSPropertyString _ nm) = Just (trimStringQuotes nm)
+extractLabel (JSPropertyString _ nm) = Just $ strValue nm
extractLabel (JSPropertyIdent _ nm) = Just nm
extractLabel _ = Nothing
@@ -590,16 +596,15 @@ bundle :: (MonadError ErrorMessage m)
-> [ModuleIdentifier] -- ^ Entry points. These module identifiers are used as the roots for dead-code elimination
-> Maybe String -- ^ An optional main module.
-> String -- ^ The namespace (e.g. PS).
- -> Maybe FilePath -- ^ The require path prefix
-> m String
-bundle inputStrs entryPoints mainModule namespace requirePath = do
+bundle inputStrs entryPoints mainModule namespace = do
input <- forM inputStrs $ \(ident, js) -> do
ast <- either (throwError . ErrorInModule ident . UnableToParseModule) pure $ parse js (moduleName ident)
return (ident, ast)
let mids = S.fromList (map (moduleName . fst) input)
- modules <- traverse (fmap withDeps . uncurry (toModule requirePath mids)) input
+ modules <- traverse (fmap withDeps . uncurry (toModule mids)) input
let compiled = compile modules entryPoints
sorted = sortModules (filter (not . isModuleEmpty) compiled)
diff --git a/src/Language/PureScript/CodeGen.hs b/src/Language/PureScript/CodeGen.hs
index ee305ff..d927211 100644
--- a/src/Language/PureScript/CodeGen.hs
+++ b/src/Language/PureScript/CodeGen.hs
@@ -1,20 +1,8 @@
------------------------------------------------------------------------------
---
--- Module : Language.PureScript.CodeGen
--- Copyright : (c) Phil Freeman 2013
--- License : MIT
---
--- Maintainer : Phil Freeman <paf31@cantab.net>
--- Stability : experimental
--- Portability :
---
--- |
--- A collection of modules related to code generation:
---
--- [@Language.PureScript.CodeGen.JS@] Code generator for Javascript
---
------------------------------------------------------------------------------
-
-module Language.PureScript.CodeGen (module C) where
-
-import Language.PureScript.CodeGen.JS as C
+-- |
+-- A collection of modules related to code generation:
+--
+-- [@Language.PureScript.CodeGen.JS@] Code generator for Javascript
+--
+module Language.PureScript.CodeGen (module C) where
+
+import Language.PureScript.CodeGen.JS as C
diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs
index d4a1e8f..dfc1301 100644
--- a/src/Language/PureScript/CodeGen/JS.hs
+++ b/src/Language/PureScript/CodeGen/JS.hs
@@ -1,8 +1,3 @@
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-- |
-- This module generates code in the simplified Javascript intermediate representation from Purescript code
--
@@ -12,29 +7,28 @@ module Language.PureScript.CodeGen.JS
, moduleToJs
) where
-import Prelude ()
import Prelude.Compat
-import Data.List ((\\), delete, intersect)
-import Data.Maybe (isNothing, fromMaybe)
-import qualified Data.Map as M
-import qualified Data.Foldable as F
-import qualified Data.Traversable as T
-
import Control.Arrow ((&&&))
import Control.Monad (replicateM, forM, void)
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.Reader (MonadReader, asks)
import Control.Monad.Supply.Class
-import Language.PureScript.Crash
+import Data.List ((\\), delete, intersect)
+import Data.Maybe (isNothing, fromMaybe)
+import qualified Data.Foldable as F
+import qualified Data.Map as M
+import qualified Data.Traversable as T
+
import Language.PureScript.AST.SourcePos
import Language.PureScript.CodeGen.JS.AST as AST
import Language.PureScript.CodeGen.JS.Common as Common
+import Language.PureScript.CodeGen.JS.Optimizer
import Language.PureScript.CoreFn
-import Language.PureScript.Names
+import Language.PureScript.Crash
import Language.PureScript.Errors
-import Language.PureScript.CodeGen.JS.Optimizer
+import Language.PureScript.Names
import Language.PureScript.Options
import Language.PureScript.Traversals (sndM)
import qualified Language.PureScript.Constants as C
@@ -109,9 +103,8 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =
--
importToJs :: M.Map ModuleName (Ann, ModuleName) -> ModuleName -> m JS
importToJs mnLookup mn' = do
- path <- asks optionsRequirePath
let ((ss, _, _, _), mnSafe) = fromMaybe (internalError "Missing value in mnLookup") $ M.lookup mn' mnLookup
- let moduleBody = JSApp Nothing (JSVar Nothing "require") [JSStringLiteral Nothing (fromMaybe ".." path </> runModuleName mn')]
+ let moduleBody = JSApp Nothing (JSVar Nothing "require") [JSStringLiteral Nothing (".." </> runModuleName mn')]
withPos ss $ JSVariableIntroduction Nothing (moduleNameToJs mnSafe) (Just moduleBody)
-- |
@@ -180,7 +173,6 @@ moduleToJs (Module coms mn imps exps foreigns decls) foreign_ =
--
accessor :: Ident -> JS -> JS
accessor (Ident prop) = accessorString prop
- accessor (Op op) = JSIndexer Nothing (JSStringLiteral Nothing op)
accessor (GenIdent _ _) = internalError "GenIdent in accessor"
accessorString :: String -> JS -> JS
diff --git a/src/Language/PureScript/CodeGen/JS/AST.hs b/src/Language/PureScript/CodeGen/JS/AST.hs
index dd9a69a..abc722e 100644
--- a/src/Language/PureScript/CodeGen/JS/AST.hs
+++ b/src/Language/PureScript/CodeGen/JS/AST.hs
@@ -3,14 +3,13 @@
--
module Language.PureScript.CodeGen.JS.AST where
-import Prelude ()
import Prelude.Compat
import Control.Monad.Identity
+import Language.PureScript.AST (SourceSpan(..))
import Language.PureScript.Comments
import Language.PureScript.Traversals
-import Language.PureScript.AST (SourceSpan(..))
-- |
-- Built-in unary operators
diff --git a/src/Language/PureScript/CodeGen/JS/Common.hs b/src/Language/PureScript/CodeGen/JS/Common.hs
index 720d829..45b5391 100644
--- a/src/Language/PureScript/CodeGen/JS/Common.hs
+++ b/src/Language/PureScript/CodeGen/JS/Common.hs
@@ -3,6 +3,8 @@
--
module Language.PureScript.CodeGen.JS.Common where
+import Prelude.Compat
+
import Data.Char
import Data.List (intercalate)
@@ -27,7 +29,6 @@ identToJs :: Ident -> String
identToJs (Ident name)
| nameIsJsReserved name || nameIsJsBuiltIn name = "$$" ++ name
| otherwise = concatMap identCharToString name
-identToJs (Op op) = concatMap identCharToString op
identToJs (GenIdent _ _) = internalError "GenIdent in identToJs"
-- |
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer.hs b/src/Language/PureScript/CodeGen/JS/Optimizer.hs
index d270949..2ee3a82 100644
--- a/src/Language/PureScript/CodeGen/JS/Optimizer.hs
+++ b/src/Language/PureScript/CodeGen/JS/Optimizer.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE FlexibleContexts #-}
-
-- |
-- This module optimizes code in the simplified-Javascript intermediate representation.
--
@@ -23,22 +21,20 @@
--
module Language.PureScript.CodeGen.JS.Optimizer (optimize) where
-import Prelude ()
import Prelude.Compat
import Control.Monad.Reader (MonadReader, ask, asks)
import Control.Monad.Supply.Class (MonadSupply)
import Language.PureScript.CodeGen.JS.AST
-import Language.PureScript.Options
-import qualified Language.PureScript.Constants as C
-
+import Language.PureScript.CodeGen.JS.Optimizer.Blocks
import Language.PureScript.CodeGen.JS.Optimizer.Common
-import Language.PureScript.CodeGen.JS.Optimizer.TCO
-import Language.PureScript.CodeGen.JS.Optimizer.MagicDo
import Language.PureScript.CodeGen.JS.Optimizer.Inliner
+import Language.PureScript.CodeGen.JS.Optimizer.MagicDo
+import Language.PureScript.CodeGen.JS.Optimizer.TCO
import Language.PureScript.CodeGen.JS.Optimizer.Unused
-import Language.PureScript.CodeGen.JS.Optimizer.Blocks
+import Language.PureScript.Options
+import qualified Language.PureScript.Constants as C
-- |
-- Apply a series of optimizer passes to simplified Javascript code
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer/Blocks.hs b/src/Language/PureScript/CodeGen/JS/Optimizer/Blocks.hs
index 2abd781..1c80799 100644
--- a/src/Language/PureScript/CodeGen/JS/Optimizer/Blocks.hs
+++ b/src/Language/PureScript/CodeGen/JS/Optimizer/Blocks.hs
@@ -1,23 +1,13 @@
------------------------------------------------------------------------------
---
--- Module : Language.PureScript.CodeGen.JS.Optimizer.Blocks
--- Copyright : (c) Phil Freeman 2013-14
--- License : MIT
---
--- Maintainer : Phil Freeman <paf31@cantab.net>
--- Stability : experimental
--- Portability :
---
-- |
-- Optimizer steps for simplifying Javascript blocks
--
------------------------------------------------------------------------------
-
module Language.PureScript.CodeGen.JS.Optimizer.Blocks
( collapseNestedBlocks
, collapseNestedIfs
) where
+import Prelude.Compat
+
import Language.PureScript.CodeGen.JS.AST
-- |
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer/Common.hs b/src/Language/PureScript/CodeGen/JS/Optimizer/Common.hs
index 25cb331..a7ed7fb 100644
--- a/src/Language/PureScript/CodeGen/JS/Optimizer/Common.hs
+++ b/src/Language/PureScript/CodeGen/JS/Optimizer/Common.hs
@@ -3,6 +3,8 @@
--
module Language.PureScript.CodeGen.JS.Optimizer.Common where
+import Prelude.Compat
+
import Data.Maybe (fromMaybe)
import Language.PureScript.Crash
@@ -66,13 +68,12 @@ removeFromBlock go (JSBlock ss sts) = JSBlock ss (go sts)
removeFromBlock _ js = js
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 (moduleName, fnName) (JSAccessor _ x (JSVar _ y)) =
+ x == fnName && y == moduleName
+isFn (moduleName, fnName) (JSIndexer _ (JSStringLiteral _ x) (JSVar _ y)) =
+ x == fnName && y == moduleName
isFn _ _ = False
-isFn' :: [(String, String)] -> JS -> Bool
-isFn' xs js = any (`isFn` js) xs
-
isDict :: (String, String) -> JS -> Bool
isDict (moduleName, dictName) (JSAccessor _ x (JSVar _ y)) = x == dictName && y == moduleName
isDict _ _ = False
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs b/src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs
index bcc2b39..c46bc80 100644
--- a/src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs
+++ b/src/Language/PureScript/CodeGen/JS/Optimizer/Inliner.hs
@@ -12,15 +12,13 @@ module Language.PureScript.CodeGen.JS.Optimizer.Inliner
, evaluateIifes
) where
-import Prelude ()
import Prelude.Compat
import Control.Monad.Supply.Class (MonadSupply, freshName)
+
import Data.Maybe (fromMaybe)
import Language.PureScript.CodeGen.JS.AST
-import Language.PureScript.CodeGen.JS.Common
-import Language.PureScript.Names
import Language.PureScript.CodeGen.JS.Optimizer.Common
import qualified Language.PureScript.Constants as C
@@ -82,24 +80,24 @@ inlineCommonValues = everywhereOnJS convert
where
convert :: JS -> JS
convert (JSApp ss fn [dict])
- | isDict' (semiringNumber ++ semiringInt) dict && isFn' fnZero fn = JSNumericLiteral ss (Left 0)
- | isDict' (semiringNumber ++ semiringInt) dict && isFn' fnOne fn = JSNumericLiteral ss (Left 1)
- | isDict' boundedBoolean dict && isFn' fnBottom fn = JSBooleanLiteral ss False
- | isDict' boundedBoolean dict && isFn' fnTop fn = JSBooleanLiteral ss True
+ | isDict' [semiringNumber, semiringInt] dict && isFn fnZero fn = JSNumericLiteral ss (Left 0)
+ | isDict' [semiringNumber, semiringInt] dict && isFn fnOne fn = JSNumericLiteral ss (Left 1)
+ | isDict boundedBoolean dict && isFn fnBottom fn = JSBooleanLiteral ss False
+ | isDict boundedBoolean dict && isFn fnTop fn = JSBooleanLiteral ss True
convert (JSApp ss (JSApp _ (JSApp _ fn [dict]) [x]) [y])
- | isDict' semiringInt dict && isFn' fnAdd fn = intOp ss Add x y
- | isDict' semiringInt dict && isFn' fnMultiply fn = intOp ss Multiply x y
- | isDict' moduloSemiringInt dict && isFn' fnDivide fn = intOp ss Divide x y
- | isDict' ringInt dict && isFn' fnSubtract fn = intOp ss Subtract x y
+ | isDict semiringInt dict && isFn fnAdd fn = intOp ss Add x y
+ | isDict semiringInt dict && isFn fnMultiply fn = intOp ss Multiply x y
+ | isDict euclideanRingInt dict && isFn fnDivide fn = intOp ss Divide x y
+ | isDict ringInt dict && isFn fnSubtract fn = intOp ss Subtract x y
convert other = other
- fnZero = [(C.prelude, C.zero), (C.dataSemiring, C.zero)]
- fnOne = [(C.prelude, C.one), (C.dataSemiring, C.one)]
- fnBottom = [(C.prelude, C.bottom), (C.dataBounded, C.bottom)]
- fnTop = [(C.prelude, C.top), (C.dataBounded, C.top)]
- fnAdd = [(C.prelude, (C.+)), (C.prelude, C.add), (C.dataSemiring, (C.+)), (C.dataSemiring, C.add)]
- fnDivide = [(C.prelude, (C./)), (C.prelude, C.div), (C.dataModuloSemiring, C.div)]
- fnMultiply = [(C.prelude, (C.*)), (C.prelude, C.mul), (C.dataSemiring, (C.*)), (C.dataSemiring, C.mul)]
- fnSubtract = [(C.prelude, (C.-)), (C.prelude, C.sub), (C.dataRing, C.sub)]
+ fnZero = (C.dataSemiring, C.zero)
+ fnOne = (C.dataSemiring, C.one)
+ fnBottom = (C.dataBounded, C.bottom)
+ fnTop = (C.dataBounded, C.top)
+ fnAdd = (C.dataSemiring, C.add)
+ fnDivide = (C.dataEuclideanRing, C.div)
+ fnMultiply = (C.dataSemiring, C.mul)
+ fnSubtract = (C.dataRing, C.sub)
intOp ss op x y = JSBinary ss BitwiseOr (JSBinary ss op x y) (JSNumericLiteral ss (Left 0))
inlineOperator :: (String, String) -> (JS -> JS -> JS) -> JS -> JS
@@ -108,7 +106,6 @@ inlineOperator (m, op) f = everywhereOnJS convert
convert :: JS -> JS
convert (JSApp _ (JSApp _ op' [x]) [y]) | isOp op' = f x y
convert other = other
- isOp (JSAccessor _ longForm (JSVar _ m')) = m == m' && longForm == identToJs (Op op)
isOp (JSIndexer _ (JSStringLiteral _ op') (JSVar _ m')) = m == m' && op == op'
isOp _ = False
@@ -122,8 +119,8 @@ inlineCommonOperators = applyAll $
, binary ringInt opSub Subtract
, unary ringInt opNegate Negate
- , binary moduloSemiringNumber opDiv Divide
- , binary moduloSemiringInt opMod Modulus
+ , binary euclideanRingNumber opDiv Divide
+ , binary euclideanRingInt opMod Modulus
, binary eqNumber opEq EqualTo
, binary eqNumber opNotEq NotEqualTo
@@ -159,9 +156,9 @@ inlineCommonOperators = applyAll $
, binary semigroupString opAppend Add
- , binary booleanAlgebraBoolean opConj And
- , binary booleanAlgebraBoolean opDisj Or
- , unary booleanAlgebraBoolean opNot Not
+ , binary heytingAlgebraBoolean opConj And
+ , binary heytingAlgebraBoolean opDisj Or
+ , unary heytingAlgebraBoolean opNot Not
, binary' C.dataIntBits (C..|.) BitwiseOr
, binary' C.dataIntBits (C..&.) BitwiseAnd
@@ -173,11 +170,11 @@ inlineCommonOperators = applyAll $
] ++
[ fn | i <- [0..10], fn <- [ mkFn i, runFn i ] ]
where
- binary :: [(String, String)] -> [(String, String)] -> BinaryOperator -> JS -> JS
+ binary :: (String, String) -> (String, String) -> BinaryOperator -> JS -> JS
binary dict fns op = everywhereOnJS convert
where
convert :: JS -> JS
- convert (JSApp ss (JSApp _ (JSApp _ fn [dict']) [x]) [y]) | isDict' dict dict' && isFn' fns fn = JSBinary ss op x y
+ convert (JSApp ss (JSApp _ (JSApp _ fn [dict']) [x]) [y]) | isDict dict dict' && isFn fns fn = JSBinary ss op x y
convert other = other
binary' :: String -> String -> BinaryOperator -> JS -> JS
binary' moduleName opString op = everywhereOnJS convert
@@ -185,11 +182,11 @@ inlineCommonOperators = applyAll $
convert :: JS -> JS
convert (JSApp ss (JSApp _ fn [x]) [y]) | isFn (moduleName, opString) fn = JSBinary ss op x y
convert other = other
- unary :: [(String, String)] -> [(String, String)] -> UnaryOperator -> JS -> JS
+ unary :: (String, String) -> (String, String) -> UnaryOperator -> JS -> JS
unary dicts fns op = everywhereOnJS convert
where
convert :: JS -> JS
- convert (JSApp ss (JSApp _ fn [dict']) [x]) | isDict' dicts dict' && isFn' fns fn = JSUnary ss op x
+ convert (JSApp ss (JSApp _ fn [dict']) [x]) | isDict dicts dict' && isFn fns fn = JSUnary ss op x
convert other = other
unary' :: String -> String -> UnaryOperator -> JS -> JS
unary' moduleName fnName op = everywhereOnJS convert
@@ -251,118 +248,118 @@ inlineFnComposition = everywhereOnJSTopDownM convert
return $ JSFunction ss Nothing [arg] (JSBlock ss [JSReturn Nothing $ JSApp Nothing y [JSApp Nothing x [JSVar Nothing arg]]])
convert other = return other
isFnCompose :: JS -> JS -> Bool
- isFnCompose dict' fn = isDict' semigroupoidFn dict' && isFn' fnCompose fn
+ isFnCompose dict' fn = isDict semigroupoidFn dict' && isFn fnCompose fn
isFnComposeFlipped :: JS -> JS -> Bool
- isFnComposeFlipped dict' fn = isDict' semigroupoidFn dict' && isFn' fnComposeFlipped fn
- fnCompose :: [(String, String)]
- fnCompose = [(C.prelude, C.compose), (C.prelude, (C.<<<)), (C.controlSemigroupoid, C.compose)]
- fnComposeFlipped :: [(String, String)]
- fnComposeFlipped = [(C.prelude, (C.>>>)), (C.controlSemigroupoid, C.composeFlipped)]
+ isFnComposeFlipped dict' fn = isDict semigroupoidFn dict' && isFn fnComposeFlipped fn
+ fnCompose :: (String, String)
+ fnCompose = (C.controlSemigroupoid, C.compose)
+ fnComposeFlipped :: (String, String)
+ fnComposeFlipped = (C.controlSemigroupoid, C.composeFlipped)
-semiringNumber :: [(String, String)]
-semiringNumber = [(C.prelude, C.semiringNumber), (C.dataSemiring, C.semiringNumber)]
+semiringNumber :: (String, String)
+semiringNumber = (C.dataSemiring, C.semiringNumber)
-semiringInt :: [(String, String)]
-semiringInt = [(C.prelude, C.semiringInt), (C.dataSemiring, C.semiringInt)]
+semiringInt :: (String, String)
+semiringInt = (C.dataSemiring, C.semiringInt)
-ringNumber :: [(String, String)]
-ringNumber = [(C.prelude, C.ringNumber), (C.dataRing, C.ringNumber)]
+ringNumber :: (String, String)
+ringNumber = (C.dataRing, C.ringNumber)
-ringInt :: [(String, String)]
-ringInt = [(C.prelude, C.ringInt), (C.dataRing, C.ringInt)]
+ringInt :: (String, String)
+ringInt = (C.dataRing, C.ringInt)
-moduloSemiringNumber :: [(String, String)]
-moduloSemiringNumber = [(C.prelude, C.moduloSemiringNumber), (C.dataModuloSemiring, C.moduloSemiringNumber)]
+euclideanRingNumber :: (String, String)
+euclideanRingNumber = (C.dataEuclideanRing, C.euclideanRingNumber)
-moduloSemiringInt :: [(String, String)]
-moduloSemiringInt = [(C.prelude, C.moduloSemiringInt), (C.dataModuloSemiring, C.moduloSemiringInt)]
+euclideanRingInt :: (String, String)
+euclideanRingInt = (C.dataEuclideanRing, C.euclideanRingInt)
-eqNumber :: [(String, String)]
-eqNumber = [(C.prelude, C.eqNumber), (C.dataEq, C.eqNumber)]
+eqNumber :: (String, String)
+eqNumber = (C.dataEq, C.eqNumber)
-eqInt :: [(String, String)]
-eqInt = [(C.prelude, C.eqInt), (C.dataEq, C.eqInt)]
+eqInt :: (String, String)
+eqInt = (C.dataEq, C.eqInt)
-eqString :: [(String, String)]
-eqString = [(C.prelude, C.eqString), (C.dataEq, C.eqString)]
+eqString :: (String, String)
+eqString = (C.dataEq, C.eqString)
-eqChar :: [(String, String)]
-eqChar = [(C.prelude, C.eqChar), (C.dataEq, C.eqChar)]
+eqChar :: (String, String)
+eqChar = (C.dataEq, C.eqChar)
-eqBoolean :: [(String, String)]
-eqBoolean = [(C.prelude, C.eqBoolean), (C.dataEq, C.eqBoolean)]
+eqBoolean :: (String, String)
+eqBoolean = (C.dataEq, C.eqBoolean)
-ordBoolean :: [(String, String)]
-ordBoolean = [(C.prelude, C.ordBoolean), (C.dataOrd, C.ordBoolean)]
+ordBoolean :: (String, String)
+ordBoolean = (C.dataOrd, C.ordBoolean)
-ordNumber :: [(String, String)]
-ordNumber = [(C.prelude, C.ordNumber), (C.dataOrd, C.ordNumber)]
+ordNumber :: (String, String)
+ordNumber = (C.dataOrd, C.ordNumber)
-ordInt :: [(String, String)]
-ordInt = [(C.prelude, C.ordInt), (C.dataOrd, C.ordInt)]
+ordInt :: (String, String)
+ordInt = (C.dataOrd, C.ordInt)
-ordString :: [(String, String)]
-ordString = [(C.prelude, C.ordString), (C.dataOrd, C.ordString)]
+ordString :: (String, String)
+ordString = (C.dataOrd, C.ordString)
-ordChar :: [(String, String)]
-ordChar = [(C.prelude, C.ordChar), (C.dataOrd, C.ordChar)]
+ordChar :: (String, String)
+ordChar = (C.dataOrd, C.ordChar)
-semigroupString :: [(String, String)]
-semigroupString = [(C.prelude, C.semigroupString), (C.dataSemigroup, C.semigroupString)]
+semigroupString :: (String, String)
+semigroupString = (C.dataSemigroup, C.semigroupString)
-boundedBoolean :: [(String, String)]
-boundedBoolean = [(C.prelude, C.boundedBoolean), (C.dataBounded, C.boundedBoolean)]
+boundedBoolean :: (String, String)
+boundedBoolean = (C.dataBounded, C.boundedBoolean)
-booleanAlgebraBoolean :: [(String, String)]
-booleanAlgebraBoolean = [(C.prelude, C.booleanAlgebraBoolean), (C.dataBooleanAlgebra, C.booleanAlgebraBoolean)]
+heytingAlgebraBoolean :: (String, String)
+heytingAlgebraBoolean = (C.dataHeytingAlgebra, C.heytingAlgebraBoolean)
-semigroupoidFn :: [(String, String)]
-semigroupoidFn = [(C.prelude, C.semigroupoidFn), (C.controlSemigroupoid, C.semigroupoidFn)]
+semigroupoidFn :: (String, String)
+semigroupoidFn = (C.controlSemigroupoid, C.semigroupoidFn)
-opAdd :: [(String, String)]
-opAdd = [(C.prelude, (C.+)), (C.prelude, C.add), (C.dataSemiring, C.add)]
+opAdd :: (String, String)
+opAdd = (C.dataSemiring, C.add)
-opMul :: [(String, String)]
-opMul = [(C.prelude, (C.*)), (C.prelude, C.mul), (C.dataSemiring, C.mul)]
+opMul :: (String, String)
+opMul = (C.dataSemiring, C.mul)
-opEq :: [(String, String)]
-opEq = [(C.prelude, (C.==)), (C.prelude, C.eq), (C.dataEq, C.eq)]
+opEq :: (String, String)
+opEq = (C.dataEq, C.eq)
-opNotEq :: [(String, String)]
-opNotEq = [(C.prelude, (C./=)), (C.dataEq, C.notEq)]
+opNotEq :: (String, String)
+opNotEq = (C.dataEq, C.notEq)
-opLessThan :: [(String, String)]
-opLessThan = [(C.prelude, (C.<)), (C.dataOrd, C.lessThan)]
+opLessThan :: (String, String)
+opLessThan = (C.dataOrd, C.lessThan)
-opLessThanOrEq :: [(String, String)]
-opLessThanOrEq = [(C.prelude, (C.<=)), (C.dataOrd, C.lessThanOrEq)]
+opLessThanOrEq :: (String, String)
+opLessThanOrEq = (C.dataOrd, C.lessThanOrEq)
-opGreaterThan :: [(String, String)]
-opGreaterThan = [(C.prelude, (C.>)), (C.dataOrd, C.greaterThan)]
+opGreaterThan :: (String, String)
+opGreaterThan = (C.dataOrd, C.greaterThan)
-opGreaterThanOrEq :: [(String, String)]
-opGreaterThanOrEq = [(C.prelude, (C.>=)), (C.dataOrd, C.greaterThanOrEq)]
+opGreaterThanOrEq :: (String, String)
+opGreaterThanOrEq = (C.dataOrd, C.greaterThanOrEq)
-opAppend :: [(String, String)]
-opAppend = [(C.prelude, (C.<>)), (C.prelude, (C.++)), (C.prelude, C.append), (C.dataSemigroup, C.append)]
+opAppend :: (String, String)
+opAppend = (C.dataSemigroup, C.append)
-opSub :: [(String, String)]
-opSub = [(C.prelude, (C.-)), (C.prelude, C.sub), (C.dataRing, C.sub)]
+opSub :: (String, String)
+opSub = (C.dataRing, C.sub)
-opNegate :: [(String, String)]
-opNegate = [(C.prelude, C.negate), (C.dataRing, C.negate)]
+opNegate :: (String, String)
+opNegate = (C.dataRing, C.negate)
-opDiv :: [(String, String)]
-opDiv = [(C.prelude, (C./)), (C.prelude, C.div), (C.dataModuloSemiring, C.div)]
+opDiv :: (String, String)
+opDiv = (C.dataEuclideanRing, C.div)
-opMod :: [(String, String)]
-opMod = [(C.prelude, C.mod), (C.dataModuloSemiring, C.mod)]
+opMod :: (String, String)
+opMod = (C.dataEuclideanRing, C.mod)
-opConj :: [(String, String)]
-opConj = [(C.prelude, (C.&&)), (C.prelude, C.conj), (C.dataBooleanAlgebra, C.conj)]
+opConj :: (String, String)
+opConj = (C.dataHeytingAlgebra, C.conj)
-opDisj :: [(String, String)]
-opDisj = [(C.prelude, (C.||)), (C.prelude, C.disj), (C.dataBooleanAlgebra, C.disj)]
+opDisj :: (String, String)
+opDisj = (C.dataHeytingAlgebra, C.disj)
-opNot :: [(String, String)]
-opNot = [(C.prelude, C.not), (C.dataBooleanAlgebra, C.not)]
+opNot :: (String, String)
+opNot = (C.dataHeytingAlgebra, C.not)
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs b/src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs
index 30edbf0..8fb82ab 100644
--- a/src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs
+++ b/src/Language/PureScript/CodeGen/JS/Optimizer/MagicDo.hs
@@ -4,6 +4,8 @@
--
module Language.PureScript.CodeGen.JS.Optimizer.MagicDo (magicDo) where
+import Prelude.Compat
+
import Data.List (nub)
import Data.Maybe (fromJust, isJust)
@@ -61,9 +63,9 @@ magicDo' = everywhereOnJS undo . everywhereOnJSTopDown convert
isPure (JSApp _ fn [dict]) | isDict (C.eff, C.applicativeEffDictionary) dict && isPurePoly fn = True
isPure _ = False
-- Check if an expression represents the polymorphic >>= function
- isBindPoly = isFn' [(C.prelude, C.bind), (C.prelude, (C.>>=)), (C.controlBind, C.bind)]
+ isBindPoly = isFn (C.controlBind, C.bind)
-- Check if an expression represents the polymorphic pure or return function
- isPurePoly = isFn' [(C.prelude, C.pure'), (C.prelude, C.return), (C.controlApplicative, C.pure')]
+ isPurePoly = isFn (C.controlApplicative, C.pure')
-- Check if an expression represents a function in the Eff module
isEffFunc name (JSAccessor _ name' (JSVar _ eff)) = eff == C.eff && name == name'
isEffFunc _ _ = False
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs b/src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs
index 8cff910..c1b261e 100644
--- a/src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs
+++ b/src/Language/PureScript/CodeGen/JS/Optimizer/TCO.hs
@@ -1,20 +1,10 @@
------------------------------------------------------------------------------
---
--- Module : Language.PureScript.CodeGen.JS.Optimizer.TCO
--- Copyright : (c) Phil Freeman 2013-14
--- License : MIT
---
--- Maintainer : Phil Freeman <paf31@cantab.net>
--- Stability : experimental
--- Portability :
---
-- |
-- This module implements tail call elimination.
--
------------------------------------------------------------------------------
-
module Language.PureScript.CodeGen.JS.Optimizer.TCO (tco) where
+import Prelude.Compat
+
import Data.Monoid
import Language.PureScript.Options
diff --git a/src/Language/PureScript/CodeGen/JS/Optimizer/Unused.hs b/src/Language/PureScript/CodeGen/JS/Optimizer/Unused.hs
index 0f3d851..942414b 100644
--- a/src/Language/PureScript/CodeGen/JS/Optimizer/Unused.hs
+++ b/src/Language/PureScript/CodeGen/JS/Optimizer/Unused.hs
@@ -1,27 +1,16 @@
------------------------------------------------------------------------------
---
--- Module : Language.PureScript.CodeGen.JS.Optimizer.Unused
--- Copyright : (c) Phil Freeman 2013-14
--- License : MIT
---
--- Maintainer : Phil Freeman <paf31@cantab.net>
--- Stability : experimental
--- Portability :
---
-- |
-- Removes unused variables
--
------------------------------------------------------------------------------
-
module Language.PureScript.CodeGen.JS.Optimizer.Unused
( removeCodeAfterReturnStatements
, removeUnusedArg
, removeUndefinedApp
) where
+import Prelude.Compat
+
import Language.PureScript.CodeGen.JS.AST
import Language.PureScript.CodeGen.JS.Optimizer.Common
-
import qualified Language.PureScript.Constants as C
removeCodeAfterReturnStatements :: JS -> JS
diff --git a/src/Language/PureScript/Comments.hs b/src/Language/PureScript/Comments.hs
index 2e72595..3bc00ce 100644
--- a/src/Language/PureScript/Comments.hs
+++ b/src/Language/PureScript/Comments.hs
@@ -5,6 +5,8 @@
--
module Language.PureScript.Comments where
+import Prelude.Compat
+
import Data.Aeson.TH
data Comment
diff --git a/src/Language/PureScript/Constants.hs b/src/Language/PureScript/Constants.hs
index 6a57d3f..1713a0d 100644
--- a/src/Language/PureScript/Constants.hs
+++ b/src/Language/PureScript/Constants.hs
@@ -1,8 +1,10 @@
--- |
--- Various constants which refer to things in the Prelude
---
+-- | Various constants which refer to things in the Prelude
module Language.PureScript.Constants where
+import Prelude.Compat
+
+import Language.PureScript.Names
+
-- Operators
($) :: String
@@ -247,6 +249,12 @@ moduloSemiringNumber = "moduloSemiringNumber"
moduloSemiringInt :: String
moduloSemiringInt = "moduloSemiringInt"
+euclideanRingNumber :: String
+euclideanRingNumber = "euclideanRingNumber"
+
+euclideanRingInt :: String
+euclideanRingInt = "euclideanRingInt"
+
ordBoolean :: String
ordBoolean = "ordBoolean"
@@ -283,6 +291,9 @@ boundedBoolean = "boundedBoolean"
booleanAlgebraBoolean :: String
booleanAlgebraBoolean = "booleanAlgebraBoolean"
+heytingAlgebraBoolean :: String
+heytingAlgebraBoolean = "heytingAlgebraBoolean"
+
semigroupString :: String
semigroupString = "semigroupString"
@@ -308,6 +319,17 @@ toSignature = "toSignature"
main :: String
main = "main"
+-- Prim
+
+partial :: String
+partial = "Partial"
+
+pattern Partial :: Qualified (ProperName 'ClassName)
+pattern Partial = Qualified (Just (ModuleName [ProperName "Prim"])) (ProperName "Partial")
+
+pattern Fail :: Qualified (ProperName 'ClassName)
+pattern Fail = Qualified (Just (ModuleName [ProperName "Prim"])) (ProperName "Fail")
+
-- Code Generation
__superclass_ :: String
@@ -348,11 +370,8 @@ dataBounded = "Data_Bounded"
dataSemigroup :: String
dataSemigroup = "Data_Semigroup"
-dataModuloSemiring :: String
-dataModuloSemiring = "Data_ModuloSemiring"
-
-dataBooleanAlgebra :: String
-dataBooleanAlgebra = "Data_BooleanAlgebra"
+dataHeytingAlgebra :: String
+dataHeytingAlgebra = "Data_HeytingAlgebra"
dataEq :: String
dataEq = "Data_Eq"
@@ -366,6 +385,9 @@ dataSemiring = "Data_Semiring"
dataRing :: String
dataRing = "Data_Ring"
+dataEuclideanRing :: String
+dataEuclideanRing = "Data_EuclideanRing"
+
dataFunction :: String
dataFunction = "Data_Function"
diff --git a/src/Language/PureScript/CoreFn.hs b/src/Language/PureScript/CoreFn.hs
index ffebd2e..7675a87 100644
--- a/src/Language/PureScript/CoreFn.hs
+++ b/src/Language/PureScript/CoreFn.hs
@@ -5,11 +5,11 @@ module Language.PureScript.CoreFn (
module C
) where
+import Language.PureScript.AST.Literals as C
import Language.PureScript.CoreFn.Ann as C
import Language.PureScript.CoreFn.Binders as C
import Language.PureScript.CoreFn.Desugar as C
import Language.PureScript.CoreFn.Expr as C
-import Language.PureScript.AST.Literals as C
import Language.PureScript.CoreFn.Meta as C
import Language.PureScript.CoreFn.Module as C
import Language.PureScript.CoreFn.Traversals as C
diff --git a/src/Language/PureScript/CoreFn/Ann.hs b/src/Language/PureScript/CoreFn/Ann.hs
index d75c84f..823a755 100644
--- a/src/Language/PureScript/CoreFn/Ann.hs
+++ b/src/Language/PureScript/CoreFn/Ann.hs
@@ -1,37 +1,25 @@
------------------------------------------------------------------------------
---
--- Module : Language.PureScript.CoreFn.Ann
--- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
--- License : MIT
---
--- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
--- Stability : experimental
--- Portability :
---
--- | Type alias for basic annotations
---
------------------------------------------------------------------------------
-
-module Language.PureScript.CoreFn.Ann where
-
-import Language.PureScript.AST.SourcePos
-import Language.PureScript.CoreFn.Meta
-import Language.PureScript.Types
-import Language.PureScript.Comments
-
--- |
--- Type alias for basic annotations
---
-type Ann = (Maybe SourceSpan, [Comment], Maybe Type, Maybe Meta)
-
--- |
--- Initial annotation with no metadata
---
-nullAnn :: Ann
-nullAnn = (Nothing, [], Nothing, Nothing)
-
--- |
--- Remove the comments from an annotation
---
-removeComments :: Ann -> Ann
-removeComments (ss, _, ty, meta) = (ss, [], ty, meta)
+module Language.PureScript.CoreFn.Ann where
+
+import Prelude.Compat
+
+import Language.PureScript.AST.SourcePos
+import Language.PureScript.Comments
+import Language.PureScript.CoreFn.Meta
+import Language.PureScript.Types
+
+-- |
+-- Type alias for basic annotations
+--
+type Ann = (Maybe SourceSpan, [Comment], Maybe Type, Maybe Meta)
+
+-- |
+-- Initial annotation with no metadata
+--
+nullAnn :: Ann
+nullAnn = (Nothing, [], Nothing, Nothing)
+
+-- |
+-- Remove the comments from an annotation
+--
+removeComments :: Ann -> Ann
+removeComments (ss, _, ty, meta) = (ss, [], ty, meta)
diff --git a/src/Language/PureScript/CoreFn/Binders.hs b/src/Language/PureScript/CoreFn/Binders.hs
index 7f6623b..5ef7061 100644
--- a/src/Language/PureScript/CoreFn/Binders.hs
+++ b/src/Language/PureScript/CoreFn/Binders.hs
@@ -1,10 +1,10 @@
-{-# LANGUAGE DeriveFunctor #-}
-
-- |
-- The core functional representation for binders
--
module Language.PureScript.CoreFn.Binders where
+import Prelude.Compat
+
import Language.PureScript.AST.Literals
import Language.PureScript.Names
diff --git a/src/Language/PureScript/CoreFn/Desugar.hs b/src/Language/PureScript/CoreFn/Desugar.hs
index fc782e6..e36d07d 100644
--- a/src/Language/PureScript/CoreFn/Desugar.hs
+++ b/src/Language/PureScript/CoreFn/Desugar.hs
@@ -1,30 +1,28 @@
module Language.PureScript.CoreFn.Desugar (moduleToCoreFn) where
-import Prelude ()
import Prelude.Compat
+import Control.Arrow (second, (***))
import Data.Function (on)
import Data.List (sort, sortBy, nub)
import Data.Maybe (mapMaybe)
import qualified Data.Map as M
-import Control.Arrow (second, (***))
-
-import Language.PureScript.Crash
+import Language.PureScript.AST.Literals
import Language.PureScript.AST.SourcePos
import Language.PureScript.AST.Traversals
+import Language.PureScript.Comments
import Language.PureScript.CoreFn.Ann
import Language.PureScript.CoreFn.Binders
import Language.PureScript.CoreFn.Expr
-import Language.PureScript.AST.Literals
import Language.PureScript.CoreFn.Meta
import Language.PureScript.CoreFn.Module
+import Language.PureScript.Crash
import Language.PureScript.Environment
import Language.PureScript.Names
import Language.PureScript.Sugar.TypeClasses (typeClassMemberName, superClassDictionaryNames)
import Language.PureScript.Types
-import Language.PureScript.Comments
import qualified Language.PureScript.AST as A
-- |
@@ -72,12 +70,6 @@ moduleToCoreFn env (A.Module _ coms mn decls (Just exps)) =
declToCoreFn ss _ (A.DataBindingGroupDeclaration ds) = concatMap (declToCoreFn ss []) ds
declToCoreFn ss com (A.ValueDeclaration name _ _ (Right e)) =
[NonRec (ssA ss) name (exprToCoreFn ss com Nothing e)]
- declToCoreFn ss com (A.FixityDeclaration _ name (Just (Qualified mn' (A.AliasValue name')))) =
- let meta = getValueMeta (Qualified mn' name')
- in [NonRec (ssA ss) (Op name) (Var (ss, com, Nothing, meta) (Qualified mn' name'))]
- declToCoreFn ss com (A.FixityDeclaration _ name (Just (Qualified mn' (A.AliasConstructor name')))) =
- let meta = Just $ getConstructorMeta (Qualified mn' name')
- in [NonRec (ssA ss) (Op name) (Var (ss, com, Nothing, meta) (Qualified mn' (properToIdent name')))]
declToCoreFn ss _ (A.BindingGroupDeclaration ds) =
[Rec $ map (\(name, _, e) -> ((ssA ss, name), exprToCoreFn ss [] Nothing e)) ds]
declToCoreFn ss com (A.TypeClassDeclaration name _ supers members) =
@@ -206,31 +198,31 @@ moduleToCoreFn env (A.Module _ coms mn decls (Just exps)) =
findQualModules :: [A.Declaration] -> [(Ann, ModuleName)]
findQualModules decls =
let (f, _, _, _, _) = everythingOnValues (++) fqDecls fqValues fqBinders (const []) (const [])
- in f `concatMap` decls
+ in map (nullAnn,) $ f `concatMap` decls
where
- fqDecls :: A.Declaration -> [(Ann, ModuleName)]
- fqDecls (A.TypeInstanceDeclaration _ _ q _ _) = getQual q
- fqDecls (A.FixityDeclaration _ _ (Just q)) = getQual q
+ fqDecls :: A.Declaration -> [ModuleName]
+ fqDecls (A.TypeInstanceDeclaration _ _ q _ _) = getQual' q
+ fqDecls (A.ValueFixityDeclaration _ q _) = getQual' q
+ fqDecls (A.TypeFixityDeclaration _ q _) = getQual' q
fqDecls _ = []
- fqValues :: A.Expr -> [(Ann, ModuleName)]
- fqValues (A.Var q) = getQual q
- fqValues (A.Constructor q) = getQual q
+ fqValues :: A.Expr -> [ModuleName]
+ fqValues (A.Var q) = getQual' q
+ fqValues (A.Constructor q) = getQual' q
fqValues _ = []
- fqBinders :: A.Binder -> [(Ann, ModuleName)]
- fqBinders (A.ConstructorBinder q _) = getQual q
+ fqBinders :: A.Binder -> [ModuleName]
+ fqBinders (A.ConstructorBinder q _) = getQual' q
fqBinders _ = []
- getQual :: Qualified a -> [(Ann, ModuleName)]
- getQual (Qualified (Just mn) _) = [(nullAnn, mn)]
- getQual _ = []
+ getQual' :: Qualified a -> [ModuleName]
+ getQual' = maybe [] return . getQual
-- |
-- Desugars import declarations from AST to CoreFn representation.
--
importToCoreFn :: A.Declaration -> Maybe (Ann, ModuleName)
-importToCoreFn (A.ImportDeclaration name _ _ _) = Just (nullAnn, name)
+importToCoreFn (A.ImportDeclaration name _ _) = Just (nullAnn, name)
importToCoreFn (A.PositionedDeclaration ss _ d) =
((,) (Just ss, [], Nothing, Nothing) . snd) <$> importToCoreFn d
importToCoreFn _ = Nothing
diff --git a/src/Language/PureScript/CoreFn/Expr.hs b/src/Language/PureScript/CoreFn/Expr.hs
index 961c70b..4d7ae02 100644
--- a/src/Language/PureScript/CoreFn/Expr.hs
+++ b/src/Language/PureScript/CoreFn/Expr.hs
@@ -1,14 +1,14 @@
-{-# LANGUAGE DeriveFunctor #-}
-
-- |
-- The core functional representation
--
module Language.PureScript.CoreFn.Expr where
+import Prelude.Compat
+
import Control.Arrow ((***))
-import Language.PureScript.CoreFn.Binders
import Language.PureScript.AST.Literals
+import Language.PureScript.CoreFn.Binders
import Language.PureScript.Names
-- |
diff --git a/src/Language/PureScript/CoreFn/Meta.hs b/src/Language/PureScript/CoreFn/Meta.hs
index da583ae..220d474 100644
--- a/src/Language/PureScript/CoreFn/Meta.hs
+++ b/src/Language/PureScript/CoreFn/Meta.hs
@@ -3,6 +3,8 @@
--
module Language.PureScript.CoreFn.Meta where
+import Prelude.Compat
+
import Language.PureScript.Names
-- |
diff --git a/src/Language/PureScript/CoreFn/Module.hs b/src/Language/PureScript/CoreFn/Module.hs
index 383c9ca..52f4f90 100644
--- a/src/Language/PureScript/CoreFn/Module.hs
+++ b/src/Language/PureScript/CoreFn/Module.hs
@@ -1,24 +1,15 @@
------------------------------------------------------------------------------
---
--- Module : Language.PureScript.CoreFn.Module
--- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
--- License : MIT
---
--- Maintainer : Phil Freeman <paf31@cantab.net>, Gary Burgess <gary.burgess@gmail.com>
--- Stability : experimental
--- Portability :
---
--- | The CoreFn module representation
---
------------------------------------------------------------------------------
-
module Language.PureScript.CoreFn.Module where
+import Prelude.Compat
+
import Language.PureScript.Comments
import Language.PureScript.CoreFn.Expr
import Language.PureScript.Names
import Language.PureScript.Types
+-- |
+-- The CoreFn module representation
+--
data Module a = Module
{ moduleComments :: [Comment]
, moduleName :: ModuleName
diff --git a/src/Language/PureScript/CoreFn/Traversals.hs b/src/Language/PureScript/CoreFn/Traversals.hs
index 613062e..20b0cd3 100644
--- a/src/Language/PureScript/CoreFn/Traversals.hs
+++ b/src/Language/PureScript/CoreFn/Traversals.hs
@@ -3,11 +3,13 @@
--
module Language.PureScript.CoreFn.Traversals where
+import Prelude.Compat
+
import Control.Arrow (second, (***), (+++))
+import Language.PureScript.AST.Literals
import Language.PureScript.CoreFn.Binders
import Language.PureScript.CoreFn.Expr
-import Language.PureScript.AST.Literals
everywhereOnValues :: (Bind a -> Bind a) ->
(Expr a -> Expr a) ->
diff --git a/src/Language/PureScript/Crash.hs b/src/Language/PureScript/Crash.hs
index ab4cdc1..4acdea1 100644
--- a/src/Language/PureScript/Crash.hs
+++ b/src/Language/PureScript/Crash.hs
@@ -1,9 +1,11 @@
-module Language.PureScript.Crash where
-
--- | Exit with an error message and a crash report link.
-internalError :: String -> a
-internalError =
- error
- . ("An internal error ocurred during compilation: " ++)
- . (++ "\nPlease report this at https://github.com/purescript/purescript/issues")
- . show
+module Language.PureScript.Crash where
+
+import Prelude.Compat
+
+-- | Exit with an error message and a crash report link.
+internalError :: String -> a
+internalError =
+ error
+ . ("An internal error ocurred during compilation: " ++)
+ . (++ "\nPlease report this at https://github.com/purescript/purescript/issues")
+ . show
diff --git a/src/Language/PureScript/Docs.hs b/src/Language/PureScript/Docs.hs
index bd84e8b..9297000 100644
--- a/src/Language/PureScript/Docs.hs
+++ b/src/Language/PureScript/Docs.hs
@@ -6,9 +6,9 @@ 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.ParseAndBookmark as Docs
+import Language.PureScript.Docs.Render as Docs
+import Language.PureScript.Docs.RenderedCode.Render as Docs
+import Language.PureScript.Docs.RenderedCode.Types as Docs
+import Language.PureScript.Docs.Types as Docs
diff --git a/src/Language/PureScript/Docs/AsMarkdown.hs b/src/Language/PureScript/Docs/AsMarkdown.hs
index 8cd8c0b..4a07663 100644
--- a/src/Language/PureScript/Docs/AsMarkdown.hs
+++ b/src/Language/PureScript/Docs/AsMarkdown.hs
@@ -1,6 +1,3 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE FlexibleContexts #-}
-
module Language.PureScript.Docs.AsMarkdown
( renderModulesAsMarkdown
, Docs
@@ -9,19 +6,18 @@ module Language.PureScript.Docs.AsMarkdown
, codeToString
) where
-import Prelude ()
import Prelude.Compat
import Control.Monad (unless, zipWithM_)
-import Control.Monad.Writer (Writer, tell, execWriter)
import Control.Monad.Error.Class (MonadError)
+import Control.Monad.Writer (Writer, tell, execWriter)
+
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 Language.PureScript.Docs.Types
+import qualified Language.PureScript as P
import qualified Language.PureScript.Docs.Convert as Convert
import qualified Language.PureScript.Docs.Render as Render
@@ -63,8 +59,6 @@ declAsMarkdown mn decl@Declaration{..} = do
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
@@ -86,19 +80,19 @@ codeToString = outputWith elemAsMarkdown
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"
+-- 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{..} =
diff --git a/src/Language/PureScript/Docs/Convert.hs b/src/Language/PureScript/Docs/Convert.hs
index 0358a70..a5f9c34 100644
--- a/src/Language/PureScript/Docs/Convert.hs
+++ b/src/Language/PureScript/Docs/Convert.hs
@@ -1,6 +1,4 @@
-{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE FlexibleContexts #-}
-- | Functions for converting PureScript ASTs into values of the data types
-- from Language.PureScript.Docs.
@@ -11,24 +9,23 @@ module Language.PureScript.Docs.Convert
, collectBookmarks
) where
-import Prelude ()
import Prelude.Compat
import Control.Arrow ((&&&), second)
import Control.Category ((>>>))
import Control.Monad
+import Control.Monad.Error.Class (MonadError)
import Control.Monad.State (runStateT)
import Control.Monad.Writer.Strict (runWriterT)
-import Control.Monad.Error.Class (MonadError)
import qualified Data.Map as Map
-import Text.Parsec (eof)
-import qualified Language.PureScript as P
-import qualified Language.PureScript.Constants as C
-
import Language.PureScript.Docs.Convert.ReExports (updateReExports)
import Language.PureScript.Docs.Convert.Single (convertSingleModule, collectBookmarks)
import Language.PureScript.Docs.Types
+import qualified Language.PureScript as P
+import qualified Language.PureScript.Constants as C
+
+import Text.Parsec (eof)
-- |
-- Like convertModules, except that it takes a list of modules, together with
@@ -107,8 +104,9 @@ typeCheckIfNecessary modules convertedModules =
else pure convertedModules
where
- hasWildcards =
- any ((==) (ValueDeclaration P.TypeWildcard) . declInfo) . modDeclarations
+ hasWildcards = any (isWild . declInfo) . modDeclarations
+ isWild (ValueDeclaration P.TypeWildcard{}) = True
+ isWild _ = False
go = do
checkEnv <- snd <$> typeCheck modules
@@ -147,7 +145,7 @@ insertValueTypes ::
insertValueTypes env m =
m { modDeclarations = map go (modDeclarations m) }
where
- go (d@Declaration { declInfo = ValueDeclaration P.TypeWildcard }) =
+ go (d@Declaration { declInfo = ValueDeclaration P.TypeWildcard{} }) =
let
ident = parseIdent (declTitle d)
ty = lookupName ident
@@ -187,8 +185,8 @@ partiallyDesugar = P.evalSupplyT 0 . desugar'
where
desugar' =
traverse P.desugarDoModule
- >=> P.desugarCasesModule
- >=> P.desugarTypeDeclarationsModule
+ >=> traverse P.desugarCasesModule
+ >=> traverse P.desugarTypeDeclarationsModule
>=> ignoreWarnings . P.desugarImportsWithEnv []
ignoreWarnings = fmap fst . runWriterT
diff --git a/src/Language/PureScript/Docs/Convert/ReExports.hs b/src/Language/PureScript/Docs/Convert/ReExports.hs
index a6b54f1..f4bce8c 100644
--- a/src/Language/PureScript/Docs/Convert/ReExports.hs
+++ b/src/Language/PureScript/Docs/Convert/ReExports.hs
@@ -1,29 +1,24 @@
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE FlexibleContexts #-}
-
module Language.PureScript.Docs.Convert.ReExports
( updateReExports
) where
-import Prelude ()
import Prelude.Compat
+import Control.Arrow ((&&&), second)
import Control.Monad
-import Control.Monad.Trans.State.Strict (execState)
+import Control.Monad.Reader.Class (MonadReader, ask)
import Control.Monad.State.Class (MonadState, gets, modify)
import Control.Monad.Trans.Reader (runReaderT)
-import Control.Monad.Reader.Class (MonadReader, ask)
-import Control.Arrow ((&&&), first, second)
+import Control.Monad.Trans.State.Strict (execState)
+
import Data.Either
-import Data.Maybe (mapMaybe)
import Data.Map (Map)
-import qualified Data.Map as Map
+import Data.Maybe (mapMaybe)
import Data.Monoid ((<>))
-
-import qualified Language.PureScript as P
+import qualified Data.Map as Map
import Language.PureScript.Docs.Types
+import qualified Language.PureScript as P
-- |
-- Given:
@@ -40,8 +35,7 @@ updateReExports ::
[P.ModuleName] ->
Map P.ModuleName Module ->
Map P.ModuleName Module
-updateReExports env order modules =
- execState action modules
+updateReExports env order = execState action
where
action =
void (traverse go order)
@@ -102,39 +96,50 @@ getReExports env mn =
-- * Filters type class declarations to ensure that only re-exported type
-- class members are listed.
--
-collectDeclarations ::
+collectDeclarations :: forall m.
(MonadState (Map P.ModuleName Module) m, MonadReader P.ModuleName m) =>
P.Imports ->
P.Exports ->
m [(P.ModuleName, [Declaration])]
collectDeclarations imports exports = do
- valsAndMembers <- collect lookupValueDeclaration impVals expVals
- typeClasses <- collect lookupTypeClassDeclaration impTCs expTCs
- types <- collect lookupTypeDeclaration impTypes expTypes
- typeOps <- collect lookupTypeOpDeclaration impTypeOps expTypeOps
+ valsAndMembers <- collect lookupValueDeclaration impVals expVals
+ valOps <- collect lookupValueOpDeclaration impValOps expValOps
+ typeClasses <- collect lookupTypeClassDeclaration impTCs expTCs
+ types <- collect lookupTypeDeclaration impTypes expTypes
+ typeOps <- collect lookupTypeOpDeclaration impTypeOps expTypeOps
(vals, classes) <- handleTypeClassMembers valsAndMembers typeClasses
let filteredTypes = filterDataConstructors expCtors types
- let filteredClasses = filterTypeClassMembers (map fst expVals) classes
+ let filteredClasses = filterTypeClassMembers (Map.keys expVals) classes
- pure (Map.toList (Map.unionsWith (<>) [filteredTypes, typeOps, filteredClasses, vals]))
+ pure (Map.toList (Map.unionsWith (<>) [filteredTypes, filteredClasses, vals, valOps, typeOps]))
where
+
+ collect
+ :: (Eq a, Show a)
+ => (P.ModuleName -> a -> m (P.ModuleName, [b]))
+ -> [P.ImportRecord a]
+ -> Map a P.ModuleName
+ -> m (Map P.ModuleName [b])
collect lookup' imps exps = do
- imps' <- traverse (findImport imps) exps
+ imps' <- traverse (findImport imps) $ Map.toList exps
Map.fromListWith (<>) <$> traverse (uncurry lookup') imps'
expVals = P.exportedValues exports
impVals = concat (Map.elems (P.importedValues imports))
- expTypes = map (first fst) (P.exportedTypes exports)
+ expValOps = P.exportedValueOps exports
+ impValOps = concat (Map.elems (P.importedValueOps imports))
+
+ expTypes = Map.map snd (P.exportedTypes exports)
impTypes = concat (Map.elems (P.importedTypes imports))
expTypeOps = P.exportedTypeOps exports
impTypeOps = concat (Map.elems (P.importedTypeOps imports))
- expCtors = concatMap (snd . fst) (P.exportedTypes exports)
+ expCtors = concatMap fst (Map.elems (P.exportedTypes exports))
expTCs = P.exportedTypeClasses exports
impTCs = concat (Map.elems (P.importedTypeClasses imports))
@@ -226,6 +231,20 @@ lookupValueDeclaration importedFrom ident = do
thd :: (a, b, c) -> c
thd (_, _, x) = x
+lookupValueOpDeclaration
+ :: (MonadState (Map P.ModuleName Module) m, MonadReader P.ModuleName m)
+ => P.ModuleName
+ -> P.OpName 'P.ValueOpName
+ -> m (P.ModuleName, [Declaration])
+lookupValueOpDeclaration importedFrom op = do
+ decls <- lookupModuleDeclarations "lookupValueOpDeclaration" importedFrom
+ case filter (\d -> declTitle d == P.showOp op && isValueAlias d) decls of
+ [d] ->
+ pure (importedFrom, [d])
+ other ->
+ internalErrorInModule
+ ("lookupValueOpDeclaration: unexpected result for: " ++ show other)
+
-- |
-- Extract a particular type declaration. For data declarations, constructors
-- are only included in the output if they are listed in the arguments.
@@ -247,16 +266,15 @@ lookupTypeDeclaration importedFrom ty = do
internalErrorInModule
("lookupTypeDeclaration: unexpected result: " ++ show other)
-lookupTypeOpDeclaration ::
- (MonadState (Map P.ModuleName Module) m,
- MonadReader P.ModuleName m) =>
- P.ModuleName ->
- P.Ident ->
- m (P.ModuleName, [Declaration])
+lookupTypeOpDeclaration
+ :: (MonadState (Map P.ModuleName Module) m,MonadReader P.ModuleName m)
+ => P.ModuleName
+ -> P.OpName 'P.TypeOpName
+ -> m (P.ModuleName, [Declaration])
lookupTypeOpDeclaration importedFrom tyOp = do
decls <- lookupModuleDeclarations "lookupTypeOpDeclaration" importedFrom
let
- ds = filter (\d -> declTitle d == ("type " ++ P.showIdent tyOp) && isTypeAlias d) decls
+ ds = filter (\d -> declTitle d == ("type " ++ P.showOp tyOp) && isTypeAlias d) decls
case ds of
[d] ->
pure (importedFrom, [d])
@@ -264,12 +282,11 @@ lookupTypeOpDeclaration importedFrom tyOp = do
internalErrorInModule
("lookupTypeOpDeclaration: unexpected result: " ++ show other)
-lookupTypeClassDeclaration ::
- (MonadState (Map P.ModuleName Module) m,
- MonadReader P.ModuleName m) =>
- P.ModuleName ->
- P.ProperName 'P.ClassName ->
- m (P.ModuleName, [Declaration])
+lookupTypeClassDeclaration
+ :: (MonadState (Map P.ModuleName Module) m, MonadReader P.ModuleName m)
+ => P.ModuleName
+ -> P.ProperName 'P.ClassName
+ -> m (P.ModuleName, [Declaration])
lookupTypeClassDeclaration importedFrom tyClass = do
decls <- lookupModuleDeclarations "lookupTypeClassDeclaration" importedFrom
let
@@ -374,10 +391,10 @@ instance Monoid TypeClassEnv where
--
-- Returns a tuple of (values, type classes).
--
-handleEnv ::
- (MonadReader P.ModuleName m) =>
- TypeClassEnv ->
- m ([Declaration], [Declaration])
+handleEnv
+ :: (MonadReader P.ModuleName m)
+ => TypeClassEnv
+ -> m ([Declaration], [Declaration])
handleEnv TypeClassEnv{..} =
envUnhandledMembers
|> foldM go (envValues, mkMap envTypeClasses)
@@ -405,7 +422,6 @@ handleEnv TypeClassEnv{..} =
, declComments = cdeclComments
, declSourceSpan = cdeclSourceSpan
, declChildren = []
- , declFixity = Nothing
, declInfo = ValueDeclaration (addConstraint constraint typ)
}
_ ->
@@ -426,10 +442,10 @@ splitMap = foldl go (Map.empty, Map.empty) . Map.toList
-- Given a list of exported constructor names, remove any data constructor
-- names in the provided Map of declarations which are not in the list.
--
-filterDataConstructors ::
- [P.ProperName 'P.ConstructorName] ->
- Map P.ModuleName [Declaration] ->
- Map P.ModuleName [Declaration]
+filterDataConstructors
+ :: [P.ProperName 'P.ConstructorName]
+ -> Map P.ModuleName [Declaration]
+ -> Map P.ModuleName [Declaration]
filterDataConstructors =
filterExportedChildren isDataConstructor P.runProperName
@@ -438,27 +454,25 @@ filterDataConstructors =
-- type class member names in the provided Map of declarations which are not in
-- the list.
--
-filterTypeClassMembers ::
- [P.Ident] ->
- Map P.ModuleName [Declaration] ->
- Map P.ModuleName [Declaration]
+filterTypeClassMembers
+ :: [P.Ident]
+ -> Map P.ModuleName [Declaration]
+ -> Map P.ModuleName [Declaration]
filterTypeClassMembers =
filterExportedChildren isTypeClassMember P.showIdent
-filterExportedChildren ::
- (Functor f) =>
- (ChildDeclaration -> Bool) ->
- (name -> String) ->
- [name] ->
- f [Declaration] ->
- f [Declaration]
-filterExportedChildren isTargetedKind runName expNames =
- fmap filterDecls
+filterExportedChildren
+ :: (Functor f)
+ => (ChildDeclaration -> Bool)
+ -> (name -> String)
+ -> [name]
+ -> f [Declaration]
+ -> f [Declaration]
+filterExportedChildren isTargetedKind runName expNames = fmap filterDecls
where
filterDecls =
- map (filterChildren (\c -> not (isTargetedKind c) ||
- cdeclTitle c `elem` expNames'))
-
+ map $ filterChildren $ \c ->
+ not (isTargetedKind c) || cdeclTitle c `elem` expNames'
expNames' = map runName expNames
allDeclarations :: Module -> [Declaration]
@@ -471,10 +485,10 @@ x |> f = f x
internalError :: String -> a
internalError = P.internalError . ("Docs.Convert.ReExports: " ++)
-internalErrorInModule ::
- (MonadReader P.ModuleName m) =>
- String ->
- m a
+internalErrorInModule
+ :: (MonadReader P.ModuleName m)
+ => String
+ -> m a
internalErrorInModule msg = do
mn <- ask
internalError
@@ -489,7 +503,7 @@ typeClassConstraintFor :: Declaration -> Maybe P.Constraint
typeClassConstraintFor Declaration{..} =
case declInfo of
TypeClassDeclaration tyArgs _ ->
- Just (P.Qualified Nothing (P.ProperName declTitle), mkConstraint tyArgs)
+ Just (P.Constraint (P.Qualified Nothing (P.ProperName declTitle)) (mkConstraint tyArgs) Nothing)
_ ->
Nothing
where
diff --git a/src/Language/PureScript/Docs/Convert/Single.hs b/src/Language/PureScript/Docs/Convert/Single.hs
index 7e60bfd..ef61b37 100644
--- a/src/Language/PureScript/Docs/Convert/Single.hs
+++ b/src/Language/PureScript/Docs/Convert/Single.hs
@@ -1,26 +1,19 @@
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE FlexibleContexts #-}
-
module Language.PureScript.Docs.Convert.Single
( convertSingleModule
, collectBookmarks
) where
-import Prelude ()
import Prelude.Compat
-import Data.Maybe (mapMaybe, isNothing)
-import Control.Monad
import Control.Category ((>>>))
-import Data.Either
-import Data.List (nub, isPrefixOf, isSuffixOf)
+import Control.Monad
-import qualified Language.PureScript as P
+import Data.Either
+import Data.List (nub)
+import Data.Maybe (mapMaybe)
import Language.PureScript.Docs.Types
+import qualified Language.PureScript as P
-- |
-- Convert a single Module, but ignore re-exports; any re-exported types or
@@ -35,7 +28,6 @@ convertSingleModule m@(P.Module _ coms moduleName _ _) =
P.exportedDeclarations
>>> mapMaybe (\d -> getDeclarationTitle d >>= convertDeclaration d)
>>> augmentDeclarations
- >>> map addDefaultFixity
-- | The data type for an intermediate stage which we go through during
-- converting.
@@ -65,12 +57,8 @@ type IntermediateDeclaration
-- 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.
@@ -84,28 +72,8 @@ augmentDeclarations (partitionEithers -> (augments, toplevels)) =
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.9.
-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)
+ augmentWith (AugmentChild child) d =
+ d { declChildren = declChildren d ++ [child] }
getDeclarationTitle :: P.Declaration -> Maybe String
getDeclarationTitle (P.ValueDeclaration name _ _ _) = Just (P.showIdent name)
@@ -115,8 +83,8 @@ getDeclarationTitle (P.ExternDataDeclaration name _) = Just (P.runProperName nam
getDeclarationTitle (P.TypeSynonymDeclaration name _ _) = Just (P.runProperName name)
getDeclarationTitle (P.TypeClassDeclaration name _ _ _) = Just (P.runProperName name)
getDeclarationTitle (P.TypeInstanceDeclaration name _ _ _ _) = Just (P.showIdent name)
-getDeclarationTitle (P.FixityDeclaration _ name (Just (P.Qualified _ P.AliasType{}))) = Just ("type (" ++ name ++ ")")
-getDeclarationTitle (P.FixityDeclaration _ name _) = Just ("(" ++ name ++ ")")
+getDeclarationTitle (P.TypeFixityDeclaration _ _ op) = Just ("type " ++ P.showOp op)
+getDeclarationTitle (P.ValueFixityDeclaration _ _ op) = Just (P.showOp op)
getDeclarationTitle (P.PositionedDeclaration _ _ d) = getDeclarationTitle d
getDeclarationTitle _ = Nothing
@@ -127,7 +95,6 @@ mkDeclaration title info =
, declComments = Nothing
, declSourceSpan = Nothing
, declChildren = []
- , declFixity = Nothing
, declInfo = info
}
@@ -137,10 +104,10 @@ basicDeclaration title info = Just $ Right $ mkDeclaration title info
convertDeclaration :: P.Declaration -> String -> Maybe IntermediateDeclaration
convertDeclaration (P.ValueDeclaration _ _ _ (Right (P.TypedValue _ _ ty))) title =
basicDeclaration title (ValueDeclaration ty)
-convertDeclaration (P.ValueDeclaration {}) title =
+convertDeclaration P.ValueDeclaration{} title =
-- If no explicit type declaration was provided, insert a wildcard, so that
-- the actual type will be added during type checking.
- basicDeclaration title (ValueDeclaration P.TypeWildcard)
+ basicDeclaration title (ValueDeclaration P.TypeWildcard{})
convertDeclaration (P.ExternDeclaration _ ty) title =
basicDeclaration title (ValueDeclaration ty)
convertDeclaration (P.DataDeclaration dtype _ args ctors) title =
@@ -177,10 +144,10 @@ convertDeclaration (P.TypeInstanceDeclaration _ constraints className tys _) tit
childDecl = ChildDeclaration title Nothing Nothing (ChildInstance constraints classApp)
classApp = foldl P.TypeApp (P.TypeConstructor (fmap P.coerceProperName className)) tys
-convertDeclaration (P.FixityDeclaration fixity _ Nothing) title =
- Just (Left ([title], AugmentFixity fixity))
-convertDeclaration (P.FixityDeclaration fixity _ (Just alias)) title =
- Just $ Right $ (mkDeclaration title (AliasDeclaration alias fixity)) { declFixity = Just fixity }
+convertDeclaration (P.ValueFixityDeclaration fixity (P.Qualified mn alias) _) title =
+ Just $ Right $ mkDeclaration title (AliasDeclaration fixity (P.Qualified mn (Right alias)))
+convertDeclaration (P.TypeFixityDeclaration fixity (P.Qualified mn alias) _) title =
+ Just $ Right $ mkDeclaration title (AliasDeclaration fixity (P.Qualified mn (Left alias)))
convertDeclaration (P.PositionedDeclaration srcSpan com d') title =
fmap (addComments . addSourceSpan) (convertDeclaration d' title)
where
@@ -196,10 +163,7 @@ convertDeclaration (P.PositionedDeclaration srcSpan com d') title =
Left (withAugmentChild (\d -> d { cdeclSourceSpan = Just srcSpan })
augment)
- withAugmentChild f (t, a) =
- case a of
- AugmentChild d -> (t, AugmentChild (f d))
- _ -> (t, a)
+ withAugmentChild f (t, AugmentChild d) = (t, AugmentChild (f d))
convertDeclaration _ _ = Nothing
convertComments :: [P.Comment] -> Maybe String
diff --git a/src/Language/PureScript/Docs/ParseAndBookmark.hs b/src/Language/PureScript/Docs/ParseAndBookmark.hs
index bea862d..a0dc8fe 100644
--- a/src/Language/PureScript/Docs/ParseAndBookmark.hs
+++ b/src/Language/PureScript/Docs/ParseAndBookmark.hs
@@ -1,26 +1,22 @@
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE FlexibleContexts #-}
-
module Language.PureScript.Docs.ParseAndBookmark
( parseAndBookmark
) where
-import Prelude ()
import Prelude.Compat
-import qualified Data.Map as M
import Control.Arrow (first)
-
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.IO.Class (MonadIO(..))
-import Web.Bower.PackageMeta (PackageName)
+import qualified Data.Map as M
+
+import Language.PureScript.Docs.Convert (collectBookmarks)
+import Language.PureScript.Docs.Types
+import qualified Language.PureScript as P
import System.IO.UTF8 (readUTF8File)
-import qualified Language.PureScript as P
-import Language.PureScript.Docs.Types
-import Language.PureScript.Docs.Convert (collectBookmarks)
+import Web.Bower.PackageMeta (PackageName)
-- |
-- Given:
diff --git a/src/Language/PureScript/Docs/Render.hs b/src/Language/PureScript/Docs/Render.hs
index 9ac9a4e..e13e03a 100644
--- a/src/Language/PureScript/Docs/Render.hs
+++ b/src/Language/PureScript/Docs/Render.hs
@@ -1,6 +1,5 @@
-{-# LANGUAGE RecordWildCards #-}
-
--- | Functions for creating `RenderedCode` values from data types in
+-- |
+-- Functions for creating `RenderedCode` values from data types in
-- Language.PureScript.Docs.Types.
--
-- These functions are the ones that are used in markdown/html documentation
@@ -10,13 +9,15 @@
module Language.PureScript.Docs.Render where
+import Prelude.Compat
+
import Data.Maybe (maybeToList)
import Data.Monoid ((<>))
-import qualified Language.PureScript as P
-import Language.PureScript.Docs.Types
import Language.PureScript.Docs.RenderedCode
+import Language.PureScript.Docs.Types
import Language.PureScript.Docs.Utils.MonoidExtras
+import qualified Language.PureScript as P
renderDeclaration :: Declaration -> RenderedCode
renderDeclaration = renderDeclarationWithOptions defaultRenderTypeOptions
@@ -58,27 +59,33 @@ renderDeclarationWithOptions opts Declaration{..} =
syntax "("
<> mintersperse (syntax "," <> sp) (map renderConstraint implies)
<> syntax ")" <> sp <> syntax "<="
- AliasDeclaration for@(P.Qualified _ alias) (P.Fixity associativity precedence) ->
+
+ AliasDeclaration (P.Fixity associativity precedence) for@(P.Qualified _ alias) ->
[ keywordFixity associativity
, syntax $ show precedence
- , ident $ renderAlias for
+ , ident $ renderQualAlias for
, keyword "as"
, ident $ adjustAliasName alias declTitle
]
where
+ renderType' :: P.Type -> RenderedCode
renderType' = renderTypeWithOptions opts
- renderAlias (P.Qualified mn alias)
- | mn == currentModule opts =
- P.foldFixityAlias P.runIdent P.runProperName (("type " ++) . P.runProperName) alias
- | otherwise =
- P.foldFixityAlias
- (P.showQualified P.runIdent . P.Qualified mn)
- (P.showQualified P.runProperName . P.Qualified mn)
- (("type " ++) . P.showQualified P.runProperName . P.Qualified mn)
- alias
-
- adjustAliasName (P.AliasType{}) title = drop 6 (init title)
+
+ renderQualAlias :: FixityAlias -> String
+ renderQualAlias (P.Qualified mn alias)
+ | mn == currentModule opts = renderAlias id alias
+ | otherwise = renderAlias (\f -> P.showQualified f . P.Qualified mn) alias
+
+ renderAlias
+ :: (forall a. (a -> String) -> a -> String)
+ -> Either (P.ProperName 'P.TypeName) (Either P.Ident (P.ProperName 'P.ConstructorName))
+ -> String
+ renderAlias f
+ = either (("type " ++) . f P.runProperName)
+ $ either (f P.runIdent) (f P.runProperName)
+
+ -- adjustAliasName (P.AliasType{}) title = drop 6 (init title)
adjustAliasName _ title = tail (init title)
renderChildDeclaration :: ChildDeclaration -> RenderedCode
@@ -107,7 +114,7 @@ renderConstraint :: P.Constraint -> RenderedCode
renderConstraint = renderConstraintWithOptions defaultRenderTypeOptions
renderConstraintWithOptions :: RenderTypeOptions -> P.Constraint -> RenderedCode
-renderConstraintWithOptions opts (pn, tys) =
+renderConstraintWithOptions opts (P.Constraint pn tys _) =
renderTypeWithOptions opts $ foldl P.TypeApp (P.TypeConstructor (fmap P.coerceProperName pn)) tys
renderConstraints :: [P.Constraint] -> Maybe RenderedCode
diff --git a/src/Language/PureScript/Docs/RenderedCode.hs b/src/Language/PureScript/Docs/RenderedCode.hs
index d9008a6..27de533 100644
--- a/src/Language/PureScript/Docs/RenderedCode.hs
+++ b/src/Language/PureScript/Docs/RenderedCode.hs
@@ -1,11 +1,8 @@
-
--- | Data types and functions for representing a simplified form of PureScript
--- code, intended for use in e.g. HTML documentation.
-
-module Language.PureScript.Docs.RenderedCode (
- module RenderedCode
-) where
-
-import Language.PureScript.Docs.RenderedCode.Types as RenderedCode
-import Language.PureScript.Docs.RenderedCode.Render as RenderedCode
-
+
+-- | Data types and functions for representing a simplified form of PureScript
+-- code, intended for use in e.g. HTML documentation.
+
+module Language.PureScript.Docs.RenderedCode (module RenderedCode) where
+
+import Language.PureScript.Docs.RenderedCode.Types as RenderedCode
+import Language.PureScript.Docs.RenderedCode.Render as RenderedCode
diff --git a/src/Language/PureScript/Docs/RenderedCode/Render.hs b/src/Language/PureScript/Docs/RenderedCode/Render.hs
index ec23588..332530b 100644
--- a/src/Language/PureScript/Docs/RenderedCode/Render.hs
+++ b/src/Language/PureScript/Docs/RenderedCode/Render.hs
@@ -1,38 +1,36 @@
-- | Functions for producing RenderedCode values from PureScript Type values.
-module Language.PureScript.Docs.RenderedCode.Render (
- renderType,
- renderTypeAtom,
- renderRow,
- renderKind,
- RenderTypeOptions(..),
- defaultRenderTypeOptions,
- renderTypeWithOptions
-) where
-
-import Prelude ()
+module Language.PureScript.Docs.RenderedCode.Render
+ ( renderType
+ , renderTypeAtom
+ , renderRow
+ , renderKind
+ , RenderTypeOptions(..)
+ , defaultRenderTypeOptions
+ , renderTypeWithOptions
+ ) where
+
import Prelude.Compat
-import Data.Monoid ((<>))
import Data.Maybe (fromMaybe)
+import Data.Monoid ((<>))
import Control.Arrow ((<+>))
-import Control.PatternArrows
+import Control.PatternArrows as PA
import Language.PureScript.Crash
-import Language.PureScript.Names
-import Language.PureScript.Types
-import Language.PureScript.Kinds
-import Language.PureScript.Pretty.Kinds
-import Language.PureScript.Environment
-
import Language.PureScript.Docs.RenderedCode.Types
import Language.PureScript.Docs.Utils.MonoidExtras
+import Language.PureScript.Environment
+import Language.PureScript.Kinds
+import Language.PureScript.Names
+import Language.PureScript.Pretty.Kinds
+import Language.PureScript.Types
typeLiterals :: Pattern () Type RenderedCode
typeLiterals = mkPattern match
where
- match TypeWildcard =
+ match TypeWildcard{} =
Just (syntax "_")
match (TypeVar var) =
Just (ident var)
@@ -51,12 +49,12 @@ typeLiterals = mkPattern match
match (BinaryNoParensType op l r) =
Just $ renderTypeAtom l <> sp <> renderTypeAtom op <> sp <> renderTypeAtom r
match (TypeOp (Qualified mn op)) =
- Just (ident' (runIdent op) (maybeToContainingModule mn))
+ Just (ident' (runOpName op) (maybeToContainingModule mn))
match _ =
Nothing
renderConstraint :: Constraint -> RenderedCode
-renderConstraint (pn, tys) =
+renderConstraint (Constraint pn tys _) =
let instApp = foldl TypeApp (TypeConstructor (fmap coerceProperName pn)) tys
in renderType instApp
@@ -161,7 +159,7 @@ dePrim other = other
convert :: RenderTypeOptions -> Type -> Type
convert _ (TypeApp (TypeApp f arg) ret) | f == tyFunction = PrettyPrintFunction arg ret
-convert opts (TypeApp o r) | o == tyObject && prettyPrintObjects opts = PrettyPrintObject r
+convert opts (TypeApp o r) | o == tyRecord && prettyPrintObjects opts = PrettyPrintObject r
convert _ other = other
convertForAlls :: Type -> Type
@@ -184,9 +182,10 @@ renderKind = kind . prettyPrintKind
-- Render code representing a Type, as it should appear inside parentheses
--
renderTypeAtom :: Type -> RenderedCode
-renderTypeAtom =
- fromMaybe (internalError "Incomplete pattern") . pattern matchTypeAtom () . preprocessType defaultRenderTypeOptions
-
+renderTypeAtom
+ = fromMaybe (internalError "Incomplete pattern")
+ . PA.pattern matchTypeAtom ()
+ . preprocessType defaultRenderTypeOptions
-- |
-- Render code representing a Type
@@ -207,5 +206,7 @@ defaultRenderTypeOptions =
}
renderTypeWithOptions :: RenderTypeOptions -> Type -> RenderedCode
-renderTypeWithOptions opts =
- fromMaybe (internalError "Incomplete pattern") . pattern matchType () . preprocessType opts
+renderTypeWithOptions opts
+ = fromMaybe (internalError "Incomplete pattern")
+ . PA.pattern matchType ()
+ . preprocessType opts
diff --git a/src/Language/PureScript/Docs/RenderedCode/Types.hs b/src/Language/PureScript/Docs/RenderedCode/Types.hs
index 8c5289d..63f837e 100644
--- a/src/Language/PureScript/Docs/RenderedCode/Types.hs
+++ b/src/Language/PureScript/Docs/RenderedCode/Types.hs
@@ -32,13 +32,13 @@ module Language.PureScript.Docs.RenderedCode.Types
, keywordFixity
) where
-import Prelude ()
import Prelude.Compat
-import qualified Data.Aeson as A
-import Data.Aeson.BetterErrors
import Control.Monad.Error.Class (MonadError(..))
+import Data.Aeson.BetterErrors
+import qualified Data.Aeson as A
+
import qualified Language.PureScript as P
-- |
diff --git a/src/Language/PureScript/Docs/Types.hs b/src/Language/PureScript/Docs/Types.hs
index ea09893..c5e15b2 100644
--- a/src/Language/PureScript/Docs/Types.hs
+++ b/src/Language/PureScript/Docs/Types.hs
@@ -1,7 +1,4 @@
-{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE RankNTypes #-}
module Language.PureScript.Docs.Types
( module Language.PureScript.Docs.Types
@@ -9,25 +6,27 @@ module Language.PureScript.Docs.Types
)
where
-import Prelude ()
import Prelude.Compat
import Control.Arrow (first, (***))
import Control.Monad (when)
-import Data.Maybe (mapMaybe)
-import Data.Version
+
import Data.Aeson ((.=))
-import qualified Data.Aeson as A
import Data.Aeson.BetterErrors
-import Text.ParserCombinators.ReadP (readP_to_S)
-import Data.Text (Text)
import Data.ByteString.Lazy (ByteString)
+import Data.Either (isLeft, isRight)
+import Data.Maybe (mapMaybe)
+import Data.Text (Text)
+import Data.Version
+import qualified Data.Aeson as A
import qualified Data.Text as T
-import Web.Bower.PackageMeta hiding (Version, displayError)
-
import qualified Language.PureScript as P
+import Text.ParserCombinators.ReadP (readP_to_S)
+
+import Web.Bower.PackageMeta hiding (Version, displayError)
+
import Language.PureScript.Docs.RenderedCode as ReExports
(RenderedCode, asRenderedCode,
ContainingModule(..), asContainingModule,
@@ -86,7 +85,6 @@ data Declaration = Declaration
, declComments :: Maybe String
, declSourceSpan :: Maybe P.SourceSpan
, declChildren :: [ChildDeclaration]
- , declFixity :: Maybe P.Fixity -- TODO: remove in 0.9
, declInfo :: DeclarationInfo
}
deriving (Show, Eq, Ord)
@@ -133,9 +131,11 @@ data DeclarationInfo
-- An operator alias declaration, with the member the alias is for and the
-- operator's fixity.
--
- | AliasDeclaration (P.Qualified P.FixityAlias) P.Fixity
+ | AliasDeclaration P.Fixity FixityAlias
deriving (Show, Eq, Ord)
+type FixityAlias = P.Qualified (Either (P.ProperName 'P.TypeName) (Either P.Ident (P.ProperName 'P.ConstructorName)))
+
declInfoToString :: DeclarationInfo -> String
declInfoToString (ValueDeclaration _) = "value"
declInfoToString (DataDeclaration _ _) = "data"
@@ -167,14 +167,13 @@ isType Declaration{..} =
isValueAlias :: Declaration -> Bool
isValueAlias Declaration{..} =
case declInfo of
- (AliasDeclaration (P.Qualified _ P.AliasConstructor{}) _) -> True
- (AliasDeclaration (P.Qualified _ P.AliasValue{}) _) -> True
+ AliasDeclaration _ (P.Qualified _ d) -> isRight d
_ -> False
isTypeAlias :: Declaration -> Bool
isTypeAlias Declaration{..} =
case declInfo of
- (AliasDeclaration (P.Qualified _ P.AliasType{}) _) -> True
+ AliasDeclaration _ (P.Qualified _ d) -> isLeft d
_ -> False
-- | Discard any children which do not satisfy the given predicate.
@@ -364,7 +363,6 @@ asDeclaration =
<*> key "comments" (perhaps asString)
<*> key "sourceSpan" (perhaps asSourceSpan)
<*> key "children" (eachInArray asChildDeclaration)
- <*> key "fixity" (perhaps asFixity)
<*> key "info" asDeclarationInfo
asReExport :: Parse PackageError (P.ModuleName, [Declaration])
@@ -385,6 +383,9 @@ asFixity =
P.Fixity <$> key "associativity" asAssociativity
<*> key "precedence" asIntegral
+asFixityAlias :: Parse PackageError FixityAlias
+asFixityAlias = fromAesonParser
+
parseAssociativity :: String -> Maybe P.Associativity
parseAssociativity str = case str of
"infix" -> Just P.Infix
@@ -413,14 +414,11 @@ asDeclarationInfo = do
TypeClassDeclaration <$> key "arguments" asTypeArguments
<*> key "superclasses" (eachInArray asConstraint)
"alias" ->
- AliasDeclaration <$> key "for" asAliasFor
- <*> key "fixity" asFixity
+ AliasDeclaration <$> key "fixity" asFixity
+ <*> key "alias" asFixityAlias
other ->
throwCustomError (InvalidDeclarationType other)
-asAliasFor :: Parse e (P.Qualified P.FixityAlias)
-asAliasFor = fromAesonParser
-
asTypeArguments :: Parse PackageError [(String, Maybe P.Kind)]
asTypeArguments = eachInArray asTypeArgument
where
@@ -465,8 +463,9 @@ asSourcePos = P.SourcePos <$> nth 0 asIntegral
<*> nth 1 asIntegral
asConstraint :: Parse PackageError P.Constraint
-asConstraint = (,) <$> nth 0 asQualifiedProperName
- <*> nth 1 (eachInArray asType)
+asConstraint = P.Constraint <$> key "constraintClass" asQualifiedProperName
+ <*> key "constraintArgs" (eachInArray asType)
+ <*> pure Nothing
asQualifiedProperName :: Parse e (P.Qualified (P.ProperName a))
asQualifiedProperName = fromAesonParser
@@ -538,7 +537,6 @@ instance A.ToJSON Declaration where
, "comments" .= declComments
, "sourceSpan" .= declSourceSpan
, "children" .= declChildren
- , "fixity" .= declFixity
, "info" .= declInfo
]
@@ -559,7 +557,7 @@ instance A.ToJSON DeclarationInfo where
ExternDataDeclaration kind -> ["kind" .= kind]
TypeSynonymDeclaration args ty -> ["arguments" .= args, "type" .= ty]
TypeClassDeclaration args super -> ["arguments" .= args, "superclasses" .= super]
- AliasDeclaration for fixity -> ["for" .= for, "fixity" .= fixity]
+ AliasDeclaration fixity alias -> ["fixity" .= fixity, "alias" .= alias]
instance A.ToJSON ChildDeclarationInfo where
toJSON info = A.object $ "declType" .= childDeclInfoToString info : props
diff --git a/src/Language/PureScript/Environment.hs b/src/Language/PureScript/Environment.hs
index 56f48f0..c8c6b0a 100644
--- a/src/Language/PureScript/Environment.hs
+++ b/src/Language/PureScript/Environment.hs
@@ -3,11 +3,13 @@
module Language.PureScript.Environment where
-import Data.Maybe (fromMaybe)
+import Prelude.Compat
+
import Data.Aeson.TH
+import Data.Maybe (fromMaybe)
+import qualified Data.Aeson as A
import qualified Data.Map as M
import qualified Data.Text as T
-import qualified Data.Aeson as A
import Language.PureScript.Crash
import Language.PureScript.Kinds
@@ -194,16 +196,16 @@ tyArray :: Type
tyArray = primTy "Array"
-- |
--- Type constructor for objects
+-- Type constructor for records
--
-tyObject :: Type
-tyObject = primTy "Object"
+tyRecord :: Type
+tyRecord = primTy "Record"
-- |
--- Check whether a type is an object
+-- Check whether a type is a record
--
isObject :: Type -> Bool
-isObject = isTypeOrApplied tyObject
+isObject = isTypeOrApplied tyRecord
-- |
-- Check whether a type is a function
@@ -230,14 +232,15 @@ primTypes :: M.Map (Qualified (ProperName 'TypeName)) (Kind, TypeKind)
primTypes =
M.fromList
[ (primName "Function", (FunKind Star (FunKind Star Star), ExternData))
- , (primName "Array", (FunKind Star Star, ExternData))
- , (primName "Object", (FunKind (Row Star) Star, ExternData))
- , (primName "String", (Star, ExternData))
- , (primName "Char", (Star, ExternData))
- , (primName "Number", (Star, ExternData))
- , (primName "Int", (Star, ExternData))
- , (primName "Boolean", (Star, ExternData))
- , (primName "Partial", (Star, ExternData))
+ , (primName "Array", (FunKind Star Star, ExternData))
+ , (primName "Record", (FunKind (Row Star) Star, ExternData))
+ , (primName "String", (Star, ExternData))
+ , (primName "Char", (Star, ExternData))
+ , (primName "Number", (Star, ExternData))
+ , (primName "Int", (Star, ExternData))
+ , (primName "Boolean", (Star, ExternData))
+ , (primName "Partial", (Star, ExternData))
+ , (primName "Fail", (FunKind Symbol Star, ExternData))
]
-- |
@@ -247,7 +250,9 @@ primTypes =
primClasses :: M.Map (Qualified (ProperName 'ClassName)) ([(String, Maybe Kind)], [(Ident, Type)], [Constraint])
primClasses =
M.fromList
- [ (primName "Partial", ([], [], [])) ]
+ [ (primName "Partial", ([], [], []))
+ , (primName "Fail", ([("message", Just Symbol)], [], []))
+ ]
-- |
-- Finds information about data constructors from the current environment.
diff --git a/src/Language/PureScript/Errors.hs b/src/Language/PureScript/Errors.hs
index 29508b4..9eff7d4 100644
--- a/src/Language/PureScript/Errors.hs
+++ b/src/Language/PureScript/Errors.hs
@@ -1,40 +1,40 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
module Language.PureScript.Errors where
-import Prelude ()
import Prelude.Compat
-import Data.Ord (comparing)
+import Control.Arrow ((&&&))
+import Control.Monad
+import Control.Monad.Error.Class (MonadError(..))
+import Control.Monad.Trans.State.Lazy
+import Control.Monad.Writer
+
import Data.Char (isSpace)
import Data.Either (lefts, rights)
-import Data.List (intercalate, transpose, nub, nubBy, sortBy, partition)
import Data.Foldable (fold)
+import Data.List (intercalate, transpose, nub, nubBy, sortBy, partition)
import Data.Maybe (maybeToList)
-
+import Data.Ord (comparing)
import qualified Data.Map as M
-import Control.Monad
-import Control.Monad.Writer
-import Control.Monad.Error.Class (MonadError(..))
-import Control.Monad.Trans.State.Lazy
-import Control.Arrow ((&&&))
-
-import Language.PureScript.Crash
import Language.PureScript.AST
+import Language.PureScript.Crash
+import Language.PureScript.Kinds
+import Language.PureScript.Names
import Language.PureScript.Pretty
-import Language.PureScript.Pretty.Common (before)
+import Language.PureScript.Traversals
import Language.PureScript.Types
-import Language.PureScript.Names
-import Language.PureScript.Kinds
+import Language.PureScript.Pretty.Common (endWith)
import qualified Language.PureScript.Bundle as Bundle
+import qualified Language.PureScript.Constants as C
-import qualified Text.PrettyPrint.Boxes as Box
+import qualified System.Console.ANSI as ANSI
import qualified Text.Parsec as P
import qualified Text.Parsec.Error as PE
+import qualified Text.PrettyPrint.Boxes as Box
import Text.Parsec.Error (Message(..))
-- | A type of error messages
@@ -52,42 +52,22 @@ data SimpleErrorMessage
| CannotWriteFile FilePath
| InfiniteType Type
| InfiniteKind Kind
- | MultipleFixities Ident
+ | MultipleValueOpFixities (OpName 'ValueOpName)
+ | MultipleTypeOpFixities (OpName 'TypeOpName)
| OrphanTypeDeclaration Ident
- | OrphanFixityDeclaration String
| RedefinedModule ModuleName [SourceSpan]
| RedefinedIdent Ident
| OverlappingNamesInLet
- | UnknownModule ModuleName
- | UnknownType (Qualified (ProperName 'TypeName))
- | UnknownTypeOp (Qualified Ident)
- | UnknownTypeClass (Qualified (ProperName 'ClassName))
- | UnknownValue (Qualified Ident)
- | UnknownDataConstructor (Qualified (ProperName 'ConstructorName)) (Maybe (Qualified (ProperName 'ConstructorName)))
- | UnknownTypeConstructor (Qualified (ProperName 'TypeName))
- | UnknownImportType ModuleName (ProperName 'TypeName)
- | UnknownExportType (ProperName 'TypeName)
- | UnknownImportTypeOp ModuleName Ident
- | UnknownExportTypeOp Ident
- | UnknownImportTypeClass ModuleName (ProperName 'ClassName)
- | UnknownExportTypeClass (ProperName 'ClassName)
- | UnknownImportValue ModuleName Ident
- | UnknownExportValue Ident
- | UnknownExportModule ModuleName
+ | UnknownName (Qualified Name)
+ | UnknownImport ModuleName Name
| UnknownImportDataConstructor ModuleName (ProperName 'TypeName) (ProperName 'ConstructorName)
+ | UnknownExport Name
| UnknownExportDataConstructor (ProperName 'TypeName) (ProperName 'ConstructorName)
- | ScopeConflict String [ModuleName]
- | ScopeShadowing String (Maybe ModuleName) [ModuleName]
- | ConflictingTypeDecls (ProperName 'TypeName)
- | ConflictingCtorDecls (ProperName 'ConstructorName)
- | TypeConflictsWithClass (ProperName 'TypeName)
- | CtorConflictsWithClass (ProperName 'ConstructorName)
- | ClassConflictsWithType (ProperName 'ClassName)
- | ClassConflictsWithCtor (ProperName 'ClassName)
+ | ScopeConflict Name [ModuleName]
+ | ScopeShadowing Name (Maybe ModuleName) [ModuleName]
+ | DeclConflict Name Name
+ | ExportConflict (Qualified Name) (Qualified Name)
| DuplicateModuleName ModuleName
- | DuplicateClassExport (ProperName 'ClassName)
- | DuplicateValueExport Ident
- | DuplicateTypeOpExport Ident
| DuplicateTypeArgument String
| InvalidDoBind
| InvalidDoLet
@@ -102,7 +82,7 @@ data SimpleErrorMessage
| KindsDoNotUnify Kind Kind
| ConstrainedTypeUnified Type Type
| OverlappingInstances (Qualified (ProperName 'ClassName)) [Type] [Qualified Ident]
- | NoInstanceFound (Qualified (ProperName 'ClassName)) [Type]
+ | NoInstanceFound Constraint
| PossiblyInfiniteInstance (Qualified (ProperName 'ClassName)) [Type]
| CannotDerive (Qualified (ProperName 'ClassName)) [Type]
| CannotFindDerivingType (ProperName 'TypeName)
@@ -128,35 +108,27 @@ data SimpleErrorMessage
| ShadowedTypeVar String
| UnusedTypeVar String
| WildcardInferredType Type
- | HoleInferredType String Type
+ | HoleInferredType String Type [(Ident, Type)]
| MissingTypeDeclaration Ident Type
- | NotExhaustivePattern [[Binder]] Bool
| OverlappingPattern [[Binder]] Bool
| IncompleteExhaustivityCheck
- | ClassOperator (ProperName 'ClassName) Ident
| MisleadingEmptyTypeImport ModuleName (ProperName 'TypeName)
| ImportHidingModule ModuleName
| UnusedImport ModuleName
| UnusedExplicitImport ModuleName [String] (Maybe ModuleName) [DeclarationRef]
| UnusedDctorImport (ProperName 'TypeName)
| UnusedDctorExplicitImport (ProperName 'TypeName) [ProperName 'ConstructorName]
- | DeprecatedOperatorDecl String
- | DeprecatedOperatorSection Expr (Either Expr Expr)
- | DeprecatedQualifiedSyntax ModuleName ModuleName
- | DeprecatedClassImport ModuleName (ProperName 'ClassName)
- | DeprecatedClassExport (ProperName 'ClassName)
| DuplicateSelectiveImport ModuleName
| DuplicateImport ModuleName ImportDeclarationType (Maybe ModuleName)
- | DuplicateImportRef String
- | DuplicateExportRef String
+ | DuplicateImportRef Name
+ | DuplicateExportRef Name
| IntOutOfRange Integer String Integer Integer
- | RedundantEmptyHidingImport ModuleName
| ImplicitQualifiedImport ModuleName ModuleName [DeclarationRef]
| ImplicitImport ModuleName [DeclarationRef]
| HidingImport ModuleName [DeclarationRef]
| CaseBinderLengthDiffers Int [Binder]
| IncorrectAnonymousArgument
- | InvalidOperatorInBinder Ident Ident
+ | InvalidOperatorInBinder (Qualified (OpName 'ValueOpName)) (Qualified Ident)
| DeprecatedRequirePath
| CannotGeneralizeRecursiveFunction Ident Type
deriving (Show)
@@ -241,42 +213,22 @@ errorCode em = case unwrapErrorMessage em of
CannotWriteFile{} -> "CannotWriteFile"
InfiniteType{} -> "InfiniteType"
InfiniteKind{} -> "InfiniteKind"
- MultipleFixities{} -> "MultipleFixities"
+ MultipleValueOpFixities{} -> "MultipleValueOpFixities"
+ MultipleTypeOpFixities{} -> "MultipleTypeOpFixities"
OrphanTypeDeclaration{} -> "OrphanTypeDeclaration"
- OrphanFixityDeclaration{} -> "OrphanFixityDeclaration"
RedefinedModule{} -> "RedefinedModule"
RedefinedIdent{} -> "RedefinedIdent"
OverlappingNamesInLet -> "OverlappingNamesInLet"
- UnknownModule{} -> "UnknownModule"
- UnknownType{} -> "UnknownType"
- UnknownTypeOp{} -> "UnknownTypeOp"
- UnknownTypeClass{} -> "UnknownTypeClass"
- UnknownValue{} -> "UnknownValue"
- UnknownDataConstructor{} -> "UnknownDataConstructor"
- UnknownTypeConstructor{} -> "UnknownTypeConstructor"
- UnknownImportType{} -> "UnknownImportType"
- UnknownImportTypeOp{} -> "UnknownImportTypeOp"
- UnknownExportType{} -> "UnknownExportType"
- UnknownExportTypeOp{} -> "UnknownExportTypeOp"
- UnknownImportTypeClass{} -> "UnknownImportTypeClass"
- UnknownExportTypeClass{} -> "UnknownExportTypeClass"
- UnknownImportValue{} -> "UnknownImportValue"
- UnknownExportValue{} -> "UnknownExportValue"
- UnknownExportModule{} -> "UnknownExportModule"
+ UnknownName{} -> "UnknownName"
+ UnknownImport{} -> "UnknownImport"
UnknownImportDataConstructor{} -> "UnknownImportDataConstructor"
+ UnknownExport{} -> "UnknownExport"
UnknownExportDataConstructor{} -> "UnknownExportDataConstructor"
ScopeConflict{} -> "ScopeConflict"
ScopeShadowing{} -> "ScopeShadowing"
- ConflictingTypeDecls{} -> "ConflictingTypeDecls"
- ConflictingCtorDecls{} -> "ConflictingCtorDecls"
- TypeConflictsWithClass{} -> "TypeConflictsWithClass"
- CtorConflictsWithClass{} -> "CtorConflictsWithClass"
- ClassConflictsWithType{} -> "ClassConflictsWithType"
- ClassConflictsWithCtor{} -> "ClassConflictsWithCtor"
+ DeclConflict{} -> "DeclConflict"
+ ExportConflict{} -> "ExportConflict"
DuplicateModuleName{} -> "DuplicateModuleName"
- DuplicateClassExport{} -> "DuplicateClassExport"
- DuplicateValueExport{} -> "DuplicateValueExport"
- DuplicateTypeOpExport{} -> "DuplicateTypeOpExport"
DuplicateTypeArgument{} -> "DuplicateTypeArgument"
InvalidDoBind -> "InvalidDoBind"
InvalidDoLet -> "InvalidDoLet"
@@ -319,27 +271,19 @@ errorCode em = case unwrapErrorMessage em of
WildcardInferredType{} -> "WildcardInferredType"
HoleInferredType{} -> "HoleInferredType"
MissingTypeDeclaration{} -> "MissingTypeDeclaration"
- NotExhaustivePattern{} -> "NotExhaustivePattern"
OverlappingPattern{} -> "OverlappingPattern"
IncompleteExhaustivityCheck{} -> "IncompleteExhaustivityCheck"
- ClassOperator{} -> "ClassOperator"
MisleadingEmptyTypeImport{} -> "MisleadingEmptyTypeImport"
ImportHidingModule{} -> "ImportHidingModule"
UnusedImport{} -> "UnusedImport"
UnusedExplicitImport{} -> "UnusedExplicitImport"
UnusedDctorImport{} -> "UnusedDctorImport"
UnusedDctorExplicitImport{} -> "UnusedDctorExplicitImport"
- DeprecatedOperatorDecl{} -> "DeprecatedOperatorDecl"
- DeprecatedOperatorSection{} -> "DeprecatedOperatorSection"
- DeprecatedQualifiedSyntax{} -> "DeprecatedQualifiedSyntax"
- DeprecatedClassImport{} -> "DeprecatedClassImport"
- DeprecatedClassExport{} -> "DeprecatedClassExport"
DuplicateSelectiveImport{} -> "DuplicateSelectiveImport"
DuplicateImport{} -> "DuplicateImport"
DuplicateImportRef{} -> "DuplicateImportRef"
DuplicateExportRef{} -> "DuplicateExportRef"
IntOutOfRange{} -> "IntOutOfRange"
- RedundantEmptyHidingImport{} -> "RedundantEmptyHidingImport"
ImplicitQualifiedImport{} -> "ImplicitQualifiedImport"
ImplicitImport{} -> "ImplicitImport"
HidingImport{} -> "HidingImport"
@@ -381,14 +325,17 @@ addHint hint = onErrorMessages $ \(ErrorMessage hints se) -> ErrorMessage (hint
-- | A map from rigid type variable name/unknown variable pairs to new variables.
data TypeMap = TypeMap
- { umSkolemMap :: M.Map Int (String, Int, Maybe SourceSpan)
- , umNextSkolem :: Int
- , umUnknownMap :: M.Map Int Int
- , umNextUnknown :: Int
+ { umSkolemMap :: M.Map Int (String, Int, Maybe SourceSpan)
+ -- ^ a map from skolems to their new names, including source and naming info
+ , umUnknownMap :: M.Map Int Int
+ -- ^ a map from unification variables to their new names
+ , umNextIndex :: Int
+ -- ^ unknowns and skolems share a source of names during renaming, to
+ -- avoid overlaps in error messages. This is the next label for either case.
} deriving Show
defaultUnknownMap :: TypeMap
-defaultUnknownMap = TypeMap M.empty 0 M.empty 0
+defaultUnknownMap = TypeMap M.empty M.empty 0
-- | How critical the issue is
data Level = Error | Warning deriving Show
@@ -407,16 +354,16 @@ replaceUnknowns = everywhereOnTypesM replaceTypes
m <- get
case M.lookup u (umUnknownMap m) of
Nothing -> do
- let u' = umNextUnknown m
- put $ m { umUnknownMap = M.insert u u' (umUnknownMap m), umNextUnknown = u' + 1 }
+ let u' = umNextIndex m
+ put $ m { umUnknownMap = M.insert u u' (umUnknownMap m), umNextIndex = u' + 1 }
return (TUnknown u')
Just u' -> return (TUnknown u')
replaceTypes (Skolem name s sko ss) = do
m <- get
case M.lookup s (umSkolemMap m) of
Nothing -> do
- let s' = umNextSkolem m
- put $ m { umSkolemMap = M.insert s (name, s', ss) (umSkolemMap m), umNextSkolem = s' + 1 }
+ let s' = umNextIndex m
+ put $ m { umSkolemMap = M.insert s (name, s', ss) (umSkolemMap m), umNextIndex = s' + 1 }
return (Skolem name s' sko ss)
Just (_, s', _) -> return (Skolem name s' sko ss)
replaceTypes other = return other
@@ -430,14 +377,14 @@ onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse
gSimple (ExprDoesNotHaveType e t) = ExprDoesNotHaveType e <$> f t
gSimple (CannotApplyFunction t e) = CannotApplyFunction <$> f t <*> pure e
gSimple (InvalidInstanceHead t) = InvalidInstanceHead <$> f t
- gSimple (NoInstanceFound cl ts) = NoInstanceFound cl <$> traverse f ts
+ gSimple (NoInstanceFound con) = NoInstanceFound <$> overConstraintArgs (traverse f) con
gSimple (OverlappingInstances cl ts insts) = OverlappingInstances cl <$> traverse f ts <*> pure insts
gSimple (PossiblyInfiniteInstance cl ts) = PossiblyInfiniteInstance cl <$> traverse f ts
gSimple (CannotDerive cl ts) = CannotDerive cl <$> traverse f ts
gSimple (ExpectedType ty k) = ExpectedType <$> f ty <*> pure k
gSimple (OrphanInstance nm cl ts) = OrphanInstance nm cl <$> traverse f ts
gSimple (WildcardInferredType ty) = WildcardInferredType <$> f ty
- gSimple (HoleInferredType name ty) = HoleInferredType name <$> f ty
+ gSimple (HoleInferredType name ty env) = HoleInferredType name <$> f ty <*> traverse (sndM f) env
gSimple (MissingTypeDeclaration nm ty) = MissingTypeDeclaration nm <$> f ty
gSimple (CannotGeneralizeRecursiveFunction nm ty) = CannotGeneralizeRecursiveFunction nm <$> f ty
@@ -457,18 +404,16 @@ wikiUri e = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ error
-- TODO Other possible suggestions:
-- WildcardInferredType - source span not small enough
-- DuplicateSelectiveImport - would require 2 ranges to remove and 1 insert
--- DeprecatedClassExport, DeprecatedClassImport, DeprecatedOperatorSection, would want to replace smaller span?
errorSuggestion :: SimpleErrorMessage -> Maybe ErrorSuggestion
errorSuggestion err = case err of
UnusedImport{} -> emptySuggestion
- RedundantEmptyHidingImport{} -> emptySuggestion
DuplicateImport{} -> emptySuggestion
- DeprecatedQualifiedSyntax name qualName -> suggest $
- "import " ++ runModuleName name ++ " as " ++ runModuleName qualName
UnusedExplicitImport mn _ qual refs -> suggest $ importSuggestion mn refs qual
ImplicitImport mn refs -> suggest $ importSuggestion mn refs Nothing
ImplicitQualifiedImport mn asModule refs -> suggest $ importSuggestion mn refs (Just asModule)
HidingImport mn refs -> suggest $ importSuggestion mn refs Nothing
+ MissingTypeDeclaration ident ty -> suggest $ showIdent ident ++ " :: " ++ prettyPrintType ty
+ WildcardInferredType ty -> suggest $ prettyPrintType ty
_ -> Nothing
where
@@ -483,20 +428,81 @@ errorSuggestion err = case err of
qstr (Just mn) = " as " ++ runModuleName mn
qstr Nothing = ""
+suggestionSpan :: ErrorMessage -> Maybe SourceSpan
+suggestionSpan e =
+ getSpan (unwrapErrorMessage e) <$> errorSpan e
+ where
+ startOnly SourceSpan{spanName, spanStart} = SourceSpan {spanName, spanStart, spanEnd = spanStart}
+
+ getSpan simple ss =
+ case simple of
+ MissingTypeDeclaration{} -> startOnly ss
+ _ -> ss
+
showSuggestion :: SimpleErrorMessage -> String
showSuggestion suggestion = case errorSuggestion suggestion of
Just (ErrorSuggestion x) -> x
_ -> ""
+ansiColor :: (ANSI.ColorIntensity, ANSI.Color) -> String
+ansiColor (intesity, color) =
+ ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground intesity color]
+
+ansiColorReset :: String
+ansiColorReset =
+ ANSI.setSGRCode [ANSI.Reset]
+
+colorCode :: Maybe (ANSI.ColorIntensity, ANSI.Color) -> String -> String
+colorCode codeColor code = case codeColor of
+ Nothing -> code
+ Just cc -> concat [ansiColor cc, code, ansiColorReset]
+
+colorCodeBox :: Maybe (ANSI.ColorIntensity, ANSI.Color) -> Box.Box -> Box.Box
+colorCodeBox codeColor b = case codeColor of
+ Nothing -> b
+ Just cc
+ | Box.rows b == 1 ->
+ Box.text (ansiColor cc) Box.<> b `endWith` Box.text ansiColorReset
+
+ | otherwise -> Box.hcat Box.left -- making two boxes, one for each side of the box so that it will set each row it's own color and will reset it afterwards
+ [ Box.vcat Box.top $ replicate (Box.rows b) $ Box.text $ ansiColor cc
+ , b
+ , Box.vcat Box.top $ replicate (Box.rows b) $ Box.text ansiColorReset
+ ]
+
+
+-- | Default color intesity and color for code
+defaultCodeColor :: (ANSI.ColorIntensity, ANSI.Color)
+defaultCodeColor = (ANSI.Dull, ANSI.Yellow)
+
+-- | `prettyPrintSingleError` Options
+data PPEOptions = PPEOptions
+ { ppeCodeColor :: Maybe (ANSI.ColorIntensity, ANSI.Color) -- ^ Color code with this color... or not
+ , ppeFull :: Bool -- ^ Should write a full error message?
+ , ppeLevel :: Level -- ^ Should this report an error or a warning?
+ , ppeShowWiki :: Bool -- ^ Should show a link to error message's wiki page?
+ }
+
+-- | Default options for PPEOptions
+defaultPPEOptions :: PPEOptions
+defaultPPEOptions = PPEOptions
+ { ppeCodeColor = Just defaultCodeColor
+ , ppeFull = False
+ , ppeLevel = Error
+ , ppeShowWiki = True
+ }
+
+
-- |
-- Pretty print a single error, simplifying if necessary
--
-prettyPrintSingleError :: Bool -> Level -> Bool -> ErrorMessage -> Box.Box
-prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap $ do
+prettyPrintSingleError :: PPEOptions -> ErrorMessage -> Box.Box
+prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalState defaultUnknownMap $ do
em <- onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)
um <- get
return (prettyPrintErrorMessage um em)
where
+ (markCode, markCodeBox) = (colorCode &&& colorCodeBox) codeColor
-- Pretty print an ErrorMessage
prettyPrintErrorMessage :: TypeMap -> ErrorMessage -> Box.Box
@@ -505,9 +511,10 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
[ foldr renderHint (indent (renderSimpleErrorMessage simple)) hints
] ++
maybe [] (return . Box.moveDown 1) typeInformation ++
- [ Box.moveDown 1 $ paras [ line $ "See " ++ wikiUri e ++ " for more information, "
- , line $ "or to contribute content related to this " ++ levelText ++ "."
- ]
+ [ Box.moveDown 1 $ paras
+ [ line $ "See " ++ wikiUri e ++ " for more information, "
+ , line $ "or to contribute content related to this " ++ levelText ++ "."
+ ]
| showWiki
]
where
@@ -522,11 +529,11 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
skolemInfo :: (String, Int, Maybe SourceSpan) -> Box.Box
skolemInfo (name, s, ss) =
paras $
- line (name ++ show s ++ " is a rigid type variable")
+ line (markCode (name ++ show s) ++ " is a rigid type variable")
: foldMap (return . line . (" bound at " ++) . displayStartEndPos) ss
unknownInfo :: Int -> Box.Box
- unknownInfo u = line $ "_" ++ show u ++ " is an unknown type"
+ unknownInfo u = line $ markCode ("t" ++ show u) ++ " is an unknown type"
renderSimpleErrorMessage :: SimpleErrorMessage -> Box.Box
renderSimpleErrorMessage (CannotGetFileInfo path) =
@@ -545,35 +552,35 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
paras $ [ line "Unable to parse foreign module:"
, indent . line $ path
] ++
- (map (indent . line) (concatMap Bundle.printErrorMessage (maybeToList extra)))
+ map (indent . line) (concatMap Bundle.printErrorMessage (maybeToList extra))
renderSimpleErrorMessage (ErrorParsingModule err) =
paras [ line "Unable to parse module: "
, prettyPrintParseError err
]
renderSimpleErrorMessage (MissingFFIModule mn) =
- line $ "The foreign module implementation for module " ++ runModuleName mn ++ " is missing."
+ line $ "The foreign module implementation for module " ++ markCode (runModuleName mn) ++ " is missing."
renderSimpleErrorMessage (UnnecessaryFFIModule mn path) =
- paras [ line $ "An unnecessary foreign module implementation was provided for module " ++ runModuleName mn ++ ": "
+ paras [ line $ "An unnecessary foreign module implementation was provided for module " ++ markCode (runModuleName mn) ++ ": "
, indent . line $ path
- , line $ "Module " ++ runModuleName mn ++ " does not contain any foreign import declarations, so a foreign module is not necessary."
+ , line $ "Module " ++ markCode (runModuleName mn) ++ " does not contain any foreign import declarations, so a foreign module is not necessary."
]
renderSimpleErrorMessage (MissingFFIImplementations mn idents) =
- paras [ line $ "The following values are not defined in the foreign module for module " ++ runModuleName mn ++ ": "
+ paras [ line $ "The following values are not defined in the foreign module for module " ++ markCode (runModuleName mn) ++ ": "
, indent . paras $ map (line . runIdent) idents
]
renderSimpleErrorMessage (UnusedFFIImplementations mn idents) =
- paras [ line $ "The following definitions in the foreign module for module " ++ runModuleName mn ++ " are unused: "
+ paras [ line $ "The following definitions in the foreign module for module " ++ markCode (runModuleName mn) ++ " are unused: "
, indent . paras $ map (line . runIdent) idents
]
renderSimpleErrorMessage (InvalidFFIIdentifier mn ident) =
- paras [ line $ "In the FFI module for " ++ runModuleName mn ++ ":"
+ paras [ line $ "In the FFI module for " ++ markCode (runModuleName mn) ++ ":"
, indent . paras $
- [ line $ "The identifier `" ++ ident ++ "` is not valid in PureScript."
+ [ line $ "The identifier " ++ markCode ident ++ " is not valid in PureScript."
, line "Note that exported identifiers in FFI modules must be valid PureScript identifiers."
]
]
renderSimpleErrorMessage (MultipleFFIModules mn paths) =
- paras [ line $ "Multiple foreign module implementations have been provided for module " ++ runModuleName mn ++ ": "
+ paras [ line $ "Multiple foreign module implementations have been provided for module " ++ markCode (runModuleName mn) ++ ": "
, indent . paras $ map line paths
]
renderSimpleErrorMessage InvalidDoBind =
@@ -584,126 +591,78 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
line "The same name was used more than once in a let binding."
renderSimpleErrorMessage (InfiniteType ty) =
paras [ line "An infinite type was inferred for an expression: "
- , indent $ typeAsBox ty
+ , markCodeBox $ indent $ typeAsBox ty
]
renderSimpleErrorMessage (InfiniteKind ki) =
paras [ line "An infinite kind was inferred for a type: "
- , indent $ line $ prettyPrintKind ki
+ , indent $ line $ markCode $ prettyPrintKind ki
]
- renderSimpleErrorMessage (MultipleFixities name) =
- line $ "There are multiple fixity/precedence declarations for " ++ showIdent name
+ renderSimpleErrorMessage (MultipleValueOpFixities op) =
+ line $ "There are multiple fixity/precedence declarations for operator " ++ markCode (showOp op)
+ renderSimpleErrorMessage (MultipleTypeOpFixities op) =
+ line $ "There are multiple fixity/precedence declarations for type operator " ++ markCode (showOp op)
renderSimpleErrorMessage (OrphanTypeDeclaration nm) =
- line $ "The type declaration for " ++ showIdent nm ++ " should be followed by its definition."
- renderSimpleErrorMessage (OrphanFixityDeclaration op) =
- line $ "The fixity/precedence declaration for " ++ show op ++ " should appear in the same module as its definition."
+ line $ "The type declaration for " ++ markCode (showIdent nm) ++ " should be followed by its definition."
renderSimpleErrorMessage (RedefinedModule name filenames) =
- paras [ line ("The module " ++ runModuleName name ++ " has been defined multiple times:")
+ paras [ line ("The module " ++ markCode (runModuleName name) ++ " has been defined multiple times:")
, indent . paras $ map (line . displaySourceSpan) filenames
]
renderSimpleErrorMessage (RedefinedIdent name) =
- line $ "The value " ++ showIdent name ++ " has been defined multiple times"
- renderSimpleErrorMessage (UnknownModule mn) =
- line $ "Unknown module " ++ runModuleName mn
- renderSimpleErrorMessage (UnknownType name) =
- line $ "Unknown type " ++ showQualified runProperName name
- renderSimpleErrorMessage (UnknownTypeOp name) =
- line $ "Unknown type operator " ++ showQualified showIdent name
- renderSimpleErrorMessage (UnknownTypeClass name) =
- line $ "Unknown type class " ++ showQualified runProperName name
- renderSimpleErrorMessage (UnknownValue name) =
- line $ "Unknown value " ++ showQualified showIdent name
- renderSimpleErrorMessage (UnknownTypeConstructor name) =
- line $ "Unknown type constructor " ++ showQualified runProperName name
- renderSimpleErrorMessage (UnknownDataConstructor dc tc) =
- line $ "Unknown data constructor " ++ showQualified runProperName dc ++ foldMap ((" for type constructor " ++) . showQualified runProperName) tc
- renderSimpleErrorMessage (UnknownImportType mn name) =
- paras [ line $ "Cannot import type " ++ runProperName name ++ " from module " ++ runModuleName mn
+ line $ "The value " ++ markCode (showIdent name) ++ " has been defined multiple times"
+ renderSimpleErrorMessage (UnknownName name) =
+ line $ "Unknown " ++ printName name
+ renderSimpleErrorMessage (UnknownImport mn name) =
+ paras [ line $ "Cannot import " ++ printName (Qualified Nothing name) ++ " from module " ++ markCode (runModuleName mn)
, line "It either does not exist or the module does not export it."
]
- renderSimpleErrorMessage (UnknownExportType name) =
- line $ "Cannot export unknown type " ++ runProperName name
- renderSimpleErrorMessage (UnknownImportTypeOp mn name) =
- paras [ line $ "Cannot import type operator " ++ showIdent name ++ " from module " ++ runModuleName mn
- , line "It either does not exist or the module does not export it."
- ]
- renderSimpleErrorMessage (UnknownExportTypeOp name) =
- line $ "Cannot export unknown type operator " ++ showIdent name
- renderSimpleErrorMessage (UnknownImportTypeClass mn name) =
- paras [ line $ "Cannot import type class " ++ runProperName name ++ " from module " ++ runModuleName mn
- , line "It either does not exist or the module does not export it."
- ]
- renderSimpleErrorMessage (UnknownExportTypeClass name) =
- line $ "Cannot export unknown type class " ++ runProperName name
- renderSimpleErrorMessage (UnknownImportValue mn name) =
- paras [ line $ "Cannot import value " ++ showIdent name ++ " from module " ++ runModuleName mn
- , line "It either does not exist or the module does not export it."
- ]
- renderSimpleErrorMessage (UnknownExportValue name) =
- line $ "Cannot export unknown value " ++ showIdent name
- renderSimpleErrorMessage (UnknownExportModule name) =
- paras [ line $ "Cannot export unknown module " ++ runModuleName name
- , line "It either does not exist or has not been imported by the current module."
- ]
renderSimpleErrorMessage (UnknownImportDataConstructor mn tcon dcon) =
- line $ "Module " ++ runModuleName mn ++ " does not export data constructor " ++ runProperName dcon ++ " for type " ++ runProperName tcon
+ line $ "Module " ++ runModuleName mn ++ " does not export data constructor " ++ markCode (runProperName dcon) ++ " for type " ++ markCode (runProperName tcon)
+ renderSimpleErrorMessage (UnknownExport name) =
+ line $ "Cannot export unknown " ++ printName (Qualified Nothing name)
renderSimpleErrorMessage (UnknownExportDataConstructor tcon dcon) =
- line $ "Cannot export data constructor " ++ runProperName dcon ++ " for type " ++ runProperName tcon ++ ", as it has not been declared."
+ line $ "Cannot export data constructor " ++ markCode (runProperName dcon) ++ " for type " ++ markCode (runProperName tcon) ++ ", as it has not been declared."
renderSimpleErrorMessage (ScopeConflict nm ms) =
- paras [ line $ "Conflicting definitions are in scope for " ++ nm ++ " from the following modules:"
- , indent $ paras $ map (line . runModuleName) ms
+ paras [ line $ "Conflicting definitions are in scope for " ++ printName (Qualified Nothing nm) ++ " from the following modules:"
+ , indent $ paras $ map (line . markCode . runModuleName) ms
]
renderSimpleErrorMessage (ScopeShadowing nm exmn ms) =
- paras [ line $ "Shadowed definitions are in scope for " ++ nm ++ " from the following open imports:"
- , indent $ paras $ map (line . ("import " ++) . runModuleName) ms
+ paras [ line $ "Shadowed definitions are in scope for " ++ printName (Qualified Nothing nm) ++ " from the following open imports:"
+ , indent $ paras $ map (line . markCode . ("import " ++) . runModuleName) ms
, line $ "These will be ignored and the " ++ case exmn of
- Just exmn' -> "declaration from " ++ runModuleName exmn' ++ " will be used."
+ Just exmn' -> "declaration from " ++ markCode (runModuleName exmn') ++ " will be used."
Nothing -> "local declaration will be used."
]
- renderSimpleErrorMessage (ConflictingTypeDecls nm) =
- line $ "Conflicting type declarations for " ++ runProperName nm
- renderSimpleErrorMessage (ConflictingCtorDecls nm) =
- line $ "Conflicting data constructor declarations for " ++ runProperName nm
- renderSimpleErrorMessage (TypeConflictsWithClass nm) =
- line $ "Type " ++ runProperName nm ++ " conflicts with a type class declaration with the same name."
- renderSimpleErrorMessage (CtorConflictsWithClass nm) =
- line $ "Data constructor " ++ runProperName nm ++ " conflicts with a type class declaration with the same name."
- renderSimpleErrorMessage (ClassConflictsWithType nm) =
- line $ "Type class " ++ runProperName nm ++ " conflicts with a type declaration with the same name."
- renderSimpleErrorMessage (ClassConflictsWithCtor nm) =
- line $ "Type class " ++ runProperName nm ++ " conflicts with a data constructor declaration with the same name."
+ renderSimpleErrorMessage (DeclConflict new existing) =
+ line $ "Declaration for " ++ printName (Qualified Nothing new) ++ " conflicts with an existing " ++ nameType existing ++ " of the same name."
+ renderSimpleErrorMessage (ExportConflict new existing) =
+ line $ "Export for " ++ printName new ++ " conflicts with " ++ runName existing
renderSimpleErrorMessage (DuplicateModuleName mn) =
- line $ "Module " ++ runModuleName mn ++ " has been defined multiple times."
- renderSimpleErrorMessage (DuplicateClassExport nm) =
- line $ "Duplicate export declaration for type class " ++ runProperName nm
- renderSimpleErrorMessage (DuplicateValueExport nm) =
- line $ "Duplicate export declaration for value " ++ showIdent nm
- renderSimpleErrorMessage (DuplicateTypeOpExport nm) =
- line $ "Duplicate export declaration for type operator " ++ showIdent nm
+ line $ "Module " ++ markCode (runModuleName mn) ++ " has been defined multiple times."
renderSimpleErrorMessage (CycleInDeclaration nm) =
- line $ "The value of " ++ showIdent nm ++ " is undefined here, so this reference is not allowed."
+ line $ "The value of " ++ markCode (showIdent nm) ++ " is undefined here, so this reference is not allowed."
renderSimpleErrorMessage (CycleInModules mns) =
paras [ line "There is a cycle in module dependencies in these modules: "
- , indent $ paras (map (line . runModuleName) mns)
+ , indent $ paras (map (line . markCode . runModuleName) mns)
]
renderSimpleErrorMessage (CycleInTypeSynonym name) =
paras [ line $ case name of
- Just pn -> "A cycle appears in the definition of type synonym " ++ runProperName pn
+ Just pn -> "A cycle appears in the definition of type synonym " ++ markCode (runProperName pn)
Nothing -> "A cycle appears in a set of type synonym definitions."
, line "Cycles are disallowed because they can lead to loops in the type checker."
, line "Consider using a 'newtype' instead."
]
renderSimpleErrorMessage (NameIsUndefined ident) =
- line $ "Value " ++ showIdent ident ++ " is undefined."
+ line $ "Value " ++ markCode (showIdent ident) ++ " is undefined."
renderSimpleErrorMessage (UndefinedTypeVariable name) =
- line $ "Type variable " ++ runProperName name ++ " is undefined."
+ line $ "Type variable " ++ markCode (runProperName name) ++ " is undefined."
renderSimpleErrorMessage (PartiallyAppliedSynonym name) =
- paras [ line $ "Type synonym " ++ showQualified runProperName name ++ " is partially applied."
+ paras [ line $ "Type synonym " ++ markCode (showQualified runProperName name) ++ " is partially applied."
, line "Type synonyms must be applied to all of their type arguments."
]
renderSimpleErrorMessage (EscapedSkolem binding) =
paras $ [ line "A type variable has escaped its scope." ]
<> foldMap (\expr -> [ line "Relevant expression: "
- , indent $ prettyPrintValue valueDepth expr
+ , markCodeBox $ indent $ prettyPrintValue valueDepth expr
]) binding
renderSimpleErrorMessage (TypesDoNotUnify u1 u2)
= let (sorted1, sorted2) = sortRows u1 u2
@@ -725,39 +684,56 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
, rowFromList (sortBy (comparing fst) sd2 ++ map (fst &&& snd . snd) common, r2)
)
in paras [ line "Could not match type"
- , indent $ typeAsBox sorted1
+ , markCodeBox $ indent $ typeAsBox sorted1
, line "with type"
- , indent $ typeAsBox sorted2
+ , markCodeBox $ indent $ typeAsBox sorted2
]
renderSimpleErrorMessage (KindsDoNotUnify k1 k2) =
paras [ line "Could not match kind"
- , indent $ line $ prettyPrintKind k1
+ , indent $ line $ markCode $ prettyPrintKind k1
, line "with kind"
- , indent $ line $ prettyPrintKind k2
+ , indent $ line $ markCode $ prettyPrintKind k2
]
renderSimpleErrorMessage (ConstrainedTypeUnified t1 t2) =
paras [ line "Could not match constrained type"
- , indent $ typeAsBox t1
+ , markCodeBox $ indent $ typeAsBox t1
, line "with type"
- , indent $ typeAsBox t2
+ , markCodeBox $ indent $ typeAsBox t2
]
renderSimpleErrorMessage (OverlappingInstances nm ts (d : ds)) =
paras [ line "Overlapping type class instances found for"
- , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
- , Box.vcat Box.left (map typeAtomAsBox ts)
- ]
+ , markCodeBox $ indent $ Box.hsep 1 Box.left
+ [ line (showQualified runProperName nm)
+ , Box.vcat Box.left (map typeAtomAsBox ts)
+ ]
, line "The following instances were found:"
, indent $ paras (line (showQualified showIdent d ++ " (chosen)") : map (line . showQualified showIdent) ds)
, line "Overlapping type class instances can lead to different behavior based on the order of module imports, and for that reason are not recommended."
, line "They may be disallowed completely in a future version of the compiler."
]
renderSimpleErrorMessage OverlappingInstances{} = internalError "OverlappingInstances: empty instance list"
- renderSimpleErrorMessage (NoInstanceFound nm ts) =
+ renderSimpleErrorMessage (NoInstanceFound (Constraint C.Fail [ TypeLevelString message ] _)) =
+ paras [ line "A custom type error occurred while solving type class constraints:"
+ , indent . paras . map line . lines $ message
+ ]
+ renderSimpleErrorMessage (NoInstanceFound (Constraint C.Partial
+ _
+ (Just (PartialConstraintData bs b)))) =
+ paras [ line "A case expression could not be determined to cover all inputs."
+ , line "The following additional cases are required to cover all inputs:\n"
+ , indent $ paras $
+ Box.hsep 1 Box.left
+ (map (paras . map (line . markCode)) (transpose bs))
+ : [line "..." | not b]
+ , line "Alternatively, add a Partial constraint to the type of the enclosing value."
+ ]
+ renderSimpleErrorMessage (NoInstanceFound (Constraint nm ts _)) =
paras [ line "No type class instance was found for"
- , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
- , Box.vcat Box.left (map typeAtomAsBox ts)
- ]
+ , markCodeBox $ indent $ Box.hsep 1 Box.left
+ [ line (showQualified runProperName nm)
+ , Box.vcat Box.left (map typeAtomAsBox ts)
+ ]
, paras [ line "The instance head contains unknown type variables. Consider adding a type annotation."
| any containsUnknowns ts
]
@@ -770,130 +746,128 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
go _ = False
renderSimpleErrorMessage (PossiblyInfiniteInstance nm ts) =
paras [ line "Type class instance for"
- , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
- , Box.vcat Box.left (map typeAtomAsBox ts)
- ]
+ , markCodeBox $ indent $ Box.hsep 1 Box.left
+ [ line (showQualified runProperName nm)
+ , Box.vcat Box.left (map typeAtomAsBox ts)
+ ]
, line "is possibly infinite."
]
renderSimpleErrorMessage (CannotDerive nm ts) =
paras [ line "Cannot derive a type class instance for"
- , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
- , Box.vcat Box.left (map typeAtomAsBox ts)
- ]
+ , markCodeBox $ indent $ Box.hsep 1 Box.left
+ [ line (showQualified runProperName nm)
+ , Box.vcat Box.left (map typeAtomAsBox ts)
+ ]
]
renderSimpleErrorMessage (CannotFindDerivingType nm) =
- line $ "Cannot derive a type class instance, because the type declaration for " ++ runProperName nm ++ " could not be found."
+ line $ "Cannot derive a type class instance, because the type declaration for " ++ markCode (runProperName nm) ++ " could not be found."
renderSimpleErrorMessage (DuplicateLabel l expr) =
- paras $ [ line $ "Label " ++ show l ++ " appears more than once in a row type." ]
+ paras $ [ line $ "Label " ++ markCode l ++ " appears more than once in a row type." ]
<> foldMap (\expr' -> [ line "Relevant expression: "
- , indent $ prettyPrintValue valueDepth expr'
+ , markCodeBox $ indent $ prettyPrintValue valueDepth expr'
]) expr
renderSimpleErrorMessage (DuplicateTypeArgument name) =
- line $ "Type argument " ++ show name ++ " appears more than once."
+ line $ "Type argument " ++ markCode name ++ " appears more than once."
renderSimpleErrorMessage (DuplicateValueDeclaration nm) =
- line $ "Multiple value declarations exist for " ++ showIdent nm ++ "."
+ line $ "Multiple value declarations exist for " ++ markCode (showIdent nm) ++ "."
renderSimpleErrorMessage (ArgListLengthsDiffer ident) =
- line $ "Argument list lengths differ in declaration " ++ showIdent ident
+ line $ "Argument list lengths differ in declaration " ++ markCode (showIdent ident)
renderSimpleErrorMessage (OverlappingArgNames ident) =
line $ "Overlapping names in function/binder" ++ foldMap ((" in declaration " ++) . showIdent) ident
renderSimpleErrorMessage (MissingClassMember ident) =
- line $ "Type class member " ++ showIdent ident ++ " has not been implemented."
+ line $ "Type class member " ++ markCode (showIdent ident) ++ " has not been implemented."
renderSimpleErrorMessage (ExtraneousClassMember ident className) =
- line $ showIdent ident ++ " is not a member of type class " ++ showQualified runProperName className
+ line $ "" ++ markCode (showIdent ident) ++ " is not a member of type class " ++ markCode (showQualified runProperName className)
renderSimpleErrorMessage (ExpectedType ty kind) =
- paras [ line "In a type-annotated expression x :: t, the type t must have kind *."
+ paras [ line $ "In a type-annotated expression " ++ markCode "x :: t" ++ ", the type " ++ markCode "t" ++ " must have kind " ++ markCode "*" ++ "."
, line "The error arises from the type"
- , indent $ typeAsBox ty
+ , markCodeBox $ indent $ typeAsBox ty
, line "having the kind"
- , indent $ line $ prettyPrintKind kind
+ , indent $ line $ markCode $ prettyPrintKind kind
, line "instead."
]
renderSimpleErrorMessage (IncorrectConstructorArity nm) =
- line $ "Data constructor " ++ showQualified runProperName nm ++ " was given the wrong number of arguments in a case expression."
+ line $ "Data constructor " ++ markCode (showQualified runProperName nm) ++ " was given the wrong number of arguments in a case expression."
renderSimpleErrorMessage (ExprDoesNotHaveType expr ty) =
paras [ line "Expression"
- , indent $ prettyPrintValue valueDepth expr
+ , markCodeBox $ indent $ prettyPrintValue valueDepth expr
, line "does not have type"
- , indent $ typeAsBox ty
+ , markCodeBox $ indent $ typeAsBox ty
]
renderSimpleErrorMessage (PropertyIsMissing prop) =
- line $ "Type of expression lacks required label " ++ show prop ++ "."
+ line $ "Type of expression lacks required label " ++ markCode prop ++ "."
renderSimpleErrorMessage (AdditionalProperty prop) =
- line $ "Type of expression contains additional label " ++ show prop ++ "."
+ line $ "Type of expression contains additional label " ++ markCode prop ++ "."
renderSimpleErrorMessage (CannotApplyFunction fn arg) =
paras [ line "A function of type"
- , indent $ typeAsBox fn
+ , markCodeBox $ indent $ typeAsBox fn
, line "can not be applied to the argument"
- , indent $ prettyPrintValue valueDepth arg
+ , markCodeBox $ indent $ prettyPrintValue valueDepth arg
]
renderSimpleErrorMessage TypeSynonymInstance =
line "Type class instances for type synonyms are disallowed."
renderSimpleErrorMessage (OrphanInstance nm cnm ts) =
- paras [ line $ "Type class instance " ++ showIdent nm ++ " for "
- , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName cnm)
- , Box.vcat Box.left (map typeAtomAsBox ts)
- ]
+ paras [ line $ "Type class instance " ++ markCode (showIdent nm) ++ " for "
+ , markCodeBox $ indent $ Box.hsep 1 Box.left
+ [ line (showQualified runProperName cnm)
+ , Box.vcat Box.left (map typeAtomAsBox ts)
+ ]
, line "is an orphan instance."
, line "An orphan instance is an instance which is defined in neither the class module nor the data type module."
, line "Consider moving the instance, if possible, or using a newtype wrapper."
]
renderSimpleErrorMessage (InvalidNewtype name) =
- paras [ line $ "Newtype " ++ runProperName name ++ " is invalid."
+ paras [ line $ "Newtype " ++ markCode (runProperName name) ++ " is invalid."
, line "Newtypes must define a single constructor with a single argument."
]
renderSimpleErrorMessage (InvalidInstanceHead ty) =
paras [ line "Type class instance head is invalid due to use of type"
- , indent $ typeAsBox ty
+ , markCodeBox $ indent $ typeAsBox ty
, line "All types appearing in instance declarations must be of the form T a_1 .. a_n, where each type a_i is of the same form."
]
renderSimpleErrorMessage (TransitiveExportError x ys) =
- paras [ line $ "An export for " ++ prettyPrintExport x ++ " requires the following to also be exported: "
- , indent $ paras $ map (line . prettyPrintExport) ys
+ paras [ line $ "An export for " ++ markCode (prettyPrintExport x) ++ " requires the following to also be exported: "
+ , indent $ paras $ map (line . markCode . prettyPrintExport) ys
]
renderSimpleErrorMessage (TransitiveDctorExportError x ctor) =
- paras [ line $ "An export for " ++ prettyPrintExport x ++ " requires the following data constructor to also be exported: "
- , indent $ line $ runProperName ctor
+ paras [ line $ "An export for " ++ markCode (prettyPrintExport x) ++ " requires the following data constructor to also be exported: "
+ , indent $ line $ markCode $ runProperName ctor
]
renderSimpleErrorMessage (ShadowedName nm) =
- line $ "Name '" ++ showIdent nm ++ "' was shadowed."
+ line $ "Name " ++ markCode (showIdent nm) ++ " was shadowed."
renderSimpleErrorMessage (ShadowedTypeVar tv) =
- line $ "Type variable '" ++ tv ++ "' was shadowed."
+ line $ "Type variable " ++ markCode tv ++ " was shadowed."
renderSimpleErrorMessage (UnusedTypeVar tv) =
- line $ "Type variable '" ++ tv ++ "' was declared but not used."
- renderSimpleErrorMessage (ClassOperator className opName) =
- paras [ line $ "Type class '" ++ runProperName className ++ "' declares operator " ++ showIdent opName ++ "."
- , line "This may be disallowed in the future - consider declaring a named member in the class and making the operator an alias:"
- , indent . line $ showIdent opName ++ " = someMember"
- ]
+ line $ "Type variable " ++ markCode tv ++ " was declared but not used."
renderSimpleErrorMessage (MisleadingEmptyTypeImport mn name) =
- line $ "Importing type " ++ runProperName name ++ "(..) from " ++ runModuleName mn ++ " is misleading as it has no exported data constructors."
+ line $ "Importing type " ++ markCode (runProperName name ++ "(..)") ++ " from " ++ markCode (runModuleName mn) ++ " is misleading as it has no exported data constructors."
renderSimpleErrorMessage (ImportHidingModule name) =
- paras [ line "'hiding' imports cannot be used to hide modules."
- , line $ "An attempt was made to hide the import of " ++ runModuleName name
+ paras [ line "hiding imports cannot be used to hide modules."
+ , line $ "An attempt was made to hide the import of " ++ markCode (runModuleName name)
]
renderSimpleErrorMessage (WildcardInferredType ty) =
paras [ line "Wildcard type definition has the inferred type "
- , indent $ typeAsBox ty
- ]
- renderSimpleErrorMessage (HoleInferredType name ty) =
- paras [ line $ "Hole '" ++ name ++ "' has the inferred type "
- , indent $ typeAsBox ty
+ , markCodeBox $ indent $ typeAsBox ty
]
+ renderSimpleErrorMessage (HoleInferredType name ty env) =
+ paras $ [ line $ "Hole '" ++ markCode name ++ "' has the inferred type "
+ , markCodeBox $ indent $ typeAsBox ty
+ ] ++ if null env then [] else envInfo
+ where
+ envInfo :: [Box.Box]
+ envInfo = [ line "in the following context:"
+ , indent $ paras
+ [ Box.hcat Box.left [ Box.text (showIdent ident <> " :: ")
+ , markCodeBox $ typeAsBox ty'
+ ]
+ | (ident, ty') <- take 5 env
+ ]
+ ]
renderSimpleErrorMessage (MissingTypeDeclaration ident ty) =
- paras [ line $ "No type declaration was provided for the top-level declaration of " ++ showIdent ident ++ "."
+ paras [ line $ "No type declaration was provided for the top-level declaration of " ++ markCode (showIdent ident) ++ "."
, line "It is good practice to provide type declarations as a form of documentation."
- , line $ "The inferred type of " ++ showIdent ident ++ " was:"
- , indent $ typeAsBox ty
- ]
- renderSimpleErrorMessage (NotExhaustivePattern bs b) =
- paras [ line "A case expression could not be determined to cover all inputs."
- , line "The following additional cases are required to cover all inputs:\n"
- , indent $ paras $
- Box.hsep 1 Box.left
- (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))
- : [line "..." | not b]
- , line "Or alternatively, add a Partial constraint to the type of the enclosing value."
- , line "Non-exhaustive patterns for values without a `Partial` constraint will be disallowed in PureScript 0.9."
+ , line $ "The inferred type of " ++ markCode (showIdent ident) ++ " was:"
+ , markCodeBox $ indent $ typeAsBox ty
]
renderSimpleErrorMessage (OverlappingPattern bs b) =
paras $ [ line "A case expression contains unreachable cases:\n"
@@ -905,109 +879,51 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
, line "You may want to decompose your data types into smaller types."
]
renderSimpleErrorMessage (UnusedImport name) =
- line $ "The import of module " ++ runModuleName name ++ " is redundant"
+ line $ "The import of module " ++ markCode (runModuleName name) ++ " is redundant"
renderSimpleErrorMessage msg@(UnusedExplicitImport mn names _ _) =
- paras [ line $ "The import of module " ++ runModuleName mn ++ " contains the following unused references:"
+ paras [ line $ "The import of module " ++ markCode (runModuleName mn) ++ " contains the following unused references:"
, indent $ paras $ map line names
, line "It could be replaced with:"
- , indent $ line $ showSuggestion msg ]
+ , indent $ line $ markCode $ showSuggestion msg ]
renderSimpleErrorMessage (UnusedDctorImport name) =
- line $ "The import of type " ++ runProperName name ++ " includes data constructors but only the type is used"
+ line $ "The import of type " ++ markCode (runProperName name) ++ " includes data constructors but only the type is used"
renderSimpleErrorMessage (UnusedDctorExplicitImport name names) =
- paras [ line $ "The import of type " ++ runProperName name ++ " includes the following unused data constructors:"
- , indent $ paras $ map (line .runProperName) names ]
-
- renderSimpleErrorMessage (DeprecatedOperatorDecl name) =
- paras [ line $ "The operator (" ++ name ++ ") was declared as a value rather than an alias for a named function."
- , line "Operator aliases are declared by using a fixity declaration, for example:"
- , indent $ line $ "infixl 9 someFunction as " ++ name
- , line "Support for value-declared operators will be removed in PureScript 0.9."
- ]
-
- renderSimpleErrorMessage (DeprecatedOperatorSection op val) =
- paras [ line "An operator section uses legacy syntax. Operator sections are now written using anonymous function syntax:"
- , indent $ foldr1 before $
- case val of
- Left l ->
- [ line "("
- , prettyPrintValue valueDepth l
- , line " "
- , renderOperator op
- , line " _)"
- ]
- Right r ->
- [ line "(_ "
- , renderOperator op
- , line " "
- , prettyPrintValue valueDepth r
- , line ")"
- ]
- , line "Support for legacy operator sections will be removed in PureScript 0.9."
- ]
- where
- renderOperator (PositionedValue _ _ ex) = renderOperator ex
- renderOperator (Var (Qualified _ (Op ident))) = line ident
- renderOperator other = Box.hcat Box.top [ line "`", prettyPrintValue valueDepth other, line "`" ]
- renderSimpleErrorMessage (DeprecatedQualifiedSyntax name qualName) =
- paras [ line "Import uses the deprecated 'qualified' syntax:"
- , indent $ line $ "import qualified " ++ runModuleName name ++ " as " ++ runModuleName qualName
- , line "Should instead use the form:"
- , indent $ line $ "import " ++ runModuleName name ++ " as " ++ runModuleName qualName
- , line "The deprecated syntax will be removed in PureScript 0.9."
- ]
-
- renderSimpleErrorMessage (DeprecatedClassImport mn name) =
- paras [ line $ "Class import from " ++ runModuleName mn ++ " uses deprecated syntax that omits the 'class' keyword:"
- , indent $ line $ runProperName name
- , line "Should instead use the form:"
- , indent $ line $ "class " ++ runProperName name
- , line "The deprecated syntax will be removed in PureScript 0.9."
- ]
-
- renderSimpleErrorMessage (DeprecatedClassExport name) =
- paras [ line "Class export uses deprecated syntax that omits the 'class' keyword:"
- , indent $ line $ runProperName name
- , line "Should instead use the form:"
- , indent $ line $ "class " ++ runProperName name
- , line "The deprecated syntax will be removed in PureScript 0.9."
- ]
+ paras [ line $ "The import of type " ++ markCode (runProperName name) ++ " includes the following unused data constructors:"
+ , indent $ paras $ map (line . markCode . runProperName) names ]
renderSimpleErrorMessage (DuplicateSelectiveImport name) =
- line $ "There is an existing import of " ++ runModuleName name ++ ", consider merging the import lists"
+ line $ "There is an existing import of " ++ markCode (runModuleName name) ++ ", consider merging the import lists"
renderSimpleErrorMessage (DuplicateImport name imp qual) =
- line $ "Duplicate import of " ++ prettyPrintImport name imp qual
+ line $ "Duplicate import of " ++ markCode (prettyPrintImport name imp qual)
- renderSimpleErrorMessage (DuplicateImportRef ref) =
- line $ "Import list contains multiple references to " ++ ref
+ renderSimpleErrorMessage (DuplicateImportRef name) =
+ line $ "Import list contains multiple references to " ++ printName (Qualified Nothing name)
- renderSimpleErrorMessage (DuplicateExportRef ref) =
- line $ "Export list contains multiple references to " ++ ref
+ renderSimpleErrorMessage (DuplicateExportRef name) =
+ line $ "Export list contains multiple references to " ++ printName (Qualified Nothing name)
renderSimpleErrorMessage (IntOutOfRange value backend lo hi) =
- paras [ line $ "Integer value " ++ show value ++ " is out of range for the " ++ backend ++ " backend."
- , line $ "Acceptable values fall within the range " ++ show lo ++ " to " ++ show hi ++ " (inclusive)." ]
-
- renderSimpleErrorMessage (RedundantEmptyHidingImport mn) =
- line $ "The import for module " ++ runModuleName mn ++ " is redundant as all members have been explicitly hidden."
+ paras [ line $ "Integer value " ++ markCode (show value) ++ " is out of range for the " ++ backend ++ " backend."
+ , line $ "Acceptable values fall within the range " ++ markCode (show lo) ++ " to " ++ markCode (show hi) ++ " (inclusive)." ]
renderSimpleErrorMessage msg@(ImplicitQualifiedImport importedModule asModule _) =
- paras [ line $ "Module " ++ runModuleName importedModule ++ " was imported as " ++ runModuleName asModule ++ " with unspecified imports."
- , line $ "As there are multiple modules being imported as " ++ runModuleName asModule ++ ", consider using the explicit form:"
- , indent $ line $ showSuggestion msg
+ paras [ line $ "Module " ++ markCode (runModuleName importedModule) ++ " was imported as " ++ markCode (runModuleName asModule) ++ " with unspecified imports."
+ , line $ "As there are multiple modules being imported as " ++ markCode (runModuleName asModule) ++ ", consider using the explicit form:"
+ , indent $ line $ markCode $ showSuggestion msg
]
renderSimpleErrorMessage msg@(ImplicitImport mn _) =
- paras [ line $ "Module " ++ runModuleName mn ++ " has unspecified imports, consider using the explicit form: "
- , indent $ line $ showSuggestion msg
+ paras [ line $ "Module " ++ markCode (runModuleName mn) ++ " has unspecified imports, consider using the explicit form: "
+ , indent $ line $ markCode $ showSuggestion msg
]
renderSimpleErrorMessage msg@(HidingImport mn _) =
- paras [ line $ "Module " ++ runModuleName mn ++ " has unspecified imports, consider using the inclusive form: "
- , indent $ line $ showSuggestion msg
+ paras [ line $ "Module " ++ markCode (runModuleName mn) ++ " has unspecified imports, consider using the inclusive form: "
+ , indent $ line $ markCode $ showSuggestion msg
]
renderSimpleErrorMessage (CaseBinderLengthDiffers l bs) =
@@ -1020,7 +936,7 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
line "An anonymous function argument appears in an invalid context."
renderSimpleErrorMessage (InvalidOperatorInBinder op fn) =
- paras [ line $ "Operator " ++ showIdent op ++ " cannot be used in a pattern as it is an alias for function " ++ showIdent fn ++ "."
+ paras [ line $ "Operator " ++ markCode (showQualified showOp op) ++ " cannot be used in a pattern as it is an alias for function " ++ showQualified showIdent fn ++ "."
, line "Only aliases for data constructors may be used in patterns."
]
@@ -1028,9 +944,9 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
line "The require-path option is deprecated and will be removed in PureScript 0.9."
renderSimpleErrorMessage (CannotGeneralizeRecursiveFunction ident ty) =
- paras [ line $ "Unable to generalize the type of the recursive function " ++ showIdent ident ++ "."
- , line $ "The inferred type of " ++ showIdent ident ++ " was:"
- , indent $ typeAsBox ty
+ paras [ line $ "Unable to generalize the type of the recursive function " ++ markCode (showIdent ident) ++ "."
+ , line $ "The inferred type of " ++ markCode (showIdent ident) ++ " was:"
+ , markCodeBox $ indent $ typeAsBox ty
, line "Try adding a type signature."
]
@@ -1038,42 +954,43 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
renderHint (ErrorUnifyingTypes t1 t2) detail =
paras [ detail
, Box.hsep 1 Box.top [ line "while trying to match type"
- , typeAsBox t1
+ , markCodeBox $ typeAsBox t1
]
, Box.moveRight 2 $ Box.hsep 1 Box.top [ line "with type"
- , typeAsBox t2
+ , markCodeBox $ typeAsBox t2
]
]
renderHint (ErrorInExpression expr) detail =
paras [ detail
, Box.hsep 1 Box.top [ Box.text "in the expression"
- , prettyPrintValue valueDepth expr
+ , markCodeBox $ markCodeBox $ prettyPrintValue valueDepth expr
]
]
renderHint (ErrorInModule mn) detail =
- paras [ line $ "in module " ++ runModuleName mn
+ paras [ line $ "in module " ++ markCode (runModuleName mn)
, detail
]
renderHint (ErrorInSubsumption t1 t2) detail =
paras [ detail
, Box.hsep 1 Box.top [ line "while checking that type"
- , typeAsBox t1
+ , markCodeBox $ typeAsBox t1
]
, Box.moveRight 2 $ Box.hsep 1 Box.top [ line "is at least as general as type"
- , typeAsBox t2
+ , markCodeBox $ typeAsBox t2
]
]
renderHint (ErrorInInstance nm ts) detail =
paras [ detail
- , Box.hsep 1 Box.top [ line "in type class instance"
- , line (showQualified runProperName nm)
- , Box.vcat Box.left (map typeAtomAsBox ts)
- ]
+ , line "in type class instance"
+ , markCodeBox $ indent $ Box.hsep 1 Box.top
+ [ line $ showQualified runProperName nm
+ , Box.vcat Box.left (map typeAtomAsBox ts)
+ ]
]
renderHint (ErrorCheckingKind ty) detail =
paras [ detail
, Box.hsep 1 Box.top [ line "while checking the kind of"
- , typeAsBox ty
+ , markCodeBox $ typeAsBox ty
]
]
renderHint ErrorCheckingGuard detail =
@@ -1083,43 +1000,43 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
renderHint (ErrorInferringType expr) detail =
paras [ detail
, Box.hsep 1 Box.top [ line "while inferring the type of"
- , prettyPrintValue valueDepth expr
+ , markCodeBox $ prettyPrintValue valueDepth expr
]
]
renderHint (ErrorCheckingType expr ty) detail =
paras [ detail
, Box.hsep 1 Box.top [ line "while checking that expression"
- , prettyPrintValue valueDepth expr
+ , markCodeBox $ prettyPrintValue valueDepth expr
]
, Box.moveRight 2 $ Box.hsep 1 Box.top [ line "has type"
- , typeAsBox ty
+ , markCodeBox $ typeAsBox ty
]
]
renderHint (ErrorCheckingAccessor expr prop) detail =
paras [ detail
, Box.hsep 1 Box.top [ line "while checking type of property accessor"
- , prettyPrintValue valueDepth (Accessor prop expr)
+ , markCodeBox $ prettyPrintValue valueDepth (Accessor prop expr)
]
]
renderHint (ErrorInApplication f t a) detail =
paras [ detail
, Box.hsep 1 Box.top [ line "while applying a function"
- , prettyPrintValue valueDepth f
+ , markCodeBox $ prettyPrintValue valueDepth f
]
, Box.moveRight 2 $ Box.hsep 1 Box.top [ line "of type"
- , typeAsBox t
+ , markCodeBox $ typeAsBox t
]
, Box.moveRight 2 $ Box.hsep 1 Box.top [ line "to argument"
- , prettyPrintValue valueDepth a
+ , markCodeBox $ prettyPrintValue valueDepth a
]
]
renderHint (ErrorInDataConstructor nm) detail =
paras [ detail
- , line $ "in data constructor " ++ runProperName nm
+ , line $ "in data constructor " ++ markCode (runProperName nm)
]
renderHint (ErrorInTypeConstructor nm) detail =
paras [ detail
- , line $ "in type constructor " ++ runProperName nm
+ , line $ "in type constructor " ++ markCode (runProperName nm)
]
renderHint (ErrorInBindingGroup nms) detail =
paras [ detail
@@ -1131,25 +1048,55 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
]
renderHint (ErrorInTypeSynonym name) detail =
paras [ detail
- , line $ "in type synonym " ++ runProperName name
+ , line $ "in type synonym " ++ markCode (runProperName name)
]
renderHint (ErrorInValueDeclaration n) detail =
paras [ detail
- , line $ "in value declaration " ++ showIdent n
+ , line $ "in value declaration " ++ markCode (showIdent n)
]
renderHint (ErrorInTypeDeclaration n) detail =
paras [ detail
- , line $ "in type declaration for " ++ showIdent n
+ , line $ "in type declaration for " ++ markCode (showIdent n)
]
renderHint (ErrorInForeignImport nm) detail =
paras [ detail
- , line $ "in foreign import " ++ showIdent nm
+ , line $ "in foreign import " ++ markCode (showIdent nm)
]
renderHint (PositionedError srcSpan) detail =
paras [ line $ "at " ++ displaySourceSpan srcSpan
, detail
]
+ printName :: Qualified Name -> String
+ printName qn = nameType (disqualify qn) ++ " " ++ markCode (runName qn)
+
+ nameType :: Name -> String
+ nameType (IdentName _) = "value"
+ nameType (ValOpName _) = "operator"
+ nameType (TyName _) = "type"
+ nameType (TyOpName _) = "type operator"
+ nameType (DctorName _) = "data constructor"
+ nameType (TyClassName _) = "type class"
+ nameType (ModName _) = "module"
+
+ runName :: Qualified Name -> String
+ runName (Qualified mn (IdentName name)) =
+ showQualified showIdent (Qualified mn name)
+ runName (Qualified mn (ValOpName op)) =
+ showQualified showOp (Qualified mn op)
+ runName (Qualified mn (TyName name)) =
+ showQualified runProperName (Qualified mn name)
+ runName (Qualified mn (TyOpName op)) =
+ showQualified showOp (Qualified mn op)
+ runName (Qualified mn (DctorName name)) =
+ showQualified runProperName (Qualified mn name)
+ runName (Qualified mn (TyClassName name)) =
+ showQualified runProperName (Qualified mn name)
+ runName (Qualified Nothing (ModName name)) =
+ runModuleName name
+ runName (Qualified _ ModName{}) =
+ internalError "qualified ModName in runName"
+
valueDepth :: Int
valueDepth | full = 1000
| otherwise = 3
@@ -1230,10 +1177,10 @@ prettyPrintRef :: DeclarationRef -> String
prettyPrintRef (TypeRef pn Nothing) = runProperName pn ++ "(..)"
prettyPrintRef (TypeRef pn (Just [])) = runProperName pn
prettyPrintRef (TypeRef pn (Just dctors)) = runProperName pn ++ "(" ++ intercalate ", " (map runProperName dctors) ++ ")"
-prettyPrintRef (TypeOpRef ident) = "type " ++ showIdent ident
+prettyPrintRef (TypeOpRef op) = "type " ++ showOp op
prettyPrintRef (ValueRef ident) = showIdent ident
+prettyPrintRef (ValueOpRef op) = showOp op
prettyPrintRef (TypeClassRef pn) = "class " ++ runProperName pn
-prettyPrintRef (ProperRef name) = name
prettyPrintRef (TypeInstanceRef ident) = showIdent ident
prettyPrintRef (ModuleRef name) = "module " ++ runModuleName name
prettyPrintRef (PositionedDeclarationRef _ _ ref) = prettyPrintExport ref
@@ -1241,32 +1188,32 @@ prettyPrintRef (PositionedDeclarationRef _ _ ref) = prettyPrintExport ref
-- |
-- Pretty print multiple errors
--
-prettyPrintMultipleErrors :: Bool -> MultipleErrors -> String
-prettyPrintMultipleErrors full = unlines . map renderBox . prettyPrintMultipleErrorsBox full
+prettyPrintMultipleErrors :: PPEOptions -> MultipleErrors -> String
+prettyPrintMultipleErrors ppeOptions = unlines . map renderBox . prettyPrintMultipleErrorsBox ppeOptions
-- |
-- Pretty print multiple warnings
--
-prettyPrintMultipleWarnings :: Bool -> MultipleErrors -> String
-prettyPrintMultipleWarnings full = unlines . map renderBox . prettyPrintMultipleWarningsBox full
+prettyPrintMultipleWarnings :: PPEOptions -> MultipleErrors -> String
+prettyPrintMultipleWarnings ppeOptions = unlines . map renderBox . prettyPrintMultipleWarningsBox ppeOptions
-- | Pretty print warnings as a Box
-prettyPrintMultipleWarningsBox :: Bool -> MultipleErrors -> [Box.Box]
-prettyPrintMultipleWarningsBox = prettyPrintMultipleErrorsWith Warning "Warning found:" "Warning"
+prettyPrintMultipleWarningsBox :: PPEOptions -> MultipleErrors -> [Box.Box]
+prettyPrintMultipleWarningsBox ppeOptions = prettyPrintMultipleErrorsWith (ppeOptions { ppeLevel = Warning }) "Warning found:" "Warning"
-- | Pretty print errors as a Box
-prettyPrintMultipleErrorsBox :: Bool -> MultipleErrors -> [Box.Box]
-prettyPrintMultipleErrorsBox = prettyPrintMultipleErrorsWith Error "Error found:" "Error"
+prettyPrintMultipleErrorsBox :: PPEOptions -> MultipleErrors -> [Box.Box]
+prettyPrintMultipleErrorsBox ppeOptions = prettyPrintMultipleErrorsWith (ppeOptions { ppeLevel = Error }) "Error found:" "Error"
-prettyPrintMultipleErrorsWith :: Level -> String -> String -> Bool -> MultipleErrors -> [Box.Box]
-prettyPrintMultipleErrorsWith level intro _ full (MultipleErrors [e]) =
- let result = prettyPrintSingleError full level True e
+prettyPrintMultipleErrorsWith :: PPEOptions -> String -> String -> MultipleErrors -> [Box.Box]
+prettyPrintMultipleErrorsWith ppeOptions intro _ (MultipleErrors [e]) =
+ let result = prettyPrintSingleError ppeOptions e
in [ Box.vcat Box.left [ Box.text intro
, result
]
]
-prettyPrintMultipleErrorsWith level _ intro full (MultipleErrors es) =
- let result = map (prettyPrintSingleError full level True) es
+prettyPrintMultipleErrorsWith ppeOptions _ intro (MultipleErrors es) =
+ let result = map (prettyPrintSingleError ppeOptions) es
in concat $ zipWith withIntro [1 :: Int ..] result
where
withIntro i err = [ Box.text (intro ++ " " ++ show i ++ " of " ++ show (length es) ++ ":")
diff --git a/src/Language/PureScript/Errors/JSON.hs b/src/Language/PureScript/Errors/JSON.hs
index a36f8e2..c693640 100644
--- a/src/Language/PureScript/Errors/JSON.hs
+++ b/src/Language/PureScript/Errors/JSON.hs
@@ -1,22 +1,7 @@
------------------------------------------------------------------------------
---
--- Module : Language.PureScript.Errors.JSON
--- Copyright : (c) 2013-15 Phil Freeman, (c) 2014-15 Gary Burgess
--- License : MIT (http://opensource.org/licenses/MIT)
---
--- Maintainer : Phil Freeman <paf31@cantab.net>
--- Stability : experimental
--- Portability :
---
--- |
---
------------------------------------------------------------------------------
-
{-# LANGUAGE TemplateHaskell #-}
module Language.PureScript.Errors.JSON where
-import Prelude ()
import Prelude.Compat
import qualified Data.Aeson.TH as A
@@ -30,7 +15,10 @@ data ErrorPosition = ErrorPosition
, endColumn :: Int
} deriving (Show, Eq, Ord)
-data ErrorSuggestion = ErrorSuggestion { replacement :: String } deriving (Show, Eq)
+data ErrorSuggestion = ErrorSuggestion
+ { replacement :: String
+ , replaceRange :: Maybe ErrorPosition
+ } deriving (Show, Eq)
data JSONError = JSONError
{ position :: Maybe ErrorPosition
@@ -40,7 +28,7 @@ data JSONError = JSONError
, filename :: Maybe String
, moduleName :: Maybe String
, suggestion :: Maybe ErrorSuggestion
- } deriving (Show, Eq)
+ } deriving (Show, Eq)
data JSONResult = JSONResult
{ warnings :: [JSONError]
@@ -59,12 +47,12 @@ toJSONErrors verbose level = map (toJSONError verbose level) . P.runMultipleErro
toJSONError :: Bool -> P.Level -> P.ErrorMessage -> JSONError
toJSONError verbose level e =
JSONError (toErrorPosition <$> sspan)
- (P.renderBox (P.prettyPrintSingleError verbose level False (P.stripModuleAndSpan e)))
+ (P.renderBox (P.prettyPrintSingleError (P.PPEOptions Nothing verbose level False) (P.stripModuleAndSpan e)))
(P.errorCode e)
(P.wikiUri e)
(P.spanName <$> sspan)
(P.runModuleName <$> P.errorModule e)
- (toSuggestion <$> P.errorSuggestion (P.unwrapErrorMessage e))
+ (toSuggestion e)
where
sspan :: Maybe P.SourceSpan
sspan = P.errorSpan e
@@ -75,6 +63,11 @@ toJSONError verbose level e =
(P.sourcePosColumn (P.spanStart ss))
(P.sourcePosLine (P.spanEnd ss))
(P.sourcePosColumn (P.spanEnd ss))
- toSuggestion :: P.ErrorSuggestion -> ErrorSuggestion
--- TODO: Adding a newline because source spans chomp everything up to the next character
- toSuggestion (P.ErrorSuggestion s) = ErrorSuggestion $ if null s then s else s ++ "\n"
+ toSuggestion :: P.ErrorMessage -> Maybe ErrorSuggestion
+ toSuggestion em =
+ case P.errorSuggestion $ P.unwrapErrorMessage em of
+ Nothing -> Nothing
+ Just s -> Just $ ErrorSuggestion (suggestionText s) (toErrorPosition <$> P.suggestionSpan em)
+
+ -- TODO: Adding a newline because source spans chomp everything up to the next character
+ suggestionText (P.ErrorSuggestion s) = if null s then s else s ++ "\n"
diff --git a/src/Language/PureScript/Externs.hs b/src/Language/PureScript/Externs.hs
index f9617d5..e6a850c 100644
--- a/src/Language/PureScript/Externs.hs
+++ b/src/Language/PureScript/Externs.hs
@@ -1,37 +1,35 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TemplateHaskell #-}
-- |
--- This module generates code for \"externs\" files, i.e. files containing only foreign import declarations.
+-- This module generates code for \"externs\" files, i.e. files containing only
+-- foreign import declarations.
--
module Language.PureScript.Externs
( ExternsFile(..)
, ExternsImport(..)
, ExternsFixity(..)
+ , ExternsTypeFixity(..)
, ExternsDeclaration(..)
, moduleToExternsFile
, applyExternsFileToEnvironment
) where
-import Prelude ()
import Prelude.Compat
+import Data.Aeson.TH
+import Data.Foldable (fold)
import Data.List (find, foldl')
import Data.Maybe (mapMaybe, maybeToList, fromMaybe)
-import Data.Foldable (fold)
import Data.Version (showVersion)
-import Data.Aeson.TH
-
import qualified Data.Map as M
-import Language.PureScript.Crash
import Language.PureScript.AST
+import Language.PureScript.Crash
import Language.PureScript.Environment
-import Language.PureScript.Names
-import Language.PureScript.Types
import Language.PureScript.Kinds
+import Language.PureScript.Names
import Language.PureScript.TypeClassDictionaries
+import Language.PureScript.Types
import Paths_purescript as Paths
@@ -48,6 +46,8 @@ data ExternsFile = ExternsFile
, efImports :: [ExternsImport]
-- | List of operators and their fixities
, efFixities :: [ExternsFixity]
+ -- | List of type operators and their fixities
+ , efTypeFixities :: [ExternsTypeFixity]
-- | List of type and value declaration
, efDeclarations :: [ExternsDeclaration]
} deriving (Show, Read)
@@ -71,9 +71,22 @@ data ExternsFixity = ExternsFixity
-- | The precedence level of the operator
, efPrecedence :: Precedence
-- | The operator symbol
- , efOperator :: String
+ , efOperator :: OpName 'ValueOpName
-- | The value the operator is an alias for
- , efAlias :: Maybe (Qualified FixityAlias)
+ , efAlias :: Qualified (Either Ident (ProperName 'ConstructorName))
+ } deriving (Show, Read)
+
+-- | A type fixity declaration in an externs file
+data ExternsTypeFixity = ExternsTypeFixity
+ {
+ -- | The associativity of the operator
+ efTypeAssociativity :: Associativity
+ -- | The precedence level of the operator
+ , efTypePrecedence :: Precedence
+ -- | The operator symbol
+ , efTypeOperator :: OpName 'TypeOpName
+ -- | The value the operator is an alias for
+ , efTypeAlias :: Qualified (ProperName 'TypeName)
} deriving (Show, Read)
-- | A type or value declaration appearing in an externs file
@@ -150,22 +163,26 @@ moduleToExternsFile (Module _ _ mn ds (Just exps)) env = ExternsFile{..}
efExports = exps
efImports = mapMaybe importDecl ds
efFixities = mapMaybe fixityDecl ds
+ efTypeFixities = mapMaybe typeFixityDecl ds
efDeclarations = concatMap toExternsDeclaration efExports
fixityDecl :: Declaration -> Maybe ExternsFixity
- fixityDecl (FixityDeclaration (Fixity assoc prec) op alias) =
- fmap (const (ExternsFixity assoc prec op alias)) (find exportsOp exps)
- where
- exportsOp :: DeclarationRef -> Bool
- exportsOp (PositionedDeclarationRef _ _ r) = exportsOp r
- exportsOp (ValueRef ident') = ident' == Op op
- exportsOp (TypeOpRef ident') = ident' == Op op
- exportsOp _ = False
+ fixityDecl (ValueFixityDeclaration (Fixity assoc prec) name op) =
+ fmap (const (ExternsFixity assoc prec op name)) (find (findOp getValueOpRef op) exps)
fixityDecl (PositionedDeclaration _ _ d) = fixityDecl d
fixityDecl _ = Nothing
+ typeFixityDecl :: Declaration -> Maybe ExternsTypeFixity
+ typeFixityDecl (TypeFixityDeclaration (Fixity assoc prec) name op) =
+ fmap (const (ExternsTypeFixity assoc prec op name)) (find (findOp getTypeOpRef op) exps)
+ typeFixityDecl (PositionedDeclaration _ _ d) = typeFixityDecl d
+ typeFixityDecl _ = Nothing
+
+ findOp :: (DeclarationRef -> Maybe (OpName a)) -> OpName a -> DeclarationRef -> Bool
+ findOp get op = maybe False (== op) . get
+
importDecl :: Declaration -> Maybe ExternsImport
- importDecl (ImportDeclaration m mt qmn _) = Just (ExternsImport m mt qmn)
+ importDecl (ImportDeclaration m mt qmn) = Just (ExternsImport m mt qmn)
importDecl (PositionedDeclaration _ _ d) = importDecl d
importDecl _ = Nothing
@@ -204,5 +221,6 @@ moduleToExternsFile (Module _ _ mn ds (Just exps)) env = ExternsFile{..}
$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ExternsImport)
$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ExternsFixity)
+$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ExternsTypeFixity)
$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ExternsDeclaration)
$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ExternsFile)
diff --git a/src/Language/PureScript/Ide.hs b/src/Language/PureScript/Ide.hs
index dd51325..b545a82 100644
--- a/src/Language/PureScript/Ide.hs
+++ b/src/Language/PureScript/Ide.hs
@@ -12,13 +12,9 @@
-- Interface for the psc-ide-server
-----------------------------------------------------------------------------
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
module Language.PureScript.Ide
( handleCommand
@@ -40,6 +36,7 @@ import Data.Maybe (catMaybes, mapMaybe)
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
+import qualified Language.PureScript as P
import qualified Language.PureScript.Ide.CaseSplit as CS
import Language.PureScript.Ide.Command
import Language.PureScript.Ide.Completion
@@ -64,10 +61,10 @@ handleCommand :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
handleCommand (Load [] []) = loadAllModules
handleCommand (Load modules deps) =
loadModulesAndDeps modules deps
-handleCommand (Type search filters) =
- findType search filters
-handleCommand (Complete filters matcher) =
- findCompletions filters matcher
+handleCommand (Type search filters currentModule) =
+ findType search filters currentModule
+handleCommand (Complete filters matcher currentModule) =
+ findCompletions filters matcher currentModule
handleCommand (Pursuit query Package) =
findPursuitPackages query
handleCommand (Pursuit query Identifier) =
@@ -94,17 +91,20 @@ handleCommand (Rebuild file) =
rebuildFile file
handleCommand Cwd =
TextResult . T.pack <$> liftIO getCurrentDirectory
+handleCommand Reset = resetPscIdeState *> pure (TextResult "State has been reset.")
handleCommand Quit = liftIO exitSuccess
findCompletions :: (PscIde m, MonadLogger m) =>
- [Filter] -> Matcher -> m Success
-findCompletions filters matcher =
- CompletionResult . mapMaybe completionFromMatch . getCompletions filters matcher <$> getAllModulesWithReexports
+ [Filter] -> Matcher -> Maybe P.ModuleName -> m Success
+findCompletions filters matcher currentModule = do
+ modules <- getAllModulesWithReexportsAndCache currentModule
+ pure . CompletionResult . mapMaybe completionFromMatch . getCompletions filters matcher $ modules
findType :: (PscIde m, MonadLogger m) =>
- DeclIdent -> [Filter] -> m Success
-findType search filters =
- CompletionResult . mapMaybe completionFromMatch . getExactMatches search filters <$> getAllModulesWithReexports
+ DeclIdent -> [Filter] -> Maybe P.ModuleName -> m Success
+findType search filters currentModule = do
+ modules <- getAllModulesWithReexportsAndCache currentModule
+ pure . CompletionResult . mapMaybe completionFromMatch . getExactMatches search filters $ modules
findPursuitCompletions :: (MonadIO m, MonadLogger m) =>
PursuitQuery -> m Success
@@ -116,14 +116,14 @@ findPursuitPackages :: (MonadIO m, MonadLogger m) =>
findPursuitPackages (PursuitQuery q) =
PursuitResult <$> liftIO (findPackagesForModuleIdent q)
-loadExtern ::(PscIde m, MonadLogger m, MonadError PscIdeError m) =>
+loadExtern :: (PscIde m, MonadLogger m, MonadError PscIdeError m) =>
FilePath -> m ()
loadExtern fp = do
m <- readExternFile fp
insertModule m
printModules :: (PscIde m) => m Success
-printModules = printModules' <$> getPscIdeState
+printModules = printModules' . pscIdeStateModules <$> getPscIdeState
printModules' :: M.Map ModuleIdent [ExternDecl] -> Success
printModules' = ModuleList . M.keys
diff --git a/src/Language/PureScript/Ide/CaseSplit.hs b/src/Language/PureScript/Ide/CaseSplit.hs
index 450ba5f..53e1db0 100644
--- a/src/Language/PureScript/Ide/CaseSplit.hs
+++ b/src/Language/PureScript/Ide/CaseSplit.hs
@@ -12,14 +12,8 @@
-- Casesplitting and adding function clauses
-----------------------------------------------------------------------------
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
-{-# LANGUAGE RecordWildCards #-}
module Language.PureScript.Ide.CaseSplit
( WildcardAnnotations()
diff --git a/src/Language/PureScript/Ide/Command.hs b/src/Language/PureScript/Ide/Command.hs
index 3fd90ca..8f405a8 100644
--- a/src/Language/PureScript/Ide/Command.hs
+++ b/src/Language/PureScript/Ide/Command.hs
@@ -12,9 +12,7 @@
-- Datatypes for the commands psc-ide accepts
-----------------------------------------------------------------------------
-{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
module Language.PureScript.Ide.Command where
@@ -23,10 +21,8 @@ import Prelude.Compat
import Control.Monad
import Data.Aeson
-import Data.Maybe
import Data.Text (Text)
-import Language.PureScript (ModuleName,
- moduleNameFromString)
+import qualified Language.PureScript as P
import Language.PureScript.Ide.CaseSplit
import Language.PureScript.Ide.Filter
import Language.PureScript.Ide.Matcher
@@ -38,12 +34,14 @@ data Command
, loadDependencies :: [ModuleIdent]
}
| Type
- { typeSearch :: DeclIdent
- , typeFilters :: [Filter]
+ { typeSearch :: DeclIdent
+ , typeFilters :: [Filter]
+ , typeCurrentModule :: Maybe P.ModuleName
}
| Complete
- { completeFilters :: [Filter]
- , completeMatcher :: Matcher
+ { completeFilters :: [Filter]
+ , completeMatcher :: Matcher
+ , completeCurrentModule :: Maybe P.ModuleName
}
| Pursuit
{ pursuitQuery :: PursuitQuery
@@ -65,10 +63,11 @@ data Command
| List { listType :: ListType }
| Rebuild FilePath -- ^ Rebuild the specified file using the loaded externs
| Cwd
+ | Reset
| Quit
data ImportCommand
- = AddImplicitImport ModuleName
+ = AddImplicitImport P.ModuleName
| AddImportForIdentifier DeclIdent
deriving (Show, Eq)
@@ -76,12 +75,10 @@ instance FromJSON ImportCommand where
parseJSON = withObject "ImportCommand" $ \o -> do
(command :: String) <- o .: "importCommand"
case command of
- "addImplicitImport" -> do
- mn <- o .: "module"
- pure (AddImplicitImport (moduleNameFromString mn))
- "addImport" -> do
- ident <- o .: "identifier"
- pure (AddImportForIdentifier ident)
+ "addImplicitImport" ->
+ AddImplicitImport <$> (P.moduleNameFromString <$> o .: "module")
+ "addImport" ->
+ AddImportForIdentifier <$> o .: "identifier"
_ -> mzero
data ListType = LoadedModules | Imports FilePath | AvailableModules
@@ -90,68 +87,69 @@ instance FromJSON ListType where
parseJSON = withObject "ListType" $ \o -> do
(listType' :: String) <- o .: "type"
case listType' of
- "import" -> do
- fp <- o .: "file"
- return (Imports fp)
- "loadedModules" -> return LoadedModules
- "availableModules" -> return AvailableModules
+ "import" -> Imports <$> o .: "file"
+ "loadedModules" -> pure LoadedModules
+ "availableModules" -> pure AvailableModules
_ -> mzero
instance FromJSON Command where
parseJSON = withObject "command" $ \o -> do
(command :: String) <- o .: "command"
case command of
- "list" -> do
- listType' <- o .:? "params"
- return $ List (fromMaybe LoadedModules listType')
- "cwd" -> return Cwd
- "quit" -> return Quit
- "load" ->
- maybe (pure (Load [] [])) (\params -> do
- mods <- params .:? "modules"
- deps <- params .:? "dependencies"
- pure $ Load (fromMaybe [] mods) (fromMaybe [] deps)) =<< o .:? "params"
+ "list" -> List <$> o .:? "params" .!= LoadedModules
+ "cwd" -> pure Cwd
+ "quit" -> pure Quit
+ "reset" -> pure Reset
+ "load" -> do
+ params' <- o .:? "params"
+ case params' of
+ Nothing -> pure (Load [] [])
+ Just params ->
+ Load
+ <$> params .:? "modules" .!= []
+ <*> params .:? "dependencies" .!= []
"type" -> do
params <- o .: "params"
- search <- params .: "search"
- filters <- params .: "filters"
- return $ Type search filters
+ Type
+ <$> params .: "search"
+ <*> params .: "filters"
+ <*> (fmap P.moduleNameFromString <$> params .:? "currentModule")
"complete" -> do
params <- o .: "params"
- filters <- params .:? "filters"
- matcher <- params .:? "matcher"
- return $ Complete (fromMaybe [] filters) (fromMaybe mempty matcher)
+ Complete
+ <$> params .:? "filters" .!= []
+ <*> params .:? "matcher" .!= mempty
+ <*> (fmap P.moduleNameFromString <$> params .:? "currentModule")
"pursuit" -> do
params <- o .: "params"
- query <- params .: "query"
- queryType <- params .: "type"
- return $ Pursuit query queryType
+ Pursuit
+ <$> params .: "query"
+ <*> params .: "type"
"caseSplit" -> do
params <- o .: "params"
- line <- params .: "line"
- begin <- params .: "begin"
- end <- params .: "end"
- annotations <- params .: "annotations"
- type' <- params .: "type"
- return $ CaseSplit line begin end (if annotations
- then explicitAnnotations
- else noAnnotations) type'
+ CaseSplit
+ <$> params .: "line"
+ <*> params .: "begin"
+ <*> params .: "end"
+ <*> (mkAnnotations <$> params .: "annotations")
+ <*> params .: "type"
"addClause" -> do
params <- o .: "params"
- line <- params .: "line"
- annotations <- params .: "annotations"
- return $ AddClause line (if annotations
- then explicitAnnotations
- else noAnnotations)
+ AddClause
+ <$> params .: "line"
+ <*> (mkAnnotations <$> params .: "annotations")
"import" -> do
params <- o .: "params"
- fp <- params .: "file"
- out <- params .:? "outfile"
- filters <- params .:? "filters"
- importCommand <- params .: "importCommand"
- pure $ Import fp out (fromMaybe [] filters) importCommand
+ Import
+ <$> params .: "file"
+ <*> params .:? "outfile"
+ <*> params .:? "filters" .!= []
+ <*> params .: "importCommand"
"rebuild" -> do
params <- o .: