summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorkl0tl <>2021-03-01 17:58:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2021-03-01 17:58:00 (GMT)
commit15a4e78905d8dcb52a02343bd4c9a57077879a63 (patch)
tree6982b900da6b458ceeea83c746513e92e04327fa
parent9b6ffebd89f34156e28483d7c2a77e446f8f48db (diff)
version 0.14.0HEAD0.14.0master
-rw-r--r--CONTRIBUTING.md59
-rw-r--r--CONTRIBUTORS.md8
-rw-r--r--INSTALL.md18
-rw-r--r--LICENSE194
-rw-r--r--README.md2
-rw-r--r--app/Command/Bundle.hs2
-rw-r--r--app/Command/Compile.hs16
-rw-r--r--app/Command/Docs.hs2
-rw-r--r--app/Command/Docs/Html.hs2
-rw-r--r--app/Command/Docs/Markdown.hs2
-rw-r--r--app/Command/Graph.hs2
-rw-r--r--app/Command/Hierarchy.hs5
-rw-r--r--app/Command/Ide.hs9
-rw-r--r--app/Command/Publish.hs2
-rw-r--r--app/Main.hs4
-rw-r--r--app/Version.hs11
-rw-r--r--purescript.cabal707
-rw-r--r--src/Control/Monad/Supply.hs33
-rw-r--r--src/Control/Monad/Supply/Class.hs36
-rw-r--r--src/Language/PureScript.hs2
-rw-r--r--src/Language/PureScript/AST.hs14
-rw-r--r--src/Language/PureScript/AST/Binders.hs193
-rw-r--r--src/Language/PureScript/AST/Declarations.hs937
-rw-r--r--src/Language/PureScript/AST/Exported.hs156
-rw-r--r--src/Language/PureScript/AST/Literals.hs38
-rw-r--r--src/Language/PureScript/AST/Operators.hs61
-rw-r--r--src/Language/PureScript/AST/SourcePos.hs119
-rw-r--r--src/Language/PureScript/AST/Traversals.hs706
-rw-r--r--src/Language/PureScript/Bundle.hs8
-rw-r--r--src/Language/PureScript/CST.hs20
-rw-r--r--src/Language/PureScript/CST/Convert.hs639
-rw-r--r--src/Language/PureScript/CST/Errors.hs165
-rw-r--r--src/Language/PureScript/CST/Layout.hs401
-rw-r--r--src/Language/PureScript/CST/Lexer.hs712
-rw-r--r--src/Language/PureScript/CST/Monad.hs174
-rw-r--r--src/Language/PureScript/CST/Parser.y793
-rw-r--r--src/Language/PureScript/CST/Positions.hs352
-rw-r--r--src/Language/PureScript/CST/Print.hs82
-rw-r--r--src/Language/PureScript/CST/Traversals.hs11
-rw-r--r--src/Language/PureScript/CST/Traversals/Type.hs39
-rw-r--r--src/Language/PureScript/CST/Types.hs437
-rw-r--r--src/Language/PureScript/CST/Utils.hs315
-rw-r--r--src/Language/PureScript/CodeGen/JS.hs22
-rw-r--r--src/Language/PureScript/Comments.hs25
-rw-r--r--src/Language/PureScript/Constants/Data/Generic/Rep.hs40
-rw-r--r--src/Language/PureScript/Constants/Data/Newtype.hs7
-rw-r--r--src/Language/PureScript/Constants/Prelude.hs (renamed from src/Language/PureScript/Constants.hs)146
-rw-r--r--src/Language/PureScript/CoreFn/Desugar.hs23
-rw-r--r--src/Language/PureScript/CoreFn/FromJSON.hs5
-rw-r--r--src/Language/PureScript/CoreFn/Meta.hs4
-rw-r--r--src/Language/PureScript/CoreFn/Module.hs6
-rw-r--r--src/Language/PureScript/CoreFn/Optimizer.hs4
-rw-r--r--src/Language/PureScript/CoreFn/ToJSON.hs5
-rw-r--r--src/Language/PureScript/CoreImp/Optimizer/Inliner.hs3
-rw-r--r--src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs2
-rw-r--r--src/Language/PureScript/CoreImp/Optimizer/TCO.hs2
-rw-r--r--src/Language/PureScript/CoreImp/Optimizer/Unused.hs2
-rw-r--r--src/Language/PureScript/Crash.hs26
-rw-r--r--src/Language/PureScript/Docs/AsHtml.hs5
-rw-r--r--src/Language/PureScript/Docs/Convert.hs24
-rw-r--r--src/Language/PureScript/Docs/Convert/ReExports.hs30
-rw-r--r--src/Language/PureScript/Docs/Convert/Single.hs3
-rw-r--r--src/Language/PureScript/Docs/Prim.hs135
-rw-r--r--src/Language/PureScript/Docs/Render.hs15
-rw-r--r--src/Language/PureScript/Docs/RenderedCode.hs1
-rw-r--r--src/Language/PureScript/Docs/RenderedCode/RenderKind.hs57
-rw-r--r--src/Language/PureScript/Docs/RenderedCode/RenderType.hs29
-rw-r--r--src/Language/PureScript/Docs/RenderedCode/Types.hs12
-rw-r--r--src/Language/PureScript/Docs/Types.hs40
-rw-r--r--src/Language/PureScript/Environment.hs622
-rw-r--r--src/Language/PureScript/Errors.hs498
-rw-r--r--src/Language/PureScript/Errors/JSON.hs4
-rw-r--r--src/Language/PureScript/Externs.hs43
-rw-r--r--src/Language/PureScript/Graph.hs2
-rw-r--r--src/Language/PureScript/Hierarchy.hs2
-rw-r--r--src/Language/PureScript/Ide.hs2
-rw-r--r--src/Language/PureScript/Ide/CaseSplit.hs10
-rw-r--r--src/Language/PureScript/Ide/Command.hs15
-rw-r--r--src/Language/PureScript/Ide/Completion.hs9
-rw-r--r--src/Language/PureScript/Ide/Error.hs22
-rw-r--r--src/Language/PureScript/Ide/Externs.hs97
-rw-r--r--src/Language/PureScript/Ide/Filter.hs7
-rw-r--r--src/Language/PureScript/Ide/Filter/Declaration.hs28
-rw-r--r--src/Language/PureScript/Ide/Imports.hs17
-rw-r--r--src/Language/PureScript/Ide/Matcher.hs3
-rw-r--r--src/Language/PureScript/Ide/Prim.hs28
-rw-r--r--src/Language/PureScript/Ide/Rebuild.hs6
-rw-r--r--src/Language/PureScript/Ide/Reexports.hs4
-rw-r--r--src/Language/PureScript/Ide/SourceFile.hs4
-rw-r--r--src/Language/PureScript/Ide/State.hs8
-rw-r--r--src/Language/PureScript/Ide/Types.hs38
-rw-r--r--src/Language/PureScript/Ide/Usage.hs3
-rw-r--r--src/Language/PureScript/Ide/Util.hs7
-rw-r--r--src/Language/PureScript/Interactive.hs8
-rw-r--r--src/Language/PureScript/Interactive/Module.hs4
-rw-r--r--src/Language/PureScript/Interactive/Parser.hs7
-rw-r--r--src/Language/PureScript/Interactive/Printer.hs16
-rw-r--r--src/Language/PureScript/Interactive/Types.hs9
-rw-r--r--src/Language/PureScript/Kinds.hs185
-rw-r--r--src/Language/PureScript/Label.hs24
-rw-r--r--src/Language/PureScript/Linter.hs7
-rw-r--r--src/Language/PureScript/Linter/Exhaustive.hs13
-rw-r--r--src/Language/PureScript/Linter/Imports.hs11
-rw-r--r--src/Language/PureScript/Make.hs32
-rw-r--r--src/Language/PureScript/Make/Actions.hs19
-rw-r--r--src/Language/PureScript/Make/Monad.hs1
-rw-r--r--src/Language/PureScript/ModuleDependencies.hs17
-rw-r--r--src/Language/PureScript/Names.hs262
-rw-r--r--src/Language/PureScript/PSString.hs242
-rw-r--r--src/Language/PureScript/Pretty.hs1
-rw-r--r--src/Language/PureScript/Pretty/Common.hs2
-rw-r--r--src/Language/PureScript/Pretty/Kinds.hs57
-rw-r--r--src/Language/PureScript/Pretty/Types.hs50
-rw-r--r--src/Language/PureScript/Pretty/Values.hs3
-rw-r--r--src/Language/PureScript/Publish.hs52
-rw-r--r--src/Language/PureScript/Publish/ErrorsWarnings.hs76
-rw-r--r--src/Language/PureScript/Renamer.hs2
-rw-r--r--src/Language/PureScript/Sugar.hs73
-rw-r--r--src/Language/PureScript/Sugar/AdoNotation.hs2
-rw-r--r--src/Language/PureScript/Sugar/BindingGroups.hs102
-rw-r--r--src/Language/PureScript/Sugar/CaseDeclarations.hs10
-rw-r--r--src/Language/PureScript/Sugar/DoNotation.hs2
-rw-r--r--src/Language/PureScript/Sugar/Names.hs86
-rw-r--r--src/Language/PureScript/Sugar/Names/Common.hs15
-rw-r--r--src/Language/PureScript/Sugar/Names/Env.hs53
-rw-r--r--src/Language/PureScript/Sugar/Names/Exports.hs15
-rw-r--r--src/Language/PureScript/Sugar/Names/Imports.hs6
-rw-r--r--src/Language/PureScript/Sugar/Operators.hs31
-rw-r--r--src/Language/PureScript/Sugar/Operators/Types.hs2
-rw-r--r--src/Language/PureScript/Sugar/TypeClasses.hs80
-rwxr-xr-xsrc/Language/PureScript/Sugar/TypeClasses/Deriving.hs225
-rw-r--r--src/Language/PureScript/Sugar/TypeDeclarations.hs57
-rw-r--r--src/Language/PureScript/Traversals.hs27
-rw-r--r--src/Language/PureScript/TypeChecker.hs321
-rw-r--r--src/Language/PureScript/TypeChecker/Entailment.hs270
-rw-r--r--src/Language/PureScript/TypeChecker/Entailment/Coercible.hs940
-rw-r--r--src/Language/PureScript/TypeChecker/Kinds.hs1160
-rw-r--r--src/Language/PureScript/TypeChecker/Monad.hs163
-rw-r--r--src/Language/PureScript/TypeChecker/Roles.hs243
-rw-r--r--src/Language/PureScript/TypeChecker/Skolems.hs16
-rw-r--r--src/Language/PureScript/TypeChecker/Subsumption.hs13
-rw-r--r--src/Language/PureScript/TypeChecker/Synonyms.hs34
-rw-r--r--src/Language/PureScript/TypeChecker/TypeSearch.hs4
-rw-r--r--src/Language/PureScript/TypeChecker/Types.hs150
-rw-r--r--src/Language/PureScript/TypeChecker/Unify.hs124
-rw-r--r--src/Language/PureScript/TypeClassDictionaries.hs44
-rw-r--r--src/Language/PureScript/Types.hs647
-rw-r--r--stack.yaml2
-rw-r--r--tests/Language/PureScript/Ide/CompletionSpec.hs64
-rw-r--r--tests/Language/PureScript/Ide/FilterSpec.hs34
-rw-r--r--tests/Language/PureScript/Ide/ImportsSpec.hs16
-rw-r--r--tests/Language/PureScript/Ide/ReexportsSpec.hs1
-rw-r--r--tests/Language/PureScript/Ide/SourceFileSpec.hs5
-rw-r--r--tests/Language/PureScript/Ide/StateSpec.hs6
-rw-r--r--tests/Language/PureScript/Ide/Test.hs10
-rw-r--r--tests/Main.hs5
-rw-r--r--tests/TestCompiler.hs191
-rw-r--r--tests/TestCoreFn.hs59
-rw-r--r--tests/TestCst.hs226
-rw-r--r--tests/TestDocs.hs4
-rw-r--r--tests/TestGraph.hs2
-rw-r--r--tests/TestHierarchy.hs2
-rw-r--r--tests/TestPrimDocs.hs8
-rw-r--r--tests/TestPscPublish.hs5
-rw-r--r--tests/TestPsci/CompletionTest.hs2
-rw-r--r--tests/TestUtils.hs9
-rw-r--r--tests/purs/docs/bower_components/purescript-newtype/src/Data/Newtype.purs7
-rw-r--r--tests/purs/docs/output/Ado/docs.json2
-rw-r--r--tests/purs/docs/output/ChildDeclOrder/docs.json2
-rw-r--r--tests/purs/docs/output/Clash1a/docs.json2
-rw-r--r--tests/purs/docs/output/Clash2a/docs.json2
-rw-r--r--tests/purs/docs/output/ConstrainedArgument/docs.json2
-rw-r--r--tests/purs/docs/output/Data.Newtype/docs.json2
-rw-r--r--tests/purs/docs/output/DeclOrder/docs.json2
-rw-r--r--tests/purs/docs/output/DeclOrderNoExportList/docs.json2
-rw-r--r--tests/purs/docs/output/Desugar/docs.json2
-rw-r--r--tests/purs/docs/output/DocComments/docs.json2
-rw-r--r--tests/purs/docs/output/DocCommentsClassMethod/docs.json2
-rw-r--r--tests/purs/docs/output/DocCommentsDataConstructor/docs.json2
-rw-r--r--tests/purs/docs/output/DuplicateNames/docs.json2
-rw-r--r--tests/purs/docs/output/Example2/docs.json2
-rw-r--r--tests/purs/docs/output/ExplicitExport/docs.json2
-rw-r--r--tests/purs/docs/output/ExplicitTypeSignatures/docs.json2
-rw-r--r--tests/purs/docs/output/ImportedTwiceB/docs.json2
-rw-r--r--tests/purs/docs/output/MultiVirtual1/docs.json2
-rw-r--r--tests/purs/docs/output/MultiVirtual2/docs.json2
-rw-r--r--tests/purs/docs/output/MultiVirtual3/docs.json2
-rw-r--r--tests/purs/docs/output/NewOperators2/docs.json2
-rw-r--r--tests/purs/docs/output/Prim.Boolean/docs.json2
-rw-r--r--tests/purs/docs/output/Prim.Coerce/docs.json1
-rw-r--r--tests/purs/docs/output/Prim.Ordering/docs.json2
-rw-r--r--tests/purs/docs/output/Prim.Row/docs.json2
-rw-r--r--tests/purs/docs/output/Prim.RowList/docs.json2
-rw-r--r--tests/purs/docs/output/Prim.Symbol/docs.json2
-rw-r--r--tests/purs/docs/output/Prim.TypeError/docs.json2
-rw-r--r--tests/purs/docs/output/Prim/docs.json2
-rw-r--r--tests/purs/docs/output/PrimSubmodules/docs.json2
-rw-r--r--tests/purs/docs/output/SomeTypeClass/docs.json2
-rw-r--r--tests/purs/docs/output/Transitive3/docs.json2
-rw-r--r--tests/purs/docs/output/TypeClassWithFunDeps/docs.json2
-rw-r--r--tests/purs/docs/output/TypeLevelString/docs.json2
-rw-r--r--tests/purs/docs/output/TypeOpAliases/docs.json2
-rw-r--r--tests/purs/docs/output/TypeSynonym/docs.json2
-rw-r--r--tests/purs/docs/output/TypeSynonymInstance/docs.json2
-rw-r--r--tests/purs/docs/output/UTF8/docs.json2
-rw-r--r--tests/purs/docs/output/cache-db.json2
-rw-r--r--tests/purs/docs/src/Clash1a.purs2
-rw-r--r--tests/purs/docs/src/Clash2a.purs2
-rw-r--r--tests/purs/docs/src/ConstrainedArgument.purs2
-rw-r--r--tests/purs/failing/1071.out22
-rw-r--r--tests/purs/failing/1169.out15
-rw-r--r--tests/purs/failing/1175.out22
-rw-r--r--tests/purs/failing/1310.out25
-rw-r--r--tests/purs/failing/1570.out23
-rw-r--r--tests/purs/failing/1733.out10
-rw-r--r--tests/purs/failing/1825.out10
-rw-r--r--tests/purs/failing/1881.out10
-rw-r--r--tests/purs/failing/2109-bind.out10
-rw-r--r--tests/purs/failing/2109-bind.purs9
-rw-r--r--tests/purs/failing/2109-discard.out10
-rw-r--r--tests/purs/failing/2109-discard.purs8
-rw-r--r--tests/purs/failing/2109-negate.out10
-rw-r--r--tests/purs/failing/2109-negate.purs4
-rw-r--r--tests/purs/failing/2128-class.out10
-rw-r--r--tests/purs/failing/2128-instance.out10
-rw-r--r--tests/purs/failing/2197-shouldFail.out14
-rw-r--r--tests/purs/failing/2197-shouldFail2.out10
-rw-r--r--tests/purs/failing/2378.out18
-rw-r--r--tests/purs/failing/2379.out31
-rw-r--r--tests/purs/failing/2434.out10
-rw-r--r--tests/purs/failing/2534.out21
-rw-r--r--tests/purs/failing/2542.out22
-rw-r--r--tests/purs/failing/2567.out18
-rw-r--r--tests/purs/failing/2601.out21
-rw-r--r--tests/purs/failing/2616.out25
-rw-r--r--tests/purs/failing/2806.out28
-rw-r--r--tests/purs/failing/2874-forall.out10
-rw-r--r--tests/purs/failing/2874-forall2.out10
-rw-r--r--tests/purs/failing/2874-wildcard.out10
-rw-r--r--tests/purs/failing/2947.out10
-rw-r--r--tests/purs/failing/3077.out25
-rw-r--r--tests/purs/failing/3077.purs11
-rw-r--r--tests/purs/failing/3132.out14
-rw-r--r--tests/purs/failing/3275-BindingGroupErrorPos.out24
-rw-r--r--tests/purs/failing/3275-DataBindingGroupErrorPos.out24
-rw-r--r--tests/purs/failing/3335-TypeOpAssociativityError.out10
-rw-r--r--tests/purs/failing/3405.out9
-rw-r--r--tests/purs/failing/3549-a.out10
-rw-r--r--tests/purs/failing/3549.out25
-rw-r--r--tests/purs/failing/365.out9
-rw-r--r--tests/purs/failing/3689.out10
-rw-r--r--tests/purs/failing/438.out25
-rw-r--r--tests/purs/failing/881.out14
-rw-r--r--tests/purs/failing/AnonArgument1.out9
-rw-r--r--tests/purs/failing/AnonArgument2.out9
-rw-r--r--tests/purs/failing/AnonArgument3.out9
-rw-r--r--tests/purs/failing/ApostropheModuleName.out10
-rw-r--r--tests/purs/failing/ArgLengthMismatch.out10
-rw-r--r--tests/purs/failing/ArrayType.out22
-rw-r--r--tests/purs/failing/Arrays.out24
-rw-r--r--tests/purs/failing/AtPatternPrecedence.out10
-rw-r--r--tests/purs/failing/BindInDo-2.out9
-rw-r--r--tests/purs/failing/BindInDo.out9
-rw-r--r--tests/purs/failing/CannotDeriveNewtypeForData.out9
-rw-r--r--tests/purs/failing/CaseBinderLengthsDiffer.out14
-rw-r--r--tests/purs/failing/CaseDoesNotMatchAllConstructorArgs.out16
-rw-r--r--tests/purs/failing/CoercibleClosedRowsDoNotUnify.out39
-rw-r--r--tests/purs/failing/CoercibleClosedRowsDoNotUnify.purs7
-rw-r--r--tests/purs/failing/CoercibleConstrained1.out29
-rw-r--r--tests/purs/failing/CoercibleConstrained1.purs11
-rw-r--r--tests/purs/failing/CoercibleConstrained2.out32
-rw-r--r--tests/purs/failing/CoercibleConstrained2.purs11
-rw-r--r--tests/purs/failing/CoercibleConstrained3.out30
-rw-r--r--tests/purs/failing/CoercibleConstrained3.purs13
-rw-r--r--tests/purs/failing/CoercibleForeign.out32
-rw-r--r--tests/purs/failing/CoercibleForeign.purs11
-rw-r--r--tests/purs/failing/CoercibleForeign2.out36
-rw-r--r--tests/purs/failing/CoercibleForeign2.purs9
-rw-r--r--tests/purs/failing/CoercibleForeign3.out36
-rw-r--r--tests/purs/failing/CoercibleForeign3.purs9
-rw-r--r--tests/purs/failing/CoercibleHigherKindedData.out33
-rw-r--r--tests/purs/failing/CoercibleHigherKindedData.purs13
-rw-r--r--tests/purs/failing/CoercibleHigherKindedNewtypes.out24
-rw-r--r--tests/purs/failing/CoercibleHigherKindedNewtypes.purs13
-rw-r--r--tests/purs/failing/CoercibleKindMismatch.out31
-rw-r--r--tests/purs/failing/CoercibleKindMismatch.purs15
-rw-r--r--tests/purs/failing/CoercibleNominal.out34
-rw-r--r--tests/purs/failing/CoercibleNominal.purs11
-rw-r--r--tests/purs/failing/CoercibleNominalTypeApp.out27
-rw-r--r--tests/purs/failing/CoercibleNominalTypeApp.purs13
-rw-r--r--tests/purs/failing/CoercibleNominalWrapped.out32
-rw-r--r--tests/purs/failing/CoercibleNominalWrapped.purs15
-rw-r--r--tests/purs/failing/CoercibleNonCanonical1.out27
-rw-r--r--tests/purs/failing/CoercibleNonCanonical1.purs11
-rw-r--r--tests/purs/failing/CoercibleNonCanonical2.out24
-rw-r--r--tests/purs/failing/CoercibleNonCanonical2.purs10
-rw-r--r--tests/purs/failing/CoercibleOpenRowsDoNotUnify.out43
-rw-r--r--tests/purs/failing/CoercibleOpenRowsDoNotUnify.purs7
-rw-r--r--tests/purs/failing/CoercibleRepresentational.out31
-rw-r--r--tests/purs/failing/CoercibleRepresentational.purs11
-rw-r--r--tests/purs/failing/CoercibleRepresentational2.out24
-rw-r--r--tests/purs/failing/CoercibleRepresentational2.purs9
-rw-r--r--tests/purs/failing/CoercibleRepresentational3.out24
-rw-r--r--tests/purs/failing/CoercibleRepresentational3.purs9
-rw-r--r--tests/purs/failing/CoercibleRepresentational4.out24
-rw-r--r--tests/purs/failing/CoercibleRepresentational4.purs11
-rw-r--r--tests/purs/failing/CoercibleRepresentational5.out24
-rw-r--r--tests/purs/failing/CoercibleRepresentational5.purs15
-rw-r--r--tests/purs/failing/CoercibleRepresentational6.out24
-rw-r--r--tests/purs/failing/CoercibleRepresentational6.purs8
-rw-r--r--tests/purs/failing/CoercibleRepresentational6/N.purs3
-rw-r--r--tests/purs/failing/CoercibleRepresentational7.out24
-rw-r--r--tests/purs/failing/CoercibleRepresentational7.purs8
-rw-r--r--tests/purs/failing/CoercibleRepresentational7/N.purs3
-rw-r--r--tests/purs/failing/CoercibleRepresentational8.out24
-rw-r--r--tests/purs/failing/CoercibleRepresentational8.purs9
-rw-r--r--tests/purs/failing/CoercibleRepresentational8/UnsafeCoerce.purs7
-rw-r--r--tests/purs/failing/CoercibleRoleMismatch1.out15
-rw-r--r--tests/purs/failing/CoercibleRoleMismatch1.purs6
-rw-r--r--tests/purs/failing/CoercibleRoleMismatch2.out15
-rw-r--r--tests/purs/failing/CoercibleRoleMismatch2.purs10
-rw-r--r--tests/purs/failing/CoercibleRoleMismatch3.out15
-rw-r--r--tests/purs/failing/CoercibleRoleMismatch3.purs10
-rw-r--r--tests/purs/failing/CoercibleRoleMismatch4.out15
-rw-r--r--tests/purs/failing/CoercibleRoleMismatch4.purs8
-rw-r--r--tests/purs/failing/CoercibleRoleMismatch5.out15
-rw-r--r--tests/purs/failing/CoercibleRoleMismatch5.purs7
-rw-r--r--tests/purs/failing/CoercibleUnknownRowTail1.out41
-rw-r--r--tests/purs/failing/CoercibleUnknownRowTail1.purs7
-rw-r--r--tests/purs/failing/CoercibleUnknownRowTail2.out46
-rw-r--r--tests/purs/failing/CoercibleUnknownRowTail2.purs7
-rw-r--r--tests/purs/failing/ConflictingExports.out14
-rw-r--r--tests/purs/failing/ConflictingImports.out14
-rw-r--r--tests/purs/failing/ConflictingImports/B.out14
-rw-r--r--tests/purs/failing/ConflictingImports2.out14
-rw-r--r--tests/purs/failing/ConflictingImports2/B.out14
-rw-r--r--tests/purs/failing/ConflictingQualifiedImports.out14
-rw-r--r--tests/purs/failing/ConflictingQualifiedImports2.out14
-rw-r--r--tests/purs/failing/ConflictingQualifiedImports2/B.out14
-rw-r--r--tests/purs/failing/ConstraintFailure.out22
-rw-r--r--tests/purs/failing/ConstraintInference.out19
-rw-r--r--tests/purs/failing/CycleInForeignDataKinds.out13
-rw-r--r--tests/purs/failing/CycleInForeignDataKinds.purs5
-rw-r--r--tests/purs/failing/CycleInKindDeclaration.out13
-rw-r--r--tests/purs/failing/CycleInKindDeclaration.purs8
-rw-r--r--tests/purs/failing/DctorOperatorAliasExport.out13
-rw-r--r--tests/purs/failing/DeclConflictClassCtor.out10
-rw-r--r--tests/purs/failing/DeclConflictClassSynonym.out10
-rw-r--r--tests/purs/failing/DeclConflictClassType.out10
-rw-r--r--tests/purs/failing/DeclConflictCtorClass.out10
-rw-r--r--tests/purs/failing/DeclConflictCtorCtor.out10
-rw-r--r--tests/purs/failing/DeclConflictDuplicateCtor.out10
-rw-r--r--tests/purs/failing/DeclConflictSynonymClass.out10
-rw-r--r--tests/purs/failing/DeclConflictSynonymType.out10
-rw-r--r--tests/purs/failing/DeclConflictTypeClass.out10
-rw-r--r--tests/purs/failing/DeclConflictTypeSynonym.out10
-rw-r--r--tests/purs/failing/DeclConflictTypeType.out10
-rw-r--r--tests/purs/failing/DiffKindsSameName.out21
-rw-r--r--tests/purs/failing/DiffKindsSameName/LibA.out19
-rw-r--r--tests/purs/failing/Do.out20
-rw-r--r--tests/purs/failing/DoNotSuggestComposition.out24
-rw-r--r--tests/purs/failing/DoNotSuggestComposition2.out24
-rw-r--r--tests/purs/failing/DuplicateDeclarationsInLet.out10
-rw-r--r--tests/purs/failing/DuplicateInstance.out17
-rw-r--r--tests/purs/failing/DuplicateModule.out9
-rw-r--r--tests/purs/failing/DuplicateProperties.out41
-rw-r--r--tests/purs/failing/DuplicateRoleDeclaration.out10
-rw-r--r--tests/purs/failing/DuplicateRoleDeclaration.purs6
-rw-r--r--tests/purs/failing/DuplicateTypeClass.out14
-rw-r--r--tests/purs/failing/DuplicateTypeVars.out11
-rw-r--r--tests/purs/failing/EmptyCase.out10
-rw-r--r--tests/purs/failing/EmptyClass.out10
-rw-r--r--tests/purs/failing/EmptyDo.out10
-rw-r--r--tests/purs/failing/ExpectedWildcard.out9
-rw-r--r--tests/purs/failing/ExportConflictClass.out10
-rw-r--r--tests/purs/failing/ExportConflictClass/B.out10
-rw-r--r--tests/purs/failing/ExportConflictClassAndType.out10
-rw-r--r--tests/purs/failing/ExportConflictClassAndType/B.out10
-rw-r--r--tests/purs/failing/ExportConflictCtor.out10
-rw-r--r--tests/purs/failing/ExportConflictType.out10
-rw-r--r--tests/purs/failing/ExportConflictType/B.out10
-rw-r--r--tests/purs/failing/ExportConflictTypeOp.out10
-rw-r--r--tests/purs/failing/ExportConflictValue.out10
-rw-r--r--tests/purs/failing/ExportConflictValueOp.out10
-rw-r--r--tests/purs/failing/ExportConflictValueOp/B.out10
-rw-r--r--tests/purs/failing/ExportExplicit.out10
-rw-r--r--tests/purs/failing/ExportExplicit1.out22
-rw-r--r--tests/purs/failing/ExportExplicit1.purs4
-rw-r--r--tests/purs/failing/ExportExplicit1/M1.purs2
-rw-r--r--tests/purs/failing/ExportExplicit2.out10
-rw-r--r--tests/purs/failing/ExportExplicit3.out10
-rw-r--r--tests/purs/failing/ExtraRecordField.out27
-rw-r--r--tests/purs/failing/ExtraneousClassMember.out13
-rw-r--r--tests/purs/failing/Foldable.out9
-rw-r--r--tests/purs/failing/Generalization1.out16
-rw-r--r--tests/purs/failing/Generalization2.out16
-rw-r--r--tests/purs/failing/ImportExplicit.out11
-rw-r--r--tests/purs/failing/ImportExplicit/M1.out11
-rw-r--r--tests/purs/failing/ImportExplicit2.out10
-rw-r--r--tests/purs/failing/ImportHidingModule.out10
-rw-r--r--tests/purs/failing/ImportModule.out11
-rw-r--r--tests/purs/failing/InfiniteKind.out19
-rw-r--r--tests/purs/failing/InfiniteKind2.out19
-rw-r--r--tests/purs/failing/InfiniteKind2.purs2
-rw-r--r--tests/purs/failing/InfiniteType.out21
-rw-r--r--tests/purs/failing/InstanceChainBothUnknownAndMatch.out36
-rw-r--r--tests/purs/failing/InstanceChainSkolemUnknownMatch.out28
-rw-r--r--tests/purs/failing/InstanceChainSkolemUnknownMatch.purs2
-rw-r--r--tests/purs/failing/InstanceExport.out13
-rw-r--r--tests/purs/failing/InstanceSigsBodyIncorrect.out22
-rw-r--r--tests/purs/failing/InstanceSigsDifferentTypes.out22
-rw-r--r--tests/purs/failing/InstanceSigsIncorrectType.out22
-rw-r--r--tests/purs/failing/InstanceSigsOrphanTypeDeclaration.out10
-rw-r--r--tests/purs/failing/IntOutOfRange.out11
-rw-r--r--tests/purs/failing/InvalidCoercibleInstanceDeclaration.out14
-rw-r--r--tests/purs/failing/InvalidCoercibleInstanceDeclaration.purs8
-rw-r--r--tests/purs/failing/InvalidDerivedInstance.out14
-rw-r--r--tests/purs/failing/InvalidDerivedInstance2.out17
-rw-r--r--tests/purs/failing/InvalidDerivedInstance3.out10
-rw-r--r--tests/purs/failing/InvalidDerivedInstance3.purs10
-rw-r--r--tests/purs/failing/InvalidOperatorInBinder.out10
-rw-r--r--tests/purs/failing/KindError.out24
-rw-r--r--tests/purs/failing/KindStar.out20
-rw-r--r--tests/purs/failing/LacksWithSubGoal.out28
-rw-r--r--tests/purs/failing/LeadingZeros1.out10
-rw-r--r--tests/purs/failing/LeadingZeros2.out10
-rw-r--r--tests/purs/failing/Let.out9
-rw-r--r--tests/purs/failing/LetPatterns1.out10
-rw-r--r--tests/purs/failing/LetPatterns2.out10
-rw-r--r--tests/purs/failing/LetPatterns3.out16
-rw-r--r--tests/purs/failing/LetPatterns4.out10
-rw-r--r--tests/purs/failing/MPTCs.out16
-rw-r--r--tests/purs/failing/MissingClassExport.out13
-rw-r--r--tests/purs/failing/MissingClassMember.out15
-rw-r--r--tests/purs/failing/MissingClassMemberExport.out13
-rw-r--r--tests/purs/failing/MissingFFIImplementations.out12
-rw-r--r--tests/purs/failing/MissingRecordField.out23
-rw-r--r--tests/purs/failing/MixedAssociativityError.out14
-rw-r--r--tests/purs/failing/MonoKindDataBindingGroup.out21
-rw-r--r--tests/purs/failing/MonoKindDataBindingGroup.purs8
-rw-r--r--tests/purs/failing/MultipleErrors.out46
-rw-r--r--tests/purs/failing/MultipleErrors2.out22
-rw-r--r--tests/purs/failing/MultipleTypeOpFixities.out10
-rw-r--r--tests/purs/failing/MultipleValueOpFixities.out10
-rw-r--r--tests/purs/failing/MutRec.out20
-rw-r--r--tests/purs/failing/MutRec2.out9
-rw-r--r--tests/purs/failing/NewtypeInstance.out13
-rw-r--r--tests/purs/failing/NewtypeInstance2.out13
-rw-r--r--tests/purs/failing/NewtypeInstance3.out13
-rw-r--r--tests/purs/failing/NewtypeInstance4.out13
-rw-r--r--tests/purs/failing/NewtypeInstance5.out13
-rw-r--r--tests/purs/failing/NewtypeInstance6.out13
-rw-r--r--tests/purs/failing/NewtypeMultiArgs.out10
-rw-r--r--tests/purs/failing/NewtypeMultiCtor.out10
-rw-r--r--tests/purs/failing/NonAssociativeError.out26
-rw-r--r--tests/purs/failing/NonExhaustivePatGuard.out26
-rw-r--r--tests/purs/failing/NullaryAbs.out10
-rw-r--r--tests/purs/failing/Object.out24
-rw-r--r--tests/purs/failing/OperatorAliasNoExport.out13
-rw-r--r--tests/purs/failing/OperatorAt.out10
-rw-r--r--tests/purs/failing/OperatorBackslash.out10
-rw-r--r--tests/purs/failing/OperatorSections.out27
-rw-r--r--tests/purs/failing/OrphanInstance.out18
-rw-r--r--tests/purs/failing/OrphanInstance/Class.out18
-rw-r--r--tests/purs/failing/OrphanInstanceFunDepCycle.out20
-rw-r--r--tests/purs/failing/OrphanInstanceFunDepCycle/Lib.out20
-rw-r--r--tests/purs/failing/OrphanInstanceNullary.out18
-rw-r--r--tests/purs/failing/OrphanInstanceNullary/Lib.out18
-rw-r--r--tests/purs/failing/OrphanInstanceWithDetermined.out22
-rw-r--r--tests/purs/failing/OrphanInstanceWithDetermined/Lib.out22
-rw-r--r--tests/purs/failing/OrphanKindDeclaration1.out10
-rw-r--r--tests/purs/failing/OrphanKindDeclaration1.purs4
-rw-r--r--tests/purs/failing/OrphanKindDeclaration2.out10
-rw-r--r--tests/purs/failing/OrphanKindDeclaration2.purs5
-rw-r--r--tests/purs/failing/OrphanRoleDeclaration1.out10
-rw-r--r--tests/purs/failing/OrphanRoleDeclaration1.purs4
-rw-r--r--tests/purs/failing/OrphanRoleDeclaration2.out10
-rw-r--r--tests/purs/failing/OrphanRoleDeclaration2.purs5
-rw-r--r--tests/purs/failing/OrphanRoleDeclaration3.out10
-rw-r--r--tests/purs/failing/OrphanRoleDeclaration3.purs8
-rw-r--r--tests/purs/failing/OrphanTypeDecl.out10
-rw-r--r--tests/purs/failing/OverlapAcrossModules.out24
-rw-r--r--tests/purs/failing/OverlapAcrossModules/Class.out24
-rw-r--r--tests/purs/failing/OverlappingArguments.out10
-rw-r--r--tests/purs/failing/OverlappingBinders.out14
-rw-r--r--tests/purs/failing/OverlappingInstances.out22
-rw-r--r--tests/purs/failing/OverlappingVars.out20
-rw-r--r--tests/purs/failing/PolykindGeneralizationLet.out24
-rw-r--r--tests/purs/failing/PolykindGeneralizationLet.purs14
-rw-r--r--tests/purs/failing/PolykindInstanceOverlapping.out22
-rw-r--r--tests/purs/failing/PolykindInstanceOverlapping.purs13
-rw-r--r--tests/purs/failing/PolykindInstantiatedInstance.out25
-rw-r--r--tests/purs/failing/PolykindInstantiatedInstance.purs12
-rw-r--r--tests/purs/failing/PolykindInstantiation.out22
-rw-r--r--tests/purs/failing/PolykindInstantiation.purs8
-rw-r--r--tests/purs/failing/PossiblyInfiniteCoercibleInstance.out25
-rw-r--r--tests/purs/failing/PossiblyInfiniteCoercibleInstance.purs9
-rw-r--r--tests/purs/failing/PrimModuleReserved.out10
-rw-r--r--tests/purs/failing/PrimRow.out10
-rw-r--r--tests/purs/failing/PrimSubModuleReserved.out10
-rw-r--r--tests/purs/failing/PrimSubModuleReserved/Prim_Foobar.out10
-rw-r--r--tests/purs/failing/ProgrammableTypeErrors.out24
-rw-r--r--tests/purs/failing/ProgrammableTypeErrorsTypeString.out21
-rw-r--r--tests/purs/failing/QualifiedOperators.out10
-rw-r--r--tests/purs/failing/QualifiedOperators.purs4
-rw-r--r--tests/purs/failing/QualifiedOperators2.out10
-rw-r--r--tests/purs/failing/QualifiedOperators2.purs4
-rw-r--r--tests/purs/failing/QuantificationCheckFailure.out12
-rw-r--r--tests/purs/failing/QuantificationCheckFailure.purs14
-rw-r--r--tests/purs/failing/QuantificationCheckFailure2.out16
-rw-r--r--tests/purs/failing/QuantificationCheckFailure2.purs6
-rw-r--r--tests/purs/failing/QuantificationCheckFailure3.out12
-rw-r--r--tests/purs/failing/QuantificationCheckFailure3.purs7
-rw-r--r--tests/purs/failing/QuantifiedKind.out15
-rw-r--r--tests/purs/failing/QuantifiedKind.purs7
-rw-r--r--tests/purs/failing/Rank2Types.out25
-rw-r--r--tests/purs/failing/RequiredHiddenType.out13
-rw-r--r--tests/purs/failing/Reserved.out10
-rw-r--r--tests/purs/failing/RoleDeclarationArityMismatch.out10
-rw-r--r--tests/purs/failing/RoleDeclarationArityMismatch.purs5
-rw-r--r--tests/purs/failing/RoleDeclarationArityMismatchForeign.out10
-rw-r--r--tests/purs/failing/RoleDeclarationArityMismatchForeign.purs5
-rw-r--r--tests/purs/failing/RowConstructors1.out21
-rw-r--r--tests/purs/failing/RowConstructors2.out21
-rw-r--r--tests/purs/failing/RowConstructors3.out21
-rw-r--r--tests/purs/failing/RowInInstanceNotDetermined0.out19
-rw-r--r--tests/purs/failing/RowInInstanceNotDetermined1.out20
-rw-r--r--tests/purs/failing/RowInInstanceNotDetermined2.out19
-rw-r--r--tests/purs/failing/RowLacks.out25
-rw-r--r--tests/purs/failing/RowsInKinds.out28
-rw-r--r--tests/purs/failing/RowsInKinds.purs15
-rw-r--r--tests/purs/failing/ScopedKindVariableSynonym.out12
-rw-r--r--tests/purs/failing/ScopedKindVariableSynonym.purs7
-rw-r--r--tests/purs/failing/SelfImport.out9
-rw-r--r--tests/purs/failing/SelfImport/Dummy.out9
-rw-r--r--tests/purs/failing/SkolemEscape.out20
-rw-r--r--tests/purs/failing/SkolemEscape2.out22
-rw-r--r--tests/purs/failing/SkolemEscapeKinds.out18
-rw-r--r--tests/purs/failing/SkolemEscapeKinds.purs8
-rw-r--r--tests/purs/failing/StandaloneKindSignatures1.out21
-rw-r--r--tests/purs/failing/StandaloneKindSignatures1.purs7
-rw-r--r--tests/purs/failing/StandaloneKindSignatures2.out21
-rw-r--r--tests/purs/failing/StandaloneKindSignatures2.purs8
-rw-r--r--tests/purs/failing/StandaloneKindSignatures3.out21
-rw-r--r--tests/purs/failing/StandaloneKindSignatures3.purs7
-rw-r--r--tests/purs/failing/StandaloneKindSignatures4.out25
-rw-r--r--tests/purs/failing/StandaloneKindSignatures4.purs7
-rw-r--r--tests/purs/failing/SuggestComposition.out32
-rw-r--r--tests/purs/failing/Superclasses1.out17
-rw-r--r--tests/purs/failing/Superclasses2.out13
-rw-r--r--tests/purs/failing/Superclasses3.out22
-rw-r--r--tests/purs/failing/Superclasses5.out30
-rw-r--r--tests/purs/failing/TooFewClassInstanceArgs.out15
-rw-r--r--tests/purs/failing/TopLevelCaseNoArgs.out10
-rw-r--r--tests/purs/failing/TransitiveDctorExport.out13
-rw-r--r--tests/purs/failing/TransitiveDctorExportError.out13
-rw-r--r--tests/purs/failing/TransitiveDctorExportError.purs4
-rw-r--r--tests/purs/failing/TransitiveKindExport.out13
-rw-r--r--tests/purs/failing/TransitiveSynonymExport.out13
-rw-r--r--tests/purs/failing/TypeClasses2.out20
-rw-r--r--tests/purs/failing/TypeError.out22
-rw-r--r--tests/purs/failing/TypeOperatorAliasNoExport.out13
-rw-r--r--tests/purs/failing/TypeSynonymCycle.out14
-rw-r--r--tests/purs/failing/TypeSynonymCycle.purs6
-rw-r--r--tests/purs/failing/TypeSynonyms.out14
-rw-r--r--tests/purs/failing/TypeSynonyms2.purs12
-rw-r--r--tests/purs/failing/TypeSynonyms3.purs12
-rw-r--r--tests/purs/failing/TypeSynonyms4.out12
-rw-r--r--tests/purs/failing/TypeSynonyms5.out11
-rw-r--r--tests/purs/failing/TypeSynonyms7.out20
-rw-r--r--tests/purs/failing/TypeSynonyms7.purs9
-rw-r--r--tests/purs/failing/TypeSynonymsOverlappingInstance.out24
-rw-r--r--tests/purs/failing/TypeSynonymsOverlappingInstance.purs15
-rw-r--r--tests/purs/failing/TypeWildcards1.out10
-rw-r--r--tests/purs/failing/TypeWildcards2.out10
-rw-r--r--tests/purs/failing/TypeWildcards3.out18
-rw-r--r--tests/purs/failing/TypeWildcards4.out10
-rw-r--r--tests/purs/failing/TypeWildcards4.purs4
-rw-r--r--tests/purs/failing/TypedBinders.out10
-rw-r--r--tests/purs/failing/TypedBinders2.out30
-rw-r--r--tests/purs/failing/TypedBinders3.out21
-rw-r--r--tests/purs/failing/TypedHole.out19
-rw-r--r--tests/purs/failing/TypedHole2.out14
-rw-r--r--tests/purs/failing/UnderscoreModuleName.out10
-rw-r--r--tests/purs/failing/UnknownType.out10
-rw-r--r--tests/purs/failing/UnsupportedRoleDeclarationTypeClass.out10
-rw-r--r--tests/purs/failing/UnsupportedRoleDeclarationTypeClass.purs5
-rw-r--r--tests/purs/failing/UnsupportedRoleDeclarationTypeSynonym.out10
-rw-r--r--tests/purs/failing/UnsupportedRoleDeclarationTypeSynonym.purs7
-rw-r--r--tests/purs/failing/UnsupportedTypeInKind.out14
-rw-r--r--tests/purs/failing/UnsupportedTypeInKind.purs7
-rw-r--r--tests/purs/failing/UnusableTypeClassMethod.out12
-rw-r--r--tests/purs/failing/UnusableTypeClassMethodConflictingIdent.out12
-rw-r--r--tests/purs/failing/UnusableTypeClassMethodSynonym.out12
-rw-r--r--tests/purs/failing/Whitespace1.out10
-rw-r--r--tests/purs/graph/graph.json2
-rw-r--r--tests/purs/graph/src/Module2.purs2
-rw-r--r--tests/purs/graph/src/Module3.purs4
-rw-r--r--tests/purs/layout/AdoIn.purs19
-rw-r--r--tests/purs/layout/CaseGuards.purs53
-rw-r--r--tests/purs/layout/CaseWhere.purs12
-rw-r--r--tests/purs/layout/ClassHead.purs10
-rw-r--r--tests/purs/layout/Commas.purs22
-rw-r--r--tests/purs/layout/Delimiter.purs13
-rw-r--r--tests/purs/layout/DoLet.purs15
-rw-r--r--tests/purs/layout/DoOperator.purs8
-rw-r--r--tests/purs/layout/DoWhere.purs6
-rw-r--r--tests/purs/layout/IfThenElseDo.purs10
-rw-r--r--tests/purs/layout/InstanceChainElse.purs4
-rw-r--r--tests/purs/layout/LetGuards.purs29
-rw-r--r--tests/purs/passing/2172.purs10
-rw-r--r--tests/purs/passing/3830.purs16
-rw-r--r--tests/purs/passing/BlockStringEdgeCases.purs30
-rw-r--r--tests/purs/passing/Coercible.purs285
-rw-r--r--tests/purs/passing/Coercible/Lib.purs12
-rw-r--r--tests/purs/passing/Coercible/Lib2.purs3
-rw-r--r--tests/purs/passing/ExportExplicit/M1.purs2
-rw-r--r--tests/purs/passing/ForeignDataInKind.purs9
-rw-r--r--tests/purs/passing/GenericsRep.purs2
-rw-r--r--tests/purs/passing/Guards.purs2
-rw-r--r--tests/purs/passing/KindUnificationInSolver.purs21
-rw-r--r--tests/purs/passing/KindedType.purs4
-rw-r--r--tests/purs/passing/MinusConstructor.purs38
-rw-r--r--tests/purs/passing/NegativeBinder.purs7
-rw-r--r--tests/purs/passing/NewtypeClass.purs18
-rw-r--r--tests/purs/passing/PolykindBindingGroup1.purs13
-rw-r--r--tests/purs/passing/PolykindBindingGroup2.purs16
-rw-r--r--tests/purs/passing/PolykindGeneralization.purs15
-rw-r--r--tests/purs/passing/PolykindGeneralizationHygiene.purs11
-rw-r--r--tests/purs/passing/PolykindGeneralizedTypeSynonym.purs12
-rw-r--r--tests/purs/passing/PolykindInstanceDispatch.purs21
-rw-r--r--tests/purs/passing/PolykindInstantiatedInstance.purs22
-rw-r--r--tests/purs/passing/PolykindInstantiation.purs17
-rw-r--r--tests/purs/passing/PolykindRowCons.purs51
-rw-r--r--tests/purs/passing/QualifiedOperators.purs13
-rw-r--r--tests/purs/passing/QualifiedOperators/Foo.purs8
-rw-r--r--tests/purs/passing/QuantifiedKind.purs10
-rw-r--r--tests/purs/passing/Rank2Kinds.purs21
-rw-r--r--tests/purs/passing/ReExportsExported.js4
-rw-r--r--tests/purs/passing/ReExportsExported.purs7
-rw-r--r--tests/purs/passing/ReExportsExported/A.purs4
-rw-r--r--tests/purs/passing/ReExportsExported/B.purs7
-rw-r--r--tests/purs/passing/ReExportsExported/C.purs4
-rw-r--r--tests/purs/passing/RowLacks.purs12
-rw-r--r--tests/purs/passing/RowsInInstanceContext.purs7
-rw-r--r--tests/purs/passing/RowsInKinds.purs15
-rw-r--r--tests/purs/passing/RowsInKinds2.purs11
-rw-r--r--tests/purs/passing/SolvingAppendSymbol.purs28
-rw-r--r--tests/purs/passing/SolvingCompareSymbol.purs18
-rw-r--r--tests/purs/passing/StandaloneKindSignatures.purs27
-rw-r--r--tests/purs/passing/TypeOperators.purs3
-rw-r--r--tests/purs/passing/TypeSynonymInSuperClass.purs18
-rw-r--r--tests/purs/passing/TypeSynonymInstance.purs16
-rw-r--r--tests/purs/passing/TypeSynonymInstance2.purs14
-rw-r--r--tests/purs/passing/TypeSynonymInstance3.purs23
-rw-r--r--tests/purs/passing/TypeSynonymInstance4.purs13
-rw-r--r--tests/purs/passing/TypeSynonymInstance5.purs13
-rw-r--r--tests/purs/passing/TypeSynonymsInKinds.purs25
-rw-r--r--tests/purs/publish/basic-example/output/Control.Applicative/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Control.Apply/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Control.Bind/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Control.Category/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Control.Monad/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Control.Semigroupoid/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.BooleanAlgebra/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Bounded.Generic/docs.json1
-rw-r--r--tests/purs/publish/basic-example/output/Data.Bounded/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.CommutativeRing/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.DivisionRing/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Eq.Generic/docs.json1
-rw-r--r--tests/purs/publish/basic-example/output/Data.Eq/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.EuclideanRing/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Field/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Function/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Functor/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Generic.Rep/docs.json1
-rw-r--r--tests/purs/publish/basic-example/output/Data.HeytingAlgebra.Generic/docs.json1
-rw-r--r--tests/purs/publish/basic-example/output/Data.HeytingAlgebra/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Monoid.Additive/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Monoid.Conj/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Monoid.Disj/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Monoid.Dual/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Monoid.Endo/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Monoid.Generic/docs.json1
-rw-r--r--tests/purs/publish/basic-example/output/Data.Monoid.Multiplicative/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Monoid/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.NaturalTransformation/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Newtype/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Ord.Generic/docs.json1
-rw-r--r--tests/purs/publish/basic-example/output/Data.Ord.Unsafe/docs.json1
-rw-r--r--tests/purs/publish/basic-example/output/Data.Ord/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Ring.Generic/docs.json1
-rw-r--r--tests/purs/publish/basic-example/output/Data.Ring/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Semigroup.First/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Semigroup.Generic/docs.json1
-rw-r--r--tests/purs/publish/basic-example/output/Data.Semigroup.Last/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Semigroup/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Semiring.Generic/docs.json1
-rw-r--r--tests/purs/publish/basic-example/output/Data.Semiring/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Show.Generic/docs.json1
-rw-r--r--tests/purs/publish/basic-example/output/Data.Show/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Symbol/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Unit/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Data.Void/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Effect.Class.Console/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Effect.Class/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Effect.Console/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Effect.Uncurried/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Effect/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Main/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/PSCI.Support/docs.json1
-rw-r--r--tests/purs/publish/basic-example/output/Prim.Boolean/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Prim.Coerce/docs.json1
-rw-r--r--tests/purs/publish/basic-example/output/Prim.Ordering/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Prim.Row/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Prim.RowList/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Prim.Symbol/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Prim.TypeError/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Prim/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Record.Unsafe/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Safe.Coerce/docs.json1
-rw-r--r--tests/purs/publish/basic-example/output/Type.Data.Row/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Type.Data.RowList/docs.json2
-rw-r--r--tests/purs/publish/basic-example/output/Type.Proxy/docs.json1
-rw-r--r--tests/purs/publish/basic-example/output/Unsafe.Coerce/docs.json1
-rw-r--r--tests/purs/publish/basic-example/output/cache-db.json2
-rw-r--r--tests/purs/publish/basic-example/resolutions-legacy.json640
-rw-r--r--tests/purs/publish/basic-example/resolutions.json6
-rw-r--r--tests/purs/warning/2140.out12
-rw-r--r--tests/purs/warning/2383.out0
-rw-r--r--tests/purs/warning/2411.out11
-rw-r--r--tests/purs/warning/2542.out16
-rw-r--r--tests/purs/warning/CoercibleUnusedImport.out0
-rw-r--r--tests/purs/warning/CoercibleUnusedImport.purs8
-rw-r--r--tests/purs/warning/CoercibleUnusedImport/N1.purs3
-rw-r--r--tests/purs/warning/CoercibleUnusedImport/N2.purs5
-rw-r--r--tests/purs/warning/CoercibleUnusedNewtypeCtorExplicitImport.out0
-rw-r--r--tests/purs/warning/CoercibleUnusedNewtypeCtorExplicitImport.purs7
-rw-r--r--tests/purs/warning/CoercibleUnusedNewtypeCtorExplicitImport/N.purs3
-rw-r--r--tests/purs/warning/CoercibleUnusedNewtypeCtorImplicitImport.out0
-rw-r--r--tests/purs/warning/CoercibleUnusedNewtypeCtorImplicitImport.purs7
-rw-r--r--tests/purs/warning/CoercibleUnusedNewtypeCtorImplicitImport/N.purs3
-rw-r--r--tests/purs/warning/CustomWarning.out14
-rw-r--r--tests/purs/warning/CustomWarning2.out14
-rw-r--r--tests/purs/warning/CustomWarning3.out30
-rw-r--r--tests/purs/warning/CustomWarning4.out60
-rw-r--r--tests/purs/warning/DeprecatedConstraintInForeignImport.js5
-rw-r--r--tests/purs/warning/DeprecatedConstraintInForeignImport.out9
-rw-r--r--tests/purs/warning/DeprecatedConstraintInForeignImport.purs6
-rw-r--r--tests/purs/warning/DeprecatedFFIPrime.js (renamed from tests/purs/passing/2172.js)0
-rw-r--r--tests/purs/warning/DeprecatedFFIPrime.out56
-rw-r--r--tests/purs/warning/DeprecatedFFIPrime.purs10
-rw-r--r--tests/purs/warning/DeprecatedForeignImportKind.out9
-rw-r--r--tests/purs/warning/DeprecatedForeignImportKind.purs4
-rw-r--r--tests/purs/warning/DeprecatedImportExportKinds.out30
-rw-r--r--tests/purs/warning/DeprecatedImportExportKinds.purs8
-rw-r--r--tests/purs/warning/DeprecatedImportExportKinds/Lib.purs5
-rw-r--r--tests/purs/warning/DeprecatedRowKindSyntax.out9
-rw-r--r--tests/purs/warning/DeprecatedRowKindSyntax.purs4
-rw-r--r--tests/purs/warning/DuplicateExportRef.out77
-rw-r--r--tests/purs/warning/DuplicateExportRef.purs4
-rw-r--r--tests/purs/warning/DuplicateImport.out10
-rw-r--r--tests/purs/warning/DuplicateImportRef.out44
-rw-r--r--tests/purs/warning/DuplicateSelectiveImport.out10
-rw-r--r--tests/purs/warning/HiddenConstructorsGeneric.out11
-rw-r--r--tests/purs/warning/HiddenConstructorsGeneric.purs8
-rw-r--r--tests/purs/warning/HiddenConstructorsNewtype.out11
-rw-r--r--tests/purs/warning/HiddenConstructorsNewtype.purs8
-rw-r--r--tests/purs/warning/HidingImport.out28
-rw-r--r--tests/purs/warning/ImplicitImport.out28
-rw-r--r--tests/purs/warning/ImplicitQualifiedImport.out30
-rw-r--r--tests/purs/warning/ImplicitQualifiedImportReExport.out30
-rw-r--r--tests/purs/warning/Kind-UnusedExplicitImport-1.out17
-rw-r--r--tests/purs/warning/Kind-UnusedExplicitImport-1.purs4
-rw-r--r--tests/purs/warning/Kind-UnusedExplicitImport-2.out17
-rw-r--r--tests/purs/warning/Kind-UnusedExplicitImport-2.purs2
-rw-r--r--tests/purs/warning/Kind-UnusedImport.out10
-rw-r--r--tests/purs/warning/Kind-UnusedImport.purs2
-rw-r--r--tests/purs/warning/KindReExport.out0
-rw-r--r--tests/purs/warning/KindReExport.purs2
-rw-r--r--tests/purs/warning/MissingKindDeclaration.out64
-rw-r--r--tests/purs/warning/MissingKindDeclaration.purs13
-rw-r--r--tests/purs/warning/MissingTypeDeclaration.out16
-rw-r--r--tests/purs/warning/NewtypeInstance.out13
-rw-r--r--tests/purs/warning/NewtypeInstance2.out14
-rw-r--r--tests/purs/warning/NewtypeInstance3.out14
-rw-r--r--tests/purs/warning/NewtypeInstance4.out14
-rw-r--r--tests/purs/warning/OverlappingPattern.out28
-rw-r--r--tests/purs/warning/ScopeShadowing.out14
-rw-r--r--tests/purs/warning/ScopeShadowing2.out14
-rw-r--r--tests/purs/warning/ShadowedBinderPatternGuard.out11
-rw-r--r--tests/purs/warning/ShadowedNameParens.out11
-rw-r--r--tests/purs/warning/ShadowedTypeVar.out11
-rw-r--r--tests/purs/warning/UnambiguousQuantifiedKind.out16
-rw-r--r--tests/purs/warning/UnambiguousQuantifiedKind.purs12
-rw-r--r--tests/purs/warning/UnnecessaryFFIModule.out13
-rw-r--r--tests/purs/warning/UnusedDctorExplicitImport.out17
-rw-r--r--tests/purs/warning/UnusedDctorImportAll.out14
-rw-r--r--tests/purs/warning/UnusedDctorImportExplicit.out14
-rw-r--r--tests/purs/warning/UnusedExplicitImport.out17
-rw-r--r--tests/purs/warning/UnusedExplicitImportTypeOp.out17
-rw-r--r--tests/purs/warning/UnusedExplicitImportTypeOp/Lib.purs1
-rw-r--r--tests/purs/warning/UnusedExplicitImportValOp.out17
-rw-r--r--tests/purs/warning/UnusedFFIImplementations.out12
-rw-r--r--tests/purs/warning/UnusedImport.out22
-rw-r--r--tests/purs/warning/UnusedTypeVar.out11
-rw-r--r--tests/purs/warning/WildcardInferredType.out30
-rw-r--r--tests/purs/warning/WildcardInferredType2.out14
-rw-r--r--tests/support/bower.json21
-rw-r--r--tests/support/package-lock.json402
-rw-r--r--tests/support/pscide/src/CompletionSpec.purs18
811 files changed, 13621 insertions, 12067 deletions
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
index dc455d6..a89f39e 100644
--- a/CONTRIBUTING.md
+++ b/CONTRIBUTING.md
@@ -1,50 +1,55 @@
+# Contributing to the PureScript Compiler
+
+## Reporting Issues
+
+When reporting issues, please be aware of the following:
+
+* Please use the appropriate issue template if there is one: filling out all of the sections in the template makes it much easier for us to understand what the problem is and how we might want to address it.
+* We prefer to reserve the issue tracker in this repository for tasks which involve work on the compiler. If your report or proposal doesn't involve work on the compiler, please open it on the repository where the work would be done. If you're unsure, you can always ask in [the #purescript channel in FP Slack][] or [Discourse][].
+* If you have a question or need help, please ask in [the #purescript channel in FP Slack][] or [Discourse][] instead.
+* When submitting feature proposals, please be aware that we prefer to be conservative about adding things to the language/compiler. A feature proposal is much more likely to be accepted if it includes a clear description of the problem it intends to solve, as well as not only a strong justification for why adding the feature will solve that problem, but also for why any existing features or techniques that could be used to solve that problem are insufficient.
+
+We have defined some [Project Values](https://github.com/purescript/governance#project-values) in our organization's governance document; referring to these may help you get a better idea of what is likely to be accepted and what isn't.
+
+## Sending Pull Requests
+
Pull requests are encouraged, but please open issues before starting to work on something that you intend to make into a PR, so that we can decide if it is a good fit or not.
-## Finding Issues to Work On
+### Finding Issues to Work On
If you would like to contribute, please consider the issues in the current milestone first. If you are a new contributor, you may want to have a go at the ["new contributor" issues](https://github.com/purescript/purescript/labels/new%20contributor) to get started.
-## Pull Requests
+### Submitting Your Code
-Please follow the following guidelines:
+When submitting a pull request, please follow the following guidelines:
- Add at least a test to `tests/purs/passing/` and possibly to `tests/purs/failing/`.
- Build the binaries and libs with `stack build`
- Make sure that all test suites are passing. Run the test suites with `stack test`.
-- Build the core libraries by running the script in `core-tests`.
+- Please try to keep changes small and isolated: smaller pull requests which only address one issue are much easier to review.
+- For any code change, please append a copyright and licensing notice to the [CONTRIBUTORS.md](CONTRIBUTORS.md) file if your name is not in there already.
-## Tests
+### Running Tests
Run all test suites with `stack test`. You will need `npm`, `bower` and `node` on your PATH to run the tests.
-You can run individual test suites using `stack test --test-arguments="-p
-PATTERN"` where `PATTERN` is one of `compiler`, `repl`, `ide`, `docs`, `corefn`,
-or `hierarchy`.
-
-To build and run a specific test in `tests/purs/passing/` or `tests/purs/failing/`, add test arguments like so:
+You can run individual test suites using `stack test --test-arguments="-p PATTERN"` where `PATTERN` is one of `compiler`, `repl`, `ide`, `docs`, `corefn`, or `hierarchy`. You can also build and run a specific test in `tests/purs/passing/` or `tests/purs/failing/` by using the test's filename as the pattern, e.g.:
-`stack test --fast --test-arguments="-p 1110.purs"`
+```
+stack test --fast --test-arguments="-p 1110.purs"
+```
This will run whatever test uses the example file `1110.purs`.
-## Code Review
-
-To prevent core libraries from getting broken, every change must be reviewed. A pull request will be merged as long as one other team member has verified the changes.
-
-## Adding Dependencies
-
-Because the PureScript compiler is distributed in binary form, we include
-the licenses of all dependencies, including transitive ones, in the LICENSE
-file. Therefore, whenever the dependencies change, the LICENSE file should be
-updated.
+### Adding Dependencies
-This can be automated; see the `license-generator/generate.hs` file.
+Because the PureScript compiler is distributed in binary form, we include the licenses of all dependencies, including transitive ones, in the LICENSE file. Therefore, whenever the dependencies change, the LICENSE file should be updated.
-## Writing Issues
+This process can be performed automatically by running `make license-generator`.
-- If the issue is actually a question, please consider asking on Reddit, Stack Overflow or IRC first.
-- Please include a minimal, repeatable test case with any bug report.
+### Getting Pull Requests Merged
-## Copyright and Licensing
+Sometimes pull requests take a little while to be merged. This is partially because they often have knock-on effects for the rest of the ecosystem, and partially because we want to give core team members time to review and consider changes thoroughly. Please see the organization's [governance document](https://github.com/purescript/governance) for information about when a pull request may be merged.
-For any code change, please append a copyright and licensing notice to the [CONTRIBUTORS.md](CONTRIBUTORS.md) file.
+[the #purescript channel in FP Slack]: https://functionalprogramming.slack.com/
+[Discourse]: https://discourse.purescript.org/
diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md
index 42f8195..81053e8 100644
--- a/CONTRIBUTORS.md
+++ b/CONTRIBUTORS.md
@@ -21,6 +21,7 @@ If you would prefer to use different terms, please use the section below instead
| [@andyarvanitis](https://github.com/andyarvanitis) | Andy Arvanitis | [MIT license](http://opensource.org/licenses/MIT) |
| [@anthok88](https://github.com/anthok88) | anthoq88 | MIT license |
| [@ardumont](https://github.com/ardumont) | Antoine R. Dumont | [MIT license](http://opensource.org/licenses/MIT) |
+| [@arrowd](https://github.com/arrowd) | Gleb Popov | [MIT license](http://opensource.org/licenses/MIT) |
| [@aspidites](https://github.com/aspidites) | Edwin Marshall | [MIT license](http://opensource.org/licenses/MIT) |
| [@bagl](https://github.com/bagl) | Petr Vapenka | [MIT license](http://opensource.org/licenses/MIT) |
| [@balajirrao](https://github.com/balajirrao) | Balaji Rao | MIT license |
@@ -50,6 +51,7 @@ If you would prefer to use different terms, please use the section below instead
| [@fehrenbach](https://github.com/fehrenbach) | Stefan Fehrenbach | [MIT license](http://opensource.org/licenses/MIT) |
| [@felixSchl](https://github.com/felixSchl) | Felix Schlitter | [MIT license](http://opensource.org/licenses/MIT) |
| [@FrigoEU](https://github.com/FrigoEU) | Simon Van Casteren | [MIT license](http://opensource.org/licenses/MIT) |
+| [@fsoikin](https://github.com/fsoikin) | Fyodor Soikin | [MIT license](http://opensource.org/licenses/MIT) |
| [@garyb](https://github.com/garyb) | Gary Burgess | [MIT license](http://opensource.org/licenses/MIT) |
| [@hdgarrood](https://github.com/hdgarrood) | Harry Garrood | [MIT license](http://opensource.org/licenses/MIT) |
| [@houli](https://github.com/houli) | Eoin Houlihan | [MIT license](http://opensource.org/licenses/MIT) |
@@ -67,6 +69,7 @@ If you would prefer to use different terms, please use the section below instead
| [@legrostdg](https://github.com/legrostdg) | Félix Sipma | [MIT license](http://opensource.org/licenses/MIT) |
| [@LiamGoodacre](https://github.com/LiamGoodacre) | Liam Goodacre | [MIT license](http://opensource.org/licenses/MIT) |
| [@lukerandall](https://github.com/lukerandall) | Luke Randall | [MIT license](http://opensource.org/licenses/MIT) |
+| [@lunaris](https://github.com/lunaris) | Will Jones | [MIT license](http://opensource.org/licenses/MIT) |
| [@matthewleon](https://github.com/matthewleon) | Matthew Leon | [MIT license](http://opensource.org/licenses/MIT) |
| [@mcoffin](https://github.com/mcoffin) | Matt Coffin | [MIT license](http://opensource.org/licenses/MIT) |
| [@mhcurylo](https://github.com/mhcurylo) | Mateusz Curylo | [MIT license](http://opensource.org/licenses/MIT) |
@@ -75,6 +78,7 @@ If you would prefer to use different terms, please use the section below instead
| [@mgmeier](https://github.com/mgmeier) | Michael Gilliland | [MIT license](http://opensource.org/licenses/MIT) |
| [@michaelficarra](https://github.com/michaelficarra) | Michael Ficarra | [MIT license](http://opensource.org/licenses/MIT) |
| [@MichaelXavier](https://github.com/MichaelXavier) | Michael Xavier | MIT license |
+| [@milesfrain](https://github.com/milesfrain) | Miles Frain | [MIT license](http://opensource.org/licenses/MIT) |
| [@mjgpy3](https://github.com/mjgpy3) | Michael Gilliland | [MIT license](http://opensource.org/licenses/MIT) |
| [@mpietrzak](https://github.com/mpietrzak) | Maciej Pietrzak | [MIT license](http://opensource.org/licenses/MIT) |
| [@mrhania](https://github.com/mrhania) | Łukasz Hanuszczak | [MIT license](http://opensource.org/licenses/MIT) |
@@ -137,6 +141,8 @@ If you would prefer to use different terms, please use the section below instead
| [@marcosh](https://github.com/marcosh) | Marco Perone | [MIT license](http://opensource.org/licenses/MIT) |
| [@matthew-hilty](https://github.com/matthew-hilty) | Matthew Hilty | [MIT license](http://opensource.org/licenses/MIT) |
| [@woody88](https://github.com/woody88) | Woodson Delhia | [MIT license](http://opensource.org/licenses/MIT) |
+| [@mhmdanas](https://github.com/mhmdanas) | Mohammed Anas | [MIT license](http://opensource.org/licenses/MIT) |
+| [@kl0tl](https://github.com/kl0tl) | Cyril Sobierajewicz | [MIT license](http://opensource.org/licenses/MIT) |
### Contributors using Modified Terms
@@ -144,6 +150,7 @@ If you would prefer to use different terms, please use the section below instead
| :------- | :--- | :------ |
| [@charleso](https://github.com/charleso) | Charles O'Farrell | My existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright Charles O'Farrell, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). |
| [@chrissmoak](https://github.com/chrissmoak) | Chris Smoak | My existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright Chris Smoak, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). |
+| [@citizengabe](https://github.com/citizengabe) | Gabe Johnson | All contributions I have or will make using the @citizengabe GitHub account are during employment at [CitizenNet Inc.](#companies) who owns the copyright. All of my existing or future contributions made using the @gabejohnson GitHub account are personal contributions and subject to the terms specified [above](#contributors-using-standard-terms). |
| [@dylex](https://github.com/dylex) | Dylan Simon | My existing and all future contributions to the PureScript compiler until further notice are Copyright Dylan Simon, and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). |
| [@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). |
| [@nagisa](https://github.com/nagisa) | nagisa | I hereby release my [only contribution](https://github.com/purescript/purescript/commit/80287a5d0de619862d3b4cda9c1ee276d18fdcd8) into public domain. |
@@ -153,5 +160,6 @@ If you would prefer to use different terms, please use the section below instead
| Username | Company | Terms |
| :------- | :--- | :------ |
+| [@citizennet](https://github.com/citizennet) | CitizenNet Inc. | Our existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright CitizenNet Inc., and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). - [@dbenyamin-cn](https://github.com/dbenyamin-cn) |
| [@slamdata](https://github.com/slamdata) | SlamData, Inc. | Speaking on behalf of SlamData for SlamData employees, our existing contributions and all future contributions to the PureScript compiler are, until further notice, Copyright SlamData Inc., and are licensed to the owners and users of the PureScript compiler project under the terms of the [MIT license](http://opensource.org/licenses/MIT). - @jdegoes |
| [@qfpl](https://github.com/qfpl) | qfpl @ Data61 / CSIRO | Our existing contributions to the PureScript compiler and all future contributions to the PureScript compiler until further notice, are Copyright Data61 / CSIRO, 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). - [@lightandlight](https://github.com/lightandlight) |
diff --git a/INSTALL.md b/INSTALL.md
index 7b4fe9f..32f6248 100644
--- a/INSTALL.md
+++ b/INSTALL.md
@@ -15,7 +15,7 @@ See also <https://www.haskell.org/ghc/download_ghc_8_6_4.html> for more details
## Official prebuilt binaries
-Each release comes with prebuilt x86-64 binary bundles for Linux, mac OS, and Windows. Users of other operating systems or architectures will likely need to build the compiler from source; see below.
+Each [release](https://github.com/purescript/purescript/releases) comes with prebuilt x86-64 binary bundles for Linux, mac OS, and Windows. Users of other operating systems or architectures will likely need to build the compiler from source; see below.
To install a binary bundle, simply extract it and place the `purs` executable somewhere on your PATH.
@@ -46,11 +46,23 @@ If you don't have stack installed, please see the [stack install documentation](
The PureScript REPL depends on the `curses` library (via the Haskell package
`terminfo`). If you are having difficulty running the compiler, it may be
-because the `curses` library is missing.
+because the `curses` library is missing. This problem may appear as a `libtinfo`
+error:
+```
+error while loading shared libraries: libtinfo.so.5: cannot open shared object file: No such file or directory
+```
On Linux, you will probably need to install `ncurses` manually. On Ubuntu, for
example, this can be done by running:
+```
+$ sudo apt install libtinfo5 libncurses5-dev
+```
+
+## EACCES error
+If you encounter this error while trying to install via `npm`:
```
-$ sudo apt-get install libncurses5-dev
+Error: EACCES: permission denied
```
+
+The best solution is to install [Node.js and npm via a node version manager](https://docs.npmjs.com/downloading-and-installing-node-js-and-npm#using-a-node-version-manager-to-install-nodejs-and-npm). This error is due to permissions issues when installing packages globally. You can read more about this error in npm's guide to [resolving EACCES permissions errors when installing packages globally](https://docs.npmjs.com/getting-started/fixing-npm-permissions).
diff --git a/LICENSE b/LICENSE
index 0c3e490..bc9cfd2 100644
--- a/LICENSE
+++ b/LICENSE
@@ -48,6 +48,7 @@ PureScript uses the following Haskell library packages. Their license files foll
cabal-doctest
case-insensitive
cborg
+ cereal
cheapskate
clock
colour
@@ -72,7 +73,6 @@ PureScript uses the following Haskell library packages. Their license files foll
dlist
easy-file
edit-distance
- enclosed-exceptions
entropy
exceptions
fast-logger
@@ -85,7 +85,7 @@ PureScript uses the following Haskell library packages. Their license files foll
happy
hashable
haskeline
- hinotify
+ hfsevents
http-date
http-types
http2
@@ -122,6 +122,8 @@ PureScript uses the following Haskell library packages. Their license files foll
process
protolude
psqueues
+ purescript-ast
+ purescript-cst
random
regex-base
regex-tdfa
@@ -132,7 +134,6 @@ PureScript uses the following Haskell library packages. Their license files foll
semigroupoids
semigroups
serialise
- shelly
simple-sendfile
sourcemap
split
@@ -141,8 +142,6 @@ PureScript uses the following Haskell library packages. Their license files foll
streaming-commons
stringsearch
syb
- system-fileio
- system-filepath
tagged
tagsoup
template-haskell
@@ -1334,6 +1333,39 @@ cborg LICENSE file:
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+cereal LICENSE file:
+
+ Copyright (c) Lennart Kolmodin, Galois, Inc.
+
+ All rights reserved.
+
+ Redistribution and use in source and binary forms, with or without
+ modification, are permitted provided that the following conditions
+ are met:
+
+ 1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ 2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+ 3. Neither the name of the author nor the names of his contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+ THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+ OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+ DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+ STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ POSSIBILITY OF SUCH DAMAGE.
+
cheapskate LICENSE file:
Copyright (c) 2013, John MacFarlane
@@ -2060,29 +2092,6 @@ edit-distance LICENSE file:
IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-enclosed-exceptions LICENSE file:
-
- Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/
-
- Permission is hereby granted, free of charge, to any person obtaining
- a copy of this software and associated documentation files (the
- "Software"), to deal in the Software without restriction, including
- without limitation the rights to use, copy, modify, merge, publish,
- distribute, sublicense, and/or sell copies of the Software, and to
- permit persons to whom the Software is furnished to do so, subject to
- the following conditions:
-
- The above copyright notice and this permission notice shall be
- included in all copies or substantial portions of the Software.
-
- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
- LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
- OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
- WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-
entropy LICENSE file:
Copyright (c) Thomas DuBuisson
@@ -2496,38 +2505,38 @@ haskeline LICENSE file:
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-hinotify LICENSE file:
+hfsevents LICENSE file:
- Copyright (c) Lennart Kolmodin
+ Copyright (c) 2012, Luite Stegeman
All rights reserved.
Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions
- are met:
+ modification, are permitted provided that the following conditions are met:
- 1. Redistributions of source code must retain the above copyright
- notice, this list of conditions and the following disclaimer.
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
- 2. Redistributions in binary form must reproduce the above copyright
- notice, this list of conditions and the following disclaimer in the
- documentation and/or other materials provided with the distribution.
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
- 3. Neither the name of the author nor the names of his contributors
- may be used to endorse or promote products derived from this software
- without specific prior written permission.
+ * Neither the name of Luite Stegeman nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
- THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
- OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
- DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
- ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
- POSSIBILITY OF SUCH DAMAGE.
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
http-date LICENSE file:
@@ -4048,39 +4057,6 @@ serialise LICENSE file:
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-shelly LICENSE file:
-
- Copyright (c) 2017, Petr Rockai <me@mornfall.net>
-
- All rights reserved.
-
- Redistribution and use in source and binary forms, with or without
- modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright
- notice, this list of conditions and the following disclaimer.
-
- * Redistributions in binary form must reproduce the above
- copyright notice, this list of conditions and the following
- disclaimer in the documentation and/or other materials provided
- with the distribution.
-
- * Neither the name of Petr Rockai nor the names of other
- contributors may be used to endorse or promote products derived
- from this software without specific prior written permission.
-
- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
simple-sendfile LICENSE file:
Copyright (c) 2009, IIJ Innovation Institute Inc.
@@ -4391,56 +4367,6 @@ syb LICENSE file:
-----------------------------------------------------------------------------
-system-fileio LICENSE file:
-
- Copyright (c) 2011 John Millikin
-
- Permission is hereby granted, free of charge, to any person
- obtaining a copy of this software and associated documentation
- files (the "Software"), to deal in the Software without
- restriction, including without limitation the rights to use,
- copy, modify, merge, publish, distribute, sublicense, and/or sell
- copies of the Software, and to permit persons to whom the
- Software is furnished to do so, subject to the following
- conditions:
-
- The above copyright notice and this permission notice shall be
- included in all copies or substantial portions of the Software.
-
- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
- OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
- HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
- WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
- FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
- OTHER DEALINGS IN THE SOFTWARE.
-
-system-filepath LICENSE file:
-
- Copyright (c) 2010 John Millikin
-
- Permission is hereby granted, free of charge, to any person
- obtaining a copy of this software and associated documentation
- files (the "Software"), to deal in the Software without
- restriction, including without limitation the rights to use,
- copy, modify, merge, publish, distribute, sublicense, and/or sell
- copies of the Software, and to permit persons to whom the
- Software is furnished to do so, subject to the following
- conditions:
-
- The above copyright notice and this permission notice shall be
- included in all copies or substantial portions of the Software.
-
- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
- OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
- NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
- HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
- WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
- FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
- OTHER DEALINGS IN THE SOFTWARE.
-
tagged LICENSE file:
Copyright (c) 2009-2015 Edward Kmett
diff --git a/README.md b/README.md
index f2239f3..df88303 100644
--- a/README.md
+++ b/README.md
@@ -12,7 +12,7 @@ A small strongly typed programming language with expressive types that compiles
## Resources
-- [PureScript book](https://leanpub.com/purescript/read)
+- [PureScript book](https://book.purescript.org/)
- [Documentation](https://github.com/purescript/documentation)
- [Try PureScript](http://try.purescript.org)
- [Pursuit Package Index](http://pursuit.purescript.org/)
diff --git a/app/Command/Bundle.hs b/app/Command/Bundle.hs
index c030a2b..a06a383 100644
--- a/app/Command/Bundle.hs
+++ b/app/Command/Bundle.hs
@@ -7,6 +7,8 @@
-- | Bundles compiled PureScript modules for the browser.
module Command.Bundle (command) where
+import Prelude
+
import Data.Traversable (for)
import Data.Aeson (encode)
import Data.Aeson.Encode.Pretty (confCompare, defConfig, encodePretty', keyOrder)
diff --git a/app/Command/Compile.hs b/app/Command/Compile.hs
index 9246748..2528957 100644
--- a/app/Command/Compile.hs
+++ b/app/Command/Compile.hs
@@ -5,6 +5,8 @@
module Command.Compile (command) where
+import Prelude
+
import Control.Applicative
import Control.Monad
import qualified Data.Aeson as A
@@ -24,7 +26,7 @@ import qualified System.Console.ANSI as ANSI
import System.Exit (exitSuccess, exitFailure)
import System.Directory (getCurrentDirectory)
import System.FilePath.Glob (glob)
-import System.IO (hPutStr, hPutStrLn, stderr)
+import System.IO (hPutStr, hPutStrLn, stderr, stdout)
import System.IO.UTF8 (readUTF8FilesT)
data PSCMakeOptions = PSCMakeOptions
@@ -39,25 +41,25 @@ data PSCMakeOptions = PSCMakeOptions
printWarningsAndErrors :: Bool -> Bool -> P.MultipleErrors -> Either P.MultipleErrors a -> IO ()
printWarningsAndErrors verbose False warnings errors = do
pwd <- getCurrentDirectory
- cc <- bool Nothing (Just P.defaultCodeColor) <$> ANSI.hSupportsANSI stderr
+ cc <- bool Nothing (Just P.defaultCodeColor) <$> ANSI.hSupportsANSI stdout
let ppeOpts = P.defaultPPEOptions { P.ppeCodeColor = cc, P.ppeFull = verbose, P.ppeRelativeDirectory = pwd }
when (P.nonEmpty warnings) $
- hPutStrLn stderr (P.prettyPrintMultipleWarnings ppeOpts warnings)
+ putStrLn (P.prettyPrintMultipleWarnings ppeOpts warnings)
case errors of
Left errs -> do
- hPutStrLn stderr (P.prettyPrintMultipleErrors ppeOpts errs)
+ putStrLn (P.prettyPrintMultipleErrors ppeOpts errs)
exitFailure
Right _ -> return ()
printWarningsAndErrors verbose True warnings errors = do
- hPutStrLn stderr . LBU8.toString . A.encode $
+ putStrLn . LBU8.toString . A.encode $
JSONResult (toJSONErrors verbose P.Warning warnings)
(either (toJSONErrors verbose P.Error) (const []) errors)
either (const exitFailure) (const (return ())) errors
compile :: PSCMakeOptions -> IO ()
compile PSCMakeOptions{..} = do
- input <- globWarningOnMisses (unless pscmJSONErrors . warnFileTypeNotFound) pscmInput
- when (null input && not pscmJSONErrors) $ do
+ input <- globWarningOnMisses warnFileTypeNotFound pscmInput
+ when (null input) $ do
hPutStr stderr $ unlines [ "purs compile: No input files."
, "Usage: For basic information, try the `--help' option."
]
diff --git a/app/Command/Docs.hs b/app/Command/Docs.hs
index f6bf57c..cd73eda 100644
--- a/app/Command/Docs.hs
+++ b/app/Command/Docs.hs
@@ -1,6 +1,8 @@
module Command.Docs (command, infoModList) where
+import Prelude
+
import Command.Docs.Html
import Command.Docs.Markdown
import Control.Applicative
diff --git a/app/Command/Docs/Html.hs b/app/Command/Docs/Html.hs
index dbb009f..6362837 100644
--- a/app/Command/Docs/Html.hs
+++ b/app/Command/Docs/Html.hs
@@ -8,6 +8,8 @@ module Command.Docs.Html
, writeHtmlModules
) where
+import Prelude
+
import Control.Applicative
import Control.Arrow ((&&&))
import Control.Monad.Writer
diff --git a/app/Command/Docs/Markdown.hs b/app/Command/Docs/Markdown.hs
index 60d5098..73338cb 100644
--- a/app/Command/Docs/Markdown.hs
+++ b/app/Command/Docs/Markdown.hs
@@ -5,6 +5,8 @@ module Command.Docs.Markdown
, writeMarkdownModules
) where
+import Prelude
+
import Data.Text (Text)
import qualified Data.Text as T
import qualified Language.PureScript as P
diff --git a/app/Command/Graph.hs b/app/Command/Graph.hs
index b1bf505..58f26ac 100644
--- a/app/Command/Graph.hs
+++ b/app/Command/Graph.hs
@@ -4,6 +4,8 @@
module Command.Graph (command) where
+import Prelude
+
import Control.Applicative (many)
import Control.Monad (unless, when)
import qualified Data.Aeson as Json
diff --git a/app/Command/Hierarchy.hs b/app/Command/Hierarchy.hs
index 30e8ae8..f732c5f 100644
--- a/app/Command/Hierarchy.hs
+++ b/app/Command/Hierarchy.hs
@@ -17,6 +17,7 @@
module Command.Hierarchy (command) where
+import Prelude
import Protolude (catMaybes)
import Control.Applicative (optional)
@@ -36,14 +37,14 @@ import qualified Language.PureScript.CST as CST
import Language.PureScript.Hierarchy (Graph(..), _unDigraph, _unGraphName, typeClasses)
data HierarchyOptions = HierarchyOptions
- { _hierachyInput :: FilePath
+ { _hierarchyInput :: FilePath
, _hierarchyOutput :: Maybe FilePath
}
parseInput :: [FilePath] -> IO (Either P.MultipleErrors [P.Module])
parseInput paths = do
content <- readUTF8FilesT paths
- return $ map snd <$> CST.parseFromFiles id content
+ return $ map (snd . snd) <$> CST.parseFromFiles id content
compile :: HierarchyOptions -> IO ()
compile (HierarchyOptions inputGlob mOutput) = do
diff --git a/app/Command/Ide.hs b/app/Command/Ide.hs
index 4c50f5e..630a476 100644
--- a/app/Command/Ide.hs
+++ b/app/Command/Ide.hs
@@ -189,7 +189,7 @@ startServer port env = Network.withSocketsDo $ do
Left err -> $(logError) err
Right (cmd, h) -> do
case decodeT cmd of
- Just cmd' -> do
+ Right cmd' -> do
let message duration =
"Command "
<> commandName cmd'
@@ -210,10 +210,11 @@ startServer port env = Network.withSocketsDo $ do
Right r -> Aeson.encode r
Left err -> Aeson.encode err
liftIO (hFlush stdout)
- Nothing -> do
- $(logError) ("Parsing the command failed. Command: " <> cmd)
+ Left err -> do
+ let errMsg = "Parsing the command failed with:\n" <> err <> "\nCommand: " <> cmd
+ $(logError) errMsg
liftIO $ do
- catchGoneHandle (T.hPutStrLn h (encodeT (GeneralError "Error parsing Command.")))
+ catchGoneHandle (T.hPutStrLn h (encodeT (GeneralError errMsg)))
hFlush stdout
liftIO $ catchGoneHandle (hClose h)
diff --git a/app/Command/Publish.hs b/app/Command/Publish.hs
index 43a9f6a..fe5f4c7 100644
--- a/app/Command/Publish.hs
+++ b/app/Command/Publish.hs
@@ -2,6 +2,8 @@
module Command.Publish (command) where
+import Prelude
+
import Control.Monad.IO.Class (liftIO)
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy.Char8 as BL
diff --git a/app/Main.hs b/app/Main.hs
index 4b5b7df..1725274 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -7,6 +7,8 @@
module Main where
+import Prelude
+
import qualified Command.Bundle as Bundle
import qualified Command.Compile as Compile
import qualified Command.Docs as Docs
@@ -27,6 +29,8 @@ main :: IO ()
main = do
IO.hSetEncoding IO.stdout IO.utf8
IO.hSetEncoding IO.stderr IO.utf8
+ IO.hSetBuffering IO.stdout IO.LineBuffering
+ IO.hSetBuffering IO.stderr IO.LineBuffering
cmd <- Opts.handleParseResult . execParserPure opts =<< getArgs
cmd
where
diff --git a/app/Version.hs b/app/Version.hs
index dcf3850..9c2f355 100644
--- a/app/Version.hs
+++ b/app/Version.hs
@@ -3,6 +3,8 @@
module Version where
+import Prelude
+
import Data.Version (showVersion)
import Paths_purescript as Paths
@@ -10,8 +12,15 @@ import Paths_purescript as Paths
import qualified Development.GitRev as GitRev
#endif
+-- Unfortunately, Cabal doesn't support prerelease identifiers on versions. To
+-- avoid misleading users who run `purs --version`, we manually add the
+-- prerelease identifier here (if any). When releasing a proper version, simply
+-- set this to an empty string.
+prerelease :: String
+prerelease = ""
+
versionString :: String
-versionString = showVersion Paths.version ++ extra
+versionString = showVersion Paths.version ++ prerelease ++ extra
where
#ifdef RELEASE
extra = ""
diff --git a/purescript.cabal b/purescript.cabal
index 4137f58..4e68611 100644
--- a/purescript.cabal
+++ b/purescript.cabal
@@ -1,19 +1,24 @@
-cabal-version: 1.12
-name: purescript
-version: 0.13.8
-license: BSD3
-license-file: LICENSE
-copyright: (c) 2013-17 Phil Freeman, (c) 2014-19 Gary Burgess, (c) other contributors (see CONTRIBUTORS.md)
-maintainer: Gary Burgess <gary.burgess@gmail.com>, Hardy Jones <jones3.hardy@gmail.com>, Harry Garrood <harry@garrood.me>, Christoph Hegemann <christoph.hegemann1337@gmail.com>, Liam Goodacre <goodacre.liam@gmail.com>, Nathan Faubion <nathan@n-son.com>
-author: Phil Freeman <paf31@cantab.net>
-stability: experimental
-homepage: http://www.purescript.org/
-bug-reports: https://github.com/purescript/purescript/issues
-synopsis: PureScript Programming Language Compiler
+cabal-version: 1.12
+name: purescript
+version: 0.14.0
+license: BSD3
+license-file: LICENSE
+copyright:
+ (c) 2013-17 Phil Freeman, (c) 2014-19 Gary Burgess, (c) other contributors (see CONTRIBUTORS.md)
+
+maintainer:
+ Gary Burgess <gary.burgess@gmail.com>, Hardy Jones <jones3.hardy@gmail.com>, Harry Garrood <harry@garrood.me>, Christoph Hegemann <christoph.hegemann1337@gmail.com>, Liam Goodacre <goodacre.liam@gmail.com>, Nathan Faubion <nathan@n-son.com>
+
+author: Phil Freeman <paf31@cantab.net>
+stability: experimental
+homepage: http://www.purescript.org/
+bug-reports: https://github.com/purescript/purescript/issues
+synopsis: PureScript Programming Language Compiler
description:
A small strongly, statically typed programming language with expressive types, inspired by Haskell and compiling to JavaScript.
-category: Language
-build-type: Simple
+
+category: Language
+build-type: Simple
extra-source-files:
app/static/index.html
app/static/index.js
@@ -26,11 +31,13 @@ extra-source-files:
tests/purs/bundle/3727.js
tests/purs/bundle/ObjectShorthand.js
tests/purs/failing/MissingFFIImplementations.js
- tests/purs/passing/2172.js
tests/purs/passing/EffFn.js
tests/purs/passing/FunWithFunDeps.js
tests/purs/passing/PolyLabels.js
+ tests/purs/passing/ReExportsExported.js
tests/purs/passing/RowUnion.js
+ tests/purs/warning/DeprecatedConstraintInForeignImport.js
+ tests/purs/warning/DeprecatedFFIPrime.js
tests/purs/warning/UnnecessaryFFIModule.js
tests/purs/warning/UnusedFFIImplementations.js
tests/purs/bundle/3551.purs
@@ -94,6 +101,9 @@ extra-source-files:
tests/purs/failing/1733/Thingy.purs
tests/purs/failing/1825.purs
tests/purs/failing/1881.purs
+ tests/purs/failing/2109-bind.purs
+ tests/purs/failing/2109-discard.purs
+ tests/purs/failing/2109-negate.purs
tests/purs/failing/2128-class.purs
tests/purs/failing/2128-instance.purs
tests/purs/failing/2197-shouldFail.purs
@@ -113,6 +123,7 @@ extra-source-files:
tests/purs/failing/2874-forall2.purs
tests/purs/failing/2874-wildcard.purs
tests/purs/failing/2947.purs
+ tests/purs/failing/3077.purs
tests/purs/failing/3132.purs
tests/purs/failing/3275-BindingGroupErrorPos.purs
tests/purs/failing/3275-DataBindingGroupErrorPos.purs
@@ -137,6 +148,40 @@ extra-source-files:
tests/purs/failing/CannotDeriveNewtypeForData.purs
tests/purs/failing/CaseBinderLengthsDiffer.purs
tests/purs/failing/CaseDoesNotMatchAllConstructorArgs.purs
+ tests/purs/failing/CoercibleClosedRowsDoNotUnify.purs
+ tests/purs/failing/CoercibleConstrained1.purs
+ tests/purs/failing/CoercibleConstrained2.purs
+ tests/purs/failing/CoercibleConstrained3.purs
+ tests/purs/failing/CoercibleForeign.purs
+ tests/purs/failing/CoercibleForeign2.purs
+ tests/purs/failing/CoercibleForeign3.purs
+ tests/purs/failing/CoercibleHigherKindedData.purs
+ tests/purs/failing/CoercibleHigherKindedNewtypes.purs
+ tests/purs/failing/CoercibleKindMismatch.purs
+ tests/purs/failing/CoercibleNominal.purs
+ tests/purs/failing/CoercibleNominalTypeApp.purs
+ tests/purs/failing/CoercibleNominalWrapped.purs
+ tests/purs/failing/CoercibleNonCanonical1.purs
+ tests/purs/failing/CoercibleNonCanonical2.purs
+ tests/purs/failing/CoercibleOpenRowsDoNotUnify.purs
+ tests/purs/failing/CoercibleRepresentational.purs
+ tests/purs/failing/CoercibleRepresentational2.purs
+ tests/purs/failing/CoercibleRepresentational3.purs
+ tests/purs/failing/CoercibleRepresentational4.purs
+ tests/purs/failing/CoercibleRepresentational5.purs
+ tests/purs/failing/CoercibleRepresentational6.purs
+ tests/purs/failing/CoercibleRepresentational6/N.purs
+ tests/purs/failing/CoercibleRepresentational7.purs
+ tests/purs/failing/CoercibleRepresentational7/N.purs
+ tests/purs/failing/CoercibleRepresentational8.purs
+ tests/purs/failing/CoercibleRepresentational8/UnsafeCoerce.purs
+ tests/purs/failing/CoercibleRoleMismatch1.purs
+ tests/purs/failing/CoercibleRoleMismatch2.purs
+ tests/purs/failing/CoercibleRoleMismatch3.purs
+ tests/purs/failing/CoercibleRoleMismatch4.purs
+ tests/purs/failing/CoercibleRoleMismatch5.purs
+ tests/purs/failing/CoercibleUnknownRowTail1.purs
+ tests/purs/failing/CoercibleUnknownRowTail2.purs
tests/purs/failing/ConflictingExports.purs
tests/purs/failing/ConflictingExports/A.purs
tests/purs/failing/ConflictingExports/B.purs
@@ -154,6 +199,8 @@ extra-source-files:
tests/purs/failing/ConflictingQualifiedImports2/B.purs
tests/purs/failing/ConstraintFailure.purs
tests/purs/failing/ConstraintInference.purs
+ tests/purs/failing/CycleInForeignDataKinds.purs
+ tests/purs/failing/CycleInKindDeclaration.purs
tests/purs/failing/DctorOperatorAliasExport.purs
tests/purs/failing/DeclConflictClassCtor.purs
tests/purs/failing/DeclConflictClassSynonym.purs
@@ -177,6 +224,7 @@ extra-source-files:
tests/purs/failing/DuplicateModule.purs
tests/purs/failing/DuplicateModule/M1.purs
tests/purs/failing/DuplicateProperties.purs
+ tests/purs/failing/DuplicateRoleDeclaration.purs
tests/purs/failing/DuplicateTypeClass.purs
tests/purs/failing/DuplicateTypeVars.purs
tests/purs/failing/EmptyCase.purs
@@ -236,8 +284,10 @@ extra-source-files:
tests/purs/failing/InstanceSigsIncorrectType.purs
tests/purs/failing/InstanceSigsOrphanTypeDeclaration.purs
tests/purs/failing/IntOutOfRange.purs
+ tests/purs/failing/InvalidCoercibleInstanceDeclaration.purs
tests/purs/failing/InvalidDerivedInstance.purs
tests/purs/failing/InvalidDerivedInstance2.purs
+ tests/purs/failing/InvalidDerivedInstance3.purs
tests/purs/failing/InvalidOperatorInBinder.purs
tests/purs/failing/KindError.purs
tests/purs/failing/KindStar.purs
@@ -255,6 +305,7 @@ extra-source-files:
tests/purs/failing/MissingFFIImplementations.purs
tests/purs/failing/MissingRecordField.purs
tests/purs/failing/MixedAssociativityError.purs
+ tests/purs/failing/MonoKindDataBindingGroup.purs
tests/purs/failing/MPTCs.purs
tests/purs/failing/MultipleErrors.purs
tests/purs/failing/MultipleErrors2.purs
@@ -286,6 +337,11 @@ extra-source-files:
tests/purs/failing/OrphanInstanceNullary/Lib.purs
tests/purs/failing/OrphanInstanceWithDetermined.purs
tests/purs/failing/OrphanInstanceWithDetermined/Lib.purs
+ tests/purs/failing/OrphanKindDeclaration1.purs
+ tests/purs/failing/OrphanKindDeclaration2.purs
+ tests/purs/failing/OrphanRoleDeclaration1.purs
+ tests/purs/failing/OrphanRoleDeclaration2.purs
+ tests/purs/failing/OrphanRoleDeclaration3.purs
tests/purs/failing/OrphanTypeDecl.purs
tests/purs/failing/OverlapAcrossModules.purs
tests/purs/failing/OverlapAcrossModules/Class.purs
@@ -294,6 +350,11 @@ extra-source-files:
tests/purs/failing/OverlappingBinders.purs
tests/purs/failing/OverlappingInstances.purs
tests/purs/failing/OverlappingVars.purs
+ tests/purs/failing/PolykindGeneralizationLet.purs
+ tests/purs/failing/PolykindInstanceOverlapping.purs
+ tests/purs/failing/PolykindInstantiatedInstance.purs
+ tests/purs/failing/PolykindInstantiation.purs
+ tests/purs/failing/PossiblyInfiniteCoercibleInstance.purs
tests/purs/failing/PrimModuleReserved.purs
tests/purs/failing/PrimModuleReserved/Prim.purs
tests/purs/failing/PrimRow.purs
@@ -301,9 +362,17 @@ extra-source-files:
tests/purs/failing/PrimSubModuleReserved/Prim_Foobar.purs
tests/purs/failing/ProgrammableTypeErrors.purs
tests/purs/failing/ProgrammableTypeErrorsTypeString.purs
+ tests/purs/failing/QualifiedOperators.purs
+ tests/purs/failing/QualifiedOperators2.purs
+ tests/purs/failing/QuantificationCheckFailure.purs
+ tests/purs/failing/QuantificationCheckFailure2.purs
+ tests/purs/failing/QuantificationCheckFailure3.purs
+ tests/purs/failing/QuantifiedKind.purs
tests/purs/failing/Rank2Types.purs
tests/purs/failing/RequiredHiddenType.purs
tests/purs/failing/Reserved.purs
+ tests/purs/failing/RoleDeclarationArityMismatch.purs
+ tests/purs/failing/RoleDeclarationArityMismatchForeign.purs
tests/purs/failing/RowConstructors1.purs
tests/purs/failing/RowConstructors2.purs
tests/purs/failing/RowConstructors3.purs
@@ -311,10 +380,17 @@ extra-source-files:
tests/purs/failing/RowInInstanceNotDetermined1.purs
tests/purs/failing/RowInInstanceNotDetermined2.purs
tests/purs/failing/RowLacks.purs
+ tests/purs/failing/RowsInKinds.purs
+ tests/purs/failing/ScopedKindVariableSynonym.purs
tests/purs/failing/SelfImport.purs
tests/purs/failing/SelfImport/Dummy.purs
tests/purs/failing/SkolemEscape.purs
tests/purs/failing/SkolemEscape2.purs
+ tests/purs/failing/SkolemEscapeKinds.purs
+ tests/purs/failing/StandaloneKindSignatures1.purs
+ tests/purs/failing/StandaloneKindSignatures2.purs
+ tests/purs/failing/StandaloneKindSignatures3.purs
+ tests/purs/failing/StandaloneKindSignatures4.purs
tests/purs/failing/SuggestComposition.purs
tests/purs/failing/Superclasses1.purs
tests/purs/failing/Superclasses2.purs
@@ -323,6 +399,7 @@ extra-source-files:
tests/purs/failing/TooFewClassInstanceArgs.purs
tests/purs/failing/TopLevelCaseNoArgs.purs
tests/purs/failing/TransitiveDctorExport.purs
+ tests/purs/failing/TransitiveDctorExportError.purs
tests/purs/failing/TransitiveKindExport.purs
tests/purs/failing/TransitiveSynonymExport.purs
tests/purs/failing/TypeClasses2.purs
@@ -333,35 +410,29 @@ extra-source-files:
tests/purs/failing/TypedHole2.purs
tests/purs/failing/TypeError.purs
tests/purs/failing/TypeOperatorAliasNoExport.purs
+ tests/purs/failing/TypeSynonymCycle.purs
tests/purs/failing/TypeSynonyms.purs
- tests/purs/failing/TypeSynonyms2.purs
- tests/purs/failing/TypeSynonyms3.purs
tests/purs/failing/TypeSynonyms4.purs
tests/purs/failing/TypeSynonyms5.purs
+ tests/purs/failing/TypeSynonyms7.purs
+ tests/purs/failing/TypeSynonymsOverlappingInstance.purs
tests/purs/failing/TypeWildcards1.purs
tests/purs/failing/TypeWildcards2.purs
tests/purs/failing/TypeWildcards3.purs
+ tests/purs/failing/TypeWildcards4.purs
tests/purs/failing/UnderscoreModuleName.purs
tests/purs/failing/UnknownType.purs
+ tests/purs/failing/UnsupportedRoleDeclarationTypeClass.purs
+ tests/purs/failing/UnsupportedRoleDeclarationTypeSynonym.purs
+ tests/purs/failing/UnsupportedTypeInKind.purs
tests/purs/failing/UnusableTypeClassMethod.purs
tests/purs/failing/UnusableTypeClassMethodConflictingIdent.purs
tests/purs/failing/UnusableTypeClassMethodSynonym.purs
tests/purs/failing/Whitespace1.purs
tests/purs/graph/src/Module.purs
tests/purs/graph/src/Module2.purs
+ tests/purs/graph/src/Module3.purs
tests/purs/graph/src/ModuleFailing.purs
- tests/purs/layout/AdoIn.purs
- tests/purs/layout/CaseGuards.purs
- tests/purs/layout/CaseWhere.purs
- tests/purs/layout/ClassHead.purs
- tests/purs/layout/Commas.purs
- tests/purs/layout/Delimiter.purs
- tests/purs/layout/DoLet.purs
- tests/purs/layout/DoOperator.purs
- tests/purs/layout/DoWhere.purs
- tests/purs/layout/IfThenElseDo.purs
- tests/purs/layout/InstanceChainElse.purs
- tests/purs/layout/LetGuards.purs
tests/purs/make/Module.purs
tests/purs/passing/1110.purs
tests/purs/passing/1185.purs
@@ -379,7 +450,6 @@ extra-source-files:
tests/purs/passing/2136.purs
tests/purs/passing/2138.purs
tests/purs/passing/2138/Lib.purs
- tests/purs/passing/2172.purs
tests/purs/passing/2197-1.purs
tests/purs/passing/2197-2.purs
tests/purs/passing/2252.purs
@@ -411,6 +481,7 @@ extra-source-files:
tests/purs/passing/3549.purs
tests/purs/passing/3558-UpToDateDictsForHigherOrderFns.purs
tests/purs/passing/3595.purs
+ tests/purs/passing/3830.purs
tests/purs/passing/652.purs
tests/purs/passing/810.purs
tests/purs/passing/862.purs
@@ -425,6 +496,7 @@ extra-source-files:
tests/purs/passing/BindersInFunctions.purs
tests/purs/passing/BindingGroups.purs
tests/purs/passing/BlockString.purs
+ tests/purs/passing/BlockStringEdgeCases.purs
tests/purs/passing/CaseInDo.purs
tests/purs/passing/CaseInputWildcard.purs
tests/purs/passing/CaseMultipleExpressions.purs
@@ -435,6 +507,9 @@ extra-source-files:
tests/purs/passing/Church.purs
tests/purs/passing/ClassRefSyntax.purs
tests/purs/passing/ClassRefSyntax/Lib.purs
+ tests/purs/passing/Coercible.purs
+ tests/purs/passing/Coercible/Lib.purs
+ tests/purs/passing/Coercible/Lib2.purs
tests/purs/passing/Collatz.purs
tests/purs/passing/Comparisons.purs
tests/purs/passing/Conditional.purs
@@ -481,6 +556,7 @@ extra-source-files:
tests/purs/passing/FieldConsPuns.purs
tests/purs/passing/FieldPuns.purs
tests/purs/passing/FinalTagless.purs
+ tests/purs/passing/ForeignDataInKind.purs
tests/purs/passing/ForeignKind.purs
tests/purs/passing/ForeignKind/Lib.purs
tests/purs/passing/FunctionalDependencies.purs
@@ -515,6 +591,7 @@ extra-source-files:
tests/purs/passing/iota.purs
tests/purs/passing/JSReserved.purs
tests/purs/passing/KindedType.purs
+ tests/purs/passing/KindUnificationInSolver.purs
tests/purs/passing/LargeSumType.purs
tests/purs/passing/Let.purs
tests/purs/passing/Let2.purs
@@ -522,6 +599,7 @@ extra-source-files:
tests/purs/passing/LetPattern.purs
tests/purs/passing/LiberalTypeSynonyms.purs
tests/purs/passing/Match.purs
+ tests/purs/passing/MinusConstructor.purs
tests/purs/passing/Module.purs
tests/purs/passing/Module/M1.purs
tests/purs/passing/Module/M2.purs
@@ -601,6 +679,15 @@ extra-source-files:
tests/purs/passing/PendingConflictingImports2.purs
tests/purs/passing/PendingConflictingImports2/A.purs
tests/purs/passing/Person.purs
+ tests/purs/passing/PolykindBindingGroup1.purs
+ tests/purs/passing/PolykindBindingGroup2.purs
+ tests/purs/passing/PolykindGeneralization.purs
+ tests/purs/passing/PolykindGeneralizationHygiene.purs
+ tests/purs/passing/PolykindGeneralizedTypeSynonym.purs
+ tests/purs/passing/PolykindInstanceDispatch.purs
+ tests/purs/passing/PolykindInstantiatedInstance.purs
+ tests/purs/passing/PolykindInstantiation.purs
+ tests/purs/passing/PolykindRowCons.purs
tests/purs/passing/PolyLabels.purs
tests/purs/passing/PrimedTypeName.purs
tests/purs/passing/QualifiedAdo.purs
@@ -609,8 +696,12 @@ extra-source-files:
tests/purs/passing/QualifiedDo/IxMonad.purs
tests/purs/passing/QualifiedNames.purs
tests/purs/passing/QualifiedNames/Either.purs
+ tests/purs/passing/QualifiedOperators.purs
+ tests/purs/passing/QualifiedOperators/Foo.purs
tests/purs/passing/QualifiedQualifiedImports.purs
+ tests/purs/passing/QuantifiedKind.purs
tests/purs/passing/Rank2Data.purs
+ tests/purs/passing/Rank2Kinds.purs
tests/purs/passing/Rank2Object.purs
tests/purs/passing/Rank2Types.purs
tests/purs/passing/Rank2TypeSynonym.purs
@@ -624,6 +715,10 @@ extra-source-files:
tests/purs/passing/ReExportQualified/A.purs
tests/purs/passing/ReExportQualified/B.purs
tests/purs/passing/ReExportQualified/C.purs
+ tests/purs/passing/ReExportsExported.purs
+ tests/purs/passing/ReExportsExported/A.purs
+ tests/purs/passing/ReExportsExported/B.purs
+ tests/purs/passing/ReExportsExported/C.purs
tests/purs/passing/ReservedWords.purs
tests/purs/passing/ResolvableScopeConflict.purs
tests/purs/passing/ResolvableScopeConflict/A.purs
@@ -638,6 +733,8 @@ extra-source-files:
tests/purs/passing/RowNub.purs
tests/purs/passing/RowPolyInstanceContext.purs
tests/purs/passing/RowsInInstanceContext.purs
+ tests/purs/passing/RowsInKinds.purs
+ tests/purs/passing/RowsInKinds2.purs
tests/purs/passing/RowUnion.purs
tests/purs/passing/RunFnInline.purs
tests/purs/passing/RuntimeScopeIssue.purs
@@ -656,6 +753,7 @@ extra-source-files:
tests/purs/passing/SolvingCompareSymbol.purs
tests/purs/passing/SolvingIsSymbol.purs
tests/purs/passing/SolvingIsSymbol/Lib.purs
+ tests/purs/passing/StandaloneKindSignatures.purs
tests/purs/passing/Stream.purs
tests/purs/passing/StringEdgeCases.purs
tests/purs/passing/StringEdgeCases/Records.purs
@@ -682,7 +780,14 @@ extra-source-files:
tests/purs/passing/TypeOperators.purs
tests/purs/passing/TypeOperators/A.purs
tests/purs/passing/TypeSynonymInData.purs
+ tests/purs/passing/TypeSynonymInstance.purs
+ tests/purs/passing/TypeSynonymInstance2.purs
+ tests/purs/passing/TypeSynonymInstance3.purs
+ tests/purs/passing/TypeSynonymInstance4.purs
+ tests/purs/passing/TypeSynonymInstance5.purs
+ tests/purs/passing/TypeSynonymInSuperClass.purs
tests/purs/passing/TypeSynonyms.purs
+ tests/purs/passing/TypeSynonymsInKinds.purs
tests/purs/passing/TypeWildcards.purs
tests/purs/passing/TypeWildcardsRecordExtension.purs
tests/purs/passing/TypeWithoutParens.purs
@@ -708,14 +813,29 @@ extra-source-files:
tests/purs/warning/2383.purs
tests/purs/warning/2411.purs
tests/purs/warning/2542.purs
+ tests/purs/warning/CoercibleUnusedImport.purs
+ tests/purs/warning/CoercibleUnusedImport/N1.purs
+ tests/purs/warning/CoercibleUnusedImport/N2.purs
+ tests/purs/warning/CoercibleUnusedNewtypeCtorExplicitImport.purs
+ tests/purs/warning/CoercibleUnusedNewtypeCtorExplicitImport/N.purs
+ tests/purs/warning/CoercibleUnusedNewtypeCtorImplicitImport.purs
+ tests/purs/warning/CoercibleUnusedNewtypeCtorImplicitImport/N.purs
tests/purs/warning/CustomWarning.purs
tests/purs/warning/CustomWarning2.purs
tests/purs/warning/CustomWarning3.purs
tests/purs/warning/CustomWarning4.purs
+ tests/purs/warning/DeprecatedConstraintInForeignImport.purs
+ tests/purs/warning/DeprecatedFFIPrime.purs
+ tests/purs/warning/DeprecatedForeignImportKind.purs
+ tests/purs/warning/DeprecatedImportExportKinds.purs
+ tests/purs/warning/DeprecatedImportExportKinds/Lib.purs
+ tests/purs/warning/DeprecatedRowKindSyntax.purs
tests/purs/warning/DuplicateExportRef.purs
tests/purs/warning/DuplicateImport.purs
tests/purs/warning/DuplicateImportRef.purs
tests/purs/warning/DuplicateSelectiveImport.purs
+ tests/purs/warning/HiddenConstructorsGeneric.purs
+ tests/purs/warning/HiddenConstructorsNewtype.purs
tests/purs/warning/HidingImport.purs
tests/purs/warning/ImplicitImport.purs
tests/purs/warning/ImplicitQualifiedImport.purs
@@ -724,6 +844,7 @@ extra-source-files:
tests/purs/warning/Kind-UnusedExplicitImport-2.purs
tests/purs/warning/Kind-UnusedImport.purs
tests/purs/warning/KindReExport.purs
+ tests/purs/warning/MissingKindDeclaration.purs
tests/purs/warning/MissingTypeDeclaration.purs
tests/purs/warning/NewtypeInstance.purs
tests/purs/warning/NewtypeInstance2.purs
@@ -735,6 +856,7 @@ extra-source-files:
tests/purs/warning/ShadowedBinderPatternGuard.purs
tests/purs/warning/ShadowedNameParens.purs
tests/purs/warning/ShadowedTypeVar.purs
+ tests/purs/warning/UnambiguousQuantifiedKind.purs
tests/purs/warning/UnnecessaryFFIModule.purs
tests/purs/warning/UnusedDctorExplicitImport.purs
tests/purs/warning/UnusedDctorImportAll.purs
@@ -782,6 +904,7 @@ extra-source-files:
tests/purs/docs/output/NotAllCtors/docs.json
tests/purs/docs/output/Prelude/docs.json
tests/purs/docs/output/Prim.Boolean/docs.json
+ tests/purs/docs/output/Prim.Coerce/docs.json
tests/purs/docs/output/Prim.Ordering/docs.json
tests/purs/docs/output/Prim.Row/docs.json
tests/purs/docs/output/Prim.RowList/docs.json
@@ -816,32 +939,41 @@ extra-source-files:
tests/purs/publish/basic-example/output/Control.Semigroupoid/docs.json
tests/purs/publish/basic-example/output/Data.Boolean/docs.json
tests/purs/publish/basic-example/output/Data.BooleanAlgebra/docs.json
+ tests/purs/publish/basic-example/output/Data.Bounded.Generic/docs.json
tests/purs/publish/basic-example/output/Data.Bounded/docs.json
tests/purs/publish/basic-example/output/Data.CommutativeRing/docs.json
tests/purs/publish/basic-example/output/Data.DivisionRing/docs.json
+ tests/purs/publish/basic-example/output/Data.Eq.Generic/docs.json
tests/purs/publish/basic-example/output/Data.Eq/docs.json
tests/purs/publish/basic-example/output/Data.EuclideanRing/docs.json
tests/purs/publish/basic-example/output/Data.Field/docs.json
tests/purs/publish/basic-example/output/Data.Function/docs.json
tests/purs/publish/basic-example/output/Data.Functor/docs.json
+ tests/purs/publish/basic-example/output/Data.Generic.Rep/docs.json
+ tests/purs/publish/basic-example/output/Data.HeytingAlgebra.Generic/docs.json
tests/purs/publish/basic-example/output/Data.HeytingAlgebra/docs.json
tests/purs/publish/basic-example/output/Data.Monoid.Additive/docs.json
tests/purs/publish/basic-example/output/Data.Monoid.Conj/docs.json
tests/purs/publish/basic-example/output/Data.Monoid.Disj/docs.json
tests/purs/publish/basic-example/output/Data.Monoid.Dual/docs.json
tests/purs/publish/basic-example/output/Data.Monoid.Endo/docs.json
+ tests/purs/publish/basic-example/output/Data.Monoid.Generic/docs.json
tests/purs/publish/basic-example/output/Data.Monoid.Multiplicative/docs.json
tests/purs/publish/basic-example/output/Data.Monoid/docs.json
tests/purs/publish/basic-example/output/Data.NaturalTransformation/docs.json
tests/purs/publish/basic-example/output/Data.Newtype/docs.json
- tests/purs/publish/basic-example/output/Data.Ord.Unsafe/docs.json
+ tests/purs/publish/basic-example/output/Data.Ord.Generic/docs.json
tests/purs/publish/basic-example/output/Data.Ord/docs.json
tests/purs/publish/basic-example/output/Data.Ordering/docs.json
+ tests/purs/publish/basic-example/output/Data.Ring.Generic/docs.json
tests/purs/publish/basic-example/output/Data.Ring/docs.json
tests/purs/publish/basic-example/output/Data.Semigroup.First/docs.json
+ tests/purs/publish/basic-example/output/Data.Semigroup.Generic/docs.json
tests/purs/publish/basic-example/output/Data.Semigroup.Last/docs.json
tests/purs/publish/basic-example/output/Data.Semigroup/docs.json
+ tests/purs/publish/basic-example/output/Data.Semiring.Generic/docs.json
tests/purs/publish/basic-example/output/Data.Semiring/docs.json
+ tests/purs/publish/basic-example/output/Data.Show.Generic/docs.json
tests/purs/publish/basic-example/output/Data.Show/docs.json
tests/purs/publish/basic-example/output/Data.Symbol/docs.json
tests/purs/publish/basic-example/output/Data.Unit/docs.json
@@ -855,18 +987,378 @@ extra-source-files:
tests/purs/publish/basic-example/output/Main/docs.json
tests/purs/publish/basic-example/output/Prelude/docs.json
tests/purs/publish/basic-example/output/Prim.Boolean/docs.json
+ tests/purs/publish/basic-example/output/Prim.Coerce/docs.json
tests/purs/publish/basic-example/output/Prim.Ordering/docs.json
tests/purs/publish/basic-example/output/Prim.Row/docs.json
tests/purs/publish/basic-example/output/Prim.RowList/docs.json
tests/purs/publish/basic-example/output/Prim.Symbol/docs.json
tests/purs/publish/basic-example/output/Prim.TypeError/docs.json
tests/purs/publish/basic-example/output/Prim/docs.json
- tests/purs/publish/basic-example/output/PSCI.Support/docs.json
tests/purs/publish/basic-example/output/Record.Unsafe/docs.json
+ tests/purs/publish/basic-example/output/Safe.Coerce/docs.json
tests/purs/publish/basic-example/output/Type.Data.Row/docs.json
tests/purs/publish/basic-example/output/Type.Data.RowList/docs.json
- tests/purs/publish/basic-example/resolutions-legacy.json
+ tests/purs/publish/basic-example/output/Type.Proxy/docs.json
+ tests/purs/publish/basic-example/output/Unsafe.Coerce/docs.json
tests/purs/publish/basic-example/resolutions.json
+ tests/purs/failing/1071.out
+ tests/purs/failing/1169.out
+ tests/purs/failing/1175.out
+ tests/purs/failing/1310.out
+ tests/purs/failing/1570.out
+ tests/purs/failing/1733.out
+ tests/purs/failing/1825.out
+ tests/purs/failing/1881.out
+ tests/purs/failing/2109-bind.out
+ tests/purs/failing/2109-discard.out
+ tests/purs/failing/2109-negate.out
+ tests/purs/failing/2128-class.out
+ tests/purs/failing/2128-instance.out
+ tests/purs/failing/2197-shouldFail.out
+ tests/purs/failing/2197-shouldFail2.out
+ tests/purs/failing/2378.out
+ tests/purs/failing/2379.out
+ tests/purs/failing/2434.out
+ tests/purs/failing/2534.out
+ tests/purs/failing/2542.out
+ tests/purs/failing/2567.out
+ tests/purs/failing/2601.out
+ tests/purs/failing/2616.out
+ tests/purs/failing/2806.out
+ tests/purs/failing/2874-forall.out
+ tests/purs/failing/2874-forall2.out
+ tests/purs/failing/2874-wildcard.out
+ tests/purs/failing/2947.out
+ tests/purs/failing/3077.out
+ tests/purs/failing/3132.out
+ tests/purs/failing/3275-BindingGroupErrorPos.out
+ tests/purs/failing/3275-DataBindingGroupErrorPos.out
+ tests/purs/failing/3335-TypeOpAssociativityError.out
+ tests/purs/failing/3405.out
+ tests/purs/failing/3549-a.out
+ tests/purs/failing/3549.out
+ tests/purs/failing/365.out
+ tests/purs/failing/3689.out
+ tests/purs/failing/438.out
+ tests/purs/failing/881.out
+ tests/purs/failing/AnonArgument1.out
+ tests/purs/failing/AnonArgument2.out
+ tests/purs/failing/AnonArgument3.out
+ tests/purs/failing/ApostropheModuleName.out
+ tests/purs/failing/ArgLengthMismatch.out
+ tests/purs/failing/Arrays.out
+ tests/purs/failing/ArrayType.out
+ tests/purs/failing/AtPatternPrecedence.out
+ tests/purs/failing/BindInDo-2.out
+ tests/purs/failing/BindInDo.out
+ tests/purs/failing/CannotDeriveNewtypeForData.out
+ tests/purs/failing/CaseBinderLengthsDiffer.out
+ tests/purs/failing/CaseDoesNotMatchAllConstructorArgs.out
+ tests/purs/failing/CoercibleClosedRowsDoNotUnify.out
+ tests/purs/failing/CoercibleConstrained1.out
+ tests/purs/failing/CoercibleConstrained2.out
+ tests/purs/failing/CoercibleConstrained3.out
+ tests/purs/failing/CoercibleForeign.out
+ tests/purs/failing/CoercibleForeign2.out
+ tests/purs/failing/CoercibleForeign3.out
+ tests/purs/failing/CoercibleHigherKindedData.out
+ tests/purs/failing/CoercibleHigherKindedNewtypes.out
+ tests/purs/failing/CoercibleKindMismatch.out
+ tests/purs/failing/CoercibleNominal.out
+ tests/purs/failing/CoercibleNominalTypeApp.out
+ tests/purs/failing/CoercibleNominalWrapped.out
+ tests/purs/failing/CoercibleNonCanonical1.out
+ tests/purs/failing/CoercibleNonCanonical2.out
+ tests/purs/failing/CoercibleOpenRowsDoNotUnify.out
+ tests/purs/failing/CoercibleRepresentational.out
+ tests/purs/failing/CoercibleRepresentational2.out
+ tests/purs/failing/CoercibleRepresentational3.out
+ tests/purs/failing/CoercibleRepresentational4.out
+ tests/purs/failing/CoercibleRepresentational5.out
+ tests/purs/failing/CoercibleRepresentational6.out
+ tests/purs/failing/CoercibleRepresentational7.out
+ tests/purs/failing/CoercibleRepresentational8.out
+ tests/purs/failing/CoercibleRoleMismatch1.out
+ tests/purs/failing/CoercibleRoleMismatch2.out
+ tests/purs/failing/CoercibleRoleMismatch3.out
+ tests/purs/failing/CoercibleRoleMismatch4.out
+ tests/purs/failing/CoercibleRoleMismatch5.out
+ tests/purs/failing/CoercibleUnknownRowTail1.out
+ tests/purs/failing/CoercibleUnknownRowTail2.out
+ tests/purs/failing/ConflictingExports.out
+ tests/purs/failing/ConflictingImports.out
+ tests/purs/failing/ConflictingImports/B.out
+ tests/purs/failing/ConflictingImports2.out
+ tests/purs/failing/ConflictingImports2/B.out
+ tests/purs/failing/ConflictingQualifiedImports.out
+ tests/purs/failing/ConflictingQualifiedImports2.out
+ tests/purs/failing/ConflictingQualifiedImports2/B.out
+ tests/purs/failing/ConstraintFailure.out
+ tests/purs/failing/ConstraintInference.out
+ tests/purs/failing/CycleInForeignDataKinds.out
+ tests/purs/failing/CycleInKindDeclaration.out
+ tests/purs/failing/DctorOperatorAliasExport.out
+ tests/purs/failing/DeclConflictClassCtor.out
+ tests/purs/failing/DeclConflictClassSynonym.out
+ tests/purs/failing/DeclConflictClassType.out
+ tests/purs/failing/DeclConflictCtorClass.out
+ tests/purs/failing/DeclConflictCtorCtor.out
+ tests/purs/failing/DeclConflictDuplicateCtor.out
+ tests/purs/failing/DeclConflictSynonymClass.out
+ tests/purs/failing/DeclConflictSynonymType.out
+ tests/purs/failing/DeclConflictTypeClass.out
+ tests/purs/failing/DeclConflictTypeSynonym.out
+ tests/purs/failing/DeclConflictTypeType.out
+ tests/purs/failing/DiffKindsSameName.out
+ tests/purs/failing/DiffKindsSameName/LibA.out
+ tests/purs/failing/Do.out
+ tests/purs/failing/DoNotSuggestComposition.out
+ tests/purs/failing/DoNotSuggestComposition2.out
+ tests/purs/failing/DuplicateDeclarationsInLet.out
+ tests/purs/failing/DuplicateInstance.out
+ tests/purs/failing/DuplicateModule.out
+ tests/purs/failing/DuplicateProperties.out
+ tests/purs/failing/DuplicateRoleDeclaration.out
+ tests/purs/failing/DuplicateTypeClass.out
+ tests/purs/failing/DuplicateTypeVars.out
+ tests/purs/failing/EmptyCase.out
+ tests/purs/failing/EmptyClass.out
+ tests/purs/failing/EmptyDo.out
+ tests/purs/failing/ExpectedWildcard.out
+ tests/purs/failing/ExportConflictClass.out
+ tests/purs/failing/ExportConflictClass/B.out
+ tests/purs/failing/ExportConflictClassAndType.out
+ tests/purs/failing/ExportConflictClassAndType/B.out
+ tests/purs/failing/ExportConflictCtor.out
+ tests/purs/failing/ExportConflictType.out
+ tests/purs/failing/ExportConflictType/B.out
+ tests/purs/failing/ExportConflictTypeOp.out
+ tests/purs/failing/ExportConflictValue.out
+ tests/purs/failing/ExportConflictValueOp.out
+ tests/purs/failing/ExportConflictValueOp/B.out
+ tests/purs/failing/ExportExplicit.out
+ tests/purs/failing/ExportExplicit1.out
+ tests/purs/failing/ExportExplicit2.out
+ tests/purs/failing/ExportExplicit3.out
+ tests/purs/failing/ExtraneousClassMember.out
+ tests/purs/failing/ExtraRecordField.out
+ tests/purs/failing/Foldable.out
+ tests/purs/failing/Generalization1.out
+ tests/purs/failing/Generalization2.out
+ tests/purs/failing/ImportExplicit.out
+ tests/purs/failing/ImportExplicit/M1.out
+ tests/purs/failing/ImportExplicit2.out
+ tests/purs/failing/ImportHidingModule.out
+ tests/purs/failing/ImportModule.out
+ tests/purs/failing/InfiniteKind.out
+ tests/purs/failing/InfiniteKind2.out
+ tests/purs/failing/InfiniteType.out
+ tests/purs/failing/InstanceChainBothUnknownAndMatch.out
+ tests/purs/failing/InstanceChainSkolemUnknownMatch.out
+ tests/purs/failing/InstanceExport.out
+ tests/purs/failing/InstanceSigsBodyIncorrect.out
+ tests/purs/failing/InstanceSigsDifferentTypes.out
+ tests/purs/failing/InstanceSigsIncorrectType.out
+ tests/purs/failing/InstanceSigsOrphanTypeDeclaration.out
+ tests/purs/failing/IntOutOfRange.out
+ tests/purs/failing/InvalidCoercibleInstanceDeclaration.out
+ tests/purs/failing/InvalidDerivedInstance.out
+ tests/purs/failing/InvalidDerivedInstance2.out
+ tests/purs/failing/InvalidDerivedInstance3.out
+ tests/purs/failing/InvalidOperatorInBinder.out
+ tests/purs/failing/KindError.out
+ tests/purs/failing/KindStar.out
+ tests/purs/failing/LacksWithSubGoal.out
+ tests/purs/failing/LeadingZeros1.out
+ tests/purs/failing/LeadingZeros2.out
+ tests/purs/failing/Let.out
+ tests/purs/failing/LetPatterns1.out
+ tests/purs/failing/LetPatterns2.out
+ tests/purs/failing/LetPatterns3.out
+ tests/purs/failing/LetPatterns4.out
+ tests/purs/failing/MissingClassExport.out
+ tests/purs/failing/MissingClassMember.out
+ tests/purs/failing/MissingClassMemberExport.out
+ tests/purs/failing/MissingFFIImplementations.out
+ tests/purs/failing/MissingRecordField.out
+ tests/purs/failing/MixedAssociativityError.out
+ tests/purs/failing/MonoKindDataBindingGroup.out
+ tests/purs/failing/MPTCs.out
+ tests/purs/failing/MultipleErrors.out
+ tests/purs/failing/MultipleErrors2.out
+ tests/purs/failing/MultipleTypeOpFixities.out
+ tests/purs/failing/MultipleValueOpFixities.out
+ tests/purs/failing/MutRec.out
+ tests/purs/failing/MutRec2.out
+ tests/purs/failing/NewtypeInstance.out
+ tests/purs/failing/NewtypeInstance2.out
+ tests/purs/failing/NewtypeInstance3.out
+ tests/purs/failing/NewtypeInstance4.out
+ tests/purs/failing/NewtypeInstance5.out
+ tests/purs/failing/NewtypeInstance6.out
+ tests/purs/failing/NewtypeMultiArgs.out
+ tests/purs/failing/NewtypeMultiCtor.out
+ tests/purs/failing/NonAssociativeError.out
+ tests/purs/failing/NonExhaustivePatGuard.out
+ tests/purs/failing/NullaryAbs.out
+ tests/purs/failing/Object.out
+ tests/purs/failing/OperatorAliasNoExport.out
+ tests/purs/failing/OperatorAt.out
+ tests/purs/failing/OperatorBackslash.out
+ tests/purs/failing/OperatorSections.out
+ tests/purs/failing/OrphanInstance.out
+ tests/purs/failing/OrphanInstance/Class.out
+ tests/purs/failing/OrphanInstanceFunDepCycle.out
+ tests/purs/failing/OrphanInstanceFunDepCycle/Lib.out
+ tests/purs/failing/OrphanInstanceNullary.out
+ tests/purs/failing/OrphanInstanceNullary/Lib.out
+ tests/purs/failing/OrphanInstanceWithDetermined.out
+ tests/purs/failing/OrphanInstanceWithDetermined/Lib.out
+ tests/purs/failing/OrphanKindDeclaration1.out
+ tests/purs/failing/OrphanKindDeclaration2.out
+ tests/purs/failing/OrphanRoleDeclaration1.out
+ tests/purs/failing/OrphanRoleDeclaration2.out
+ tests/purs/failing/OrphanRoleDeclaration3.out
+ tests/purs/failing/OrphanTypeDecl.out
+ tests/purs/failing/OverlapAcrossModules.out
+ tests/purs/failing/OverlapAcrossModules/Class.out
+ tests/purs/failing/OverlappingArguments.out
+ tests/purs/failing/OverlappingBinders.out
+ tests/purs/failing/OverlappingInstances.out
+ tests/purs/failing/OverlappingVars.out
+ tests/purs/failing/PolykindGeneralizationLet.out
+ tests/purs/failing/PolykindInstanceOverlapping.out
+ tests/purs/failing/PolykindInstantiatedInstance.out
+ tests/purs/failing/PolykindInstantiation.out
+ tests/purs/failing/PossiblyInfiniteCoercibleInstance.out
+ tests/purs/failing/PrimModuleReserved.out
+ tests/purs/failing/PrimRow.out
+ tests/purs/failing/PrimSubModuleReserved.out
+ tests/purs/failing/PrimSubModuleReserved/Prim_Foobar.out
+ tests/purs/failing/ProgrammableTypeErrors.out
+ tests/purs/failing/ProgrammableTypeErrorsTypeString.out
+ tests/purs/failing/QualifiedOperators.out
+ tests/purs/failing/QualifiedOperators2.out
+ tests/purs/failing/QuantificationCheckFailure.out
+ tests/purs/failing/QuantificationCheckFailure2.out
+ tests/purs/failing/QuantificationCheckFailure3.out
+ tests/purs/failing/QuantifiedKind.out
+ tests/purs/failing/Rank2Types.out
+ tests/purs/failing/RequiredHiddenType.out
+ tests/purs/failing/Reserved.out
+ tests/purs/failing/RoleDeclarationArityMismatch.out
+ tests/purs/failing/RoleDeclarationArityMismatchForeign.out
+ tests/purs/failing/RowConstructors1.out
+ tests/purs/failing/RowConstructors2.out
+ tests/purs/failing/RowConstructors3.out
+ tests/purs/failing/RowInInstanceNotDetermined0.out
+ tests/purs/failing/RowInInstanceNotDetermined1.out
+ tests/purs/failing/RowInInstanceNotDetermined2.out
+ tests/purs/failing/RowLacks.out
+ tests/purs/failing/RowsInKinds.out
+ tests/purs/failing/ScopedKindVariableSynonym.out
+ tests/purs/failing/SelfImport.out
+ tests/purs/failing/SelfImport/Dummy.out
+ tests/purs/failing/SkolemEscape.out
+ tests/purs/failing/SkolemEscape2.out
+ tests/purs/failing/SkolemEscapeKinds.out
+ tests/purs/failing/StandaloneKindSignatures1.out
+ tests/purs/failing/StandaloneKindSignatures2.out
+ tests/purs/failing/StandaloneKindSignatures3.out
+ tests/purs/failing/StandaloneKindSignatures4.out
+ tests/purs/failing/SuggestComposition.out
+ tests/purs/failing/Superclasses1.out
+ tests/purs/failing/Superclasses2.out
+ tests/purs/failing/Superclasses3.out
+ tests/purs/failing/Superclasses5.out
+ tests/purs/failing/TooFewClassInstanceArgs.out
+ tests/purs/failing/TopLevelCaseNoArgs.out
+ tests/purs/failing/TransitiveDctorExport.out
+ tests/purs/failing/TransitiveDctorExportError.out
+ tests/purs/failing/TransitiveKindExport.out
+ tests/purs/failing/TransitiveSynonymExport.out
+ tests/purs/failing/TypeClasses2.out
+ tests/purs/failing/TypedBinders.out
+ tests/purs/failing/TypedBinders2.out
+ tests/purs/failing/TypedBinders3.out
+ tests/purs/failing/TypedHole.out
+ tests/purs/failing/TypedHole2.out
+ tests/purs/failing/TypeError.out
+ tests/purs/failing/TypeOperatorAliasNoExport.out
+ tests/purs/failing/TypeSynonymCycle.out
+ tests/purs/failing/TypeSynonyms.out
+ tests/purs/failing/TypeSynonyms4.out
+ tests/purs/failing/TypeSynonyms5.out
+ tests/purs/failing/TypeSynonyms7.out
+ tests/purs/failing/TypeSynonymsOverlappingInstance.out
+ tests/purs/failing/TypeWildcards1.out
+ tests/purs/failing/TypeWildcards2.out
+ tests/purs/failing/TypeWildcards3.out
+ tests/purs/failing/TypeWildcards4.out
+ tests/purs/failing/UnderscoreModuleName.out
+ tests/purs/failing/UnknownType.out
+ tests/purs/failing/UnsupportedRoleDeclarationTypeClass.out
+ tests/purs/failing/UnsupportedRoleDeclarationTypeSynonym.out
+ tests/purs/failing/UnsupportedTypeInKind.out
+ tests/purs/failing/UnusableTypeClassMethod.out
+ tests/purs/failing/UnusableTypeClassMethodConflictingIdent.out
+ tests/purs/failing/UnusableTypeClassMethodSynonym.out
+ tests/purs/failing/Whitespace1.out
+ tests/purs/warning/2140.out
+ tests/purs/warning/2383.out
+ tests/purs/warning/2411.out
+ tests/purs/warning/2542.out
+ tests/purs/warning/CoercibleUnusedImport.out
+ tests/purs/warning/CoercibleUnusedNewtypeCtorExplicitImport.out
+ tests/purs/warning/CoercibleUnusedNewtypeCtorImplicitImport.out
+ tests/purs/warning/CustomWarning.out
+ tests/purs/warning/CustomWarning2.out
+ tests/purs/warning/CustomWarning3.out
+ tests/purs/warning/CustomWarning4.out
+ tests/purs/warning/DeprecatedConstraintInForeignImport.out
+ tests/purs/warning/DeprecatedFFIPrime.out
+ tests/purs/warning/DeprecatedForeignImportKind.out
+ tests/purs/warning/DeprecatedImportExportKinds.out
+ tests/purs/warning/DeprecatedRowKindSyntax.out
+ tests/purs/warning/DuplicateExportRef.out
+ tests/purs/warning/DuplicateImport.out
+ tests/purs/warning/DuplicateImportRef.out
+ tests/purs/warning/DuplicateSelectiveImport.out
+ tests/purs/warning/HiddenConstructorsGeneric.out
+ tests/purs/warning/HiddenConstructorsNewtype.out
+ tests/purs/warning/HidingImport.out
+ tests/purs/warning/ImplicitImport.out
+ tests/purs/warning/ImplicitQualifiedImport.out
+ tests/purs/warning/ImplicitQualifiedImportReExport.out
+ tests/purs/warning/Kind-UnusedExplicitImport-1.out
+ tests/purs/warning/Kind-UnusedExplicitImport-2.out
+ tests/purs/warning/Kind-UnusedImport.out
+ tests/purs/warning/KindReExport.out
+ tests/purs/warning/MissingKindDeclaration.out
+ tests/purs/warning/MissingTypeDeclaration.out
+ tests/purs/warning/NewtypeInstance.out
+ tests/purs/warning/NewtypeInstance2.out
+ tests/purs/warning/NewtypeInstance3.out
+ tests/purs/warning/NewtypeInstance4.out
+ tests/purs/warning/OverlappingPattern.out
+ tests/purs/warning/ScopeShadowing.out
+ tests/purs/warning/ScopeShadowing2.out
+ tests/purs/warning/ShadowedBinderPatternGuard.out
+ tests/purs/warning/ShadowedNameParens.out
+ tests/purs/warning/ShadowedTypeVar.out
+ tests/purs/warning/UnambiguousQuantifiedKind.out
+ tests/purs/warning/UnnecessaryFFIModule.out
+ tests/purs/warning/UnusedDctorExplicitImport.out
+ tests/purs/warning/UnusedDctorImportAll.out
+ tests/purs/warning/UnusedDctorImportExplicit.out
+ tests/purs/warning/UnusedExplicitImport.out
+ tests/purs/warning/UnusedExplicitImportTypeOp.out
+ tests/purs/warning/UnusedExplicitImportValOp.out
+ tests/purs/warning/UnusedFFIImplementations.out
+ tests/purs/warning/UnusedImport.out
+ tests/purs/warning/UnusedTypeVar.out
+ tests/purs/warning/WildcardInferredType.out
+ tests/purs/warning/WildcardInferredType2.out
tests/json-compat/v0.11.3/generics-4.0.0.json
tests/json-compat/v0.11.3/symbols-3.0.0.json
tests/json-compat/v0.12.1/typelevel-prelude-3.0.0.json
@@ -878,6 +1370,7 @@ extra-source-files:
tests/support/psci/InteractivePrint.purs
tests/support/psci/Reload.purs
tests/support/psci/Reload.edit
+ tests/support/pscide/src/CompletionSpec.purs
tests/support/pscide/src/CompletionSpecDocs.purs
tests/support/pscide/src/FindUsage.purs
tests/support/pscide/src/FindUsage/Definition.purs
@@ -902,35 +1395,27 @@ extra-source-files:
CONTRIBUTING.md
source-repository head
- type: git
+ type: git
location: https://github.com/purescript/purescript
flag release
description:
Mark this build as a release build: prevents inclusion of extra info e.g. commit SHA in --version output)
- default: False
+
+ default: False
library
exposed-modules:
Control.Monad.Logger
- Control.Monad.Supply
- Control.Monad.Supply.Class
Language.PureScript
- Language.PureScript.AST
- Language.PureScript.AST.Binders
- Language.PureScript.AST.Declarations
- Language.PureScript.AST.Exported
- Language.PureScript.AST.Literals
- Language.PureScript.AST.Operators
- Language.PureScript.AST.SourcePos
- Language.PureScript.AST.Traversals
Language.PureScript.Bundle
Language.PureScript.CodeGen
Language.PureScript.CodeGen.JS
Language.PureScript.CodeGen.JS.Common
Language.PureScript.CodeGen.JS.Printer
- Language.PureScript.Comments
- Language.PureScript.Constants
+ Language.PureScript.Constants.Data.Generic.Rep
+ Language.PureScript.Constants.Data.Newtype
+ Language.PureScript.Constants.Prelude
Language.PureScript.CoreFn
Language.PureScript.CoreFn.Ann
Language.PureScript.CoreFn.Binders
@@ -951,20 +1436,7 @@ library
Language.PureScript.CoreImp.Optimizer.MagicDo
Language.PureScript.CoreImp.Optimizer.TCO
Language.PureScript.CoreImp.Optimizer.Unused
- Language.PureScript.Crash
Language.PureScript.CST
- Language.PureScript.CST.Convert
- Language.PureScript.CST.Errors
- Language.PureScript.CST.Layout
- Language.PureScript.CST.Lexer
- Language.PureScript.CST.Monad
- Language.PureScript.CST.Parser
- Language.PureScript.CST.Positions
- Language.PureScript.CST.Print
- Language.PureScript.CST.Traversals
- Language.PureScript.CST.Traversals.Type
- Language.PureScript.CST.Types
- Language.PureScript.CST.Utils
Language.PureScript.Docs
Language.PureScript.Docs.AsHtml
Language.PureScript.Docs.AsMarkdown
@@ -976,13 +1448,11 @@ library
Language.PureScript.Docs.Prim
Language.PureScript.Docs.Render
Language.PureScript.Docs.RenderedCode
- Language.PureScript.Docs.RenderedCode.RenderKind
Language.PureScript.Docs.RenderedCode.RenderType
Language.PureScript.Docs.RenderedCode.Types
Language.PureScript.Docs.Tags
Language.PureScript.Docs.Types
Language.PureScript.Docs.Utils.MonoidExtras
- Language.PureScript.Environment
Language.PureScript.Errors
Language.PureScript.Errors.JSON
Language.PureScript.Externs
@@ -1016,8 +1486,6 @@ library
Language.PureScript.Interactive.Parser
Language.PureScript.Interactive.Printer
Language.PureScript.Interactive.Types
- Language.PureScript.Kinds
- Language.PureScript.Label
Language.PureScript.Linter
Language.PureScript.Linter.Exhaustive
Language.PureScript.Linter.Imports
@@ -1027,14 +1495,11 @@ library
Language.PureScript.Make.Cache
Language.PureScript.Make.Monad
Language.PureScript.ModuleDependencies
- Language.PureScript.Names
Language.PureScript.Options
Language.PureScript.Pretty
Language.PureScript.Pretty.Common
- Language.PureScript.Pretty.Kinds
Language.PureScript.Pretty.Types
Language.PureScript.Pretty.Values
- Language.PureScript.PSString
Language.PureScript.Publish
Language.PureScript.Publish.BoxesHelpers
Language.PureScript.Publish.ErrorsWarnings
@@ -1060,32 +1525,35 @@ library
Language.PureScript.Sugar.TypeClasses
Language.PureScript.Sugar.TypeClasses.Deriving
Language.PureScript.Sugar.TypeDeclarations
- Language.PureScript.Traversals
Language.PureScript.TypeChecker
Language.PureScript.TypeChecker.Entailment
+ Language.PureScript.TypeChecker.Entailment.Coercible
Language.PureScript.TypeChecker.Kinds
Language.PureScript.TypeChecker.Monad
+ Language.PureScript.TypeChecker.Roles
Language.PureScript.TypeChecker.Skolems
Language.PureScript.TypeChecker.Subsumption
Language.PureScript.TypeChecker.Synonyms
Language.PureScript.TypeChecker.Types
Language.PureScript.TypeChecker.TypeSearch
Language.PureScript.TypeChecker.Unify
- Language.PureScript.TypeClassDictionaries
- Language.PureScript.Types
System.IO.UTF8
- build-tools: happy ==1.19.9
- hs-source-dirs: src
- other-modules:
- Paths_purescript
- default-language: Haskell2010
- default-extensions: ConstraintKinds DataKinds DeriveFunctor
- DeriveFoldable DeriveTraversable DeriveGeneric DerivingStrategies
- EmptyDataDecls FlexibleContexts KindSignatures LambdaCase
- MultiParamTypeClasses NoImplicitPrelude PatternGuards
- PatternSynonyms RankNTypes RecordWildCards OverloadedStrings
- ScopedTypeVariables TupleSections ViewPatterns
- ghc-options: -Wall -O2
+
+ build-tools: happy ==1.19.9
+ hs-source-dirs: src
+ other-modules: Paths_purescript
+ default-language: Haskell2010
+ default-extensions:
+ BangPatterns ConstraintKinds DataKinds DefaultSignatures
+ DeriveFunctor DeriveFoldable DeriveTraversable DeriveGeneric
+ DerivingStrategies EmptyDataDecls FlexibleContexts
+ FlexibleInstances GeneralizedNewtypeDeriving KindSignatures
+ LambdaCase MultiParamTypeClasses NamedFieldPuns NoImplicitPrelude
+ PatternGuards PatternSynonyms RankNTypes RecordWildCards
+ OverloadedStrings ScopedTypeVariables TupleSections TypeFamilies
+ ViewPatterns
+
+ ghc-options: -Wall -O2
build-depends:
Cabal >=2.2 && <3.0,
Glob ==0.9.*,
@@ -1108,13 +1576,12 @@ library
data-ordlist >=0.4.7.0 && <0.5,
deepseq <1.5,
directory >=1.2.3 && <1.4,
- dlist <0.9,
edit-distance <0.3,
file-embed <0.1,
filepath <1.5,
fsnotify >=0.2.1 && <0.4,
haskeline >=0.7.0.0 && <0.8.0.0,
- language-javascript >=0.7.0.0 && <0.8,
+ language-javascript ==0.7.0.0,
lifted-async >=0.10.0.3 && <0.10.1,
lifted-base ==0.2.3.*,
memory ==0.14.*,
@@ -1127,9 +1594,10 @@ library
pattern-arrows >=0.0.2 && <0.1,
process >=1.2.0 && <1.7,
protolude >=0.1.6 && <0.2.4,
+ purescript-ast <0.2,
+ purescript-cst <0.2,
regex-tdfa <1.3,
safe >=0.3.9 && <0.4,
- scientific >=0.3.4.9 && <0.4,
semialign >=1 && <1.1,
semigroups >=0.16.2 && <0.19,
serialise <0.3,
@@ -1149,9 +1617,9 @@ library
vector <0.13
executable purs
- main-is: Main.hs
- build-tools: happy ==1.19.9
- hs-source-dirs: app
+ main-is: Main.hs
+ build-tools: happy ==1.19.9
+ hs-source-dirs: app
other-modules:
Command.Bundle
Command.Compile
@@ -1165,9 +1633,22 @@ executable purs
Command.REPL
Paths_purescript
Version
- default-language: Haskell2010
- ghc-options: -Wall -O2 -fno-warn-unused-do-bind -threaded -rtsopts
- -with-rtsopts=-N
+
+ default-language: Haskell2010
+ default-extensions:
+ BangPatterns ConstraintKinds DataKinds DefaultSignatures
+ DeriveFunctor DeriveFoldable DeriveTraversable DeriveGeneric
+ DerivingStrategies EmptyDataDecls FlexibleContexts
+ FlexibleInstances GeneralizedNewtypeDeriving KindSignatures
+ LambdaCase MultiParamTypeClasses NamedFieldPuns NoImplicitPrelude
+ PatternGuards PatternSynonyms RankNTypes RecordWildCards
+ OverloadedStrings ScopedTypeVariables TupleSections TypeFamilies
+ ViewPatterns
+
+ ghc-options:
+ -Wall -O2 -fno-warn-unused-do-bind -threaded -rtsopts
+ -with-rtsopts=-N
+
build-depends:
Cabal >=2.2 && <3.0,
Glob ==0.9.*,
@@ -1191,14 +1672,13 @@ executable purs
data-ordlist >=0.4.7.0 && <0.5,
deepseq <1.5,
directory >=1.2.3 && <1.4,
- dlist <0.9,
edit-distance <0.3,
file-embed <0.1,
filepath <1.5,
fsnotify >=0.2.1 && <0.4,
haskeline >=0.7.0.0 && <0.8.0.0,
http-types <0.13,
- language-javascript >=0.7.0.0 && <0.8,
+ language-javascript ==0.7.0.0,
lifted-async >=0.10.0.3 && <0.10.1,
lifted-base ==0.2.3.*,
memory ==0.14.*,
@@ -1214,9 +1694,10 @@ executable purs
process >=1.2.0 && <1.7,
protolude >=0.1.6 && <0.2.4,
purescript -any,
+ purescript-ast <0.2,
+ purescript-cst <0.2,
regex-tdfa <1.3,
safe >=0.3.9 && <0.4,
- scientific >=0.3.4.9 && <0.4,
semialign >=1 && <1.1,
semigroups >=0.16.2 && <0.19,
serialise <0.3,
@@ -1238,18 +1719,18 @@ executable purs
wai-websockets ==3.*,
warp ==3.*,
websockets >=0.9 && <0.13
-
+
if flag(release)
cpp-options: -DRELEASE
+
else
- build-depends:
- gitrev >=1.2.0 && <1.4
+ build-depends: gitrev >=1.2.0 && <1.4
test-suite tests
- type: exitcode-stdio-1.0
- main-is: Main.hs
- build-tools: happy ==1.19.9
- hs-source-dirs: tests
+ type: exitcode-stdio-1.0
+ main-is: Main.hs
+ build-tools: happy ==1.19.9
+ hs-source-dirs: tests
other-modules:
Language.PureScript.Ide.CompletionSpec
Language.PureScript.Ide.FilterSpec
@@ -1265,7 +1746,6 @@ test-suite tests
TestBundle
TestCompiler
TestCoreFn
- TestCst
TestDocs
TestGraph
TestHierarchy
@@ -1280,9 +1760,19 @@ test-suite tests
TestPscPublish
TestUtils
Paths_purescript
- default-language: Haskell2010
- default-extensions: NoImplicitPrelude LambdaCase OverloadedStrings
- ghc-options: -Wall
+
+ default-language: Haskell2010
+ default-extensions:
+ BangPatterns ConstraintKinds DataKinds DefaultSignatures
+ DeriveFunctor DeriveFoldable DeriveTraversable DeriveGeneric
+ DerivingStrategies EmptyDataDecls FlexibleContexts
+ FlexibleInstances GeneralizedNewtypeDeriving KindSignatures
+ LambdaCase MultiParamTypeClasses NamedFieldPuns NoImplicitPrelude
+ PatternGuards PatternSynonyms RankNTypes RecordWildCards
+ OverloadedStrings ScopedTypeVariables TupleSections TypeFamilies
+ ViewPatterns
+
+ ghc-options: -Wall
build-depends:
Cabal >=2.2 && <3.0,
Glob ==0.9.*,
@@ -1306,7 +1796,6 @@ test-suite tests
data-ordlist >=0.4.7.0 && <0.5,
deepseq <1.5,
directory >=1.2.3 && <1.4,
- dlist <0.9,
edit-distance <0.3,
file-embed <0.1,
filepath <1.5,
@@ -1314,7 +1803,7 @@ test-suite tests
haskeline >=0.7.0.0 && <0.8.0.0,
hspec <2.7,
hspec-discover <2.7,
- language-javascript >=0.7.0.0 && <0.8,
+ language-javascript ==0.7.0.0,
lifted-async >=0.10.0.3 && <0.10.1,
lifted-base ==0.2.3.*,
memory ==0.14.*,
@@ -1328,9 +1817,11 @@ test-suite tests
process >=1.2.0 && <1.7,
protolude >=0.1.6 && <0.2.4,
purescript -any,
+ purescript-ast <0.2,
+ purescript-cst <0.2,
+ regex-base <0.94,
regex-tdfa <1.3,
safe >=0.3.9 && <0.4,
- scientific >=0.3.4.9 && <0.4,
semialign >=1 && <1.1,
semigroups >=0.16.2 && <0.19,
serialise <0.3,
diff --git a/src/Control/Monad/Supply.hs b/src/Control/Monad/Supply.hs
deleted file mode 100644
index 49df7d4..0000000
--- a/src/Control/Monad/Supply.hs
+++ /dev/null
@@ -1,33 +0,0 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
--- |
--- Fresh variable supply
---
-module Control.Monad.Supply where
-
-import Prelude.Compat
-
-import Control.Applicative
-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, Alternative, MonadPlus)
-
-runSupplyT :: Integer -> SupplyT m a -> m (a, Integer)
-runSupplyT n = flip runStateT n . unSupplyT
-
-evalSupplyT :: (Functor m) => Integer -> SupplyT m a -> m a
-evalSupplyT n = fmap fst . runSupplyT n
-
-type Supply = SupplyT Identity
-
-runSupply :: Integer -> Supply a -> (a, Integer)
-runSupply n = runIdentity . runSupplyT n
-
-evalSupply :: Integer -> Supply a -> a
-evalSupply n = runIdentity . evalSupplyT n
diff --git a/src/Control/Monad/Supply/Class.hs b/src/Control/Monad/Supply/Class.hs
deleted file mode 100644
index 64038a6..0000000
--- a/src/Control/Monad/Supply/Class.hs
+++ /dev/null
@@ -1,36 +0,0 @@
--- |
--- A class for monads supporting a supply of fresh names
---
-
-{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE TypeFamilies #-}
-
-module Control.Monad.Supply.Class where
-
-import Prelude.Compat
-
-import Control.Monad.Supply
-import Control.Monad.State
-import Control.Monad.Writer
-import Data.Text (Text, pack)
-
-class Monad m => MonadSupply m where
- fresh :: m Integer
- peek :: m Integer
- default fresh :: (MonadTrans t, MonadSupply n, m ~ t n) => m Integer
- fresh = lift fresh
- default peek :: (MonadTrans t, MonadSupply n, m ~ t n) => m Integer
- peek = lift peek
-
-instance Monad m => MonadSupply (SupplyT m) where
- fresh = SupplyT $ do
- n <- get
- put (n + 1)
- return n
- peek = SupplyT get
-
-instance MonadSupply m => MonadSupply (StateT s m)
-instance (Monoid w, MonadSupply m) => MonadSupply (WriterT w m)
-
-freshName :: MonadSupply m => m Text
-freshName = fmap (("$" <> ) . pack . show) fresh
diff --git a/src/Language/PureScript.hs b/src/Language/PureScript.hs
index 40c843e..d1e70f7 100644
--- a/src/Language/PureScript.hs
+++ b/src/Language/PureScript.hs
@@ -18,7 +18,6 @@ import Language.PureScript.Environment as P
import Language.PureScript.Errors as P hiding (indent)
import Language.PureScript.Externs as P
import Language.PureScript.Graph as P
-import Language.PureScript.Kinds as P
import Language.PureScript.Linter as P
import Language.PureScript.Make as P
import Language.PureScript.ModuleDependencies as P
@@ -26,6 +25,7 @@ import Language.PureScript.Names as P
import Language.PureScript.Options as P
import Language.PureScript.Pretty as P
import Language.PureScript.Renamer as P
+import Language.PureScript.Roles as P
import Language.PureScript.Sugar as P
import Language.PureScript.TypeChecker as P
import Language.PureScript.Types as P
diff --git a/src/Language/PureScript/AST.hs b/src/Language/PureScript/AST.hs
deleted file mode 100644
index fe82e27..0000000
--- a/src/Language/PureScript/AST.hs
+++ /dev/null
@@ -1,14 +0,0 @@
--- |
--- The initial PureScript AST
---
-module Language.PureScript.AST (
- module AST
-) where
-
-import Language.PureScript.AST.Binders as AST
-import Language.PureScript.AST.Declarations as AST
-import Language.PureScript.AST.Exported as AST
-import Language.PureScript.AST.Literals as AST
-import Language.PureScript.AST.Operators as AST
-import Language.PureScript.AST.SourcePos as AST
-import Language.PureScript.AST.Traversals as AST
diff --git a/src/Language/PureScript/AST/Binders.hs b/src/Language/PureScript/AST/Binders.hs
deleted file mode 100644
index 528ffb0..0000000
--- a/src/Language/PureScript/AST/Binders.hs
+++ /dev/null
@@ -1,193 +0,0 @@
--- |
--- Case binders
---
-module Language.PureScript.AST.Binders where
-
-import Prelude.Compat
-
-import Language.PureScript.AST.SourcePos
-import Language.PureScript.AST.Literals
-import Language.PureScript.Names
-import Language.PureScript.Comments
-import Language.PureScript.Types
-
--- |
--- Data type for binders
---
-data Binder
- -- |
- -- Wildcard binder
- --
- = NullBinder
- -- |
- -- A binder which matches a literal
- --
- | LiteralBinder SourceSpan (Literal Binder)
- -- |
- -- A binder which binds an identifier
- --
- | VarBinder SourceSpan Ident
- -- |
- -- A binder which matches a data constructor
- --
- | ConstructorBinder SourceSpan (Qualified (ProperName 'ConstructorName)) [Binder]
- -- |
- -- A operator alias binder. During the rebracketing phase of desugaring,
- -- this data constructor will be removed.
- --
- | OpBinder SourceSpan (Qualified (OpName 'ValueOpName))
- -- |
- -- Binary operator application. During the rebracketing phase of desugaring,
- -- this data constructor will be removed.
- --
- | BinaryNoParensBinder Binder Binder Binder
- -- |
- -- Explicit parentheses. During the rebracketing phase of desugaring, this
- -- data constructor will be removed.
- --
- -- Note: although it seems this constructor is not used, it _is_ useful,
- -- since it prevents certain traversals from matching.
- --
- | ParensInBinder Binder
- -- |
- -- A binder which binds its input to an identifier
- --
- | NamedBinder SourceSpan Ident Binder
- -- |
- -- A binder with source position information
- --
- | PositionedBinder SourceSpan [Comment] Binder
- -- |
- -- A binder with a type annotation
- --
- | TypedBinder SourceType Binder
- deriving (Show)
-
--- Manual Eq and Ord instances for `Binder` were added on 2018-03-05. Comparing
--- the `SourceSpan` values embedded in some of the data constructors of `Binder`
--- was expensive. This made exhaustiveness checking observably slow for code
--- such as the `explode` function in `test/purs/passing/LargeSumTypes.purs`.
--- Custom instances were written to skip comparing the `SourceSpan` values. Only
--- the `Ord` instance was needed for the speed-up, but I did not want the `Eq`
--- to have mismatched behavior.
-instance Eq Binder where
- (==) NullBinder NullBinder = True
- (==) NullBinder _ = False
-
- (==) (LiteralBinder _ lb) (LiteralBinder _ lb') = (==) lb lb'
- (==) LiteralBinder{} _ = False
-
- (==) (VarBinder _ ident) (VarBinder _ ident') = (==) ident ident'
- (==) VarBinder{} _ = False
-
- (==) (ConstructorBinder _ qpc bs) (ConstructorBinder _ qpc' bs') =
- (==) qpc qpc' && (==) bs bs'
- (==) ConstructorBinder{} _ = False
-
- (==) (OpBinder _ qov) (OpBinder _ qov') =
- (==) qov qov'
- (==) OpBinder{} _ = False
-
- (==) (BinaryNoParensBinder b1 b2 b3) (BinaryNoParensBinder b1' b2' b3') =
- (==) b1 b1' && (==) b2 b2' && (==) b3 b3'
- (==) BinaryNoParensBinder{} _ = False
-
- (==) (ParensInBinder b) (ParensInBinder b') =
- (==) b b'
- (==) ParensInBinder{} _ = False
-
- (==) (NamedBinder _ ident b) (NamedBinder _ ident' b') =
- (==) ident ident' && (==) b b'
- (==) NamedBinder{} _ = False
-
- (==) (PositionedBinder _ comments b) (PositionedBinder _ comments' b') =
- (==) comments comments' && (==) b b'
- (==) PositionedBinder{} _ = False
-
- (==) (TypedBinder ty b) (TypedBinder ty' b') =
- (==) ty ty' && (==) b b'
- (==) TypedBinder{} _ = False
-
-instance Ord Binder where
- compare NullBinder NullBinder = EQ
- compare NullBinder _ = LT
-
- compare (LiteralBinder _ lb) (LiteralBinder _ lb') = compare lb lb'
- compare LiteralBinder{} NullBinder = GT
- compare LiteralBinder{} _ = LT
-
- compare (VarBinder _ ident) (VarBinder _ ident') = compare ident ident'
- compare VarBinder{} NullBinder = GT
- compare VarBinder{} LiteralBinder{} = GT
- compare VarBinder{} _ = LT
-
- compare (ConstructorBinder _ qpc bs) (ConstructorBinder _ qpc' bs') =
- compare qpc qpc' <> compare bs bs'
- compare ConstructorBinder{} NullBinder = GT
- compare ConstructorBinder{} LiteralBinder{} = GT
- compare ConstructorBinder{} VarBinder{} = GT
- compare ConstructorBinder{} _ = LT
-
- compare (OpBinder _ qov) (OpBinder _ qov') =
- compare qov qov'
- compare OpBinder{} NullBinder = GT
- compare OpBinder{} LiteralBinder{} = GT
- compare OpBinder{} VarBinder{} = GT
- compare OpBinder{} ConstructorBinder{} = GT
- compare OpBinder{} _ = LT
-
- compare (BinaryNoParensBinder b1 b2 b3) (BinaryNoParensBinder b1' b2' b3') =
- compare b1 b1' <> compare b2 b2' <> compare b3 b3'
- compare BinaryNoParensBinder{} ParensInBinder{} = LT
- compare BinaryNoParensBinder{} NamedBinder{} = LT
- compare BinaryNoParensBinder{} PositionedBinder{} = LT
- compare BinaryNoParensBinder{} TypedBinder{} = LT
- compare BinaryNoParensBinder{} _ = GT
-
- compare (ParensInBinder b) (ParensInBinder b') =
- compare b b'
- compare ParensInBinder{} NamedBinder{} = LT
- compare ParensInBinder{} PositionedBinder{} = LT
- compare ParensInBinder{} TypedBinder{} = LT
- compare ParensInBinder{} _ = GT
-
- compare (NamedBinder _ ident b) (NamedBinder _ ident' b') =
- compare ident ident' <> compare b b'
- compare NamedBinder{} PositionedBinder{} = LT
- compare NamedBinder{} TypedBinder{} = LT
- compare NamedBinder{} _ = GT
-
- compare (PositionedBinder _ comments b) (PositionedBinder _ comments' b') =
- compare comments comments' <> compare b b'
- compare PositionedBinder{} TypedBinder{} = LT
- compare PositionedBinder{} _ = GT
-
- compare (TypedBinder ty b) (TypedBinder ty' b') =
- compare ty ty' <> compare b b'
- compare TypedBinder{} _ = GT
-
--- |
--- Collect all names introduced in binders in an expression
---
-binderNames :: Binder -> [Ident]
-binderNames = go []
- where
- go ns (LiteralBinder _ b) = lit ns b
- go ns (VarBinder _ name) = name : ns
- go ns (ConstructorBinder _ _ bs) = foldl go ns bs
- go ns (BinaryNoParensBinder b1 b2 b3) = foldl go ns [b1, b2, b3]
- go ns (ParensInBinder b) = go ns b
- go ns (NamedBinder _ name b) = go (name : ns) b
- go ns (PositionedBinder _ _ b) = go ns b
- go ns (TypedBinder _ b) = go ns b
- go ns _ = ns
- lit ns (ObjectLiteral bs) = foldl go ns (map snd bs)
- lit ns (ArrayLiteral bs) = foldl go ns bs
- lit ns _ = ns
-
-isIrrefutable :: Binder -> Bool
-isIrrefutable NullBinder = True
-isIrrefutable (VarBinder _ _) = True
-isIrrefutable (PositionedBinder _ _ b) = isIrrefutable b
-isIrrefutable (TypedBinder _ b) = isIrrefutable b
-isIrrefutable _ = False
diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs
deleted file mode 100644
index 63ef0af..0000000
--- a/src/Language/PureScript/AST/Declarations.hs
+++ /dev/null
@@ -1,937 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE DeriveAnyClass #-}
-
--- |
--- Data types for modules and declarations
---
-module Language.PureScript.AST.Declarations where
-
-import Prelude.Compat
-
-import Codec.Serialise (Serialise)
-import Control.DeepSeq (NFData)
-import Control.Monad.Identity
-
-import Data.Aeson.TH
-import qualified Data.Map as M
-import Data.Set (Set)
-import Data.Text (Text)
-import qualified Data.List.NonEmpty as NEL
-import GHC.Generics (Generic)
-
-import Language.PureScript.AST.Binders
-import Language.PureScript.AST.Literals
-import Language.PureScript.AST.Operators
-import Language.PureScript.AST.SourcePos
-import Language.PureScript.Types
-import Language.PureScript.PSString (PSString)
-import Language.PureScript.Label (Label)
-import Language.PureScript.Names
-import Language.PureScript.Kinds
-import Language.PureScript.TypeClassDictionaries
-import Language.PureScript.Comments
-import Language.PureScript.Environment
-import qualified Language.PureScript.Bundle as Bundle
-import qualified Language.PureScript.Constants as C
-import qualified Language.PureScript.CST.Errors as CST
-
-import qualified Text.Parsec as P
-
--- | A map of locally-bound names in scope.
-type Context = [(Ident, SourceType)]
-
--- | Holds the data necessary to do type directed search for typed holes
-data TypeSearch
- = TSBefore Environment
- -- ^ An Environment captured for later consumption by type directed search
- | TSAfter
- { tsAfterIdentifiers :: [(Qualified Text, SourceType)]
- -- ^ The identifiers that fully satisfy the subsumption check
- , tsAfterRecordFields :: Maybe [(Label, SourceType)]
- -- ^ Record fields that are available on the first argument to the typed
- -- hole
- }
- -- ^ Results of applying type directed search to the previously captured
- -- Environment
- deriving Show
-
-onTypeSearchTypes :: (SourceType -> SourceType) -> TypeSearch -> TypeSearch
-onTypeSearchTypes f = runIdentity . onTypeSearchTypesM (Identity . f)
-
-onTypeSearchTypesM :: (Applicative m) => (SourceType -> m SourceType) -> TypeSearch -> m TypeSearch
-onTypeSearchTypesM f (TSAfter i r) = TSAfter <$> traverse (traverse f) i <*> traverse (traverse (traverse f)) r
-onTypeSearchTypesM _ (TSBefore env) = pure (TSBefore env)
-
--- | A type of error messages
-data SimpleErrorMessage
- = ModuleNotFound ModuleName
- | ErrorParsingFFIModule FilePath (Maybe Bundle.ErrorMessage)
- | ErrorParsingModule P.ParseError
- | ErrorParsingCSTModule CST.ParserError
- | MissingFFIModule ModuleName
- | UnnecessaryFFIModule ModuleName FilePath
- | MissingFFIImplementations ModuleName [Ident]
- | UnusedFFIImplementations ModuleName [Ident]
- | InvalidFFIIdentifier ModuleName Text
- | FileIOError Text IOError -- ^ A description of what we were trying to do, and the error which occurred
- | InfiniteType SourceType
- | InfiniteKind SourceKind
- | MultipleValueOpFixities (OpName 'ValueOpName)
- | MultipleTypeOpFixities (OpName 'TypeOpName)
- | OrphanTypeDeclaration Ident
- | RedefinedIdent Ident
- | OverlappingNamesInLet
- | UnknownName (Qualified Name)
- | UnknownImport ModuleName Name
- | UnknownImportDataConstructor ModuleName (ProperName 'TypeName) (ProperName 'ConstructorName)
- | UnknownExport Name
- | UnknownExportDataConstructor (ProperName 'TypeName) (ProperName 'ConstructorName)
- | ScopeConflict Name [ModuleName]
- | ScopeShadowing Name (Maybe ModuleName) [ModuleName]
- | DeclConflict Name Name
- | ExportConflict (Qualified Name) (Qualified Name)
- | DuplicateModule ModuleName
- | DuplicateTypeClass (ProperName 'ClassName) SourceSpan
- | DuplicateInstance Ident SourceSpan
- | DuplicateTypeArgument Text
- | InvalidDoBind
- | InvalidDoLet
- | CycleInDeclaration Ident
- | CycleInTypeSynonym (Maybe (ProperName 'TypeName))
- | CycleInTypeClassDeclaration [Qualified (ProperName 'ClassName)]
- | CycleInModules [ModuleName]
- | NameIsUndefined Ident
- | UndefinedTypeVariable (ProperName 'TypeName)
- | PartiallyAppliedSynonym (Qualified (ProperName 'TypeName))
- | EscapedSkolem Text (Maybe SourceSpan) SourceType
- | TypesDoNotUnify SourceType SourceType
- | KindsDoNotUnify SourceKind SourceKind
- | ConstrainedTypeUnified SourceType SourceType
- | OverlappingInstances (Qualified (ProperName 'ClassName)) [SourceType] [Qualified Ident]
- | NoInstanceFound SourceConstraint
- | AmbiguousTypeVariables SourceType [Int]
- | UnknownClass (Qualified (ProperName 'ClassName))
- | PossiblyInfiniteInstance (Qualified (ProperName 'ClassName)) [SourceType]
- | CannotDerive (Qualified (ProperName 'ClassName)) [SourceType]
- | InvalidDerivedInstance (Qualified (ProperName 'ClassName)) [SourceType] Int
- | ExpectedTypeConstructor (Qualified (ProperName 'ClassName)) [SourceType] SourceType
- | InvalidNewtypeInstance (Qualified (ProperName 'ClassName)) [SourceType]
- | MissingNewtypeSuperclassInstance (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'ClassName)) [SourceType]
- | UnverifiableSuperclassInstance (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'ClassName)) [SourceType]
- | CannotFindDerivingType (ProperName 'TypeName)
- | DuplicateLabel Label (Maybe Expr)
- | DuplicateValueDeclaration Ident
- | ArgListLengthsDiffer Ident
- | OverlappingArgNames (Maybe Ident)
- | MissingClassMember (NEL.NonEmpty (Ident, SourceType))
- | ExtraneousClassMember Ident (Qualified (ProperName 'ClassName))
- | ExpectedType SourceType SourceKind
- -- | constructor name, expected argument count, actual argument count
- | IncorrectConstructorArity (Qualified (ProperName 'ConstructorName)) Int Int
- | ExprDoesNotHaveType Expr SourceType
- | PropertyIsMissing Label
- | AdditionalProperty Label
- | TypeSynonymInstance
- | OrphanInstance Ident (Qualified (ProperName 'ClassName)) (Set ModuleName) [SourceType]
- | InvalidNewtype (ProperName 'TypeName)
- | InvalidInstanceHead SourceType
- | TransitiveExportError DeclarationRef [DeclarationRef]
- | TransitiveDctorExportError DeclarationRef (ProperName 'ConstructorName)
- | ShadowedName Ident
- | ShadowedTypeVar Text
- | UnusedTypeVar Text
- | WildcardInferredType SourceType Context
- | HoleInferredType Text SourceType Context (Maybe TypeSearch)
- | MissingTypeDeclaration Ident SourceType
- | OverlappingPattern [[Binder]] Bool
- | IncompleteExhaustivityCheck
- | MisleadingEmptyTypeImport ModuleName (ProperName 'TypeName)
- | ImportHidingModule ModuleName
- | UnusedImport ModuleName (Maybe ModuleName)
- | UnusedExplicitImport ModuleName [Name] (Maybe ModuleName) [DeclarationRef]
- | UnusedDctorImport ModuleName (ProperName 'TypeName) (Maybe ModuleName) [DeclarationRef]
- | UnusedDctorExplicitImport ModuleName (ProperName 'TypeName) [ProperName 'ConstructorName] (Maybe ModuleName) [DeclarationRef]
- | DuplicateSelectiveImport ModuleName
- | DuplicateImport ModuleName ImportDeclarationType (Maybe ModuleName)
- | DuplicateImportRef Name
- | DuplicateExportRef Name
- | IntOutOfRange Integer Text Integer Integer
- | ImplicitQualifiedImport ModuleName ModuleName [DeclarationRef]
- | ImplicitQualifiedImportReExport ModuleName ModuleName [DeclarationRef]
- | ImplicitImport ModuleName [DeclarationRef]
- | HidingImport ModuleName [DeclarationRef]
- | CaseBinderLengthDiffers Int [Binder]
- | IncorrectAnonymousArgument
- | InvalidOperatorInBinder (Qualified (OpName 'ValueOpName)) (Qualified Ident)
- | CannotGeneralizeRecursiveFunction Ident SourceType
- | CannotDeriveNewtypeForData (ProperName 'TypeName)
- | ExpectedWildcard (ProperName 'TypeName)
- | CannotUseBindWithDo Ident
- -- | instance name, type class, expected argument count, actual argument count
- | ClassInstanceArityMismatch Ident (Qualified (ProperName 'ClassName)) Int Int
- -- | a user-defined warning raised by using the Warn type class
- | UserDefinedWarning SourceType
- -- | a declaration couldn't be used because it contained free variables
- | UnusableDeclaration Ident [[Text]]
- | CannotDefinePrimModules ModuleName
- | MixedAssociativityError (NEL.NonEmpty (Qualified (OpName 'AnyOpName), Associativity))
- | NonAssociativeError (NEL.NonEmpty (Qualified (OpName 'AnyOpName)))
- deriving (Show)
-
--- | Error message hints, providing more detailed information about failure.
-data ErrorMessageHint
- = ErrorUnifyingTypes SourceType SourceType
- | ErrorInExpression Expr
- | ErrorInModule ModuleName
- | ErrorInInstance (Qualified (ProperName 'ClassName)) [SourceType]
- | ErrorInSubsumption SourceType SourceType
- | ErrorCheckingAccessor Expr PSString
- | ErrorCheckingType Expr SourceType
- | ErrorCheckingKind SourceType
- | ErrorCheckingGuard
- | ErrorInferringType Expr
- | ErrorInApplication Expr SourceType Expr
- | ErrorInDataConstructor (ProperName 'ConstructorName)
- | ErrorInTypeConstructor (ProperName 'TypeName)
- | ErrorInBindingGroup (NEL.NonEmpty Ident)
- | ErrorInDataBindingGroup [ProperName 'TypeName]
- | ErrorInTypeSynonym (ProperName 'TypeName)
- | ErrorInValueDeclaration Ident
- | ErrorInTypeDeclaration Ident
- | ErrorInTypeClassDeclaration (ProperName 'ClassName)
- | ErrorInForeignImport Ident
- | ErrorSolvingConstraint SourceConstraint
- | PositionedError (NEL.NonEmpty SourceSpan)
- deriving (Show)
-
--- | Categories of hints
-data HintCategory
- = ExprHint
- | KindHint
- | CheckHint
- | PositionHint
- | SolverHint
- | OtherHint
- deriving (Show, Eq)
-
-data ErrorMessage = ErrorMessage
- [ErrorMessageHint]
- SimpleErrorMessage
- deriving (Show)
-
--- |
--- A module declaration, consisting of comments about the module, a module name,
--- a list of declarations, and a list of the declarations that are
--- explicitly exported. If the export list is Nothing, everything is exported.
---
-data Module = Module SourceSpan [Comment] ModuleName [Declaration] (Maybe [DeclarationRef])
- deriving (Show)
-
--- | Return a module's name.
-getModuleName :: Module -> ModuleName
-getModuleName (Module _ _ name _ _) = name
-
--- | Return a module's source span.
-getModuleSourceSpan :: Module -> SourceSpan
-getModuleSourceSpan (Module ss _ _ _ _) = ss
-
--- | Return a module's declarations.
-getModuleDeclarations :: Module -> [Declaration]
-getModuleDeclarations (Module _ _ _ declarations _) = declarations
-
--- |
--- Add an import declaration for a module if it does not already explicitly import it.
---
--- Will not import an unqualified module if that module has already been imported qualified.
--- (See #2197)
---
-addDefaultImport :: Qualified ModuleName -> Module -> Module
-addDefaultImport (Qualified toImportAs toImport) m@(Module ss coms mn decls exps) =
- if isExistingImport `any` decls || mn == toImport then m
- else Module ss coms mn (ImportDeclaration (ss, []) toImport Implicit toImportAs : decls) exps
- where
- isExistingImport (ImportDeclaration _ mn' _ as')
- | mn' == toImport =
- case toImportAs of
- Nothing -> True
- _ -> as' == toImportAs
- isExistingImport _ = False
-
--- | Adds import declarations to a module for an implicit Prim import and Prim
--- | qualified as Prim, as necessary.
-importPrim :: Module -> Module
-importPrim =
- let
- primModName = C.Prim
- in
- addDefaultImport (Qualified (Just primModName) primModName)
- . addDefaultImport (Qualified Nothing primModName)
-
--- |
--- An item in a list of explicit imports or exports
---
-data DeclarationRef
- -- |
- -- A type constructor with data constructors
- --
- = TypeRef SourceSpan (ProperName 'TypeName) (Maybe [ProperName 'ConstructorName])
- -- |
- -- A type operator
- --
- | TypeOpRef SourceSpan (OpName 'TypeOpName)
- -- |
- -- A value
- --
- | ValueRef SourceSpan Ident
- -- |
- -- A value-level operator
- --
- | ValueOpRef SourceSpan (OpName 'ValueOpName)
- -- |
- -- A type class
- --
- | TypeClassRef SourceSpan (ProperName 'ClassName)
- -- |
- -- A type class instance, created during typeclass desugaring (name, class name, instance types)
- --
- | TypeInstanceRef SourceSpan Ident
- -- |
- -- A module, in its entirety
- --
- | ModuleRef SourceSpan ModuleName
- -- |
- -- A named kind
- --
- | KindRef SourceSpan (ProperName 'KindName)
- -- |
- -- A value re-exported from another module. These will be inserted during
- -- elaboration in name desugaring.
- --
- | ReExportRef SourceSpan ExportSource DeclarationRef
- deriving (Show, Generic, NFData, Serialise)
-
-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'
- (KindRef _ name) == (KindRef _ name') = name == name'
- (ReExportRef _ mn ref) == (ReExportRef _ mn' ref') = mn == mn' && ref == ref'
- _ == _ = False
-
-data ExportSource =
- ExportSource
- { exportSourceImportedFrom :: Maybe ModuleName
- , exportSourceDefinedIn :: ModuleName
- }
- deriving (Eq, Ord, Show, Generic, NFData, Serialise)
-
--- enable sorting lists of explicitly imported refs when suggesting imports in linting, IDE, etc.
--- not an Ord because this implementation is not consistent with its Eq instance.
--- think of it as a notion of contextual, not inherent, ordering.
-compDecRef :: DeclarationRef -> DeclarationRef -> Ordering
-compDecRef (TypeRef _ name _) (TypeRef _ name' _) = compare name name'
-compDecRef (TypeOpRef _ name) (TypeOpRef _ name') = compare name name'
-compDecRef (ValueRef _ ident) (ValueRef _ ident') = compare ident ident'
-compDecRef (ValueOpRef _ name) (ValueOpRef _ name') = compare name name'
-compDecRef (TypeClassRef _ name) (TypeClassRef _ name') = compare name name'
-compDecRef (TypeInstanceRef _ ident) (TypeInstanceRef _ ident') = compare ident ident'
-compDecRef (ModuleRef _ name) (ModuleRef _ name') = compare name name'
-compDecRef (KindRef _ name) (KindRef _ name') = compare name name'
-compDecRef (ReExportRef _ name _) (ReExportRef _ name' _) = compare name name'
-compDecRef ref ref' = compare
- (orderOf ref) (orderOf ref')
- where
- orderOf :: DeclarationRef -> Int
- orderOf TypeClassRef{} = 0
- orderOf TypeOpRef{} = 1
- orderOf TypeRef{} = 2
- orderOf ValueRef{} = 3
- orderOf ValueOpRef{} = 4
- orderOf KindRef{} = 5
- orderOf _ = 6
-
-declRefSourceSpan :: DeclarationRef -> SourceSpan
-declRefSourceSpan (TypeRef ss _ _) = ss
-declRefSourceSpan (TypeOpRef ss _) = ss
-declRefSourceSpan (ValueRef ss _) = ss
-declRefSourceSpan (ValueOpRef ss _) = ss
-declRefSourceSpan (TypeClassRef ss _) = ss
-declRefSourceSpan (TypeInstanceRef ss _) = ss
-declRefSourceSpan (ModuleRef ss _) = ss
-declRefSourceSpan (KindRef ss _) = ss
-declRefSourceSpan (ReExportRef ss _ _) = ss
-
-declRefName :: DeclarationRef -> Name
-declRefName (TypeRef _ n _) = TyName n
-declRefName (TypeOpRef _ n) = TyOpName n
-declRefName (ValueRef _ n) = IdentName n
-declRefName (ValueOpRef _ n) = ValOpName n
-declRefName (TypeClassRef _ n) = TyClassName n
-declRefName (TypeInstanceRef _ n) = IdentName n
-declRefName (ModuleRef _ n) = ModName n
-declRefName (KindRef _ n) = KiName n
-declRefName (ReExportRef _ _ ref) = declRefName ref
-
-getTypeRef :: DeclarationRef -> Maybe (ProperName 'TypeName, Maybe [ProperName 'ConstructorName])
-getTypeRef (TypeRef _ name dctors) = Just (name, dctors)
-getTypeRef _ = Nothing
-
-getTypeOpRef :: DeclarationRef -> Maybe (OpName 'TypeOpName)
-getTypeOpRef (TypeOpRef _ op) = Just op
-getTypeOpRef _ = Nothing
-
-getValueRef :: DeclarationRef -> Maybe Ident
-getValueRef (ValueRef _ name) = Just name
-getValueRef _ = Nothing
-
-getValueOpRef :: DeclarationRef -> Maybe (OpName 'ValueOpName)
-getValueOpRef (ValueOpRef _ op) = Just op
-getValueOpRef _ = Nothing
-
-getTypeClassRef :: DeclarationRef -> Maybe (ProperName 'ClassName)
-getTypeClassRef (TypeClassRef _ name) = Just name
-getTypeClassRef _ = Nothing
-
-getKindRef :: DeclarationRef -> Maybe (ProperName 'KindName)
-getKindRef (KindRef _ name) = Just name
-getKindRef _ = Nothing
-
-isModuleRef :: DeclarationRef -> Bool
-isModuleRef ModuleRef{} = True
-isModuleRef _ = False
-
--- |
--- The data type which specifies type of import declaration
---
-data ImportDeclarationType
- -- |
- -- An import with no explicit list: `import M`.
- --
- = Implicit
- -- |
- -- An import with an explicit list of references to import: `import M (foo)`
- --
- | Explicit [DeclarationRef]
- -- |
- -- An import with a list of references to hide: `import M hiding (foo)`
- --
- | Hiding [DeclarationRef]
- deriving (Eq, Show, Generic, Serialise)
-
-isImplicit :: ImportDeclarationType -> Bool
-isImplicit Implicit = True
-isImplicit _ = False
-
-isExplicit :: ImportDeclarationType -> Bool
-isExplicit (Explicit _) = True
-isExplicit _ = False
-
--- | A type declaration assigns a type to an identifier, eg:
---
--- @identity :: forall a. a -> a@
---
--- In this example @identity@ is the identifier and @forall a. a -> a@ the type.
-data TypeDeclarationData = TypeDeclarationData
- { tydeclSourceAnn :: !SourceAnn
- , tydeclIdent :: !Ident
- , tydeclType :: !SourceType
- } deriving (Show, Eq)
-
-overTypeDeclaration :: (TypeDeclarationData -> TypeDeclarationData) -> Declaration -> Declaration
-overTypeDeclaration f d = maybe d (TypeDeclaration . f) (getTypeDeclaration d)
-
-getTypeDeclaration :: Declaration -> Maybe TypeDeclarationData
-getTypeDeclaration (TypeDeclaration d) = Just d
-getTypeDeclaration _ = Nothing
-
-unwrapTypeDeclaration :: TypeDeclarationData -> (Ident, SourceType)
-unwrapTypeDeclaration td = (tydeclIdent td, tydeclType td)
-
--- | A value declaration assigns a name and potential binders, to an expression (or multiple guarded expressions).
---
--- @double x = x + x@
---
--- In this example @double@ is the identifier, @x@ is a binder and @x + x@ is the expression.
-data ValueDeclarationData a = ValueDeclarationData
- { valdeclSourceAnn :: !SourceAnn
- , valdeclIdent :: !Ident
- -- ^ The declared value's name
- , valdeclName :: !NameKind
- -- ^ Whether or not this value is exported/visible
- , valdeclBinders :: ![Binder]
- , valdeclExpression :: !a
- } deriving (Show, Functor, Foldable, Traversable)
-
-overValueDeclaration :: (ValueDeclarationData [GuardedExpr] -> ValueDeclarationData [GuardedExpr]) -> Declaration -> Declaration
-overValueDeclaration f d = maybe d (ValueDeclaration . f) (getValueDeclaration d)
-
-getValueDeclaration :: Declaration -> Maybe (ValueDeclarationData [GuardedExpr])
-getValueDeclaration (ValueDeclaration d) = Just d
-getValueDeclaration _ = Nothing
-
-pattern ValueDecl :: SourceAnn -> Ident -> NameKind -> [Binder] -> [GuardedExpr] -> Declaration
-pattern ValueDecl sann ident name binders expr
- = ValueDeclaration (ValueDeclarationData sann ident name binders expr)
-
-data DataConstructorDeclaration = DataConstructorDeclaration
- { dataCtorAnn :: !SourceAnn
- , dataCtorName :: !(ProperName 'ConstructorName)
- , dataCtorFields :: ![(Ident, SourceType)]
- } deriving (Show, Eq)
-
-traverseDataCtorFields :: Monad m => ([(Ident, SourceType)] -> m [(Ident, SourceType)]) -> DataConstructorDeclaration -> m DataConstructorDeclaration
-traverseDataCtorFields f DataConstructorDeclaration{..} = DataConstructorDeclaration dataCtorAnn dataCtorName <$> f dataCtorFields
-
--- |
--- The data type of declarations
---
-data Declaration
- -- |
- -- A data type declaration (data or newtype, name, arguments, data constructors)
- --
- = DataDeclaration SourceAnn DataDeclType (ProperName 'TypeName) [(Text, Maybe SourceKind)] [DataConstructorDeclaration]
- -- |
- -- A minimal mutually recursive set of data type declarations
- --
- | DataBindingGroupDeclaration (NEL.NonEmpty Declaration)
- -- |
- -- A type synonym declaration (name, arguments, type)
- --
- | TypeSynonymDeclaration SourceAnn (ProperName 'TypeName) [(Text, Maybe SourceKind)] SourceType
- -- |
- -- A type declaration for a value (name, ty)
- --
- | TypeDeclaration {-# UNPACK #-} !TypeDeclarationData
- -- |
- -- A value declaration (name, top-level binders, optional guard, value)
- --
- | ValueDeclaration {-# UNPACK #-} !(ValueDeclarationData [GuardedExpr])
- -- |
- -- A declaration paired with pattern matching in let-in expression (binder, optional guard, value)
- | BoundValueDeclaration SourceAnn Binder Expr
- -- |
- -- A minimal mutually recursive set of value declarations
- --
- | BindingGroupDeclaration (NEL.NonEmpty ((SourceAnn, Ident), NameKind, Expr))
- -- |
- -- A foreign import declaration (name, type)
- --
- | ExternDeclaration SourceAnn Ident SourceType
- -- |
- -- A data type foreign import (name, kind)
- --
- | ExternDataDeclaration SourceAnn (ProperName 'TypeName) SourceKind
- -- |
- -- A foreign kind import (name)
- --
- | ExternKindDeclaration SourceAnn (ProperName 'KindName)
- -- |
- -- A fixity declaration
- --
- | FixityDeclaration SourceAnn (Either ValueFixity TypeFixity)
- -- |
- -- A module import (module name, qualified/unqualified/hiding, optional "qualified as" name)
- --
- | ImportDeclaration SourceAnn ModuleName ImportDeclarationType (Maybe ModuleName)
- -- |
- -- A type class declaration (name, argument, implies, member declarations)
- --
- | TypeClassDeclaration SourceAnn (ProperName 'ClassName) [(Text, Maybe SourceKind)] [SourceConstraint] [FunctionalDependency] [Declaration]
- -- |
- -- A type instance declaration (instance chain, chain index, name,
- -- dependencies, class name, instance types, member declarations)
- --
- | TypeInstanceDeclaration SourceAnn [Ident] Integer Ident [SourceConstraint] (Qualified (ProperName 'ClassName)) [SourceType] TypeInstanceBody
- deriving (Show)
-
-data ValueFixity = ValueFixity Fixity (Qualified (Either Ident (ProperName 'ConstructorName))) (OpName 'ValueOpName)
- deriving (Eq, Ord, Show)
-
-data TypeFixity = TypeFixity Fixity (Qualified (ProperName 'TypeName)) (OpName 'TypeOpName)
- deriving (Eq, Ord, Show)
-
-pattern ValueFixityDeclaration :: SourceAnn -> Fixity -> Qualified (Either Ident (ProperName 'ConstructorName)) -> OpName 'ValueOpName -> Declaration
-pattern ValueFixityDeclaration sa fixity name op = FixityDeclaration sa (Left (ValueFixity fixity name op))
-
-pattern TypeFixityDeclaration :: SourceAnn -> Fixity -> Qualified (ProperName 'TypeName) -> OpName 'TypeOpName -> Declaration
-pattern TypeFixityDeclaration sa fixity name op = FixityDeclaration sa (Right (TypeFixity fixity name op))
-
--- | The members of a type class instance declaration
-data TypeInstanceBody
- = DerivedInstance
- -- ^ This is a derived instance
- | NewtypeInstance
- -- ^ This is an instance derived from a newtype
- | NewtypeInstanceWithDictionary Expr
- -- ^ This is an instance derived from a newtype, desugared to include a
- -- dictionary for the type under the newtype.
- | ExplicitInstance [Declaration]
- -- ^ This is a regular (explicit) instance
- deriving (Show)
-
-mapTypeInstanceBody :: ([Declaration] -> [Declaration]) -> TypeInstanceBody -> TypeInstanceBody
-mapTypeInstanceBody f = runIdentity . traverseTypeInstanceBody (Identity . f)
-
--- | A traversal for TypeInstanceBody
-traverseTypeInstanceBody :: (Applicative f) => ([Declaration] -> f [Declaration]) -> TypeInstanceBody -> f TypeInstanceBody
-traverseTypeInstanceBody f (ExplicitInstance ds) = ExplicitInstance <$> f ds
-traverseTypeInstanceBody _ other = pure other
-
-declSourceAnn :: Declaration -> SourceAnn
-declSourceAnn (DataDeclaration sa _ _ _ _) = sa
-declSourceAnn (DataBindingGroupDeclaration ds) = declSourceAnn (NEL.head ds)
-declSourceAnn (TypeSynonymDeclaration sa _ _ _) = sa
-declSourceAnn (TypeDeclaration td) = tydeclSourceAnn td
-declSourceAnn (ValueDeclaration vd) = valdeclSourceAnn vd
-declSourceAnn (BoundValueDeclaration sa _ _) = sa
-declSourceAnn (BindingGroupDeclaration ds) = let ((sa, _), _, _) = NEL.head ds in sa
-declSourceAnn (ExternDeclaration sa _ _) = sa
-declSourceAnn (ExternDataDeclaration sa _ _) = sa
-declSourceAnn (ExternKindDeclaration sa _) = sa
-declSourceAnn (FixityDeclaration sa _) = sa
-declSourceAnn (ImportDeclaration sa _ _ _) = sa
-declSourceAnn (TypeClassDeclaration sa _ _ _ _ _) = sa
-declSourceAnn (TypeInstanceDeclaration sa _ _ _ _ _ _ _) = sa
-
-declSourceSpan :: Declaration -> SourceSpan
-declSourceSpan = fst . declSourceAnn
-
-declName :: Declaration -> Maybe Name
-declName (DataDeclaration _ _ n _ _) = Just (TyName n)
-declName (TypeSynonymDeclaration _ n _ _) = Just (TyName n)
-declName (ValueDeclaration vd) = Just (IdentName (valdeclIdent vd))
-declName (ExternDeclaration _ n _) = Just (IdentName n)
-declName (ExternDataDeclaration _ n _) = Just (TyName n)
-declName (ExternKindDeclaration _ n) = Just (KiName n)
-declName (FixityDeclaration _ (Left (ValueFixity _ _ n))) = Just (ValOpName n)
-declName (FixityDeclaration _ (Right (TypeFixity _ _ n))) = Just (TyOpName n)
-declName (TypeClassDeclaration _ n _ _ _ _) = Just (TyClassName n)
-declName (TypeInstanceDeclaration _ _ _ n _ _ _ _) = Just (IdentName n)
-declName ImportDeclaration{} = Nothing
-declName BindingGroupDeclaration{} = Nothing
-declName DataBindingGroupDeclaration{} = Nothing
-declName BoundValueDeclaration{} = Nothing
-declName TypeDeclaration{} = Nothing
-
--- |
--- Test if a declaration is a value declaration
---
-isValueDecl :: Declaration -> Bool
-isValueDecl ValueDeclaration{} = True
-isValueDecl _ = False
-
--- |
--- Test if a declaration is a data type or type synonym declaration
---
-isDataDecl :: Declaration -> Bool
-isDataDecl DataDeclaration{} = True
-isDataDecl TypeSynonymDeclaration{} = True
-isDataDecl _ = False
-
--- |
--- Test if a declaration is a module import
---
-isImportDecl :: Declaration -> Bool
-isImportDecl ImportDeclaration{} = True
-isImportDecl _ = False
-
--- |
--- Test if a declaration is a data type foreign import
---
-isExternDataDecl :: Declaration -> Bool
-isExternDataDecl ExternDataDeclaration{} = True
-isExternDataDecl _ = False
-
--- |
--- Test if a declaration is a foreign kind import
---
-isExternKindDecl :: Declaration -> Bool
-isExternKindDecl ExternKindDeclaration{} = True
-isExternKindDecl _ = False
-
--- |
--- Test if a declaration is a fixity declaration
---
-isFixityDecl :: Declaration -> Bool
-isFixityDecl FixityDeclaration{} = True
-isFixityDecl _ = False
-
-getFixityDecl :: Declaration -> Maybe (Either ValueFixity TypeFixity)
-getFixityDecl (FixityDeclaration _ fixity) = Just fixity
-getFixityDecl _ = Nothing
-
--- |
--- Test if a declaration is a foreign import
---
-isExternDecl :: Declaration -> Bool
-isExternDecl ExternDeclaration{} = True
-isExternDecl _ = False
-
--- |
--- Test if a declaration is a type class instance declaration
---
-isTypeClassInstanceDeclaration :: Declaration -> Bool
-isTypeClassInstanceDeclaration TypeInstanceDeclaration{} = True
-isTypeClassInstanceDeclaration _ = False
-
--- |
--- Test if a declaration is a type class declaration
---
-isTypeClassDeclaration :: Declaration -> Bool
-isTypeClassDeclaration TypeClassDeclaration{} = True
-isTypeClassDeclaration _ = False
-
--- |
--- Recursively flatten data binding groups in the list of declarations
-flattenDecls :: [Declaration] -> [Declaration]
-flattenDecls = concatMap flattenOne
- where flattenOne :: Declaration -> [Declaration]
- flattenOne (DataBindingGroupDeclaration decls) = concatMap flattenOne decls
- flattenOne d = [d]
-
--- |
--- A guard is just a boolean-valued expression that appears alongside a set of binders
---
-data Guard = ConditionGuard Expr
- | PatternGuard Binder Expr
- deriving (Show)
-
--- |
--- The right hand side of a binder in value declarations
--- and case expressions.
-data GuardedExpr = GuardedExpr [Guard] Expr
- deriving (Show)
-
-pattern MkUnguarded :: Expr -> GuardedExpr
-pattern MkUnguarded e = GuardedExpr [] e
-
--- |
--- Data type for expressions and terms
---
-data Expr
- -- |
- -- A literal value
- --
- = Literal SourceSpan (Literal Expr)
- -- |
- -- A prefix -, will be desugared
- --
- | UnaryMinus SourceSpan Expr
- -- |
- -- Binary operator application. During the rebracketing phase of desugaring, this data constructor
- -- will be removed.
- --
- | BinaryNoParens Expr Expr Expr
- -- |
- -- Explicit parentheses. During the rebracketing phase of desugaring, this data constructor
- -- will be removed.
- --
- -- Note: although it seems this constructor is not used, it _is_ useful, since it prevents
- -- certain traversals from matching.
- --
- | Parens Expr
- -- |
- -- An record property accessor expression (e.g. `obj.x` or `_.x`).
- -- Anonymous arguments will be removed during desugaring and expanded
- -- into a lambda that reads a property from a record.
- --
- | Accessor PSString Expr
- -- |
- -- Partial record update
- --
- | ObjectUpdate Expr [(PSString, Expr)]
- -- |
- -- Object updates with nested support: `x { foo { bar = e } }`
- -- Replaced during desugaring into a `Let` and nested `ObjectUpdate`s
- --
- | ObjectUpdateNested Expr (PathTree Expr)
- -- |
- -- Function introduction
- --
- | Abs Binder Expr
- -- |
- -- Function application
- --
- | App Expr Expr
- -- |
- -- Hint that an expression is unused.
- -- This is used to ignore type class dictionaries that are necessarily empty.
- -- The inner expression lets us solve subgoals before eliminating the whole expression.
- -- The code gen will render this as `undefined`, regardless of what the inner expression is.
- | Unused Expr
- -- |
- -- Variable
- --
- | Var SourceSpan (Qualified Ident)
- -- |
- -- An operator. This will be desugared into a function during the "operators"
- -- phase of desugaring.
- --
- | Op SourceSpan (Qualified (OpName 'ValueOpName))
- -- |
- -- Conditional (if-then-else expression)
- --
- | IfThenElse Expr Expr Expr
- -- |
- -- A data constructor
- --
- | Constructor SourceSpan (Qualified (ProperName 'ConstructorName))
- -- |
- -- A case expression. During the case expansion phase of desugaring, top-level binders will get
- -- desugared into case expressions, hence the need for guards and multiple binders per branch here.
- --
- | Case [Expr] [CaseAlternative]
- -- |
- -- A value with a type annotation
- --
- | TypedValue Bool Expr SourceType
- -- |
- -- A let binding
- --
- | Let WhereProvenance [Declaration] Expr
- -- |
- -- A do-notation block
- --
- | Do (Maybe ModuleName) [DoNotationElement]
- -- |
- -- An ado-notation block
- --
- | Ado (Maybe ModuleName) [DoNotationElement] Expr
- -- |
- -- An application of a typeclass dictionary constructor. The value should be
- -- an ObjectLiteral.
- --
- | TypeClassDictionaryConstructorApp (Qualified (ProperName 'ClassName)) Expr
- -- |
- -- A placeholder for a type class dictionary to be inserted later. At the end of type checking, these
- -- placeholders will be replaced with actual expressions representing type classes dictionaries which
- -- can be evaluated at runtime. The constructor arguments represent (in order): whether or not to look
- -- at superclass implementations when searching for a dictionary, the type class name and
- -- instance type, and the type class dictionaries in scope.
- --
- | TypeClassDictionary SourceConstraint
- (M.Map (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) (NEL.NonEmpty NamedDict))))
- [ErrorMessageHint]
- -- |
- -- A typeclass dictionary accessor, the implementation is left unspecified until CoreFn desugaring.
- --
- | TypeClassDictionaryAccessor (Qualified (ProperName 'ClassName)) Ident
- -- |
- -- A placeholder for a superclass dictionary to be turned into a TypeClassDictionary during typechecking
- --
- | DeferredDictionary (Qualified (ProperName 'ClassName)) [SourceType]
- -- |
- -- A placeholder for an anonymous function argument
- --
- | AnonymousArgument
- -- |
- -- A typed hole that will be turned into a hint/error during typechecking
- --
- | Hole Text
- -- |
- -- A value with source position information
- --
- | PositionedValue SourceSpan [Comment] Expr
- deriving (Show)
-
--- |
--- Metadata that tells where a let binding originated
---
-data WhereProvenance
- -- |
- -- The let binding was originally a where clause
- --
- = FromWhere
- -- |
- -- The let binding was always a let binding
- --
- | FromLet
- deriving (Show)
-
--- |
--- An alternative in a case statement
---
-data CaseAlternative = CaseAlternative
- { -- |
- -- A collection of binders with which to match the inputs
- --
- caseAlternativeBinders :: [Binder]
- -- |
- -- The result expression or a collect of guarded expressions
- --
- , caseAlternativeResult :: [GuardedExpr]
- } deriving (Show)
-
--- |
--- A statement in a do-notation block
---
-data DoNotationElement
- -- |
- -- A monadic value without a binder
- --
- = DoNotationValue Expr
- -- |
- -- A monadic value with a binder
- --
- | DoNotationBind Binder Expr
- -- |
- -- A let statement, i.e. a pure value with a binder
- --
- | DoNotationLet [Declaration]
- -- |
- -- A do notation element with source position information
- --
- | PositionedDoNotationElement SourceSpan [Comment] DoNotationElement
- deriving (Show)
-
-
--- For a record update such as:
---
--- x { foo = 0
--- , bar { baz = 1
--- , qux = 2 } }
---
--- We represent the updates as the `PathTree`:
---
--- [ ("foo", Leaf 3)
--- , ("bar", Branch [ ("baz", Leaf 1)
--- , ("qux", Leaf 2) ]) ]
---
--- Which we then convert to an expression representing the following:
---
--- let x' = x
--- in x' { foo = 0
--- , bar = x'.bar { baz = 1
--- , qux = 2 } }
---
--- The `let` here is required to prevent re-evaluating the object expression `x`.
--- However we don't generate this when using an anonymous argument for the object.
---
-
-newtype PathTree t = PathTree (AssocList PSString (PathNode t))
- deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
-
-data PathNode t = Leaf t | Branch (PathTree t)
- deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
-
-newtype AssocList k t = AssocList { runAssocList :: [(k, t)] }
- deriving (Show, Eq, Ord, Foldable, Functor, Traversable)
-
-$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''DeclarationRef)
-$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ImportDeclarationType)
-$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ExportSource)
-
-isTrueExpr :: Expr -> Bool
-isTrueExpr (Literal _ (BooleanLiteral True)) = True
-isTrueExpr (Var _ (Qualified (Just (ModuleName "Prelude")) (Ident "otherwise"))) = True
-isTrueExpr (Var _ (Qualified (Just (ModuleName "Data.Boolean")) (Ident "otherwise"))) = True
-isTrueExpr (TypedValue _ e _) = isTrueExpr e
-isTrueExpr (PositionedValue _ _ e) = isTrueExpr e
-isTrueExpr _ = False
diff --git a/src/Language/PureScript/AST/Exported.hs b/src/Language/PureScript/AST/Exported.hs
deleted file mode 100644
index 9cf015e..0000000
--- a/src/Language/PureScript/AST/Exported.hs
+++ /dev/null
@@ -1,156 +0,0 @@
-module Language.PureScript.AST.Exported
- ( exportedDeclarations
- , isExported
- ) where
-
-import Prelude.Compat
-import Protolude (sortBy, on)
-
-import Control.Category ((>>>))
-
-import Data.Maybe (mapMaybe)
-import qualified Data.Map as M
-
-import Language.PureScript.AST.Declarations
-import Language.PureScript.Types
-import Language.PureScript.Names
-
--- |
--- Return a list of all declarations which are exported from a module.
--- This function descends into data declarations to filter out unexported
--- data constructors, and also filters out type instance declarations if
--- they refer to classes or types which are not themselves exported.
---
--- Note that this function assumes that the module has already had its imports
--- desugared using 'Language.PureScript.Sugar.Names.desugarImports'. It will
--- produce incorrect results if this is not the case - for example, type class
--- instances will be incorrectly removed in some cases.
---
--- The returned declarations are in the same order as they appear in the export
--- list, unless there is no export list, in which case they appear in the same
--- order as they do in the source file.
---
-exportedDeclarations :: Module -> [Declaration]
-exportedDeclarations (Module _ _ mn decls exps) = go decls
- where
- go = flattenDecls
- >>> filter (isExported exps)
- >>> map (filterDataConstructors exps)
- >>> filterInstances mn exps
- >>> maybe id reorder exps
-
--- |
--- Filter out all data constructors from a declaration which are not exported.
--- If the supplied declaration is not a data declaration, this function returns
--- it unchanged.
---
-filterDataConstructors :: Maybe [DeclarationRef] -> Declaration -> Declaration
-filterDataConstructors exps (DataDeclaration sa dType tyName tyArgs dctors) =
- DataDeclaration sa dType tyName tyArgs $
- filter (isDctorExported tyName exps . dataCtorName) dctors
-filterDataConstructors _ other = other
-
--- |
--- Filter out all the type instances from a list of declarations which
--- reference a type or type class which is both local and not exported.
---
--- Note that this function assumes that the module has already had its imports
--- desugared using "Language.PureScript.Sugar.Names.desugarImports". It will
--- produce incorrect results if this is not the case - for example, type class
--- instances will be incorrectly removed in some cases.
---
-filterInstances
- :: ModuleName
- -> Maybe [DeclarationRef]
- -> [Declaration]
- -> [Declaration]
-filterInstances _ Nothing = id
-filterInstances mn (Just exps) =
- let refs = Left `map` mapMaybe typeClassName exps
- ++ Right `map` mapMaybe typeName exps
- in filter (all (visibleOutside refs) . typeInstanceConstituents)
- where
- -- Given a Qualified ProperName, and a list of all exported types and type
- -- classes, returns whether the supplied Qualified ProperName is visible
- -- outside this module. This is true if one of the following hold:
- --
- -- * the name is defined in the same module and is exported,
- -- * the name is defined in a different module (and must be exported from
- -- that module; the code would fail to compile otherwise).
- visibleOutside
- :: [Either (ProperName 'ClassName) (ProperName 'TypeName)]
- -> Either (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'TypeName))
- -> Bool
- visibleOutside refs q
- | either checkQual checkQual q = True
- | otherwise = either (Left . disqualify) (Right . disqualify) q `elem` refs
-
- -- Check that a qualified name is qualified for a different module
- checkQual :: Qualified a -> Bool
- checkQual q = isQualified q && not (isQualifiedWith mn q)
-
- typeName :: DeclarationRef -> Maybe (ProperName 'TypeName)
- typeName (TypeRef _ n _) = Just n
- typeName _ = Nothing
-
- typeClassName :: DeclarationRef -> Maybe (ProperName 'ClassName)
- typeClassName (TypeClassRef _ n) = Just n
- typeClassName _ = Nothing
-
--- |
--- Get all type and type class names referenced by a type instance declaration.
---
-typeInstanceConstituents :: Declaration -> [Either (Qualified (ProperName 'ClassName)) (Qualified (ProperName 'TypeName))]
-typeInstanceConstituents (TypeInstanceDeclaration _ _ _ _ constraints className tys _) =
- Left className : (concatMap fromConstraint constraints ++ concatMap fromType tys)
- where
-
- fromConstraint c = Left (constraintClass c) : concatMap fromType (constraintArgs c)
- fromType = everythingOnTypes (++) go
-
- -- Note that type synonyms are disallowed in instance declarations, so
- -- we don't need to handle them here.
- go (TypeConstructor _ n) = [Right n]
- go (ConstrainedType _ c _) = fromConstraint c
- go _ = []
-
-typeInstanceConstituents _ = []
-
-
--- |
--- Test if a declaration is exported, given a module's export list. Note that
--- this function does not account for type instance declarations of
--- non-exported types, or non-exported data constructors. Therefore, you should
--- prefer 'exportedDeclarations' to this function, where possible.
---
-isExported :: Maybe [DeclarationRef] -> Declaration -> Bool
-isExported Nothing _ = True
-isExported _ TypeInstanceDeclaration{} = True
-isExported (Just exps) decl = any matches exps
- where
- matches declRef = declName decl == Just (declRefName declRef)
-
--- |
--- Test if a data constructor for a given type is exported, given a module's
--- export list. Prefer 'exportedDeclarations' to this function, where possible.
---
-isDctorExported :: ProperName 'TypeName -> Maybe [DeclarationRef] -> ProperName 'ConstructorName -> Bool
-isDctorExported _ Nothing _ = True
-isDctorExported ident (Just exps) ctor = test `any` exps
- where
- test (TypeRef _ ident' Nothing) = ident == ident'
- test (TypeRef _ ident' (Just ctors)) = ident == ident' && ctor `elem` ctors
- test _ = False
-
--- |
--- Reorder declarations based on the order they appear in the given export
--- list.
---
-reorder :: [DeclarationRef] -> [Declaration] -> [Declaration]
-reorder refs =
- sortBy (compare `on` refIndex)
- where
- refIndices =
- M.fromList $ zip (map declRefName refs) [(0::Int)..]
- refIndex decl =
- declName decl >>= flip M.lookup refIndices
diff --git a/src/Language/PureScript/AST/Literals.hs b/src/Language/PureScript/AST/Literals.hs
deleted file mode 100644
index a161fd8..0000000
--- a/src/Language/PureScript/AST/Literals.hs
+++ /dev/null
@@ -1,38 +0,0 @@
--- |
--- The core functional representation for literal values.
---
-module Language.PureScript.AST.Literals where
-
-import Prelude.Compat
-import Language.PureScript.PSString (PSString)
-
--- |
--- Data type for literal values. Parameterised so it can be used for Exprs and
--- Binders.
---
-data Literal a
- -- |
- -- A numeric literal
- --
- = NumericLiteral (Either Integer Double)
- -- |
- -- A string literal
- --
- | StringLiteral PSString
- -- |
- -- A character literal
- --
- | CharLiteral Char
- -- |
- -- A boolean literal
- --
- | BooleanLiteral Bool
- -- |
- -- An array literal
- --
- | ArrayLiteral [a]
- -- |
- -- An object literal
- --
- | ObjectLiteral [(PSString, a)]
- deriving (Eq, Ord, Show, Functor)
diff --git a/src/Language/PureScript/AST/Operators.hs b/src/Language/PureScript/AST/Operators.hs
deleted file mode 100644
index 41a1292..0000000
--- a/src/Language/PureScript/AST/Operators.hs
+++ /dev/null
@@ -1,61 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
--- |
--- Operators fixity and associativity
---
-module Language.PureScript.AST.Operators where
-
-import Prelude.Compat
-
-import Codec.Serialise (Serialise)
-import GHC.Generics (Generic)
-import Control.DeepSeq (NFData)
-import Data.Aeson ((.=))
-import qualified Data.Aeson as A
-
-import Language.PureScript.Crash
-
--- |
--- A precedence level for an infix operator
---
-type Precedence = Integer
-
--- |
--- Associativity for infix operators
---
-data Associativity = Infixl | Infixr | Infix
- deriving (Show, Eq, Ord, Generic)
-
-instance NFData Associativity
-instance Serialise Associativity
-
-showAssoc :: Associativity -> String
-showAssoc Infixl = "infixl"
-showAssoc Infixr = "infixr"
-showAssoc Infix = "infix"
-
-readAssoc :: String -> Associativity
-readAssoc "infixl" = Infixl
-readAssoc "infixr" = Infixr
-readAssoc "infix" = Infix
-readAssoc _ = internalError "readAssoc: no parse"
-
-instance A.ToJSON Associativity where
- toJSON = A.toJSON . showAssoc
-
-instance A.FromJSON Associativity where
- parseJSON = fmap readAssoc . A.parseJSON
-
--- |
--- Fixity data for infix operators
---
-data Fixity = Fixity Associativity Precedence
- deriving (Show, Eq, Ord, Generic)
-
-instance NFData Fixity
-instance Serialise Fixity
-
-instance A.ToJSON Fixity where
- toJSON (Fixity associativity precedence) =
- A.object [ "associativity" .= associativity
- , "precedence" .= precedence
- ]
diff --git a/src/Language/PureScript/AST/SourcePos.hs b/src/Language/PureScript/AST/SourcePos.hs
deleted file mode 100644
index bd5e4f2..0000000
--- a/src/Language/PureScript/AST/SourcePos.hs
+++ /dev/null
@@ -1,119 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
--- |
--- Source position information
---
-module Language.PureScript.AST.SourcePos where
-
-import Prelude.Compat
-
-import Codec.Serialise (Serialise)
-import Control.DeepSeq (NFData)
-import Data.Aeson ((.=), (.:))
-import Data.Text (Text)
-import GHC.Generics (Generic)
-import Language.PureScript.Comments
-import qualified Data.Aeson as A
-import qualified Data.Text as T
-import System.FilePath (makeRelative)
-
--- | Source annotation - position information and comments.
-type SourceAnn = (SourceSpan, [Comment])
-
--- | Source position information
-data SourcePos = SourcePos
- { sourcePosLine :: Int
- -- ^ Line number
- , sourcePosColumn :: Int
- -- ^ Column number
- } deriving (Show, Eq, Ord, Generic, NFData, Serialise)
-
-displaySourcePos :: SourcePos -> Text
-displaySourcePos sp =
- "line " <> T.pack (show (sourcePosLine sp)) <>
- ", column " <> T.pack (show (sourcePosColumn sp))
-
-displaySourcePosShort :: SourcePos -> Text
-displaySourcePosShort sp =
- T.pack (show (sourcePosLine sp)) <>
- ":" <> T.pack (show (sourcePosColumn sp))
-
-instance A.ToJSON SourcePos where
- toJSON SourcePos{..} =
- A.toJSON [sourcePosLine, sourcePosColumn]
-
-instance A.FromJSON SourcePos where
- parseJSON arr = do
- [line, col] <- A.parseJSON arr
- return $ SourcePos line col
-
-data SourceSpan = SourceSpan
- { spanName :: String
- -- ^ Source name
- , spanStart :: SourcePos
- -- ^ Start of the span
- , spanEnd :: SourcePos
- -- ^ End of the span
- } deriving (Show, Eq, Ord, Generic, NFData, Serialise)
-
-displayStartEndPos :: SourceSpan -> Text
-displayStartEndPos sp =
- "(" <>
- displaySourcePos (spanStart sp) <> " - " <>
- displaySourcePos (spanEnd sp) <> ")"
-
-displayStartEndPosShort :: SourceSpan -> Text
-displayStartEndPosShort sp =
- displaySourcePosShort (spanStart sp) <> " - " <>
- displaySourcePosShort (spanEnd sp)
-
-displaySourceSpan :: FilePath -> SourceSpan -> Text
-displaySourceSpan relPath sp =
- T.pack (makeRelative relPath (spanName sp)) <> ":" <>
- displayStartEndPosShort sp <> " " <>
- displayStartEndPos sp
-
-instance A.ToJSON SourceSpan where
- toJSON SourceSpan{..} =
- A.object [ "name" .= spanName
- , "start" .= spanStart
- , "end" .= spanEnd
- ]
-
-instance A.FromJSON SourceSpan where
- parseJSON = A.withObject "SourceSpan" $ \o ->
- SourceSpan <$>
- o .: "name" <*>
- o .: "start" <*>
- o .: "end"
-
-internalModuleSourceSpan :: String -> SourceSpan
-internalModuleSourceSpan name = SourceSpan name (SourcePos 0 0) (SourcePos 0 0)
-
-nullSourceSpan :: SourceSpan
-nullSourceSpan = internalModuleSourceSpan ""
-
-nullSourceAnn :: SourceAnn
-nullSourceAnn = (nullSourceSpan, [])
-
-pattern NullSourceSpan :: SourceSpan
-pattern NullSourceSpan = SourceSpan "" (SourcePos 0 0) (SourcePos 0 0)
-
-pattern NullSourceAnn :: SourceAnn
-pattern NullSourceAnn = (NullSourceSpan, [])
-
-nonEmptySpan :: SourceAnn -> Maybe SourceSpan
-nonEmptySpan (NullSourceSpan, _) = Nothing
-nonEmptySpan (ss, _) = Just ss
-
-widenSourceSpan :: SourceSpan -> SourceSpan -> SourceSpan
-widenSourceSpan NullSourceSpan b = b
-widenSourceSpan a NullSourceSpan = a
-widenSourceSpan (SourceSpan n1 s1 e1) (SourceSpan n2 s2 e2) =
- SourceSpan n (min s1 s2) (max e1 e2)
- where
- n | n1 == "" = n2
- | otherwise = n1
-
-widenSourceAnn :: SourceAnn -> SourceAnn -> SourceAnn
-widenSourceAnn (s1, _) (s2, _) = (widenSourceSpan s1 s2, [])
diff --git a/src/Language/PureScript/AST/Traversals.hs b/src/Language/PureScript/AST/Traversals.hs
deleted file mode 100644
index 4aaeeec..0000000
--- a/src/Language/PureScript/AST/Traversals.hs
+++ /dev/null
@@ -1,706 +0,0 @@
--- |
--- AST traversal helpers
---
-module Language.PureScript.AST.Traversals where
-
-import Prelude.Compat
-
-import Control.Monad
-
-import Data.Foldable (fold)
-import Data.List (mapAccumL)
-import Data.Maybe (mapMaybe)
-import qualified Data.List.NonEmpty as NEL
-import qualified Data.Map as M
-import qualified Data.Set as S
-
-import Language.PureScript.AST.Binders
-import Language.PureScript.AST.Declarations
-import Language.PureScript.AST.Literals
-import Language.PureScript.Kinds
-import Language.PureScript.Names
-import Language.PureScript.Traversals
-import Language.PureScript.TypeClassDictionaries (TypeClassDictionaryInScope(..))
-import Language.PureScript.Types
-
-guardedExprM :: Applicative m
- => (Guard -> m Guard)
- -> (Expr -> m Expr)
- -> GuardedExpr
- -> m GuardedExpr
-guardedExprM f g (GuardedExpr guards rhs) =
- GuardedExpr <$> traverse f guards <*> g rhs
-
-mapGuardedExpr :: (Guard -> Guard)
- -> (Expr -> Expr)
- -> GuardedExpr
- -> GuardedExpr
-mapGuardedExpr f g (GuardedExpr guards rhs) =
- GuardedExpr (fmap f guards) (g rhs)
-
-litM :: Monad m => (a -> m a) -> Literal a -> m (Literal a)
-litM go (ObjectLiteral as) = ObjectLiteral <$> traverse (sndM go) as
-litM go (ArrayLiteral as) = ArrayLiteral <$> traverse go as
-litM _ other = pure other
-
-everywhereOnValues
- :: (Declaration -> Declaration)
- -> (Expr -> Expr)
- -> (Binder -> Binder)
- -> ( Declaration -> Declaration
- , Expr -> Expr
- , Binder -> Binder
- )
-everywhereOnValues f g h = (f', g', h')
- where
- f' :: Declaration -> Declaration
- f' (DataBindingGroupDeclaration ds) = f (DataBindingGroupDeclaration (fmap f' ds))
- f' (ValueDecl sa name nameKind bs val) =
- f (ValueDecl sa name nameKind (fmap h' bs) (fmap (mapGuardedExpr handleGuard g') val))
- f' (BoundValueDeclaration sa b expr) = f (BoundValueDeclaration sa (h' b) (g' expr))
- f' (BindingGroupDeclaration ds) = f (BindingGroupDeclaration (fmap (\(name, nameKind, val) -> (name, nameKind, g' val)) ds))
- f' (TypeClassDeclaration sa name args implies deps ds) = f (TypeClassDeclaration sa name args implies deps (fmap f' ds))
- f' (TypeInstanceDeclaration sa ch idx name cs className args ds) = f (TypeInstanceDeclaration sa ch idx name cs className args (mapTypeInstanceBody (fmap f') ds))
- f' other = f other
-
- g' :: Expr -> Expr
- g' (Literal ss l) = g (Literal ss (lit g' l))
- g' (UnaryMinus ss v) = g (UnaryMinus ss (g' v))
- g' (BinaryNoParens op v1 v2) = g (BinaryNoParens (g' op) (g' v1) (g' v2))
- g' (Parens v) = g (Parens (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) (fmap (fmap g') vs))
- g' (ObjectUpdateNested obj vs) = g (ObjectUpdateNested (g' obj) (fmap g' vs))
- g' (Abs binder v) = g (Abs (h' binder) (g' v))
- g' (App v1 v2) = g (App (g' v1) (g' v2))
- g' (Unused v) = g (Unused (g' v))
- g' (IfThenElse v1 v2 v3) = g (IfThenElse (g' v1) (g' v2) (g' v3))
- g' (Case vs alts) = g (Case (fmap g' vs) (fmap handleCaseAlternative alts))
- g' (TypedValue check v ty) = g (TypedValue check (g' v) ty)
- g' (Let w ds v) = g (Let w (fmap f' ds) (g' v))
- g' (Do m es) = g (Do m (fmap handleDoNotationElement es))
- g' (Ado m es v) = g (Ado m (fmap handleDoNotationElement es) (g' v))
- g' (PositionedValue pos com v) = g (PositionedValue pos com (g' v))
- g' other = g other
-
- h' :: Binder -> Binder
- h' (ConstructorBinder ss ctor bs) = h (ConstructorBinder ss ctor (fmap h' bs))
- h' (BinaryNoParensBinder b1 b2 b3) = h (BinaryNoParensBinder (h' b1) (h' b2) (h' b3))
- h' (ParensInBinder b) = h (ParensInBinder (h' b))
- h' (LiteralBinder ss l) = h (LiteralBinder ss (lit h' l))
- h' (NamedBinder ss name b) = h (NamedBinder ss name (h' b))
- h' (PositionedBinder pos com b) = h (PositionedBinder pos com (h' b))
- h' (TypedBinder t b) = h (TypedBinder t (h' b))
- h' other = h other
-
- lit :: (a -> a) -> Literal a -> Literal a
- lit go (ArrayLiteral as) = ArrayLiteral (fmap go as)
- lit go (ObjectLiteral as) = ObjectLiteral (fmap (fmap go) as)
- lit _ other = other
-
- handleCaseAlternative :: CaseAlternative -> CaseAlternative
- handleCaseAlternative ca =
- ca { caseAlternativeBinders = fmap h' (caseAlternativeBinders ca)
- , caseAlternativeResult = fmap (mapGuardedExpr handleGuard g') (caseAlternativeResult ca)
- }
-
- handleDoNotationElement :: DoNotationElement -> DoNotationElement
- handleDoNotationElement (DoNotationValue v) = DoNotationValue (g' v)
- handleDoNotationElement (DoNotationBind b v) = DoNotationBind (h' b) (g' v)
- handleDoNotationElement (DoNotationLet ds) = DoNotationLet (fmap f' ds)
- handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com (handleDoNotationElement e)
-
- handleGuard :: Guard -> Guard
- handleGuard (ConditionGuard e) = ConditionGuard (g' e)
- handleGuard (PatternGuard b e) = PatternGuard (h' b) (g' e)
-
-everywhereOnValuesTopDownM
- :: forall m
- . (Monad m)
- => (Declaration -> m Declaration)
- -> (Expr -> m Expr)
- -> (Binder -> m Binder)
- -> ( Declaration -> m Declaration
- , Expr -> m Expr
- , Binder -> m Binder
- )
-everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)
- where
-
- f' :: Declaration -> m Declaration
- f' (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> traverse (f' <=< f) ds
- f' (ValueDecl sa name nameKind bs val) =
- ValueDecl sa name nameKind <$> traverse (h' <=< h) bs <*> traverse (guardedExprM handleGuard (g' <=< g)) val
- f' (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> traverse (\(name, nameKind, val) -> (,,) name nameKind <$> (g val >>= g')) ds
- f' (TypeClassDeclaration sa name args implies deps ds) = TypeClassDeclaration sa name args implies deps <$> traverse (f' <=< f) ds
- f' (TypeInstanceDeclaration sa ch idx name cs className args ds) = TypeInstanceDeclaration sa ch idx name cs className args <$> traverseTypeInstanceBody (traverse (f' <=< f)) ds
- f' (BoundValueDeclaration sa b expr) = BoundValueDeclaration sa <$> (h' <=< h) b <*> (g' <=< g) expr
- f' other = f other
-
- g' :: Expr -> m Expr
- g' (Literal ss l) = Literal ss <$> litM (g >=> g') l
- g' (UnaryMinus ss v) = UnaryMinus ss <$> (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' (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
- g' (ObjectUpdateNested obj vs) = ObjectUpdateNested <$> (g obj >>= g') <*> traverse (g' <=< g) vs
- g' (Abs binder v) = Abs <$> (h binder >>= h') <*> (g v >>= g')
- g' (App v1 v2) = App <$> (g v1 >>= g') <*> (g v2 >>= g')
- g' (Unused v) = Unused <$> (g v >>= g')
- g' (IfThenElse v1 v2 v3) = IfThenElse <$> (g v1 >>= g') <*> (g v2 >>= g') <*> (g v3 >>= g')
- g' (Case vs alts) = Case <$> traverse (g' <=< g) vs <*> traverse handleCaseAlternative alts
- g' (TypedValue check v ty) = TypedValue check <$> (g v >>= g') <*> pure ty
- g' (Let w ds v) = Let w <$> traverse (f' <=< f) ds <*> (g v >>= g')
- g' (Do m es) = Do m <$> traverse handleDoNotationElement es
- g' (Ado m es v) = Ado m <$> traverse handleDoNotationElement es <*> (g v >>= g')
- g' (PositionedValue pos com v) = PositionedValue pos com <$> (g v >>= g')
- g' other = g other
-
- h' :: Binder -> m Binder
- h' (LiteralBinder ss l) = LiteralBinder ss <$> litM (h >=> h') l
- h' (ConstructorBinder ss ctor bs) = ConstructorBinder ss ctor <$> traverse (h' <=< h) bs
- h' (BinaryNoParensBinder b1 b2 b3) = BinaryNoParensBinder <$> (h b1 >>= h') <*> (h b2 >>= h') <*> (h b3 >>= h')
- h' (ParensInBinder b) = ParensInBinder <$> (h b >>= h')
- h' (NamedBinder ss name b) = NamedBinder ss name <$> (h b >>= h')
- h' (PositionedBinder pos com b) = PositionedBinder pos com <$> (h b >>= h')
- h' (TypedBinder t b) = TypedBinder t <$> (h b >>= h')
- h' other = h other
-
- handleCaseAlternative :: CaseAlternative -> m CaseAlternative
- handleCaseAlternative (CaseAlternative bs val) =
- CaseAlternative
- <$> traverse (h' <=< h) bs
- <*> traverse (guardedExprM handleGuard (g' <=< g)) val
-
- handleDoNotationElement :: DoNotationElement -> m DoNotationElement
- handleDoNotationElement (DoNotationValue v) = DoNotationValue <$> (g' <=< g) v
- handleDoNotationElement (DoNotationBind b v) = DoNotationBind <$> (h' <=< h) b <*> (g' <=< g) v
- handleDoNotationElement (DoNotationLet ds) = DoNotationLet <$> traverse (f' <=< f) ds
- handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com <$> handleDoNotationElement e
-
- handleGuard :: Guard -> m Guard
- handleGuard (ConditionGuard e) = ConditionGuard <$> (g' <=< g) e
- handleGuard (PatternGuard b e) = PatternGuard <$> (h' <=< h) b <*> (g' <=< g) e
-
-everywhereOnValuesM
- :: forall m
- . (Monad m)
- => (Declaration -> m Declaration)
- -> (Expr -> m Expr)
- -> (Binder -> m Binder)
- -> ( Declaration -> m Declaration
- , Expr -> m Expr
- , Binder -> m Binder
- )
-everywhereOnValuesM f g h = (f', g', h')
- where
-
- f' :: Declaration -> m Declaration
- f' (DataBindingGroupDeclaration ds) = (DataBindingGroupDeclaration <$> traverse f' ds) >>= f
- f' (ValueDecl sa name nameKind bs val) =
- ValueDecl sa name nameKind <$> traverse h' bs <*> traverse (guardedExprM handleGuard g') val >>= f
- f' (BindingGroupDeclaration ds) = (BindingGroupDeclaration <$> traverse (\(name, nameKind, val) -> (,,) name nameKind <$> g' val) ds) >>= f
- f' (BoundValueDeclaration sa b expr) = (BoundValueDeclaration sa <$> h' b <*> g' expr) >>= f
- f' (TypeClassDeclaration sa name args implies deps ds) = (TypeClassDeclaration sa name args implies deps <$> traverse f' ds) >>= f
- f' (TypeInstanceDeclaration sa ch idx name cs className args ds) = (TypeInstanceDeclaration sa ch idx name cs className args <$> traverseTypeInstanceBody (traverse f') ds) >>= f
- f' other = f other
-
- g' :: Expr -> m Expr
- g' (Literal ss l) = (Literal ss <$> litM g' l) >>= g
- g' (UnaryMinus ss v) = (UnaryMinus ss <$> g' v) >>= g
- g' (BinaryNoParens op v1 v2) = (BinaryNoParens <$> g' op <*> g' v1 <*> g' v2) >>= g
- g' (Parens v) = (Parens <$> 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
- g' (ObjectUpdateNested obj vs) = (ObjectUpdateNested <$> g' obj <*> traverse g' vs) >>= g
- g' (Abs binder v) = (Abs <$> h' binder <*> g' v) >>= g
- g' (App v1 v2) = (App <$> g' v1 <*> g' v2) >>= g
- g' (Unused v) = (Unused <$> g' v) >>= g
- g' (IfThenElse v1 v2 v3) = (IfThenElse <$> g' v1 <*> g' v2 <*> g' v3) >>= g
- g' (Case vs alts) = (Case <$> traverse g' vs <*> traverse handleCaseAlternative alts) >>= g
- g' (TypedValue check v ty) = (TypedValue check <$> g' v <*> pure ty) >>= g
- g' (Let w ds v) = (Let w <$> traverse f' ds <*> g' v) >>= g
- g' (Do m es) = (Do m <$> traverse handleDoNotationElement es) >>= g
- g' (Ado m es v) = (Ado m <$> traverse handleDoNotationElement es <*> g' v) >>= g
- g' (PositionedValue pos com v) = (PositionedValue pos com <$> g' v) >>= g
- g' other = g other
-
- h' :: Binder -> m Binder
- h' (LiteralBinder ss l) = (LiteralBinder ss <$> litM h' l) >>= h
- h' (ConstructorBinder ss ctor bs) = (ConstructorBinder ss ctor <$> traverse h' bs) >>= h
- h' (BinaryNoParensBinder b1 b2 b3) = (BinaryNoParensBinder <$> h' b1 <*> h' b2 <*> h' b3) >>= h
- h' (ParensInBinder b) = (ParensInBinder <$> h' b) >>= h
- h' (NamedBinder ss name b) = (NamedBinder ss name <$> h' b) >>= h
- h' (PositionedBinder pos com b) = (PositionedBinder pos com <$> h' b) >>= h
- h' (TypedBinder t b) = (TypedBinder t <$> h' b) >>= h
- h' other = h other
-
- handleCaseAlternative :: CaseAlternative -> m CaseAlternative
- handleCaseAlternative (CaseAlternative bs val) =
- CaseAlternative
- <$> traverse h' bs
- <*> traverse (guardedExprM handleGuard g') val
-
- handleDoNotationElement :: DoNotationElement -> m DoNotationElement
- handleDoNotationElement (DoNotationValue v) = DoNotationValue <$> g' v
- handleDoNotationElement (DoNotationBind b v) = DoNotationBind <$> h' b <*> g' v
- handleDoNotationElement (DoNotationLet ds) = DoNotationLet <$> traverse f' ds
- handleDoNotationElement (PositionedDoNotationElement pos com e) = PositionedDoNotationElement pos com <$> handleDoNotationElement e
-
- handleGuard :: Guard -> m Guard
- handleGuard (ConditionGuard e) = ConditionGuard <$> g' e
- handleGuard (PatternGuard b e) = PatternGuard <$> h' b <*> g' e
-
-everythingOnValues
- :: forall r
- . (r -> r -> r)
- -> (Declaration -> r)
- -> (Expr -> r)
- -> (Binder -> r)
- -> (CaseAlternative -> r)
- -> (DoNotationElement -> r)
- -> ( Declaration -> r
- , Expr -> r
- , Binder -> r
- , CaseAlternative -> r
- , DoNotationElement -> r
- )
-everythingOnValues (<>.) f g h i j = (f', g', h', i', j')
- where
-
- f' :: Declaration -> r
- f' d@(DataBindingGroupDeclaration ds) = foldl (<>.) (f d) (fmap f' ds)
- f' d@(ValueDeclaration vd) = foldl (<>.) (f d) (fmap h' (valdeclBinders vd) ++ concatMap (\(GuardedExpr grd v) -> fmap k' grd ++ [g' v]) (valdeclExpression vd))
- f' d@(BindingGroupDeclaration ds) = foldl (<>.) (f d) (fmap (\(_, _, val) -> g' val) ds)
- f' d@(TypeClassDeclaration _ _ _ _ _ ds) = foldl (<>.) (f d) (fmap f' ds)
- f' d@(TypeInstanceDeclaration _ _ _ _ _ _ _ (ExplicitInstance ds)) = foldl (<>.) (f d) (fmap f' ds)
- f' d@(BoundValueDeclaration _ b expr) = f d <>. h' b <>. g' expr
- f' d = f d
-
- g' :: Expr -> r
- g' v@(Literal _ l) = lit (g v) g' l
- 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@(TypeClassDictionaryConstructorApp _ v1) = g v <>. g' v1
- g' v@(Accessor _ v1) = g v <>. g' v1
- g' v@(ObjectUpdate obj vs) = foldl (<>.) (g v <>. g' obj) (fmap (g' . snd) vs)
- g' v@(ObjectUpdateNested obj vs) = foldl (<>.) (g v <>. g' obj) (fmap g' vs)
- g' v@(Abs b v1) = g v <>. h' b <>. g' v1
- g' v@(App v1 v2) = g v <>. g' v1 <>. g' v2
- g' v@(Unused v1) = g v <>. g' v1
- g' v@(IfThenElse v1 v2 v3) = g v <>. g' v1 <>. g' v2 <>. g' v3
- g' v@(Case vs alts) = foldl (<>.) (foldl (<>.) (g v) (fmap g' vs)) (fmap i' alts)
- g' v@(TypedValue _ v1 _) = g v <>. g' v1
- g' v@(Let _ ds v1) = foldl (<>.) (g v) (fmap f' ds) <>. g' v1
- g' v@(Do _ es) = foldl (<>.) (g v) (fmap j' es)
- g' v@(Ado _ es v1) = foldl (<>.) (g v) (fmap j' es) <>. g' v1
- g' v@(PositionedValue _ _ v1) = g v <>. g' v1
- g' v = g v
-
- h' :: Binder -> r
- h' b@(LiteralBinder _ l) = lit (h b) h' l
- h' b@(ConstructorBinder _ _ bs) = foldl (<>.) (h b) (fmap h' bs)
- h' b@(BinaryNoParensBinder b1 b2 b3) = h b <>. h' b1 <>. h' b2 <>. h' b3
- h' b@(ParensInBinder b1) = h b <>. h' b1
- h' b@(NamedBinder _ _ b1) = h b <>. h' b1
- h' b@(PositionedBinder _ _ b1) = h b <>. h' b1
- h' b@(TypedBinder _ b1) = h b <>. h' b1
- h' b = h b
-
- lit :: r -> (a -> r) -> Literal a -> r
- lit r go (ArrayLiteral as) = foldl (<>.) r (fmap go as)
- lit r go (ObjectLiteral as) = foldl (<>.) r (fmap (go . snd) as)
- lit r _ _ = r
-
- i' :: CaseAlternative -> r
- i' ca@(CaseAlternative bs gs) =
- foldl (<>.) (i ca) (fmap h' bs ++ concatMap (\(GuardedExpr grd val) -> fmap k' grd ++ [g' val]) gs)
-
- j' :: DoNotationElement -> r
- j' e@(DoNotationValue v) = j e <>. g' v
- j' e@(DoNotationBind b v) = j e <>. h' b <>. g' v
- j' e@(DoNotationLet ds) = foldl (<>.) (j e) (fmap f' ds)
- j' e@(PositionedDoNotationElement _ _ e1) = j e <>. j' e1
-
- k' :: Guard -> r
- k' (ConditionGuard e) = g' e
- k' (PatternGuard b e) = h' b <>. g' e
-
-everythingWithContextOnValues
- :: forall s r
- . s
- -> r
- -> (r -> r -> r)
- -> (s -> Declaration -> (s, r))
- -> (s -> Expr -> (s, r))
- -> (s -> Binder -> (s, r))
- -> (s -> CaseAlternative -> (s, r))
- -> (s -> DoNotationElement -> (s, r))
- -> ( Declaration -> r
- , Expr -> r
- , Binder -> r
- , CaseAlternative -> r
- , DoNotationElement -> r)
-everythingWithContextOnValues s0 r0 (<>.) f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j'' s0)
- where
-
- f'' :: s -> Declaration -> r
- f'' s d = let (s', r) = f s d in r <>. f' s' d
-
- f' :: s -> Declaration -> r
- f' s (DataBindingGroupDeclaration ds) = foldl (<>.) r0 (fmap (f'' s) ds)
- f' s (ValueDeclaration vd) = foldl (<>.) r0 (fmap (h'' s) (valdeclBinders vd) ++ concatMap (\(GuardedExpr grd v) -> fmap (k' s) grd ++ [g'' s v]) (valdeclExpression vd))
- f' s (BindingGroupDeclaration ds) = foldl (<>.) r0 (fmap (\(_, _, val) -> g'' s val) ds)
- f' s (TypeClassDeclaration _ _ _ _ _ ds) = foldl (<>.) r0 (fmap (f'' s) ds)
- f' s (TypeInstanceDeclaration _ _ _ _ _ _ _ (ExplicitInstance ds)) = foldl (<>.) r0 (fmap (f'' s) ds)
- f' _ _ = r0
-
- g'' :: s -> Expr -> r
- g'' s v = let (s', r) = g s v in r <>. g' s' v
-
- g' :: s -> Expr -> r
- g' s (Literal _ l) = lit g'' s l
- 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 (TypeClassDictionaryConstructorApp _ v1) = g'' s v1
- g' s (Accessor _ v1) = g'' s v1
- g' s (ObjectUpdate obj vs) = foldl (<>.) (g'' s obj) (fmap (g'' s . snd) vs)
- g' s (ObjectUpdateNested obj vs) = foldl (<>.) (g'' s obj) (fmap (g'' s) vs)
- g' s (Abs binder v1) = h'' s binder <>. g'' s v1
- g' s (App v1 v2) = g'' s v1 <>. g'' s v2
- g' s (Unused v) = g'' s v
- g' s (IfThenElse v1 v2 v3) = g'' s v1 <>. g'' s v2 <>. g'' s v3
- g' s (Case vs alts) = foldl (<>.) (foldl (<>.) r0 (fmap (g'' s) vs)) (fmap (i'' s) alts)
- g' s (TypedValue _ v1 _) = g'' s v1
- g' s (Let _ ds v1) = foldl (<>.) r0 (fmap (f'' s) ds) <>. g'' s v1
- g' s (Do _ es) = foldl (<>.) r0 (fmap (j'' s) es)
- g' s (Ado _ es v1) = foldl (<>.) r0 (fmap (j'' s) es) <>. g'' s v1
- g' s (PositionedValue _ _ v1) = g'' s v1
- g' _ _ = r0
-
- h'' :: s -> Binder -> r
- h'' s b = let (s', r) = h s b in r <>. h' s' b
-
- h' :: s -> Binder -> r
- h' s (LiteralBinder _ l) = lit h'' s l
- h' s (ConstructorBinder _ _ bs) = foldl (<>.) r0 (fmap (h'' s) bs)
- h' s (BinaryNoParensBinder b1 b2 b3) = h'' s b1 <>. h'' s b2 <>. h'' s b3
- h' s (ParensInBinder b) = h'' s b
- h' s (NamedBinder _ _ b1) = h'' s b1
- h' s (PositionedBinder _ _ b1) = h'' s b1
- h' s (TypedBinder _ b1) = h'' s b1
- h' _ _ = r0
-
- lit :: (s -> a -> r) -> s -> Literal a -> r
- lit go s (ArrayLiteral as) = foldl (<>.) r0 (fmap (go s) as)
- lit go s (ObjectLiteral as) = foldl (<>.) r0 (fmap (go s . snd) as)
- lit _ _ _ = r0
-
- i'' :: s -> CaseAlternative -> r
- i'' s ca = let (s', r) = i s ca in r <>. i' s' ca
-
- i' :: s -> CaseAlternative -> r
- i' s (CaseAlternative bs gs) = foldl (<>.) r0 (fmap (h'' s) bs ++ concatMap (\(GuardedExpr grd val) -> fmap (k' s) grd ++ [g'' s val]) gs)
-
- j'' :: s -> DoNotationElement -> r
- j'' s e = let (s', r) = j s e in r <>. j' s' e
-
- j' :: s -> DoNotationElement -> r
- j' s (DoNotationValue v) = g'' s v
- j' s (DoNotationBind b v) = h'' s b <>. g'' s v
- j' s (DoNotationLet ds) = foldl (<>.) r0 (fmap (f'' s) ds)
- j' s (PositionedDoNotationElement _ _ e1) = j'' s e1
-
- k' :: s -> Guard -> r
- k' s (ConditionGuard e) = g'' s e
- k' s (PatternGuard b e) = h'' s b <>. g'' s e
-
-everywhereWithContextOnValuesM
- :: forall m s
- . (Monad m)
- => s
- -> (s -> Declaration -> m (s, Declaration))
- -> (s -> Expr -> m (s, Expr))
- -> (s -> Binder -> m (s, Binder))
- -> (s -> CaseAlternative -> m (s, CaseAlternative))
- -> (s -> DoNotationElement -> m (s, DoNotationElement))
- -> ( Declaration -> m Declaration
- , Expr -> m Expr
- , Binder -> m Binder
- , CaseAlternative -> m CaseAlternative
- , DoNotationElement -> m DoNotationElement
- )
-everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j'' s0)
- where
- f'' s = uncurry f' <=< f s
-
- f' s (DataBindingGroupDeclaration ds) = DataBindingGroupDeclaration <$> traverse (f'' s) ds
- f' s (ValueDecl sa name nameKind bs val) =
- ValueDecl sa name nameKind <$> traverse (h'' s) bs <*> traverse (guardedExprM (k' s) (g'' s)) val
- f' s (BindingGroupDeclaration ds) = BindingGroupDeclaration <$> traverse (thirdM (g'' s)) ds
- f' s (TypeClassDeclaration sa name args implies deps ds) = TypeClassDeclaration sa name args implies deps <$> traverse (f'' s) ds
- f' s (TypeInstanceDeclaration sa ch idx name cs className args ds) = TypeInstanceDeclaration sa ch idx name cs className args <$> traverseTypeInstanceBody (traverse (f'' s)) ds
- f' _ other = return other
-
- g'' s = uncurry g' <=< g s
-
- g' s (Literal ss l) = Literal ss <$> lit g'' s l
- g' s (UnaryMinus ss v) = UnaryMinus ss <$> 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 (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
- g' s (ObjectUpdateNested obj vs) = ObjectUpdateNested <$> g'' s obj <*> traverse (g'' s) vs
- g' s (Abs binder v) = Abs <$> h' s binder <*> g'' s v
- g' s (App v1 v2) = App <$> g'' s v1 <*> g'' s v2
- g' s (Unused v) = Unused <$> g'' s v
- g' s (IfThenElse v1 v2 v3) = IfThenElse <$> g'' s v1 <*> g'' s v2 <*> g'' s v3
- g' s (Case vs alts) = Case <$> traverse (g'' s) vs <*> traverse (i'' s) alts
- g' s (TypedValue check v ty) = TypedValue check <$> g'' s v <*> pure ty
- g' s (Let w ds v) = Let w <$> traverse (f'' s) ds <*> g'' s v
- g' s (Do m es) = Do m <$> traverse (j'' s) es
- g' s (Ado m es v) = Ado m <$> traverse (j'' s) es <*> g'' s v
- g' s (PositionedValue pos com v) = PositionedValue pos com <$> g'' s v
- g' _ other = return other
-
- h'' s = uncurry h' <=< h s
-
- h' s (LiteralBinder ss l) = LiteralBinder ss <$> lit h'' s l
- h' s (ConstructorBinder ss ctor bs) = ConstructorBinder ss ctor <$> traverse (h'' s) bs
- h' s (BinaryNoParensBinder b1 b2 b3) = BinaryNoParensBinder <$> h'' s b1 <*> h'' s b2 <*> h'' s b3
- h' s (ParensInBinder b) = ParensInBinder <$> h'' s b
- h' s (NamedBinder ss name b) = NamedBinder ss name <$> h'' s b
- h' s (PositionedBinder pos com b) = PositionedBinder pos com <$> h'' s b
- h' s (TypedBinder t b) = TypedBinder t <$> h'' s b
- h' _ other = return other
-
- lit :: (s -> a -> m a) -> s -> Literal a -> m (Literal a)
- lit go s (ArrayLiteral as) = ArrayLiteral <$> traverse (go s) as
- lit go s (ObjectLiteral as) = ObjectLiteral <$> traverse (sndM (go s)) as
- lit _ _ other = return other
-
- i'' s = uncurry i' <=< i s
-
- i' s (CaseAlternative bs val) = CaseAlternative <$> traverse (h'' s) bs <*> traverse (guardedExprM (k' s) (g'' s)) val
-
- j'' s = uncurry j' <=< j s
-
- j' s (DoNotationValue v) = DoNotationValue <$> g'' s v
- j' s (DoNotationBind b v) = DoNotationBind <$> h'' s b <*> g'' s v
- j' s (DoNotationLet ds) = DoNotationLet <$> traverse (f'' s) ds
- j' s (PositionedDoNotationElement pos com e1) = PositionedDoNotationElement pos com <$> j'' s e1
-
- k' s (ConditionGuard e) = ConditionGuard <$> g'' s e
- k' s (PatternGuard b e) = PatternGuard <$> h'' s b <*> g'' s e
-
-data ScopedIdent = LocalIdent Ident | ToplevelIdent Ident
- deriving (Show, Eq, Ord)
-
-inScope :: Ident -> S.Set ScopedIdent -> Bool
-inScope i s = (LocalIdent i `S.member` s) || (ToplevelIdent i `S.member` s)
-
-everythingWithScope
- :: forall r
- . (Monoid r)
- => (S.Set ScopedIdent -> Declaration -> r)
- -> (S.Set ScopedIdent -> Expr -> r)
- -> (S.Set ScopedIdent -> Binder -> r)
- -> (S.Set ScopedIdent -> CaseAlternative -> r)
- -> (S.Set ScopedIdent -> DoNotationElement -> r)
- -> ( S.Set ScopedIdent -> Declaration -> r
- , S.Set ScopedIdent -> Expr -> r
- , S.Set ScopedIdent -> Binder -> r
- , S.Set ScopedIdent -> CaseAlternative -> r
- , S.Set ScopedIdent -> DoNotationElement -> r
- )
-everythingWithScope f g h i j = (f'', g'', h'', i'', \s -> snd . j'' s)
- where
- f'' :: S.Set ScopedIdent -> Declaration -> r
- f'' s a = f s a <> f' s a
-
- f' :: S.Set ScopedIdent -> Declaration -> r
- f' s (DataBindingGroupDeclaration ds) =
- let s' = S.union s (S.fromList (map ToplevelIdent (mapMaybe getDeclIdent (NEL.toList ds))))
- in foldMap (f'' s') ds
- f' s (ValueDecl _ name _ bs val) =
- let s' = S.insert (ToplevelIdent name) s
- s'' = S.union s' (S.fromList (concatMap localBinderNames bs))
- in foldMap (h'' s') bs <> foldMap (l' s'') val
- f' s (BindingGroupDeclaration ds) =
- let s' = S.union s (S.fromList (NEL.toList (fmap (\((_, name), _, _) -> ToplevelIdent name) ds)))
- in foldMap (\(_, _, val) -> g'' s' val) ds
- f' s (TypeClassDeclaration _ _ _ _ _ ds) = foldMap (f'' s) ds
- f' s (TypeInstanceDeclaration _ _ _ _ _ _ _ (ExplicitInstance ds)) = foldMap (f'' s) ds
- f' _ _ = mempty
-
- g'' :: S.Set ScopedIdent -> Expr -> r
- g'' s a = g s a <> g' s a
-
- g' :: S.Set ScopedIdent -> Expr -> r
- g' s (Literal _ l) = lit g'' s l
- 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 (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
- g' s (ObjectUpdateNested obj vs) = g'' s obj <> foldMap (g'' s) vs
- g' s (Abs b v1) =
- let s' = S.union (S.fromList (localBinderNames b)) s
- in h'' s b <> g'' s' v1
- g' s (App v1 v2) = g'' s v1 <> g'' s v2
- g' s (Unused v) = g'' s v
- g' s (IfThenElse v1 v2 v3) = g'' s v1 <> g'' s v2 <> g'' s v3
- g' s (Case vs alts) = foldMap (g'' s) vs <> foldMap (i'' s) alts
- g' s (TypedValue _ v1 _) = g'' s v1
- g' s (Let _ ds v1) =
- let s' = S.union s (S.fromList (map LocalIdent (mapMaybe getDeclIdent ds)))
- in foldMap (f'' s') ds <> g'' s' v1
- g' s (Do _ es) = fold . snd . mapAccumL j'' s $ es
- g' s (Ado _ es v1) =
- let s' = S.union s (foldMap (fst . j'' s) es)
- in g'' s' v1
- g' s (PositionedValue _ _ v1) = g'' s v1
- g' _ _ = mempty
-
- h'' :: S.Set ScopedIdent -> Binder -> r
- h'' s a = h s a <> h' s a
-
- h' :: S.Set ScopedIdent -> Binder -> r
- h' s (LiteralBinder _ l) = lit h'' s l
- h' s (ConstructorBinder _ _ bs) = foldMap (h'' s) bs
- h' s (BinaryNoParensBinder b1 b2 b3) = foldMap (h'' s) [b1, b2, b3]
- h' s (ParensInBinder b) = h'' s b
- h' s (NamedBinder _ name b1) = h'' (S.insert (LocalIdent name) s) b1
- h' s (PositionedBinder _ _ b1) = h'' s b1
- h' s (TypedBinder _ b1) = h'' s b1
- h' _ _ = mempty
-
- lit :: (S.Set ScopedIdent -> a -> r) -> S.Set ScopedIdent -> Literal a -> r
- lit go s (ArrayLiteral as) = foldMap (go s) as
- lit go s (ObjectLiteral as) = foldMap (go s . snd) as
- lit _ _ _ = mempty
-
- i'' :: S.Set ScopedIdent -> CaseAlternative -> r
- i'' s a = i s a <> i' s a
-
- i' :: S.Set ScopedIdent -> CaseAlternative -> r
- i' s (CaseAlternative bs gs) =
- let s' = S.union s (S.fromList (concatMap localBinderNames bs))
- in foldMap (h'' s) bs <> foldMap (l' s') gs
-
- j'' :: S.Set ScopedIdent -> DoNotationElement -> (S.Set ScopedIdent, r)
- j'' s a = let (s', r) = j' s a in (s', j s a <> r)
-
- j' :: S.Set ScopedIdent -> DoNotationElement -> (S.Set ScopedIdent, r)
- j' s (DoNotationValue v) = (s, g'' s v)
- j' s (DoNotationBind b v) =
- let s' = S.union (S.fromList (localBinderNames b)) s
- in (s', h'' s b <> g'' s v)
- j' s (DoNotationLet ds) =
- let s' = S.union s (S.fromList (map LocalIdent (mapMaybe getDeclIdent ds)))
- in (s', foldMap (f'' s') ds)
- j' s (PositionedDoNotationElement _ _ e1) = j'' s e1
-
- k' :: S.Set ScopedIdent -> Guard -> (S.Set ScopedIdent, r)
- k' s (ConditionGuard e) = (s, g'' s e)
- k' s (PatternGuard b e) =
- let s' = S.union (S.fromList (localBinderNames b)) s
- in (s', h'' s b <> g'' s' e)
-
- l' s (GuardedExpr [] e) = g'' s e
- l' s (GuardedExpr (grd:gs) e) =
- let (s', r) = k' s grd
- in r <> l' s' (GuardedExpr gs e)
-
- getDeclIdent :: Declaration -> Maybe Ident
- getDeclIdent (ValueDeclaration vd) = Just (valdeclIdent vd)
- getDeclIdent (TypeDeclaration td) = Just (tydeclIdent td)
- getDeclIdent _ = Nothing
-
- localBinderNames = map LocalIdent . binderNames
-
-accumTypes
- :: (Monoid r)
- => (SourceType -> r)
- -> ( Declaration -> r
- , Expr -> r
- , Binder -> r
- , CaseAlternative -> r
- , DoNotationElement -> r
- )
-accumTypes f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)
- where
- forDecls (DataDeclaration _ _ _ _ dctors) = mconcat (concatMap (fmap (f . snd) . dataCtorFields) dctors)
- forDecls (ExternDeclaration _ _ ty) = f ty
- forDecls (TypeClassDeclaration _ _ _ implies _ _) = mconcat (concatMap (fmap f . constraintArgs) implies)
- forDecls (TypeInstanceDeclaration _ _ _ _ cs _ tys _) = mconcat (concatMap (fmap f . constraintArgs) cs) <> mconcat (fmap f tys)
- forDecls (TypeSynonymDeclaration _ _ _ ty) = f ty
- forDecls (TypeDeclaration td) = f (tydeclType td)
- forDecls _ = mempty
-
- forValues (TypeClassDictionary c _ _) = mconcat (fmap f (constraintArgs c))
- forValues (DeferredDictionary _ tys) = mconcat (fmap f tys)
- forValues (TypedValue _ _ ty) = f ty
- forValues _ = mempty
-
-accumKinds
- :: (Monoid r)
- => (SourceKind -> r)
- -> ( Declaration -> r
- , Expr -> r
- , Binder -> r
- , CaseAlternative -> r
- , DoNotationElement -> r
- )
-accumKinds f = everythingOnValues mappend forDecls forValues (const mempty) (const mempty) (const mempty)
- where
- forDecls (DataDeclaration _ _ _ args dctors) =
- foldMap (foldMap f . snd) args <>
- foldMap (foldMap (forTypes . snd) . dataCtorFields) dctors
- forDecls (TypeClassDeclaration _ _ args implies _ _) =
- foldMap (foldMap f . snd) args <>
- foldMap (foldMap forTypes . constraintArgs) implies
- forDecls (TypeInstanceDeclaration _ _ _ _ cs _ tys _) =
- foldMap (foldMap forTypes . constraintArgs) cs <>
- foldMap forTypes tys
- forDecls (TypeSynonymDeclaration _ _ args ty) =
- foldMap (foldMap f . snd) args <>
- forTypes ty
- forDecls (TypeDeclaration td) = forTypes (tydeclType td)
- forDecls (ExternDeclaration _ _ ty) = forTypes ty
- forDecls (ExternDataDeclaration _ _ kn) = f kn
- forDecls _ = mempty
-
- forValues (TypeClassDictionary c _ _) = foldMap forTypes (constraintArgs c)
- forValues (DeferredDictionary _ tys) = foldMap forTypes tys
- forValues (TypedValue _ _ ty) = forTypes ty
- forValues _ = mempty
-
- forTypes (KindedType _ _ k) = f k
- forTypes _ = mempty
-
--- |
--- Map a function over type annotations appearing inside a value
---
-overTypes :: (SourceType -> SourceType) -> Expr -> Expr
-overTypes f = let (_, f', _) = everywhereOnValues id g id in f'
- where
- g :: Expr -> Expr
- g (TypedValue checkTy val t) = TypedValue checkTy val (f t)
- g (TypeClassDictionary c sco hints) =
- TypeClassDictionary
- (mapConstraintArgs (fmap f) c)
- (updateCtx sco)
- hints
- g other = other
- updateDict fn dict = dict { tcdInstanceTypes = fn (tcdInstanceTypes dict) }
- updateScope = fmap . fmap . fmap . fmap $ updateDict $ fmap f
- updateCtx = M.alter updateScope Nothing
diff --git a/src/Language/PureScript/Bundle.hs b/src/Language/PureScript/Bundle.hs
index cf90d2e..682f56a 100644
--- a/src/Language/PureScript/Bundle.hs
+++ b/src/Language/PureScript/Bundle.hs
@@ -378,6 +378,7 @@ toModule mids mid filename top
| JSAstProgram smts _ <- top = Module mid filename <$> traverse toModuleElement smts
| otherwise = err InvalidTopLevel
where
+ err :: ErrorMessage -> m a
err = throwError . ErrorInModule mid
toModuleElement :: JSStatement -> m ModuleElement
@@ -401,9 +402,13 @@ toModule mids mid filename top
exportType (JSMemberDot f _ _)
| JSIdentifier _ "$foreign" <- f
= pure ForeignReexport
+ | JSIdentifier _ ident <- f
+ = pure (RegularExport ident)
exportType (JSMemberSquare f _ _ _)
| JSIdentifier _ "$foreign" <- f
= pure ForeignReexport
+ | JSIdentifier _ ident <- f
+ = pure (RegularExport ident)
exportType (JSIdentifier _ s) = pure (RegularExport s)
exportType _ = err UnsupportedExport
@@ -415,7 +420,7 @@ toModule mids mid filename top
--
-- TODO: what if we assign to exports.foo and then later assign to
-- module.exports (presumably overwriting exports.foo)?
-getExportedIdentifiers :: (MonadError ErrorMessage m)
+getExportedIdentifiers :: forall m. (MonadError ErrorMessage m)
=> String
-> JSAST
-> m [String]
@@ -423,6 +428,7 @@ getExportedIdentifiers mname top
| JSAstProgram stmts _ <- top = concat <$> traverse go stmts
| otherwise = err InvalidTopLevel
where
+ err :: ErrorMessage -> m a
err = throwError . ErrorInModule (ModuleIdentifier mname Foreign)
go stmt
diff --git a/src/Language/PureScript/CST.hs b/src/Language/PureScript/CST.hs
index 1503f18..4fe672e 100644
--- a/src/Language/PureScript/CST.hs
+++ b/src/Language/PureScript/CST.hs
@@ -5,7 +5,9 @@ module Language.PureScript.CST
, parseModulesFromFiles
, unwrapParserError
, toMultipleErrors
+ , toMultipleWarnings
, toPositionedError
+ , toPositionedWarning
, pureResult
, module Language.PureScript.CST.Convert
, module Language.PureScript.CST.Errors
@@ -33,7 +35,7 @@ import Language.PureScript.CST.Print
import Language.PureScript.CST.Types
pureResult :: a -> PartialResult a
-pureResult a = PartialResult a (pure a)
+pureResult a = PartialResult a ([], pure a)
parseModulesFromFiles
:: forall m k
@@ -52,18 +54,18 @@ parseFromFiles
. MonadError E.MultipleErrors m
=> (k -> FilePath)
-> [(k, Text)]
- -> m [(k, AST.Module)]
+ -> m [(k, ([ParserWarning], AST.Module))]
parseFromFiles toFilePath input =
flip E.parU (handleParserError toFilePath)
. inParallel
. flip fmap input
- $ \(k, a) -> (k, parseFromFile (toFilePath k) a)
+ $ \(k, a) -> (k, sequence $ parseFromFile (toFilePath k) a)
parseModuleFromFile :: FilePath -> Text -> Either (NE.NonEmpty ParserError) (PartialResult AST.Module)
parseModuleFromFile fp content = fmap (convertModule fp) <$> parseModule (lex content)
-parseFromFile :: FilePath -> Text -> Either (NE.NonEmpty ParserError) AST.Module
-parseFromFile fp content = convertModule fp <$> parse content
+parseFromFile :: FilePath -> Text -> ([ParserWarning], Either (NE.NonEmpty ParserError) AST.Module)
+parseFromFile fp content = fmap (convertModule fp) <$> parse content
handleParserError
:: forall m k a
@@ -87,9 +89,17 @@ toMultipleErrors :: FilePath -> NE.NonEmpty ParserError -> E.MultipleErrors
toMultipleErrors fp =
E.MultipleErrors . NE.toList . fmap (toPositionedError fp)
+toMultipleWarnings :: FilePath -> [ParserWarning] -> E.MultipleErrors
+toMultipleWarnings fp =
+ E.MultipleErrors . fmap (toPositionedWarning fp)
+
toPositionedError :: FilePath -> ParserError -> E.ErrorMessage
toPositionedError name perr =
E.ErrorMessage [E.positionedError $ sourceSpan name $ errRange perr] (E.ErrorParsingCSTModule perr)
+toPositionedWarning :: FilePath -> ParserWarning -> E.ErrorMessage
+toPositionedWarning name perr =
+ E.ErrorMessage [E.positionedError $ sourceSpan name $ errRange perr] (E.WarningParsingCSTModule perr)
+
inParallel :: [(k, Either (NE.NonEmpty ParserError) a)] -> [(k, Either (NE.NonEmpty ParserError) a)]
inParallel = withStrategy (parList (evalTuple2 r0 rseq))
diff --git a/src/Language/PureScript/CST/Convert.hs b/src/Language/PureScript/CST/Convert.hs
deleted file mode 100644
index f473ffa..0000000
--- a/src/Language/PureScript/CST/Convert.hs
+++ /dev/null
@@ -1,639 +0,0 @@
--- | This module contains functions for converting the CST into the core AST. It
--- is mostly boilerplate, and does the job of resolving ranges for all the nodes
--- and attaching comments.
-
-module Language.PureScript.CST.Convert
- ( convertKind
- , convertType
- , convertExpr
- , convertBinder
- , convertDeclaration
- , convertImportDecl
- , convertModule
- , sourcePos
- , sourceSpan
- , comment
- , comments
- ) where
-
-import Prelude
-
-import Data.Bifunctor (bimap, first)
-import Data.Foldable (foldl', toList)
-import Data.Functor (($>))
-import qualified Data.List.NonEmpty as NE
-import Data.Maybe (isJust, fromJust, mapMaybe)
-import qualified Data.Text as Text
-import qualified Language.PureScript.AST as AST
-import qualified Language.PureScript.AST.SourcePos as Pos
-import qualified Language.PureScript.Comments as C
-import qualified Language.PureScript.Environment as Env
-import qualified Language.PureScript.Kinds as K
-import qualified Language.PureScript.Label as L
-import qualified Language.PureScript.Names as N
-import Language.PureScript.PSString (mkString)
-import qualified Language.PureScript.Types as T
-import Language.PureScript.CST.Positions
-import Language.PureScript.CST.Types
-
-comment :: Comment a -> Maybe C.Comment
-comment = \case
- Comment t
- | Text.isPrefixOf "{-" t -> Just $ C.BlockComment $ Text.drop 2 $ Text.dropEnd 2 t
- | Text.isPrefixOf "--" t -> Just $ C.LineComment $ Text.drop 2 t
- _ -> Nothing
-
-comments :: [Comment a] -> [C.Comment]
-comments = mapMaybe comment
-
-sourcePos :: SourcePos -> Pos.SourcePos
-sourcePos (SourcePos line col) = Pos.SourcePos line col
-
-sourceSpan :: String -> SourceRange -> Pos.SourceSpan
-sourceSpan name (SourceRange start end) = Pos.SourceSpan name (sourcePos start) (sourcePos end)
-
-widenLeft :: TokenAnn -> Pos.SourceAnn -> Pos.SourceAnn
-widenLeft ann (sp, _) =
- ( Pos.widenSourceSpan (sourceSpan (Pos.spanName sp) $ tokRange ann) sp
- , comments $ tokLeadingComments ann
- )
-
-sourceAnnCommented :: String -> SourceToken -> SourceToken -> Pos.SourceAnn
-sourceAnnCommented fileName (SourceToken ann1 _) (SourceToken ann2 _) =
- ( Pos.SourceSpan fileName (sourcePos $ srcStart $ tokRange ann1) (sourcePos $ srcEnd $ tokRange ann2)
- , comments $ tokLeadingComments ann1
- )
-
-sourceAnn :: String -> SourceToken -> SourceToken -> Pos.SourceAnn
-sourceAnn fileName (SourceToken ann1 _) (SourceToken ann2 _) =
- ( Pos.SourceSpan fileName (sourcePos $ srcStart $ tokRange ann1) (sourcePos $ srcEnd $ tokRange ann2)
- , []
- )
-
-sourceName :: String -> Name a -> Pos.SourceAnn
-sourceName fileName a = sourceAnnCommented fileName (nameTok a) (nameTok a)
-
-sourceQualName :: String -> QualifiedName a -> Pos.SourceAnn
-sourceQualName fileName a = sourceAnnCommented fileName (qualTok a) (qualTok a)
-
-moduleName :: Token -> Maybe N.ModuleName
-moduleName = \case
- TokLowerName as _ -> go as
- TokUpperName as _ -> go as
- TokSymbolName as _ -> go as
- TokOperator as _ -> go as
- _ -> Nothing
- where
- go [] = Nothing
- go ns = Just $ N.ModuleName $ Text.intercalate "." ns
-
-qualified :: QualifiedName a -> N.Qualified a
-qualified q = N.Qualified (qualModule q) (qualName q)
-
-ident :: Ident -> N.Ident
-ident = N.Ident . getIdent
-
-convertKind :: String -> Kind a -> K.SourceKind
-convertKind fileName = go
- where
- go = \case
- KindName _ a ->
- K.NamedKind (sourceQualName fileName a) $ qualified a
- KindArr _ a _ b -> do
- let
- lhs = go a
- rhs = go b
- ann = Pos.widenSourceAnn (K.getAnnForKind lhs) (K.getAnnForKind rhs)
- K.FunKind ann lhs rhs
- KindRow _ tok a -> do
- let
- kind = go a
- ann = widenLeft (tokAnn tok) $ K.getAnnForKind kind
- K.Row ann kind
- KindParens _ (Wrapped _ a _) ->
- go a
-
-convertType :: String -> Type a -> T.SourceType
-convertType fileName = go
- where
- goRow (Row labels tl) b = do
- let
- rowTail = case tl of
- Just (_, ty) -> go ty
- Nothing -> T.REmpty $ sourceAnnCommented fileName b b
- rowCons (Labeled a _ ty) c = do
- let ann = sourceAnnCommented fileName (lblTok a) (snd $ typeRange ty)
- T.RCons ann (L.Label $ lblName a) (go ty) c
- case labels of
- Just (Separated h t) ->
- rowCons h $ foldr (rowCons . snd) rowTail t
- Nothing ->
- rowTail
-
- go = \case
- TypeVar _ a ->
- T.TypeVar (sourceName fileName a) . getIdent $ nameValue a
- TypeConstructor _ a ->
- T.TypeConstructor (sourceQualName fileName a) $ qualified a
- TypeWildcard _ a ->
- T.TypeWildcard (sourceAnnCommented fileName a a) Nothing
- TypeHole _ a ->
- T.TypeWildcard (sourceName fileName a) . Just . getIdent $ nameValue a
- TypeString _ a b ->
- T.TypeLevelString (sourceAnnCommented fileName a a) $ b
- TypeRow _ (Wrapped _ row b) ->
- goRow row b
- TypeRecord _ (Wrapped a row b) -> do
- let
- ann = sourceAnnCommented fileName a b
- annRec = sourceAnn fileName a a
- T.TypeApp ann (Env.tyRecord $> annRec) $ goRow row b
- TypeForall _ kw bindings _ ty -> do
- let
- mkForAll a b t = do
- let ann' = widenLeft (tokAnn $ nameTok a) $ T.getAnnForType t
- T.ForAll ann' (getIdent $ nameValue a) b t Nothing
- k t (TypeVarKinded (Wrapped _ (Labeled a _ b) _)) = mkForAll a (Just (convertKind fileName b)) t
- k t (TypeVarName a) = mkForAll a Nothing t
- -- The existing parser builds variables in reverse order
- ty' = foldl k (go ty) bindings
- ann = widenLeft (tokAnn kw) $ T.getAnnForType ty'
- T.setAnnForType ann ty'
- TypeKinded _ ty _ kd -> do
- let
- ty' = go ty
- kd' = convertKind fileName kd
- ann = Pos.widenSourceAnn (T.getAnnForType ty') (K.getAnnForKind kd')
- T.KindedType ann ty' kd'
- TypeApp _ a b -> do
- let
- a' = go a
- b' = go b
- ann = Pos.widenSourceAnn (T.getAnnForType a') (T.getAnnForType b')
- T.TypeApp ann a' b'
- ty@(TypeOp _ _ _ _) -> do
- let
- reassoc op b' a = do
- let
- a' = go a
- op' = T.TypeOp (sourceQualName fileName op) $ qualified op
- ann = Pos.widenSourceAnn (T.getAnnForType a') (T.getAnnForType b')
- T.BinaryNoParensType ann op' (go a) b'
- loop k = \case
- TypeOp _ a op b -> loop (reassoc op (k b)) a
- expr' -> k expr'
- loop go ty
- TypeOpName _ op -> do
- let rng = qualRange op
- T.TypeOp (uncurry (sourceAnnCommented fileName) rng) (qualified op)
- TypeArr _ a arr b -> do
- let
- a' = go a
- b' = go b
- arr' = Env.tyFunction $> sourceAnnCommented fileName arr arr
- ann = Pos.widenSourceAnn (T.getAnnForType a') (T.getAnnForType b')
- T.TypeApp ann (T.TypeApp ann arr' a') b'
- TypeArrName _ a ->
- Env.tyFunction $> sourceAnnCommented fileName a a
- TypeConstrained _ a _ b -> do
- let
- a' = convertConstraint fileName a
- b' = go b
- ann = Pos.widenSourceAnn (T.constraintAnn a') (T.getAnnForType b')
- T.ConstrainedType ann a' b'
- TypeParens _ (Wrapped a ty b) ->
- T.ParensInType (sourceAnnCommented fileName a b) $ go ty
-
-convertConstraint :: String -> Constraint a -> T.SourceConstraint
-convertConstraint fileName = go
- where
- go = \case
- cst@(Constraint _ name args) -> do
- let ann = uncurry (sourceAnnCommented fileName) $ constraintRange cst
- T.Constraint ann (qualified name) (convertType fileName <$> args) Nothing
- ConstraintParens _ (Wrapped _ c _) -> go c
-
-convertGuarded :: String -> Guarded a -> [AST.GuardedExpr]
-convertGuarded fileName = \case
- Unconditional _ x -> [AST.GuardedExpr [] (convertWhere fileName x)]
- Guarded gs -> (\(GuardedExpr _ ps _ x) -> AST.GuardedExpr (p <$> toList ps) (convertWhere fileName x)) <$> NE.toList gs
- where
- go = convertExpr fileName
- p (PatternGuard Nothing x) = AST.ConditionGuard (go x)
- p (PatternGuard (Just (b, _)) x) = AST.PatternGuard (convertBinder fileName b) (go x)
-
-convertWhere :: String -> Where a -> AST.Expr
-convertWhere fileName = \case
- Where expr Nothing -> convertExpr fileName expr
- Where expr (Just (_, bs)) -> do
- let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
- uncurry AST.PositionedValue ann . AST.Let AST.FromWhere (convertLetBinding fileName <$> NE.toList bs) $ convertExpr fileName expr
-
-convertLetBinding :: String -> LetBinding a -> AST.Declaration
-convertLetBinding fileName = \case
- LetBindingSignature _ lbl ->
- convertSignature fileName lbl
- binding@(LetBindingName _ fields) -> do
- let ann = uncurry (sourceAnnCommented fileName) $ letBindingRange binding
- convertValueBindingFields fileName ann fields
- binding@(LetBindingPattern _ a _ b) -> do
- let ann = uncurry (sourceAnnCommented fileName) $ letBindingRange binding
- AST.BoundValueDeclaration ann (convertBinder fileName a) (convertWhere fileName b)
-
-convertExpr :: forall a. String -> Expr a -> AST.Expr
-convertExpr fileName = go
- where
- positioned =
- uncurry AST.PositionedValue
-
- goDoStatement = \case
- stmt@(DoLet _ as) -> do
- let ann = uncurry (sourceAnnCommented fileName) $ doStatementRange stmt
- uncurry AST.PositionedDoNotationElement ann . AST.DoNotationLet $ convertLetBinding fileName <$> NE.toList as
- stmt@(DoDiscard a) -> do
- let ann = uncurry (sourceAnn fileName) $ doStatementRange stmt
- uncurry AST.PositionedDoNotationElement ann . AST.DoNotationValue $ go a
- stmt@(DoBind a _ b) -> do
- let
- ann = uncurry (sourceAnn fileName) $ doStatementRange stmt
- a' = convertBinder fileName a
- b' = go b
- uncurry AST.PositionedDoNotationElement ann $ AST.DoNotationBind a' b'
-
- go = \case
- ExprHole _ a ->
- positioned (sourceName fileName a) . AST.Hole . getIdent $ nameValue a
- ExprSection _ a ->
- positioned (sourceAnnCommented fileName a a) AST.AnonymousArgument
- ExprIdent _ a -> do
- let ann = sourceQualName fileName a
- positioned ann . AST.Var (fst ann) . qualified $ fmap ident a
- ExprConstructor _ a -> do
- let ann = sourceQualName fileName a
- positioned ann . AST.Constructor (fst ann) $ qualified a
- ExprBoolean _ a b -> do
- let ann = sourceAnnCommented fileName a a
- positioned ann . AST.Literal (fst ann) $ AST.BooleanLiteral b
- ExprChar _ a b -> do
- let ann = sourceAnnCommented fileName a a
- positioned ann . AST.Literal (fst ann) $ AST.CharLiteral b
- ExprString _ a b -> do
- let ann = sourceAnnCommented fileName a a
- positioned ann . AST.Literal (fst ann) . AST.StringLiteral $ b
- ExprNumber _ a b -> do
- let ann = sourceAnnCommented fileName a a
- positioned ann . AST.Literal (fst ann) $ AST.NumericLiteral b
- ExprArray _ (Wrapped a bs c) -> do
- let
- ann = sourceAnnCommented fileName a c
- vals = case bs of
- Just (Separated x xs) -> go x : (go . snd <$> xs)
- Nothing -> []
- positioned ann . AST.Literal (fst ann) $ AST.ArrayLiteral vals
- ExprRecord z (Wrapped a bs c) -> do
- let
- ann = sourceAnnCommented fileName a c
- lbl = \case
- RecordPun f -> (mkString . getIdent $ nameValue f, go . ExprIdent z $ QualifiedName (nameTok f) Nothing (nameValue f))
- RecordField f _ v -> (lblName f, go v)
- vals = case bs of
- Just (Separated x xs) -> lbl x : (lbl . snd <$> xs)
- Nothing -> []
- positioned ann . AST.Literal (fst ann) $ AST.ObjectLiteral vals
- ExprParens _ (Wrapped a b c) ->
- positioned (sourceAnnCommented fileName a c) . AST.Parens $ go b
- expr@(ExprTyped _ a _ b) -> do
- let
- a' = go a
- b' = convertType fileName b
- ann = (sourceSpan fileName . toSourceRange $ exprRange expr, [])
- positioned ann $ AST.TypedValue True a' b'
- expr@(ExprInfix _ a (Wrapped _ b _) c) -> do
- let ann = (sourceSpan fileName . toSourceRange $ exprRange expr, [])
- positioned ann $ AST.BinaryNoParens (go b) (go a) (go c)
- expr@(ExprOp _ _ _ _) -> do
- let
- ann = uncurry (sourceAnn fileName) $ exprRange expr
- reassoc op b a = do
- let op' = AST.Op (sourceSpan fileName . toSourceRange $ qualRange op) $ qualified op
- AST.BinaryNoParens op' (go a) b
- loop k = \case
- ExprOp _ a op b -> loop (reassoc op (k b)) a
- expr' -> k expr'
- positioned ann $ loop go expr
- ExprOpName _ op -> do
- let
- rng = qualRange op
- op' = AST.Op (sourceSpan fileName $ toSourceRange rng) $ qualified op
- positioned (uncurry (sourceAnnCommented fileName) rng) op'
- expr@(ExprNegate _ _ b) -> do
- let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
- positioned ann . AST.UnaryMinus (fst ann) $ go b
- expr@(ExprRecordAccessor _ (RecordAccessor a _ (Separated h t))) -> do
- let
- ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
- field x f = AST.Accessor (lblName f) x
- positioned ann $ foldl' (\x (_, f) -> field x f) (field (go a) h) t
- expr@(ExprRecordUpdate _ a b) -> do
- let
- ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
- k (RecordUpdateLeaf f _ x) = (lblName f, AST.Leaf $ go x)
- k (RecordUpdateBranch f xs) = (lblName f, AST.Branch $ toTree xs)
- toTree (Wrapped _ xs _) = AST.PathTree . AST.AssocList . map k $ toList xs
- positioned ann . AST.ObjectUpdateNested (go a) $ toTree b
- expr@(ExprApp _ a b) -> do
- let ann = uncurry (sourceAnn fileName) $ exprRange expr
- positioned ann $ AST.App (go a) (go b)
- expr@(ExprLambda _ (Lambda _ as _ b)) -> do
- let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
- positioned ann
- . AST.Abs (convertBinder fileName (NE.head as))
- . foldr (AST.Abs . convertBinder fileName) (go b)
- $ NE.tail as
- expr@(ExprIf _ (IfThenElse _ a _ b _ c)) -> do
- let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
- positioned ann $ AST.IfThenElse (go a) (go b) (go c)
- expr@(ExprCase _ (CaseOf _ as _ bs)) -> do
- let
- ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
- as' = go <$> toList as
- bs' = uncurry AST.CaseAlternative . bimap (map (convertBinder fileName) . toList) (convertGuarded fileName) <$> NE.toList bs
- positioned ann $ AST.Case as' bs'
- expr@(ExprLet _ (LetIn _ as _ b)) -> do
- let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
- positioned ann . AST.Let AST.FromLet (convertLetBinding fileName <$> NE.toList as) $ go b
- -- expr@(ExprWhere _ (Where a _ bs)) -> do
- -- let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
- -- positioned ann . AST.Let AST.FromWhere (goLetBinding <$> bs) $ go a
- expr@(ExprDo _ (DoBlock kw stmts)) -> do
- let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
- positioned ann . AST.Do (moduleName $ tokValue kw) $ goDoStatement <$> NE.toList stmts
- expr@(ExprAdo _ (AdoBlock kw stms _ a)) -> do
- let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
- positioned ann . AST.Ado (moduleName $ tokValue kw) (goDoStatement <$> stms) $ go a
-
-convertBinder :: String -> Binder a -> AST.Binder
-convertBinder fileName = go
- where
- positioned =
- uncurry AST.PositionedBinder
-
- go = \case
- BinderWildcard _ a ->
- positioned (sourceAnnCommented fileName a a) AST.NullBinder
- BinderVar _ a -> do
- let ann = sourceName fileName a
- positioned ann . AST.VarBinder (fst ann) . ident $ nameValue a
- binder@(BinderNamed _ a _ b) -> do
- let ann = uncurry (sourceAnnCommented fileName) $ binderRange binder
- positioned ann . AST.NamedBinder (fst ann) (ident $ nameValue a) $ go b
- binder@(BinderConstructor _ a bs) -> do
- let ann = uncurry (sourceAnnCommented fileName) $ binderRange binder
- positioned ann . AST.ConstructorBinder (fst ann) (qualified a) $ go <$> bs
- BinderBoolean _ a b -> do
- let ann = sourceAnnCommented fileName a a
- positioned ann . AST.LiteralBinder (fst ann) $ AST.BooleanLiteral b
- BinderChar _ a b -> do
- let ann = sourceAnnCommented fileName a a
- positioned ann . AST.LiteralBinder (fst ann) $ AST.CharLiteral b
- BinderString _ a b -> do
- let ann = sourceAnnCommented fileName a a
- positioned ann . AST.LiteralBinder (fst ann) . AST.StringLiteral $ b
- BinderNumber _ n a b -> do
- let
- ann = sourceAnnCommented fileName a a
- b'
- | isJust n = bimap negate negate b
- | otherwise = b
- positioned ann . AST.LiteralBinder (fst ann) $ AST.NumericLiteral b'
- BinderArray _ (Wrapped a bs c) -> do
- let
- ann = sourceAnnCommented fileName a c
- vals = case bs of
- Just (Separated x xs) -> go x : (go . snd <$> xs)
- Nothing -> []
- positioned ann . AST.LiteralBinder (fst ann) $ AST.ArrayLiteral vals
- BinderRecord z (Wrapped a bs c) -> do
- let
- ann = sourceAnnCommented fileName a c
- lbl = \case
- RecordPun f -> (mkString . getIdent $ nameValue f, go $ BinderVar z f)
- RecordField f _ v -> (lblName f, go v)
- vals = case bs of
- Just (Separated x xs) -> lbl x : (lbl . snd <$> xs)
- Nothing -> []
- positioned ann . AST.LiteralBinder (fst ann) $ AST.ObjectLiteral vals
- BinderParens _ (Wrapped a b c) ->
- positioned (sourceAnnCommented fileName a c) . AST.ParensInBinder $ go b
- binder@(BinderTyped _ a _ b) -> do
- let
- a' = go a
- b' = convertType fileName b
- ann = (sourceSpan fileName . toSourceRange $ binderRange binder, [])
- positioned ann $ AST.TypedBinder b' a'
- binder@(BinderOp _ _ _ _) -> do
- let
- ann = uncurry (sourceAnn fileName) $ binderRange binder
- reassoc op b a = do
- let op' = AST.OpBinder (sourceSpan fileName . toSourceRange $ qualRange op) $ qualified op
- AST.BinaryNoParensBinder op' (go a) b
- loop k = \case
- BinderOp _ a op b -> loop (reassoc op (k b)) a
- binder' -> k binder'
- positioned ann $ loop go binder
-
-convertDeclaration :: String -> Declaration a -> [AST.Declaration]
-convertDeclaration fileName decl = case decl of
- DeclData _ (DataHead _ a vars) bd -> do
- let
- ctrs :: SourceToken -> DataCtor a -> [(SourceToken, DataCtor a)] -> [AST.DataConstructorDeclaration]
- ctrs st (DataCtor _ name fields) tl
- = AST.DataConstructorDeclaration (sourceAnnCommented fileName st (nameTok name)) (nameValue name) (zip ctrFields $ convertType fileName <$> fields)
- : (case tl of
- [] -> []
- (st', ctor) : tl' -> ctrs st' ctor tl'
- )
- pure $ AST.DataDeclaration ann Env.Data (nameValue a) (goTypeVar <$> vars) (maybe [] (\(st, Separated hd tl) -> ctrs st hd tl) bd)
- DeclType _ (DataHead _ a vars) _ bd ->
- pure $ AST.TypeSynonymDeclaration ann
- (nameValue a)
- (goTypeVar <$> vars)
- (convertType fileName bd)
- DeclNewtype _ (DataHead _ a vars) st x ys -> do
- let ctrs = [AST.DataConstructorDeclaration (sourceAnnCommented fileName st (snd $ declRange decl)) (nameValue x) [(head ctrFields, convertType fileName ys)]]
- pure $ AST.DataDeclaration ann Env.Newtype (nameValue a) (goTypeVar <$> vars) ctrs
- DeclClass _ (ClassHead _ sup name vars fdeps) bd -> do
- let
- goTyVar (TypeVarKinded (Wrapped _ (Labeled a _ _) _)) = nameValue a
- goTyVar (TypeVarName a) = nameValue a
- vars' = zip (toList $ goTyVar <$> vars) [0..]
- goName = fromJust . flip lookup vars' . nameValue
- goFundep (FundepDetermined _ bs) = Env.FunctionalDependency [] (goName <$> NE.toList bs)
- goFundep (FundepDetermines as _ bs) = Env.FunctionalDependency (goName <$> NE.toList as) (goName <$> NE.toList bs)
- goSig (Labeled n _ ty) = do
- let
- ty' = convertType fileName ty
- ann' = widenLeft (tokAnn $ nameTok n) $ T.getAnnForType ty'
- AST.TypeDeclaration $ AST.TypeDeclarationData ann' (ident $ nameValue n) ty'
- pure $ AST.TypeClassDeclaration ann
- (nameValue name)
- (goTypeVar <$> vars)
- (convertConstraint fileName <$> maybe [] (toList . fst) sup)
- (goFundep <$> maybe [] (toList . snd) fdeps)
- (goSig <$> maybe [] (NE.toList . snd) bd)
- DeclInstanceChain _ insts -> do
- let
- instName (Instance (InstanceHead _ a _ _ _ _) _) = ident $ nameValue a
- chainId = instName <$> toList insts
- goInst ix inst@(Instance (InstanceHead _ name _ ctrs cls args) bd) = do
- let ann' = uncurry (sourceAnnCommented fileName) $ instanceRange inst
- AST.TypeInstanceDeclaration ann' chainId ix
- (ident $ nameValue name)
- (convertConstraint fileName <$> maybe [] (toList . fst) ctrs)
- (qualified cls)
- (convertType fileName <$> args)
- (AST.ExplicitInstance $ goInstanceBinding <$> maybe [] (NE.toList . snd) bd)
- uncurry goInst <$> zip [0..] (toList insts)
- DeclDerive _ _ new (InstanceHead _ name _ ctrs cls args) -> do
- let
- name' = ident $ nameValue name
- instTy
- | isJust new = AST.NewtypeInstance
- | otherwise = AST.DerivedInstance
- pure $ AST.TypeInstanceDeclaration ann [name'] 0 name'
- (convertConstraint fileName <$> maybe [] (toList . fst) ctrs)
- (qualified cls)
- (convertType fileName <$> args)
- instTy
- DeclSignature _ lbl ->
- pure $ convertSignature fileName lbl
- DeclValue _ fields ->
- pure $ convertValueBindingFields fileName ann fields
- DeclFixity _ (FixityFields (_, kw) (_, prec) fxop) -> do
- let
- assoc = case kw of
- Infix -> AST.Infix
- Infixr -> AST.Infixr
- Infixl -> AST.Infixl
- fixity = AST.Fixity assoc prec
- pure $ AST.FixityDeclaration ann $ case fxop of
- FixityValue name _ op -> do
- Left $ AST.ValueFixity fixity (first ident <$> qualified name) (nameValue op)
- FixityType _ name _ op ->
- Right $ AST.TypeFixity fixity (qualified name) (nameValue op)
- DeclForeign _ _ _ frn ->
- pure $ case frn of
- ForeignValue (Labeled a _ b) ->
- AST.ExternDeclaration ann (ident $ nameValue a) $ convertType fileName b
- ForeignData _ (Labeled a _ b) ->
- AST.ExternDataDeclaration ann (nameValue a) $ convertKind fileName b
- ForeignKind _ a ->
- AST.ExternKindDeclaration ann (nameValue a)
- where
- ann =
- uncurry (sourceAnnCommented fileName) $ declRange decl
-
- goTypeVar = \case
- TypeVarKinded (Wrapped _ (Labeled x _ y) _) -> (getIdent $ nameValue x, Just $ convertKind fileName y)
- TypeVarName x -> (getIdent $ nameValue x, Nothing)
-
- goInstanceBinding = \case
- InstanceBindingSignature _ lbl ->
- convertSignature fileName lbl
- binding@(InstanceBindingName _ fields) -> do
- let ann' = uncurry (sourceAnnCommented fileName) $ instanceBindingRange binding
- convertValueBindingFields fileName ann' fields
-
-convertSignature :: String -> Labeled (Name Ident) (Type a) -> AST.Declaration
-convertSignature fileName (Labeled a _ b) = do
- let
- b' = convertType fileName b
- ann = widenLeft (tokAnn $ nameTok a) $ T.getAnnForType b'
- AST.TypeDeclaration $ AST.TypeDeclarationData ann (ident $ nameValue a) b'
-
-convertValueBindingFields :: String -> Pos.SourceAnn -> ValueBindingFields a -> AST.Declaration
-convertValueBindingFields fileName ann (ValueBindingFields a bs c) = do
- let
- bs' = convertBinder fileName <$> bs
- cs' = convertGuarded fileName c
- AST.ValueDeclaration $ AST.ValueDeclarationData ann (ident $ nameValue a) Env.Public bs' cs'
-
-convertImportDecl
- :: String
- -> ImportDecl a
- -> (Pos.SourceAnn, N.ModuleName, AST.ImportDeclarationType, Maybe N.ModuleName)
-convertImportDecl fileName decl@(ImportDecl _ _ modName mbNames mbQual) = do
- let
- ann = uncurry (sourceAnnCommented fileName) $ importDeclRange decl
- importTy = case mbNames of
- Nothing -> AST.Implicit
- Just (hiding, (Wrapped _ imps _)) -> do
- let imps' = convertImport fileName <$> toList imps
- if isJust hiding
- then AST.Hiding imps'
- else AST.Explicit imps'
- (ann, nameValue modName, importTy, nameValue . snd <$> mbQual)
-
-convertImport :: String -> Import a -> AST.DeclarationRef
-convertImport fileName imp = case imp of
- ImportValue _ a ->
- AST.ValueRef ann . ident $ nameValue a
- ImportOp _ a ->
- AST.ValueOpRef ann $ nameValue a
- ImportType _ a mb -> do
- let
- ctrs = case mb of
- Nothing -> Just []
- Just (DataAll _ _) -> Nothing
- Just (DataEnumerated _ (Wrapped _ Nothing _)) -> Just []
- Just (DataEnumerated _ (Wrapped _ (Just idents) _)) ->
- Just . map nameValue $ toList idents
- AST.TypeRef ann (nameValue a) ctrs
- ImportTypeOp _ _ a ->
- AST.TypeOpRef ann $ nameValue a
- ImportClass _ _ a ->
- AST.TypeClassRef ann $ nameValue a
- ImportKind _ _ a ->
- AST.KindRef ann $ nameValue a
- where
- ann = sourceSpan fileName . toSourceRange $ importRange imp
-
-convertExport :: String -> Export a -> AST.DeclarationRef
-convertExport fileName export = case export of
- ExportValue _ a ->
- AST.ValueRef ann . ident $ nameValue a
- ExportOp _ a ->
- AST.ValueOpRef ann $ nameValue a
- ExportType _ a mb -> do
- let
- ctrs = case mb of
- Nothing -> Just []
- Just (DataAll _ _) -> Nothing
- Just (DataEnumerated _ (Wrapped _ Nothing _)) -> Just []
- Just (DataEnumerated _ (Wrapped _ (Just idents) _)) ->
- Just . map nameValue $ toList idents
- AST.TypeRef ann (nameValue a) ctrs
- ExportTypeOp _ _ a ->
- AST.TypeOpRef ann $ nameValue a
- ExportClass _ _ a ->
- AST.TypeClassRef ann $ nameValue a
- ExportKind _ _ a ->
- AST.KindRef ann $ nameValue a
- ExportModule _ _ a ->
- AST.ModuleRef ann (nameValue a)
- where
- ann = sourceSpan fileName . toSourceRange $ exportRange export
-
-convertModule :: String -> Module a -> AST.Module
-convertModule fileName module'@(Module _ _ modName exps _ imps decls _) = do
- let
- ann = uncurry (sourceAnnCommented fileName) $ moduleRange module'
- imps' = importCtr. convertImportDecl fileName <$> imps
- decls' = convertDeclaration fileName =<< decls
- exps' = map (convertExport fileName) . toList . wrpValue <$> exps
- uncurry AST.Module ann (nameValue modName) (imps' <> decls') exps'
- where
- importCtr (a, b, c, d) = AST.ImportDeclaration a b c d
-
-ctrFields :: [N.Ident]
-ctrFields = [N.Ident ("value" <> Text.pack (show (n :: Integer))) | n <- [0..]]
diff --git a/src/Language/PureScript/CST/Errors.hs b/src/Language/PureScript/CST/Errors.hs
deleted file mode 100644
index 1b6bfdb..0000000
--- a/src/Language/PureScript/CST/Errors.hs
+++ /dev/null
@@ -1,165 +0,0 @@
-{-# LANGUAGE NamedFieldPuns #-}
-module Language.PureScript.CST.Errors
- ( ParserError(..)
- , ParserErrorType(..)
- , prettyPrintError
- , prettyPrintErrorMessage
- ) where
-
-import Prelude
-
-import qualified Data.Text as Text
-import Data.Char (isSpace, toUpper)
-import Language.PureScript.CST.Layout
-import Language.PureScript.CST.Print
-import Language.PureScript.CST.Types
-import Text.Printf (printf)
-
-data ParserErrorType
- = ErrWildcardInType
- | ErrHoleInType
- | ErrExprInBinder
- | ErrExprInDeclOrBinder
- | ErrExprInDecl
- | ErrBinderInDecl
- | ErrRecordUpdateInCtr
- | ErrRecordPunInUpdate
- | ErrRecordCtrInUpdate
- | ErrTypeInConstraint
- | ErrElseInDecl
- | ErrInstanceNameMismatch
- | ErrUnknownFundep
- | ErrImportInDecl
- | ErrGuardInLetBinder
- | ErrKeywordVar
- | ErrKeywordSymbol
- | ErrQuotedPun
- | ErrToken
- | ErrLineFeedInString
- | ErrAstralCodePointInChar
- | ErrCharEscape
- | ErrNumberOutOfRange
- | ErrLeadingZero
- | ErrExpectedFraction
- | ErrExpectedExponent
- | ErrExpectedHex
- | ErrReservedSymbol
- | ErrCharInGap Char
- | ErrModuleName
- | ErrQualifiedName
- | ErrEmptyDo
- | ErrLexeme (Maybe String) [String]
- | ErrEof
- | ErrCustom String
- deriving (Show, Eq, Ord)
-
-data ParserError = ParserError
- { errRange :: SourceRange
- , errToks :: [SourceToken]
- , errStack :: LayoutStack
- , errType :: ParserErrorType
- } deriving (Show, Eq)
-
-prettyPrintError :: ParserError -> String
-prettyPrintError pe@(ParserError { errRange }) =
- prettyPrintErrorMessage pe <> " at " <> errPos
- where
- errPos = case errRange of
- SourceRange (SourcePos line col) _ ->
- "line " <> show line <> ", column " <> show col
-
-prettyPrintErrorMessage :: ParserError -> String
-prettyPrintErrorMessage (ParserError {..}) = case errType of
- ErrWildcardInType ->
- "Unexpected wildcard in type; type wildcards are only allowed in value annotations"
- ErrHoleInType ->
- "Unexpected hole in type; type holes are only allowed in value annotations"
- ErrExprInBinder ->
- "Expected pattern, saw expression"
- ErrExprInDeclOrBinder ->
- "Expected declaration or pattern, saw expression"
- ErrExprInDecl ->
- "Expected declaration, saw expression"
- ErrBinderInDecl ->
- "Expected declaration, saw pattern"
- ErrRecordUpdateInCtr ->
- "Expected ':', saw '='"
- ErrRecordPunInUpdate ->
- "Expected record update, saw pun"
- ErrRecordCtrInUpdate ->
- "Expected '=', saw ':'"
- ErrTypeInConstraint ->
- "Expected constraint, saw type"
- ErrElseInDecl ->
- "Expected declaration, saw 'else'"
- ErrInstanceNameMismatch ->
- "All instances in a chain must implement the same type class"
- ErrUnknownFundep ->
- "Unknown type variable in functional dependency"
- ErrImportInDecl ->
- "Expected declaration, saw 'import'"
- ErrGuardInLetBinder ->
- "Unexpected guard in let pattern"
- ErrKeywordVar ->
- "Expected variable, saw keyword"
- ErrKeywordSymbol ->
- "Expected symbol, saw reserved symbol"
- ErrQuotedPun ->
- "Unexpected quoted label in record pun, perhaps due to a missing ':'"
- ErrEof ->
- "Unexpected end of input"
- ErrLexeme (Just (hd : _)) _ | isSpace hd ->
- "Illegal whitespace character " <> displayCodePoint hd
- ErrLexeme (Just a) _ ->
- "Unexpected " <> a
- ErrLineFeedInString ->
- "Unexpected line feed in string literal"
- ErrAstralCodePointInChar ->
- "Illegal astral code point in character literal"
- ErrCharEscape ->
- "Illegal character escape code"
- ErrNumberOutOfRange ->
- "Number literal is out of range"
- ErrLeadingZero ->
- "Unexpected leading zeros"
- ErrExpectedFraction ->
- "Expected fraction"
- ErrExpectedExponent ->
- "Expected exponent"
- ErrExpectedHex ->
- "Expected hex digit"
- ErrReservedSymbol ->
- "Unexpected reserved symbol"
- ErrCharInGap ch ->
- "Unexpected character '" <> [ch] <> "' in gap"
- ErrModuleName ->
- "Invalid module name; underscores and primes are not allowed in module names"
- ErrQualifiedName ->
- "Unexpected qualified name"
- ErrEmptyDo ->
- "Expected do statement"
- ErrLexeme _ _ ->
- basicError
- ErrToken
- | SourceToken _ (TokLeftArrow _) : _ <- errToks ->
- "Unexpected \"<-\" in expression, perhaps due to a missing 'do' or 'ado' keyword"
- ErrToken ->
- basicError
- ErrCustom err ->
- err
-
- where
- basicError = case errToks of
- tok : _ -> basicTokError (tokValue tok)
- [] -> "Unexpected input"
-
- basicTokError = \case
- TokLayoutStart -> "Unexpected or mismatched indentation"
- TokLayoutSep -> "Unexpected or mismatched indentation"
- TokLayoutEnd -> "Unexpected or mismatched indentation"
- TokEof -> "Unexpected end of input"
- tok -> "Unexpected token '" <> Text.unpack (printToken tok) <> "'"
-
- displayCodePoint :: Char -> String
- displayCodePoint x =
- "U+" <> map toUpper (printf "%0.4x" (fromEnum x))
diff --git a/src/Language/PureScript/CST/Layout.hs b/src/Language/PureScript/CST/Layout.hs
deleted file mode 100644
index 39b38fb..0000000
--- a/src/Language/PureScript/CST/Layout.hs
+++ /dev/null
@@ -1,401 +0,0 @@
--- | The parser itself is unaware of indentation, and instead only parses explicit
--- delimiters which are inserted by this layout algorithm (much like Haskell).
--- This is convenient because the actual grammar can be specified apart from the
--- indentation rules. Haskell has a few problematic productions which make it
--- impossible to implement a purely lexical layout algorithm, so it also has an
--- additional (and somewhat contentious) parser error side condition. PureScript
--- does not have these problematic productions (particularly foo, bar ::
--- SomeType syntax in declarations), but it does have a few gotchas of it's own.
--- The algorithm is "non-trivial" to say the least, but it is implemented as a
--- purely lexical delimiter parser on a token-by-token basis, which is highly
--- convenient, since it can be replicated in any language or toolchain. There is
--- likely room to simplify it, but there are some seemingly innocuous things
--- that complicate it.
---
--- "Naked" commas (case, patterns, guards, fundeps) are a constant source of
--- complexity, and indeed too much of this is what prevents Haskell from having
--- such an algorithm. Unquoted properties for layout keywords introduce a domino
--- effect of complexity since we have to mask and unmask any usage of . (also in
--- foralls!) or labels in record literals.
-
-module Language.PureScript.CST.Layout where
-
-import Prelude
-
-import Data.DList (snoc)
-import qualified Data.DList as DList
-import Data.Foldable (find)
-import Data.Function ((&))
-import Language.PureScript.CST.Types
-
-type LayoutStack = [(SourcePos, LayoutDelim)]
-
-data LayoutDelim
- = LytRoot
- | LytTopDecl
- | LytTopDeclHead
- | LytDeclGuard
- | LytCase
- | LytCaseBinders
- | LytCaseGuard
- | LytLambdaBinders
- | LytParen
- | LytBrace
- | LytSquare
- | LytIf
- | LytThen
- | LytProperty
- | LytForall
- | LytTick
- | LytLet
- | LytLetStmt
- | LytWhere
- | LytOf
- | LytDo
- | LytAdo
- deriving (Show, Eq, Ord)
-
-isIndented :: LayoutDelim -> Bool
-isIndented = \case
- LytLet -> True
- LytLetStmt -> True
- LytWhere -> True
- LytOf -> True
- LytDo -> True
- LytAdo -> True
- _ -> False
-
-isTopDecl :: SourcePos -> LayoutStack -> Bool
-isTopDecl tokPos = \case
- [(lytPos, LytWhere), (_, LytRoot)]
- | srcColumn tokPos == srcColumn lytPos -> True
- _ -> False
-
-lytToken :: SourcePos -> Token -> SourceToken
-lytToken pos = SourceToken ann
- where
- ann = TokenAnn
- { tokRange = SourceRange pos pos
- , tokLeadingComments = []
- , tokTrailingComments = []
- }
-
-insertLayout :: SourceToken -> SourcePos -> LayoutStack -> (LayoutStack, [SourceToken])
-insertLayout src@(SourceToken tokAnn tok) nextPos stack =
- DList.toList <$> insert (stack, mempty)
- where
- tokPos =
- srcStart $ tokRange tokAnn
-
- insert state@(stk, acc) = case tok of
- -- `data` declarations need masking (LytTopDecl) because the usage of `|`
- -- should not introduce a LytDeclGard context.
- TokLowerName [] "data" ->
- case state & insertDefault of
- state'@(stk', _) | isTopDecl tokPos stk' ->
- state' & pushStack tokPos LytTopDecl
- state' ->
- state' & popStack (== LytProperty)
-
- -- `class` declaration heads need masking (LytTopDeclHead) because the
- -- usage of commas in functional dependencies.
- TokLowerName [] "class" ->
- case state & insertDefault of
- state'@(stk', _) | isTopDecl tokPos stk' ->
- state' & pushStack tokPos LytTopDeclHead
- state' ->
- state' & popStack (== LytProperty)
-
- TokLowerName [] "where" ->
- case stk of
- (_, LytTopDeclHead) : stk' ->
- (stk', acc) & insertToken src & insertStart LytWhere
- (_, LytProperty) : stk' ->
- (stk', acc) & insertToken src
- _ ->
- state & collapse whereP & insertToken src & insertStart LytWhere
- where
- -- `where` always closes do blocks:
- -- example = do do do do foo where foo = ...
- --
- -- `where` closes layout contexts even when indented at the same level:
- -- example = case
- -- Foo -> ...
- -- Bar -> ...
- -- where foo = ...
- whereP _ LytDo = True
- whereP lytPos lyt = offsideEndP lytPos lyt
-
- TokLowerName [] "in" ->
- case collapse inP state of
- -- `let/in` is not allowed in `ado` syntax. `in` is treated as a
- -- delimiter and must always close the `ado`.
- -- example = ado
- -- foo <- ...
- -- let bar = ...
- -- in ...
- ((_, LytLetStmt) : (_, LytAdo) : stk', acc') ->
- (stk', acc') & insertEnd & insertEnd & insertToken src
- ((_, lyt) : stk', acc') | isIndented lyt ->
- (stk', acc') & insertEnd & insertToken src
- _ ->
- state & insertDefault & popStack (== LytProperty)
- where
- inP _ LytLet = False
- inP _ LytAdo = False
- inP _ lyt = isIndented lyt
-
- TokLowerName [] "let" ->
- state & insertKwProperty next
- where
- next state'@(stk', _) = case stk' of
- (p, LytDo) : _ | srcColumn p == srcColumn tokPos ->
- state' & insertStart LytLetStmt
- (p, LytAdo) : _ | srcColumn p == srcColumn tokPos ->
- state' & insertStart LytLetStmt
- _ ->
- state' & insertStart LytLet
-
- TokLowerName _ "do" ->
- state & insertKwProperty (insertStart LytDo)
-
- TokLowerName _ "ado" ->
- state & insertKwProperty (insertStart LytAdo)
-
- -- `case` heads need masking due to commas.
- TokLowerName [] "case" ->
- state & insertKwProperty (pushStack tokPos LytCase)
-
- TokLowerName [] "of" ->
- case collapse indentedP state of
- -- When `of` is matched with a `case`, we are in a case block, and we
- -- need to mask additional contexts (LytCaseBinders, LytCaseGuards)
- -- due to commas.
- ((_, LytCase) : stk', acc') ->
- (stk', acc') & insertToken src & insertStart LytOf & pushStack nextPos LytCaseBinders
- state' ->
- state' & insertDefault & popStack (== LytProperty)
-
- -- `if/then/else` is considered a delimiter context. This allows us to
- -- write chained expressions in `do` blocks without stair-stepping:
- -- example = do
- -- foo
- -- if ... then
- -- ...
- -- else if ... then
- -- ...
- -- else
- -- ...
- TokLowerName [] "if" ->
- state & insertKwProperty (pushStack tokPos LytIf)
-
- TokLowerName [] "then" ->
- case state & collapse indentedP of
- ((_, LytIf) : stk', acc') ->
- (stk', acc') & insertToken src & pushStack tokPos LytThen
- _ ->
- state & insertDefault & popStack (== LytProperty)
-
- TokLowerName [] "else" ->
- case state & collapse indentedP of
- ((_, LytThen) : stk', acc') ->
- (stk', acc') & insertToken src
- _ ->
- -- We don't want to insert a layout separator for top-level `else` in
- -- instance chains.
- case state & collapse offsideP of
- state'@(stk', _) | isTopDecl tokPos stk' ->
- state' & insertToken src
- state' ->
- state' & insertSep & insertToken src & popStack (== LytProperty)
-
- -- `forall` binders need masking because the usage of `.` should not
- -- introduce a LytProperty context.
- TokForall _ ->
- state & insertKwProperty (pushStack tokPos LytForall)
-
- -- Lambdas need masking because the usage of `->` should not close a
- -- LytDeclGaurd or LytCaseGuard context.
- TokBackslash ->
- state & insertDefault & pushStack tokPos LytLambdaBinders
-
- TokRightArrow _ ->
- state & collapse arrowP & popStack guardP & insertToken src
- where
- arrowP _ LytDo = True
- arrowP _ LytOf = False
- arrowP lytPos lyt = offsideEndP lytPos lyt
-
- guardP LytCaseBinders = True
- guardP LytCaseGuard = True
- guardP LytLambdaBinders = True
- guardP _ = False
-
- TokEquals ->
- case state & collapse equalsP of
- ((_, LytDeclGuard) : stk', acc') ->
- (stk', acc') & insertToken src
- _ ->
- state & insertDefault
- where
- equalsP _ LytWhere = True
- equalsP _ LytLet = True
- equalsP _ LytLetStmt = True
- equalsP _ _ = False
-
- -- Guards need masking because of commas.
- TokPipe ->
- case collapse offsideEndP state of
- state'@((_, LytOf) : _, _) ->
- state' & pushStack tokPos LytCaseGuard & insertToken src
- state'@((_, LytLet) : _, _) ->
- state' & pushStack tokPos LytDeclGuard & insertToken src
- state'@((_, LytLetStmt) : _, _) ->
- state' & pushStack tokPos LytDeclGuard & insertToken src
- state'@((_, LytWhere) : _, _) ->
- state' & pushStack tokPos LytDeclGuard & insertToken src
- _ ->
- state & insertDefault
-
- -- Ticks can either start or end an infix expression. We preemptively
- -- collapse all indentation contexts in search of a starting delimiter,
- -- and backtrack if we don't find one.
- TokTick ->
- case state & collapse indentedP of
- ((_, LytTick) : stk', acc') ->
- (stk', acc') & insertToken src
- _ ->
- state & insertDefault & pushStack tokPos LytTick
-
- -- In gneral, commas should close all indented contexts.
- -- example = [ do foo
- -- bar, baz ]
- TokComma ->
- case state & collapse indentedP of
- -- If we see a LytBrace, then we are in a record type or literal.
- -- Record labels need masking so we can use unquoted keywords as labels
- -- without accidentally littering layout delimiters.
- state'@((_, LytBrace) : _, _) ->
- state' & insertToken src & pushStack tokPos LytProperty
- state' ->
- state' & insertToken src
-
- -- TokDot tokens usually entail property access, which need masking so we
- -- can use unquoted keywords as labels.
- TokDot ->
- case state & insertDefault of
- ((_, LytForall) : stk', acc') ->
- (stk', acc')
- state' ->
- state' & pushStack tokPos LytProperty
-
- TokLeftParen ->
- state & insertDefault & pushStack tokPos LytParen
-
- TokLeftBrace ->
- state & insertDefault & pushStack tokPos LytBrace & pushStack tokPos LytProperty
-
- TokLeftSquare ->
- state & insertDefault & pushStack tokPos LytSquare
-
- TokRightParen ->
- state & collapse indentedP & popStack (== LytParen) & insertToken src
-
- TokRightBrace ->
- state & collapse indentedP & popStack (== LytProperty) & popStack (== LytBrace) & insertToken src
-
- TokRightSquare ->
- state & collapse indentedP & popStack (== LytSquare) & insertToken src
-
- TokString _ _ ->
- state & insertDefault & popStack (== LytProperty)
-
- TokLowerName [] _ ->
- state & insertDefault & popStack (== LytProperty)
-
- TokOperator _ _ ->
- state & collapse offsideEndP & insertSep & insertToken src
-
- _ ->
- state & insertDefault
-
- insertDefault state =
- state & collapse offsideP & insertSep & insertToken src
-
- insertStart lyt state@(stk, _) =
- -- We only insert a new layout start when it's going to increase indentation.
- -- This prevents things like the following from parsing:
- -- instance foo :: Foo where
- -- foo = 42
- case find (isIndented . snd) stk of
- Just (pos, _) | srcColumn nextPos <= srcColumn pos -> state
- _ -> state & pushStack nextPos lyt & insertToken (lytToken nextPos TokLayoutStart)
-
- insertSep state@(stk, acc) = case stk of
- -- LytTopDecl is closed by a separator.
- (lytPos, LytTopDecl) : stk' | sepP lytPos ->
- (stk', acc) & insertToken sepTok
- -- LytTopDeclHead can be closed by a separator if there is no `where`.
- (lytPos, LytTopDeclHead) : stk' | sepP lytPos ->
- (stk', acc) & insertToken sepTok
- (lytPos, lyt) : _ | indentSepP lytPos lyt ->
- case lyt of
- -- If a separator is inserted in a case block, we need to push an
- -- additional LytCaseBinders context for comma masking.
- LytOf -> state & insertToken sepTok & pushStack tokPos LytCaseBinders
- _ -> state & insertToken sepTok
- _ -> state
- where
- sepTok = lytToken tokPos TokLayoutSep
-
- insertKwProperty k state =
- case state & insertDefault of
- ((_, LytProperty) : stk', acc') ->
- (stk', acc')
- state' ->
- k state'
-
- insertEnd =
- insertToken (lytToken tokPos TokLayoutEnd)
-
- insertToken token (stk, acc) =
- (stk, acc `snoc` token)
-
- pushStack lytPos lyt (stk, acc) =
- ((lytPos, lyt) : stk, acc)
-
- popStack p ((_, lyt) : stk', acc)
- | p lyt = (stk', acc)
- popStack _ state = state
-
- collapse p = uncurry go
- where
- go ((lytPos, lyt) : stk) acc
- | p lytPos lyt =
- go stk $ if isIndented lyt
- then acc `snoc` lytToken tokPos TokLayoutEnd
- else acc
- go stk acc = (stk, acc)
-
- indentedP =
- const isIndented
-
- offsideP lytPos lyt =
- isIndented lyt && srcColumn tokPos < srcColumn lytPos
-
- offsideEndP lytPos lyt =
- isIndented lyt && srcColumn tokPos <= srcColumn lytPos
-
- indentSepP lytPos lyt =
- isIndented lyt && sepP lytPos
-
- sepP lytPos =
- srcColumn tokPos == srcColumn lytPos && srcLine tokPos /= srcLine lytPos
-
-unwindLayout :: SourcePos -> [Comment LineFeed] -> LayoutStack -> [SourceToken]
-unwindLayout pos leading = go
- where
- go [] = []
- go ((_, LytRoot) : _) = [SourceToken (TokenAnn (SourceRange pos pos) leading []) TokEof]
- go ((_, lyt) : stk) | isIndented lyt = lytToken pos TokLayoutEnd : go stk
- go (_ : stk) = go stk
diff --git a/src/Language/PureScript/CST/Lexer.hs b/src/Language/PureScript/CST/Lexer.hs
deleted file mode 100644
index 91faa20..0000000
--- a/src/Language/PureScript/CST/Lexer.hs
+++ /dev/null
@@ -1,712 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-module Language.PureScript.CST.Lexer
- ( lenient
- , lex
- , lexTopLevel
- , lexWithState
- , isUnquotedKey
- ) where
-
-import Prelude hiding (lex, exp, exponent, lines)
-
-import Control.Monad (join)
-import qualified Data.Char as Char
-import qualified Data.DList as DList
-import Data.Foldable (foldl')
-import Data.Functor (($>))
-import qualified Data.Scientific as Sci
-import Data.String (fromString)
-import Data.Text (Text)
-import qualified Data.Text as Text
-import Language.PureScript.CST.Errors
-import Language.PureScript.CST.Monad hiding (token)
-import Language.PureScript.CST.Layout
-import Language.PureScript.CST.Positions
-import Language.PureScript.CST.Types
-
--- | Stops at the first lexing error and replaces it with TokEof. Otherwise,
--- the parser will fail when it attempts to draw a lookahead token.
-lenient :: [LexResult] -> [LexResult]
-lenient = go
- where
- go [] = []
- go (Right a : as) = Right a : go as
- go (Left (st, _) : _) = do
- let
- pos = lexPos st
- ann = TokenAnn (SourceRange pos pos) (lexLeading st) []
- [Right (SourceToken ann TokEof)]
-
--- | Lexes according to root layout rules.
-lex :: Text -> [LexResult]
-lex src = do
- let (leading, src') = comments src
- lexWithState $ LexState
- { lexPos = advanceLeading (SourcePos 1 1) leading
- , lexLeading = leading
- , lexSource = src'
- , lexStack = [(SourcePos 0 0, LytRoot)]
- }
-
--- | Lexes according to top-level declaration context rules.
-lexTopLevel :: Text -> [LexResult]
-lexTopLevel src = do
- let
- (leading, src') = comments src
- lexPos = advanceLeading (SourcePos 1 1) leading
- hd = Right $ lytToken lexPos TokLayoutStart
- tl = lexWithState $ LexState
- { lexPos = lexPos
- , lexLeading = leading
- , lexSource = src'
- , lexStack = [(lexPos, LytWhere), (SourcePos 0 0, LytRoot)]
- }
- hd : tl
-
--- | Lexes according to some LexState.
-lexWithState :: LexState -> [LexResult]
-lexWithState = go
- where
- Parser lexK =
- tokenAndComments
-
- go state@(LexState {..}) =
- lexK lexSource onError onSuccess
- where
- onError lexSource' err = do
- let
- len1 = Text.length lexSource
- len2 = Text.length lexSource'
- chunk = Text.take (max 0 (len1 - len2)) lexSource
- chunkDelta = textDelta chunk
- pos = applyDelta lexPos chunkDelta
- pure $ Left
- ( state { lexSource = lexSource' }
- , ParserError (SourceRange pos $ applyDelta pos (0, 1)) [] lexStack err
- )
-
- onSuccess _ (TokEof, _) =
- Right <$> unwindLayout lexPos lexLeading lexStack
- onSuccess lexSource' (tok, (trailing, lexLeading')) = do
- let
- endPos = advanceToken lexPos tok
- lexPos' = advanceLeading (advanceTrailing endPos trailing) lexLeading'
- tokenAnn = TokenAnn
- { tokRange = SourceRange lexPos endPos
- , tokLeadingComments = lexLeading
- , tokTrailingComments = trailing
- }
- (lexStack', toks) =
- insertLayout (SourceToken tokenAnn tok) lexPos' lexStack
- state' = LexState
- { lexPos = lexPos'
- , lexLeading = lexLeading'
- , lexSource = lexSource'
- , lexStack = lexStack'
- }
- go2 state' toks
-
- go2 state [] = go state
- go2 state (t : ts) = Right t : go2 state ts
-
-type Lexer = ParserM ParserErrorType Text
-
-{-# INLINE next #-}
-next :: Lexer ()
-next = Parser $ \inp _ ksucc ->
- ksucc (Text.drop 1 inp) ()
-
-{-# INLINE nextWhile #-}
-nextWhile :: (Char -> Bool) -> Lexer Text
-nextWhile p = Parser $ \inp _ ksucc -> do
- let (chs, inp') = Text.span p inp
- ksucc inp' chs
-
-{-# INLINE peek #-}
-peek :: Lexer (Maybe Char)
-peek = Parser $ \inp _ ksucc ->
- if Text.null inp
- then ksucc inp Nothing
- else ksucc inp $ Just $ Text.head inp
-
-{-# INLINE restore #-}
-restore :: (ParserErrorType -> Bool) -> Lexer a -> Lexer a
-restore p (Parser k) = Parser $ \inp kerr ksucc ->
- k inp (\inp' err -> kerr (if p err then inp else inp') err) ksucc
-
-tokenAndComments :: Lexer (Token, ([Comment void], [Comment LineFeed]))
-tokenAndComments = (,) <$> token <*> breakComments
-
-comments :: Text -> ([Comment LineFeed], Text)
-comments = \src -> k src (\_ _ -> ([], src)) (\inp (a, b) -> (a <> b, inp))
- where
- Parser k = breakComments
-
-breakComments :: Lexer ([Comment void], [Comment LineFeed])
-breakComments = k0 []
- where
- k0 acc = do
- spaces <- nextWhile (== ' ')
- lines <- nextWhile isLineFeed
- let
- acc'
- | Text.null spaces = acc
- | otherwise = Space (Text.length spaces) : acc
- if Text.null lines
- then do
- mbComm <- comment
- case mbComm of
- Just comm -> k0 (comm : acc')
- Nothing -> pure (reverse acc', [])
- else
- k1 acc' (goWs [] $ Text.unpack lines)
-
- k1 trl acc = do
- ws <- nextWhile (\c -> c == ' ' || isLineFeed c)
- let acc' = goWs acc $ Text.unpack ws
- mbComm <- comment
- case mbComm of
- Just comm -> k1 trl (comm : acc')
- Nothing -> pure (reverse trl, reverse acc')
-
- goWs a ('\r' : '\n' : ls) = goWs (Line CRLF : a) ls
- goWs a ('\r' : ls) = goWs (Line CRLF : a) ls
- goWs a ('\n' : ls) = goWs (Line LF : a) ls
- goWs a (' ' : ls) = goSpace a 1 ls
- goWs a _ = a
-
- goSpace a !n (' ' : ls) = goSpace a (n + 1) ls
- goSpace a !n ls = goWs (Space n : a) ls
-
- isBlockComment = Parser $ \inp _ ksucc ->
- case Text.uncons inp of
- Just ('-', inp2) ->
- case Text.uncons inp2 of
- Just ('-', inp3) ->
- ksucc inp3 $ Just False
- _ ->
- ksucc inp Nothing
- Just ('{', inp2) ->
- case Text.uncons inp2 of
- Just ('-', inp3) ->
- ksucc inp3 $ Just True
- _ ->
- ksucc inp Nothing
- _ ->
- ksucc inp Nothing
-
- comment = isBlockComment >>= \case
- Just True -> Just <$> blockComment "{-"
- Just False -> Just <$> lineComment "--"
- Nothing -> pure $ Nothing
-
- lineComment acc = do
- comm <- nextWhile (\c -> c /= '\r' && c /= '\n')
- pure $ Comment (acc <> comm)
-
- blockComment acc = do
- chs <- nextWhile (/= '-')
- dashes <- nextWhile (== '-')
- if Text.null dashes
- then pure $ Comment $ acc <> chs
- else peek >>= \case
- Just '}' -> next $> Comment (acc <> chs <> dashes <> "}")
- _ -> blockComment (acc <> chs <> dashes)
-
-token :: Lexer Token
-token = peek >>= maybe (pure TokEof) k0
- where
- k0 ch1 = case ch1 of
- '(' -> next *> leftParen
- ')' -> next $> TokRightParen
- '{' -> next $> TokLeftBrace
- '}' -> next $> TokRightBrace
- '[' -> next $> TokLeftSquare
- ']' -> next $> TokRightSquare
- '`' -> next $> TokTick
- ',' -> next $> TokComma
- '∷' -> next *> orOperator1 (TokDoubleColon Unicode) ch1
- '←' -> next *> orOperator1 (TokLeftArrow Unicode) ch1
- '→' -> next *> orOperator1 (TokRightArrow Unicode) ch1
- '⇒' -> next *> orOperator1 (TokRightFatArrow Unicode) ch1
- '∀' -> next *> orOperator1 (TokForall Unicode) ch1
- '|' -> next *> orOperator1 TokPipe ch1
- '.' -> next *> orOperator1 TokDot ch1
- '\\' -> next *> orOperator1 TokBackslash ch1
- '<' -> next *> orOperator2 (TokLeftArrow ASCII) ch1 '-'
- '-' -> next *> orOperator2 (TokRightArrow ASCII) ch1 '>'
- '=' -> next *> orOperator2' TokEquals (TokRightFatArrow ASCII) ch1 '>'
- ':' -> next *> orOperator2' (TokOperator [] ":") (TokDoubleColon ASCII) ch1 ':'
- '?' -> next *> hole
- '\'' -> next *> char
- '"' -> next *> string
- _ | Char.isDigit ch1 -> restore (== ErrNumberOutOfRange) (next *> number ch1)
- | Char.isUpper ch1 -> next *> upper [] ch1
- | isIdentStart ch1 -> next *> lower [] ch1
- | isSymbolChar ch1 -> next *> operator [] [ch1]
- | otherwise -> throw $ ErrLexeme (Just [ch1]) []
-
- {-# INLINE orOperator1 #-}
- orOperator1 :: Token -> Char -> Lexer Token
- orOperator1 tok ch1 = join $ Parser $ \inp _ ksucc ->
- case Text.uncons inp of
- Just (ch2, inp2) | isSymbolChar ch2 ->
- ksucc inp2 $ operator [] [ch1, ch2]
- _ ->
- ksucc inp $ pure tok
-
- {-# INLINE orOperator2 #-}
- orOperator2 :: Token -> Char -> Char -> Lexer Token
- orOperator2 tok ch1 ch2 = join $ Parser $ \inp _ ksucc ->
- case Text.uncons inp of
- Just (ch2', inp2) | ch2 == ch2' ->
- case Text.uncons inp2 of
- Just (ch3, inp3) | isSymbolChar ch3 ->
- ksucc inp3 $ operator [] [ch1, ch2, ch3]
- _ ->
- ksucc inp2 $ pure tok
- _ ->
- ksucc inp $ operator [] [ch1]
-
- {-# INLINE orOperator2' #-}
- orOperator2' :: Token -> Token -> Char -> Char -> Lexer Token
- orOperator2' tok1 tok2 ch1 ch2 = join $ Parser $ \inp _ ksucc ->
- case Text.uncons inp of
- Just (ch2', inp2) | ch2 == ch2' ->
- case Text.uncons inp2 of
- Just (ch3, inp3) | isSymbolChar ch3 ->
- ksucc inp3 $ operator [] [ch1, ch2, ch3]
- _ ->
- ksucc inp2 $ pure tok2
- Just (ch2', inp2) | isSymbolChar ch2' ->
- ksucc inp2 $ operator [] [ch1, ch2']
- _ ->
- ksucc inp $ pure tok1
-
- {-
- leftParen
- : '(' '→' ')'
- | '(' '->' ')'
- | '(' symbolChar+ ')'
- | '('
- -}
- leftParen :: Lexer Token
- leftParen = Parser $ \inp kerr ksucc ->
- case Text.span isSymbolChar inp of
- (chs, inp2)
- | Text.null chs -> ksucc inp TokLeftParen
- | otherwise ->
- case Text.uncons inp2 of
- Just (')', inp3) ->
- case chs of
- "→" -> ksucc inp3 $ TokSymbolArr Unicode
- "->" -> ksucc inp3 $ TokSymbolArr ASCII
- _ | isReservedSymbol chs -> kerr inp ErrReservedSymbol
- | otherwise -> ksucc inp3 $ TokSymbolName [] chs
- _ -> ksucc inp TokLeftParen
-
- {-
- symbol
- : '(' symbolChar+ ')'
- -}
- symbol :: [Text] -> Lexer Token
- symbol qual = restore isReservedSymbolError $ peek >>= \case
- Just ch | isSymbolChar ch ->
- nextWhile isSymbolChar >>= \chs ->
- peek >>= \case
- Just ')'
- | isReservedSymbol chs -> throw ErrReservedSymbol
- | otherwise -> next $> TokSymbolName qual chs
- Just ch2 -> throw $ ErrLexeme (Just [ch2]) []
- Nothing -> throw ErrEof
- Just ch -> throw $ ErrLexeme (Just [ch]) []
- Nothing -> throw ErrEof
-
- {-
- operator
- : symbolChar+
- -}
- operator :: [Text] -> [Char] -> Lexer Token
- operator qual pre = do
- rest <- nextWhile isSymbolChar
- pure . TokOperator (reverse qual) $ Text.pack pre <> rest
-
- {-
- moduleName
- : upperChar alphaNumChar*
-
- qualifier
- : (moduleName '.')* moduleName
-
- upper
- : (qualifier '.')? upperChar identChar*
- | qualifier '.' lowerQualified
- | qualifier '.' operator
- | qualifier '.' symbol
- -}
- upper :: [Text] -> Char -> Lexer Token
- upper qual pre = do
- rest <- nextWhile isIdentChar
- ch1 <- peek
- let name = Text.cons pre rest
- case ch1 of
- Just '.' -> do
- let qual' = name : qual
- next *> peek >>= \case
- Just '(' -> next *> symbol qual'
- Just ch2
- | Char.isUpper ch2 -> next *> upper qual' ch2
- | isIdentStart ch2 -> next *> lower qual' ch2
- | isSymbolChar ch2 -> next *> operator qual' [ch2]
- | otherwise -> throw $ ErrLexeme (Just [ch2]) []
- Nothing ->
- throw ErrEof
- _ ->
- pure $ TokUpperName (reverse qual) name
-
- {-
- lower
- : '_'
- | 'forall'
- | lowerChar identChar*
-
- lowerQualified
- : lowerChar identChar*
- -}
- lower :: [Text] -> Char -> Lexer Token
- lower qual pre = do
- rest <- nextWhile isIdentChar
- case pre of
- '_' | Text.null rest ->
- if null qual
- then pure TokUnderscore
- else throw $ ErrLexeme (Just [pre]) []
- _ ->
- case Text.cons pre rest of
- "forall" | null qual -> pure $ TokForall ASCII
- name -> pure $ TokLowerName (reverse qual) name
-
- {-
- hole
- : '?' identChar+
- -}
- hole :: Lexer Token
- hole = do
- name <- nextWhile isIdentChar
- if Text.null name
- then operator [] ['?']
- else pure $ TokHole name
-
- {-
- char
- : "'" '\' escape "'"
- | "'" [^'] "'"
- -}
- char :: Lexer Token
- char = do
- (raw, ch) <- peek >>= \case
- Just '\\' -> do
- (raw, ch2) <- next *> escape
- pure (Text.cons '\\' raw, ch2)
- Just ch ->
- next $> (Text.singleton ch, ch)
- Nothing ->
- throw $ ErrEof
- peek >>= \case
- Just '\''
- | fromEnum ch > 0xFFFF -> throw ErrAstralCodePointInChar
- | otherwise -> next $> TokChar raw ch
- Just ch2 ->
- throw $ ErrLexeme (Just [ch2]) []
- _ ->
- throw $ ErrEof
-
- {-
- stringPart
- : '\' escape
- | '\' [ \r\n]+ '\'
- | [^"]
-
- string
- : '"' stringPart* '"'
- | '"""' .* '"""'
-
- This assumes maximal munch for quotes. A raw string literal can end with
- any number of quotes, where the last 3 are considered the closing
- delimiter.
- -}
- string :: Lexer Token
- string = do
- quotes1 <- nextWhile (== '"')
- case Text.length quotes1 of
- 0 -> do
- let
- go raw acc = do
- chs <- nextWhile isNormalStringChar
- let
- raw' = raw <> chs
- acc' = acc <> DList.fromList (Text.unpack chs)
- peek >>= \case
- Just '"' -> next $> TokString raw' (fromString (DList.toList acc'))
- Just '\\' -> next *> goEscape (raw' <> "\\") acc'
- Just _ -> throw ErrLineFeedInString
- Nothing -> throw ErrEof
-
- goEscape raw acc = do
- mbCh <- peek
- case mbCh of
- Just ch1 | isStringGapChar ch1 -> do
- gap <- nextWhile isStringGapChar
- peek >>= \case
- Just '"' -> next $> TokString (raw <> gap) (fromString (DList.toList acc))
- Just '\\' -> next *> go (raw <> gap <> "\\") acc
- Just ch -> throw $ ErrCharInGap ch
- Nothing -> throw ErrEof
- _ -> do
- (raw', ch) <- escape
- go (raw <> raw') (acc <> DList.singleton ch)
- go "" mempty
- 1 ->
- pure $ TokString "" ""
- n | n >= 5 -> do
- let str = Text.take 5 quotes1
- pure $ TokString str (fromString (Text.unpack str))
- _ -> do
- let
- go acc = do
- chs <- nextWhile (/= '"')
- quotes2 <- nextWhile (== '"')
- case Text.length quotes2 of
- 0 -> throw ErrEof
- n | n >= 3 -> pure $ TokRawString $ acc <> chs <> Text.drop 3 quotes2
- _ -> go (acc <> chs <> quotes2)
- go ""
-
- {-
- escape
- : 't'
- | 'r'
- | 'n'
- | "'"
- | '"'
- | 'x' [0-9a-fA-F]{0,6}
- -}
- escape :: Lexer (Text, Char)
- escape = do
- ch <- peek
- case ch of
- Just 't' -> next $> ("t", '\t')
- Just 'r' -> next $> ("r", '\r')
- Just 'n' -> next $> ("n", '\n')
- Just '"' -> next $> ("\"", '"')
- Just '\'' -> next $> ("'", '\'')
- Just '\\' -> next $> ("\\", '\\')
- Just 'x' -> (*>) next $ Parser $ \inp kerr ksucc -> do
- let
- go n acc (ch' : chs)
- | Char.isHexDigit ch' = go (n * 16 + Char.digitToInt ch') (ch' : acc) chs
- go n acc _
- | n <= 0x10FFFF =
- ksucc (Text.drop (length acc) inp)
- ("x" <> Text.pack (reverse acc), Char.chr n)
- | otherwise =
- kerr inp ErrCharEscape -- TODO
- go 0 [] $ Text.unpack $ Text.take 6 inp
- _ -> throw ErrCharEscape
-
- {-
- number
- : hexadecimal
- | integer ('.' fraction)? exponent?
- -}
- number :: Char -> Lexer Token
- number ch1 = peek >>= \ch2 -> case (ch1, ch2) of
- ('0', Just 'x') -> next *> hexadecimal
- (_, _) -> do
- mbInt <- integer1 ch1
- mbFraction <- fraction
- case (mbInt, mbFraction) of
- (Just (raw, int), Nothing) -> do
- let int' = digitsToInteger int
- exponent >>= \case
- Just (raw', exp) ->
- sciDouble (raw <> raw') $ Sci.scientific int' exp
- Nothing ->
- pure $ TokInt raw int'
- (Just (raw, int), Just (raw', frac)) -> do
- let sci = digitsToScientific int frac
- exponent >>= \case
- Just (raw'', exp) ->
- sciDouble (raw <> raw' <> raw'') $ uncurry Sci.scientific $ (+ exp) <$> sci
- Nothing ->
- sciDouble (raw <> raw') $ uncurry Sci.scientific sci
- (Nothing, Just (raw, frac)) -> do
- let sci = digitsToScientific [] frac
- exponent >>= \case
- Just (raw', exp) ->
- sciDouble (raw <> raw') $ uncurry Sci.scientific $ (+ exp) <$> sci
- Nothing ->
- sciDouble raw $ uncurry Sci.scientific sci
- (Nothing, Nothing) ->
- peek >>= \ch -> throw $ ErrLexeme (pure <$> ch) []
-
- sciDouble :: Text -> Sci.Scientific -> Lexer Token
- sciDouble raw sci = case Sci.toBoundedRealFloat sci of
- Left _ -> throw ErrNumberOutOfRange
- Right n -> pure $ TokNumber raw n
-
- {-
- integer
- : '0'
- | [1-9] digits
- -}
- integer :: Lexer (Maybe (Text, String))
- integer = peek >>= \case
- Just '0' -> next *> peek >>= \case
- Just ch | isNumberChar ch -> throw ErrLeadingZero
- _ -> pure $ Just ("0", "0")
- Just ch | isDigitChar ch -> Just <$> digits
- _ -> pure $ Nothing
-
- {-
- integer1
- : '0'
- | [1-9] digits
-
- This is the same as 'integer', the only difference is that this expects the
- first char to be consumed during dispatch.
- -}
- integer1 :: Char -> Lexer (Maybe (Text, String))
- integer1 = \case
- '0' -> peek >>= \case
- Just ch | isNumberChar ch -> throw ErrLeadingZero
- _ -> pure $ Just ("0", "0")
- ch | isDigitChar ch -> do
- (raw, chs) <- digits
- pure $ Just (Text.cons ch raw, ch : chs)
- _ -> pure $ Nothing
-
- {-
- fraction
- : '.' [0-9_]+
- -}
- fraction :: Lexer (Maybe (Text, String))
- fraction = Parser $ \inp _ ksucc ->
- -- We need more than a single char lookahead for things like `1..10`.
- case Text.uncons inp of
- Just ('.', inp')
- | (raw, inp'') <- Text.span isNumberChar inp'
- , not (Text.null raw) ->
- ksucc inp'' $ Just ("." <> raw, filter (/= '_') $ Text.unpack raw)
- _ ->
- ksucc inp Nothing
-
- {-
- digits
- : [0-9_]*
-
- Digits can contain underscores, which are ignored.
- -}
- digits :: Lexer (Text, String)
- digits = do
- raw <- nextWhile isNumberChar
- pure (raw, filter (/= '_') $ Text.unpack raw)
-
- {-
- exponent
- : 'e' ('+' | '-')? integer
- -}
- exponent :: Lexer (Maybe (Text, Int))
- exponent = peek >>= \case
- Just 'e' -> do
- (neg, sign) <- next *> peek >>= \case
- Just '-' -> next $> (True, "-")
- Just '+' -> next $> (False, "+")
- _ -> pure (False, "")
- integer >>= \case
- Just (raw, chs) -> do
- let
- int | neg = negate $ digitsToInteger chs
- | otherwise = digitsToInteger chs
- pure $ Just ("e" <> sign <> raw, fromInteger int)
- Nothing -> throw ErrExpectedExponent
- _ ->
- pure Nothing
-
- {-
- hexadecimal
- : '0x' [0-9a-fA-F]+
- -}
- hexadecimal :: Lexer Token
- hexadecimal = do
- chs <- nextWhile Char.isHexDigit
- if Text.null chs
- then throw ErrExpectedHex
- else pure $ TokInt ("0x" <> chs) $ digitsToIntegerBase 16 $ Text.unpack chs
-
-digitsToInteger :: [Char] -> Integer
-digitsToInteger = digitsToIntegerBase 10
-
-digitsToIntegerBase :: Integer -> [Char] -> Integer
-digitsToIntegerBase b = foldl' (\n c -> n * b + (toInteger (Char.digitToInt c))) 0
-
-digitsToScientific :: [Char] -> [Char] -> (Integer, Int)
-digitsToScientific = go 0 . reverse
- where
- go !exp is [] = (digitsToInteger (reverse is), exp)
- go !exp is (f : fs) = go (exp - 1) (f : is) fs
-
-isSymbolChar :: Char -> Bool
-isSymbolChar c = (c `elem` (":!#$%&*+./<=>?@\\^|-~" :: [Char])) || (not (Char.isAscii c) && Char.isSymbol c)
-
-isReservedSymbolError :: ParserErrorType -> Bool
-isReservedSymbolError = (== ErrReservedSymbol)
-
-isReservedSymbol :: Text -> Bool
-isReservedSymbol = flip elem symbols
- where
- symbols =
- [ "::"
- , "∷"
- , "<-"
- , "←"
- , "->"
- , "→"
- , "=>"
- , "⇒"
- , "∀"
- , "|"
- , "."
- , "\\"
- , "="
- ]
-
-isIdentStart :: Char -> Bool
-isIdentStart c = Char.isLower c || c == '_'
-
-isIdentChar :: Char -> Bool
-isIdentChar c = Char.isAlphaNum c || c == '_' || c == '\''
-
-isDigitChar :: Char -> Bool
-isDigitChar c = c >= '0' && c <= '9'
-
-isNumberChar :: Char -> Bool
-isNumberChar c = (c >= '0' && c <= '9') || c == '_'
-
-isNormalStringChar :: Char -> Bool
-isNormalStringChar c = c /= '"' && c /= '\\' && c /= '\r' && c /= '\n'
-
-isStringGapChar :: Char -> Bool
-isStringGapChar c = c == ' ' || c == '\r' || c == '\n'
-
-isLineFeed :: Char -> Bool
-isLineFeed c = c == '\r' || c == '\n'
-
--- | Checks if some identifier is a valid unquoted key.
-isUnquotedKey :: Text -> Bool
-isUnquotedKey t =
- case Text.uncons t of
- Nothing ->
- False
- Just (hd, tl) ->
- isIdentStart hd && Text.all isIdentChar tl
diff --git a/src/Language/PureScript/CST/Monad.hs b/src/Language/PureScript/CST/Monad.hs
deleted file mode 100644
index eb7a3be..0000000
--- a/src/Language/PureScript/CST/Monad.hs
+++ /dev/null
@@ -1,174 +0,0 @@
-module Language.PureScript.CST.Monad where
-
-import Prelude
-
-import Data.List (sortBy)
-import qualified Data.List.NonEmpty as NE
-import Data.Ord (comparing)
-import Data.Text (Text)
-import Language.PureScript.CST.Errors
-import Language.PureScript.CST.Layout
-import Language.PureScript.CST.Positions
-import Language.PureScript.CST.Types
-
-type LexResult = Either (LexState, ParserError) SourceToken
-
-data LexState = LexState
- { lexPos :: SourcePos
- , lexLeading :: [Comment LineFeed]
- , lexSource :: Text
- , lexStack :: LayoutStack
- } deriving (Show)
-
-data ParserState = ParserState
- { parserBuff :: [LexResult]
- , parserErrors :: [ParserError]
- } deriving (Show)
-
--- | A bare bones, CPS'ed `StateT s (Except e) a`.
-newtype ParserM e s a =
- Parser (forall r. s -> (s -> e -> r) -> (s -> a -> r) -> r)
-
-type Parser = ParserM ParserError ParserState
-
-instance Functor (ParserM e s) where
- {-# INLINE fmap #-}
- fmap f (Parser k) =
- Parser $ \st kerr ksucc ->
- k st kerr (\st' a -> ksucc st' (f a))
-
-instance Applicative (ParserM e s) where
- {-# INLINE pure #-}
- pure a = Parser $ \st _ k -> k st a
- {-# INLINE (<*>) #-}
- Parser k1 <*> Parser k2 =
- Parser $ \st kerr ksucc ->
- k1 st kerr $ \st' f ->
- k2 st' kerr $ \st'' a ->
- ksucc st'' (f a)
-
-instance Monad (ParserM e s) where
- {-# INLINE return #-}
- return = pure
- {-# INLINE (>>=) #-}
- Parser k1 >>= k2 =
- Parser $ \st kerr ksucc ->
- k1 st kerr $ \st' a -> do
- let Parser k3 = k2 a
- k3 st' kerr ksucc
-
-runParser :: ParserState -> Parser a -> (ParserState, Either (NE.NonEmpty ParserError) a)
-runParser st (Parser k) = k st left right
- where
- left st'@(ParserState {..}) err =
- (st', Left $ NE.sortBy (comparing errRange) $ err NE.:| parserErrors)
-
- right st'@(ParserState {..}) res
- | null parserErrors = (st', Right res)
- | otherwise = (st', Left $ NE.fromList $ sortBy (comparing errRange) parserErrors)
-
-runTokenParser :: Parser a -> [LexResult] -> Either (NE.NonEmpty ParserError) a
-runTokenParser p = snd . flip runParser p . flip ParserState []
-
-{-# INLINE throw #-}
-throw :: e -> ParserM e s a
-throw e = Parser $ \st kerr _ -> kerr st e
-
-parseError :: SourceToken -> Parser a
-parseError tok = Parser $ \st kerr _ ->
- kerr st $ ParserError
- { errRange = tokRange . tokAnn $ tok
- , errToks = [tok]
- , errStack = [] -- TODO parserStack st
- , errType = ErrToken
- }
-
-mkParserError :: LayoutStack -> [SourceToken] -> ParserErrorType -> ParserError
-mkParserError stack toks ty =
- ParserError
- { errRange = range
- , errToks = toks
- , errStack = stack
- , errType = ty
- }
- where
- range = case toks of
- [] -> SourceRange (SourcePos 0 0) (SourcePos 0 0)
- _ -> widen (tokRange . tokAnn $ head toks) (tokRange . tokAnn $ last toks)
-
-addFailure :: [SourceToken] -> ParserErrorType -> Parser ()
-addFailure toks ty = Parser $ \st _ ksucc ->
- ksucc (st { parserErrors = mkParserError [] toks ty : parserErrors st }) ()
-
-addFailures :: [ParserError] -> Parser ()
-addFailures errs = Parser $ \st _ ksucc ->
- ksucc (st { parserErrors = errs <> parserErrors st }) ()
-
-parseFail' :: [SourceToken] -> ParserErrorType -> Parser a
-parseFail' toks msg = Parser $ \st kerr _ -> kerr st (mkParserError [] toks msg)
-
-parseFail :: SourceToken -> ParserErrorType -> Parser a
-parseFail = parseFail' . pure
-
-pushBack :: SourceToken -> Parser ()
-pushBack tok = Parser $ \st _ ksucc ->
- ksucc (st { parserBuff = Right tok : parserBuff st }) ()
-
-{-# INLINE tryPrefix #-}
-tryPrefix :: Parser a -> Parser b -> Parser (Maybe a, b)
-tryPrefix (Parser lhs) rhs = Parser $ \st kerr ksucc ->
- lhs st
- (\_ _ -> do
- let Parser k = (Nothing,) <$> rhs
- k st kerr ksucc)
- (\st' res -> do
- let Parser k = (Just res,) <$> rhs
- k st' kerr ksucc)
-
-oneOf :: NE.NonEmpty (Parser a) -> Parser a
-oneOf parsers = Parser $ \st kerr ksucc -> do
- let
- go (st', Right a) _ = (st', Right a)
- go _ (st', Right a) = (st', Right a)
- go (st1, Left errs1) (st2, Left errs2)
- | errRange (NE.last errs2) > errRange (NE.last errs1) = (st2, Left errs2)
- | otherwise = (st1, Left errs1)
- case foldr1 go $ runParser st <$> parsers of
- (st', Left errs) -> kerr (st' { parserErrors = NE.tail errs }) $ NE.head errs
- (st', Right res) -> ksucc st' res
-
-manyDelimited :: Token -> Token -> Token -> Parser a -> Parser [a]
-manyDelimited open close sep p = do
- _ <- token open
- res <- go1
- _ <- token close
- pure $ res
- where
- go1 =
- oneOf $ NE.fromList
- [ go2 . pure =<< p
- , pure []
- ]
-
- go2 acc =
- oneOf $ NE.fromList
- [ token sep *> (go2 . (: acc) =<< p)
- , pure (reverse acc)
- ]
-
-token :: Token -> Parser SourceToken
-token t = do
- t' <- munch
- if t == tokValue t'
- then pure t'
- else parseError t'
-
-munch :: Parser SourceToken
-munch = Parser $ \state@(ParserState {..}) kerr ksucc ->
- case parserBuff of
- Right tok : parserBuff' ->
- ksucc (state { parserBuff = parserBuff' }) tok
- Left (_, err) : _ ->
- kerr state err
- [] ->
- error "Empty input"
diff --git a/src/Language/PureScript/CST/Parser.y b/src/Language/PureScript/CST/Parser.y
deleted file mode 100644
index d63619c..0000000
--- a/src/Language/PureScript/CST/Parser.y
+++ /dev/null
@@ -1,793 +0,0 @@
-{
-module Language.PureScript.CST.Parser
- ( parseType
- , parseKind
- , parseExpr
- , parseDecl
- , parseIdent
- , parseOperator
- , parseModule
- , parseImportDeclP
- , parseDeclP
- , parseExprP
- , parseTypeP
- , parseModuleNameP
- , parseQualIdentP
- , parse
- , PartialResult(..)
- ) where
-
-import Prelude hiding (lex)
-
-import Control.Monad ((<=<), when)
-import Data.Foldable (foldl', for_)
-import qualified Data.List.NonEmpty as NE
-import Data.Text (Text)
-import Data.Traversable (for)
-import Language.PureScript.CST.Errors
-import Language.PureScript.CST.Lexer
-import Language.PureScript.CST.Monad
-import Language.PureScript.CST.Positions
-import Language.PureScript.CST.Types
-import Language.PureScript.CST.Utils
-import qualified Language.PureScript.Names as N
-import Language.PureScript.PSString (PSString)
-}
-
-%expect 98
-
-%name parseKind kind
-%name parseType type
-%name parseExpr expr
-%name parseIdent ident
-%name parseOperator op
-%name parseModuleBody moduleBody
-%name parseDecl decl
-%partial parseImportDeclP importDeclP
-%partial parseDeclP declP
-%partial parseExprP exprP
-%partial parseTypeP typeP
-%partial parseModuleNameP moduleNameP
-%partial parseQualIdentP qualIdentP
-%partial parseModuleHeader moduleHeader
-%partial parseDoStatement doStatement
-%partial parseDoExpr doExpr
-%partial parseDoNext doNext
-%partial parseGuardExpr guardExpr
-%partial parseGuardNext guardNext
-%partial parseGuardStatement guardStatement
-%partial parseClassSuper classSuper
-%partial parseClassNameAndFundeps classNameAndFundeps
-%partial parseBinderAndArrow binderAndArrow
-%tokentype { SourceToken }
-%monad { Parser }
-%error { parseError }
-%lexer { lexer } { SourceToken _ TokEof }
-
-%token
- '(' { SourceToken _ TokLeftParen }
- ')' { SourceToken _ TokRightParen }
- '{' { SourceToken _ TokLeftBrace }
- '}' { SourceToken _ TokRightBrace }
- '[' { SourceToken _ TokLeftSquare }
- ']' { SourceToken _ TokRightSquare }
- '\{' { SourceToken _ TokLayoutStart }
- '\}' { SourceToken _ TokLayoutEnd }
- '\;' { SourceToken _ TokLayoutSep }
- '<-' { SourceToken _ (TokLeftArrow _) }
- '->' { SourceToken _ (TokRightArrow _) }
- '<=' { SourceToken _ (TokOperator [] sym) | isLeftFatArrow sym }
- '=>' { SourceToken _ (TokRightFatArrow _) }
- ':' { SourceToken _ (TokOperator [] ":") }
- '::' { SourceToken _ (TokDoubleColon _) }
- '=' { SourceToken _ TokEquals }
- '|' { SourceToken _ TokPipe }
- '`' { SourceToken _ TokTick }
- '.' { SourceToken _ TokDot }
- ',' { SourceToken _ TokComma }
- '_' { SourceToken _ TokUnderscore }
- '\\' { SourceToken _ TokBackslash }
- '-' { SourceToken _ (TokOperator [] "-") }
- '@' { SourceToken _ (TokOperator [] "@") }
- '#' { SourceToken _ (TokOperator [] "#") }
- 'ado' { SourceToken _ (TokLowerName _ "ado") }
- 'as' { SourceToken _ (TokLowerName [] "as") }
- 'case' { SourceToken _ (TokLowerName [] "case") }
- 'class' { SourceToken _ (TokLowerName [] "class") }
- 'data' { SourceToken _ (TokLowerName [] "data") }
- 'derive' { SourceToken _ (TokLowerName [] "derive") }
- 'do' { SourceToken _ (TokLowerName _ "do") }
- 'else' { SourceToken _ (TokLowerName [] "else") }
- 'false' { SourceToken _ (TokLowerName [] "false") }
- 'forall' { SourceToken _ (TokForall ASCII) }
- 'forallu' { SourceToken _ (TokForall Unicode) }
- 'foreign' { SourceToken _ (TokLowerName [] "foreign") }
- 'hiding' { SourceToken _ (TokLowerName [] "hiding") }
- 'import' { SourceToken _ (TokLowerName [] "import") }
- 'if' { SourceToken _ (TokLowerName [] "if") }
- 'in' { SourceToken _ (TokLowerName [] "in") }
- 'infix' { SourceToken _ (TokLowerName [] "infix") }
- 'infixl' { SourceToken _ (TokLowerName [] "infixl") }
- 'infixr' { SourceToken _ (TokLowerName [] "infixr") }
- 'instance' { SourceToken _ (TokLowerName [] "instance") }
- 'kind' { SourceToken _ (TokLowerName [] "kind") }
- 'let' { SourceToken _ (TokLowerName [] "let") }
- 'module' { SourceToken _ (TokLowerName [] "module") }
- 'newtype' { SourceToken _ (TokLowerName [] "newtype") }
- 'of' { SourceToken _ (TokLowerName [] "of") }
- 'then' { SourceToken _ (TokLowerName [] "then") }
- 'true' { SourceToken _ (TokLowerName [] "true") }
- 'type' { SourceToken _ (TokLowerName [] "type") }
- 'where' { SourceToken _ (TokLowerName [] "where") }
- '(->)' { SourceToken _ (TokSymbolArr _) }
- '(..)' { SourceToken _ (TokSymbolName [] "..") }
- LOWER { SourceToken _ (TokLowerName [] _) }
- QUAL_LOWER { SourceToken _ (TokLowerName _ _) }
- UPPER { SourceToken _ (TokUpperName [] _) }
- QUAL_UPPER { SourceToken _ (TokUpperName _ _) }
- SYMBOL { SourceToken _ (TokSymbolName [] _) }
- QUAL_SYMBOL { SourceToken _ (TokSymbolName _ _) }
- OPERATOR { SourceToken _ (TokOperator [] _) }
- QUAL_OPERATOR { SourceToken _ (TokOperator _ _) }
- LIT_HOLE { SourceToken _ (TokHole _) }
- LIT_CHAR { SourceToken _ (TokChar _ _) }
- LIT_STRING { SourceToken _ (TokString _ _) }
- LIT_RAW_STRING { SourceToken _ (TokRawString _) }
- LIT_INT { SourceToken _ (TokInt _ _) }
- LIT_NUMBER { SourceToken _ (TokNumber _ _) }
-
-%%
-
-many(a) :: { NE.NonEmpty a }
- : many1(a) { NE.reverse $1 }
-
-many1(a) :: { NE.NonEmpty a }
- : a { pure $1 }
- | many1(a) a { NE.cons $2 $1 }
-
-manySep(a, sep) :: { NE.NonEmpty a }
- : manySep1(a, sep) { NE.reverse $1 }
-
-manySep1(a, sep) :: { NE.NonEmpty a }
- : a { pure $1 }
- | manySep1(a, sep) sep a { NE.cons $3 $1 }
-
-manySepOrEmpty(a, sep) :: { [a] }
- : {- empty -} { [] }
- | manySep(a, sep) { NE.toList $1 }
-
-manyOrEmpty(a) :: { [a] }
- : {- empty -} { [] }
- | many(a) { NE.toList $1 }
-
-sep(a, s) :: { Separated a }
- : sep1(a, s) { separated $1 }
-
-sep1(a, s) :: { [(SourceToken, a)] }
- : a { [(placeholder, $1)] }
- | sep1(a, s) s a { ($2, $3) : $1 }
-
-delim(a, b, c, d) :: { Delimited b }
- : a d { Wrapped $1 Nothing $2 }
- | a sep(b, c) d { Wrapped $1 (Just $2) $3 }
-
-moduleName :: { Name N.ModuleName }
- : UPPER {% upperToModuleName $1 }
- | QUAL_UPPER {% upperToModuleName $1 }
-
-qualProperName :: { QualifiedName (N.ProperName a) }
- : UPPER {% toQualifiedName N.ProperName $1 }
- | QUAL_UPPER {% toQualifiedName N.ProperName $1 }
-
-properName :: { Name (N.ProperName a) }
- : UPPER {% toName N.ProperName $1 }
-
-qualIdent :: { QualifiedName Ident }
- : LOWER {% toQualifiedName Ident $1 }
- | QUAL_LOWER {% toQualifiedName Ident $1 }
- | 'as' {% toQualifiedName Ident $1 }
- | 'hiding' {% toQualifiedName Ident $1 }
- | 'kind' {% toQualifiedName Ident $1 }
-
-ident :: { Name Ident }
- : LOWER {% toName Ident $1 }
- | 'as' {% toName Ident $1 }
- | 'hiding' {% toName Ident $1 }
- | 'kind' {% toName Ident $1 }
-
-qualOp :: { QualifiedName (N.OpName a) }
- : OPERATOR {% toQualifiedName N.OpName $1 }
- | QUAL_OPERATOR {% toQualifiedName N.OpName $1 }
- | '<=' {% toQualifiedName N.OpName $1 }
- | '-' {% toQualifiedName N.OpName $1 }
- | '#' {% toQualifiedName N.OpName $1 }
- | ':' {% toQualifiedName N.OpName $1 }
-
-op :: { Name (N.OpName a) }
- : OPERATOR {% toName N.OpName $1 }
- | '<=' {% toName N.OpName $1 }
- | '-' {% toName N.OpName $1 }
- | '#' {% toName N.OpName $1 }
- | ':' {% toName N.OpName $1 }
-
-qualSymbol :: { QualifiedName (N.OpName a) }
- : SYMBOL {% toQualifiedName N.OpName $1 }
- | QUAL_SYMBOL {% toQualifiedName N.OpName $1 }
- | '(..)' {% toQualifiedName N.OpName $1 }
-
-symbol :: { Name (N.OpName a) }
- : SYMBOL {% toName N.OpName $1 }
- | '(..)' {% toName N.OpName $1 }
-
-label :: { Label }
- : LOWER { toLabel $1 }
- | LIT_STRING { toLabel $1 }
- | LIT_RAW_STRING { toLabel $1 }
- | 'ado' { toLabel $1 }
- | 'as' { toLabel $1 }
- | 'case' { toLabel $1 }
- | 'class' { toLabel $1 }
- | 'data' { toLabel $1 }
- | 'derive' { toLabel $1 }
- | 'do' { toLabel $1 }
- | 'else' { toLabel $1 }
- | 'false' { toLabel $1 }
- | 'forall' { toLabel $1 }
- | 'foreign' { toLabel $1 }
- | 'hiding' { toLabel $1 }
- | 'import' { toLabel $1 }
- | 'if' { toLabel $1 }
- | 'in' { toLabel $1 }
- | 'infix' { toLabel $1 }
- | 'infixl' { toLabel $1 }
- | 'infixr' { toLabel $1 }
- | 'instance' { toLabel $1 }
- | 'kind' { toLabel $1 }
- | 'let' { toLabel $1 }
- | 'module' { toLabel $1 }
- | 'newtype' { toLabel $1 }
- | 'of' { toLabel $1 }
- | 'then' { toLabel $1 }
- | 'true' { toLabel $1 }
- | 'type' { toLabel $1 }
- | 'where' { toLabel $1 }
-
-hole :: { Name Ident }
- : LIT_HOLE {% toName Ident $1 }
-
-string :: { (SourceToken, PSString) }
- : LIT_STRING { toString $1 }
- | LIT_RAW_STRING { toString $1 }
-
-char :: { (SourceToken, Char) }
- : LIT_CHAR { toChar $1 }
-
-number :: { (SourceToken, Either Integer Double) }
- : LIT_INT { toNumber $1 }
- | LIT_NUMBER { toNumber $1 }
-
-int :: { (SourceToken, Integer) }
- : LIT_INT { toInt $1 }
-
-boolean :: { (SourceToken, Bool) }
- : 'true' { toBoolean $1 }
- | 'false' { toBoolean $1 }
-
-kind :: { Kind () }
- : kind1 { $1 }
- | kind1 '->' kind { KindArr () $1 $2 $3 }
-
-kind1 :: { Kind () }
- : qualProperName { KindName () $1 }
- | '#' kind1 { KindRow () $1 $2 }
- | '(' kind ')' { KindParens () (Wrapped $1 $2 $3) }
-
-type :: { Type () }
- : type1 { $1 }
- | type1 '::' kind { TypeKinded () $1 $2 $3 }
-
-type1 :: { Type () }
- : type2 { $1 }
- | forall many(typeVarBinding) '.' type1 { TypeForall () $1 $2 $3 $4 }
-
-type2 :: { Type () }
- : type3 { $1 }
- | type3 '->' type1 { TypeArr () $1 $2 $3 }
- | type3 '=>' type1 {% do cs <- toConstraint $1; pure $ TypeConstrained () cs $2 $3 }
-
-type3 :: { Type () }
- : type4 { $1 }
- | type3 qualOp type4 { TypeOp () $1 $2 $3 }
-
-type4 :: { Type () }
- : typeAtom { $1 }
- | type4 typeAtom { TypeApp () $1 $2 }
-
-typeAtom :: { Type ()}
- : '_' { TypeWildcard () $1 }
- | ident { TypeVar () $1 }
- | qualProperName { TypeConstructor () $1 }
- | qualSymbol { TypeOpName () $1 }
- | string { uncurry (TypeString ()) $1 }
- | hole { TypeHole () $1 }
- | '(->)' { TypeArrName () $1 }
- | '{' row '}' { TypeRecord () (Wrapped $1 $2 $3) }
- | '(' row ')' { TypeRow () (Wrapped $1 $2 $3) }
- | '(' type1 ')' { TypeParens () (Wrapped $1 $2 $3) }
- | '(' typeKindedAtom '::' kind ')' { TypeParens () (Wrapped $1 (TypeKinded () $2 $3 $4) $5) }
-
--- Due to a conflict between row syntax and kinded type syntax, we require
--- kinded type variables to be wrapped in parens. Thus `(a :: Foo)` is always a
--- row, and to annotate `a` with kind `Foo`, one must use `((a) :: Foo)`.
-typeKindedAtom :: { Type () }
- : '_' { TypeWildcard () $1 }
- | qualProperName { TypeConstructor () $1 }
- | qualSymbol { TypeOpName () $1 }
- | hole { TypeHole () $1 }
- | '{' row '}' { TypeRecord () (Wrapped $1 $2 $3) }
- | '(' row ')' { TypeRow () (Wrapped $1 $2 $3) }
- | '(' type1 ')' { TypeParens () (Wrapped $1 $2 $3) }
- | '(' typeKindedAtom '::' kind ')' { TypeParens () (Wrapped $1 (TypeKinded () $2 $3 $4) $5) }
-
-row :: { Row () }
- : {- empty -} { Row Nothing Nothing }
- | '|' type { Row Nothing (Just ($1, $2)) }
- | sep(rowLabel, ',') { Row (Just $1) Nothing }
- | sep(rowLabel, ',') '|' type { Row (Just $1) (Just ($2, $3)) }
-
-rowLabel :: { Labeled Label (Type ()) }
- : label '::' type { Labeled $1 $2 $3 }
-
-typeVarBinding :: { TypeVarBinding () }
- : ident { TypeVarName $1 }
- | '(' ident '::' kind ')' { TypeVarKinded (Wrapped $1 (Labeled $2 $3 $4) $5) }
-
-forall :: { SourceToken }
- : 'forall' { $1 }
- | 'forallu' { $1 }
-
-exprWhere :: { Where () }
- : expr { Where $1 Nothing }
- | expr 'where' '\{' manySep(letBinding, '\;') '\}' { Where $1 (Just ($2, $4)) }
-
-expr :: { Expr () }
- : expr1 { $1 }
- | expr1 '::' type { ExprTyped () $1 $2 $3 }
-
-expr1 :: { Expr () }
- : expr2 { $1 }
- | expr1 qualOp expr2 { ExprOp () $1 $2 $3 }
-
-expr2 :: { Expr () }
- : expr3 { $1 }
- | expr2 '`' exprBacktick '`' expr3 { ExprInfix () $1 (Wrapped $2 $3 $4) $5 }
-
-exprBacktick :: { Expr () }
- : expr3 { $1 }
- | exprBacktick qualOp expr3 { ExprOp () $1 $2 $3 }
-
-expr3 :: { Expr () }
- : expr4 { $1 }
- | '-' expr3 { ExprNegate () $1 $2 }
-
-expr4 :: { Expr () }
- : expr5 { $1 }
- | expr4 expr5
- { -- Record application/updates can introduce a function application
- -- associated to the right, so we need to correct it.
- case $2 of
- ExprApp _ lhs rhs ->
- ExprApp () (ExprApp () $1 lhs) rhs
- _ -> ExprApp () $1 $2
- }
-
-expr5 :: { Expr () }
- : expr6 { $1 }
- | 'if' expr 'then' expr 'else' expr { ExprIf () (IfThenElse $1 $2 $3 $4 $5 $6) }
- | doBlock { ExprDo () $1 }
- | adoBlock 'in' expr { ExprAdo () $ uncurry AdoBlock $1 $2 $3 }
- | '\\' many(binderAtom) '->' expr { ExprLambda () (Lambda $1 $2 $3 $4) }
- | 'let' '\{' manySep(letBinding, '\;') '\}' 'in' expr { ExprLet () (LetIn $1 $3 $5 $6) }
- | 'case' sep(expr, ',') 'of' '\{' manySep(caseBranch, '\;') '\}' { ExprCase () (CaseOf $1 $2 $3 $5) }
- -- These special cases handle some idiosynchratic syntax that the current
- -- parser allows. Technically the parser allows the rhs of a case branch to be
- -- at any level, but this is ambiguous. We allow it in the case of a singleton
- -- case, since this is used in the wild.
- | 'case' sep(expr, ',') 'of' '\{' sep(binder1, ',') '->' '\}' exprWhere
- { ExprCase () (CaseOf $1 $2 $3 (pure ($5, Unconditional $6 $8))) }
- | 'case' sep(expr, ',') 'of' '\{' sep(binder1, ',') '\}' guardedCase
- { ExprCase () (CaseOf $1 $2 $3 (pure ($5, $7))) }
-
-expr6 :: { Expr () }
- : expr7 { $1 }
- | expr7 '{' '}' { ExprApp () $1 (ExprRecord () (Wrapped $2 Nothing $3)) }
- | expr7 '{' sep(recordUpdateOrLabel, ',') '}'
- {% toRecordFields $3 >>= \case
- Left xs -> pure $ ExprApp () $1 (ExprRecord () (Wrapped $2 (Just xs) $4))
- Right xs -> pure $ ExprRecordUpdate () $1 (Wrapped $2 xs $4)
- }
-
-expr7 :: { Expr () }
- : exprAtom { $1 }
- | exprAtom '.' sep(label, '.') { ExprRecordAccessor () (RecordAccessor $1 $2 $3) }
-
-exprAtom :: { Expr () }
- : '_' { ExprSection () $1 }
- | hole { ExprHole () $1 }
- | qualIdent { ExprIdent () $1 }
- | qualProperName { ExprConstructor () $1 }
- | qualSymbol { ExprOpName () $1 }
- | boolean { uncurry (ExprBoolean ()) $1 }
- | char { uncurry (ExprChar ()) $1 }
- | string { uncurry (ExprString ()) $1 }
- | number { uncurry (ExprNumber ()) $1 }
- | delim('[', expr, ',', ']') { ExprArray () $1 }
- | delim('{', recordLabel, ',', '}') { ExprRecord () $1 }
- | '(' expr ')' { ExprParens () (Wrapped $1 $2 $3) }
-
-recordLabel :: { RecordLabeled (Expr ()) }
- : label {% fmap RecordPun . toName Ident $ lblTok $1 }
- | label '=' expr {% addFailure [$2] ErrRecordUpdateInCtr *> pure (RecordPun $ unexpectedName $ lblTok $1) }
- | label ':' expr { RecordField $1 $2 $3 }
-
-recordUpdateOrLabel :: { Either (RecordLabeled (Expr ())) (RecordUpdate ()) }
- : label ':' expr { Left (RecordField $1 $2 $3) }
- | label {% fmap (Left . RecordPun) . toName Ident $ lblTok $1 }
- | label '=' expr { Right (RecordUpdateLeaf $1 $2 $3) }
- | label '{' sep(recordUpdate, ',') '}' { Right (RecordUpdateBranch $1 (Wrapped $2 $3 $4)) }
-
-recordUpdate :: { RecordUpdate () }
- : label '=' expr { RecordUpdateLeaf $1 $2 $3 }
- | label '{' sep(recordUpdate, ',') '}' { RecordUpdateBranch $1 (Wrapped $2 $3 $4) }
-
-letBinding :: { LetBinding () }
- : ident '::' type { LetBindingSignature () (Labeled $1 $2 $3) }
- | ident guardedDecl { LetBindingName () (ValueBindingFields $1 [] $2) }
- | ident many(binderAtom) guardedDecl { LetBindingName () (ValueBindingFields $1 (NE.toList $2) $3) }
- | binder1 '=' exprWhere { LetBindingPattern () $1 $2 $3 }
-
-caseBranch :: { (Separated (Binder ()), Guarded ()) }
- : sep(binder1, ',') guardedCase { ($1, $2) }
-
-guardedDecl :: { Guarded () }
- : '=' exprWhere { Unconditional $1 $2 }
- | many(guardedDeclExpr) { Guarded $1 }
-
-guardedDeclExpr :: { GuardedExpr () }
- : guard '=' exprWhere { uncurry GuardedExpr $1 $2 $3 }
-
-guardedCase :: { Guarded () }
- : '->' exprWhere { Unconditional $1 $2 }
- | many(guardedCaseExpr) { Guarded $1 }
-
-guardedCaseExpr :: { GuardedExpr () }
- : guard '->' exprWhere { uncurry GuardedExpr $1 $2 $3 }
-
--- Do/Ado statements and pattern guards require unbounded lookahead due to many
--- conflicts between `binder` and `expr` syntax. For example `Foo a b c` can
--- either be a constructor `binder` or several `expr` applications, and we won't
--- know until we see a `<-` or layout separator.
---
--- One way to resolve this would be to parse a `binder` as an `expr` and then
--- reassociate it after the fact. However this means we can't use the `binder`
--- productions to parse it, so we'd have to maintain an ad-hoc handwritten
--- parser which is very difficult to audit.
---
--- As an alternative we introduce some backtracking. Using %partial parsers and
--- monadic reductions, we can invoke productions manually and use the
--- backtracking `tryPrefix` combinator. Binders are generally very short in
--- comparison to expressions, so the cost is modest.
---
--- doBlock
--- : 'do' '\{' manySep(doStatement, '\;') '\}'
---
--- doStatement
--- : 'let' '\{' manySep(letBinding, '\;') '\}'
--- | expr
--- | binder '<-' expr
---
--- guard
--- : '|' sep(patternGuard, ',')
---
--- patternGuard
--- : expr1
--- | binder '<-' expr1
---
-doBlock :: { DoBlock () }
- : 'do' '\{'
- {%% revert $ do
- res <- parseDoStatement
- when (null res) $ addFailure [$2] ErrEmptyDo
- pure $ DoBlock $1 $ NE.fromList res
- }
-
-adoBlock :: { (SourceToken, [DoStatement ()]) }
- : 'ado' '\{' '\}' { ($1, []) }
- | 'ado' '\{'
- {%% revert $ fmap ($1,) parseDoStatement }
-
-doStatement :: { [DoStatement ()] }
- : 'let' '\{' manySep(letBinding, '\;') '\}'
- {%^ revert $ fmap (DoLet $1 $3 :) parseDoNext }
- | {- empty -}
- {%^ revert $ do
- stmt <- tryPrefix parseBinderAndArrow parseDoExpr
- let
- ctr = case stmt of
- (Just (binder, sep), expr) ->
- (DoBind binder sep expr :)
- (Nothing, expr) ->
- (DoDiscard expr :)
- fmap ctr parseDoNext
- }
-
-doExpr :: { Expr () }
- : expr {%^ revert $ pure $1 }
-
-doNext :: { [DoStatement ()] }
- : '\;' {%^ revert parseDoStatement }
- | '\}' {%^ revert $ pure [] }
-
-guard :: { (SourceToken, Separated (PatternGuard ())) }
- : '|' {%% revert $ fmap (($1,) . uncurry Separated) parseGuardStatement }
-
-guardStatement :: { (PatternGuard (), [(SourceToken, PatternGuard ())]) }
- : {- empty -}
- {%^ revert $ do
- grd <- fmap (uncurry PatternGuard) $ tryPrefix parseBinderAndArrow parseGuardExpr
- fmap (grd,) parseGuardNext
- }
-
-guardExpr :: { Expr() }
- : expr1 {%^ revert $ pure $1 }
-
-guardNext :: { [(SourceToken, PatternGuard ())] }
- : ',' {%^ revert $ fmap (\(g, gs) -> ($1, g) : gs) parseGuardStatement }
- | {- empty -} {%^ revert $ pure [] }
-
-binderAndArrow :: { (Binder (), SourceToken) }
- : binder '<-' {%^ revert $ pure ($1, $2) }
-
-binder :: { Binder () }
- : binder1 { $1 }
- | binder1 '::' type { BinderTyped () $1 $2 $3 }
-
-binder1 :: { Binder () }
- : binder2 { $1 }
- | binder1 qualOp binder2 { BinderOp () $1 $2 $3 }
-
-binder2 :: { Binder () }
- : many(binderAtom) {% toBinderConstructor $1 }
-
-binderAtom :: { Binder () }
- : '_' { BinderWildcard () $1 }
- | ident { BinderVar () $1 }
- | ident '@' binderAtom { BinderNamed () $1 $2 $3 }
- | qualProperName { BinderConstructor () $1 [] }
- | boolean { uncurry (BinderBoolean ()) $1 }
- | char { uncurry (BinderChar ()) $1 }
- | string { uncurry (BinderString ()) $1 }
- | number { uncurry (BinderNumber () Nothing) $1 }
- | '-' number { uncurry (BinderNumber () (Just $1)) $2 }
- | delim('[', binder, ',', ']') { BinderArray () $1 }
- | delim('{', recordBinder, ',', '}') { BinderRecord () $1 }
- | '(' binder ')' { BinderParens () (Wrapped $1 $2 $3) }
-
-recordBinder :: { RecordLabeled (Binder ()) }
- : label {% fmap RecordPun . toName Ident $ lblTok $1 }
- | label '=' binder {% addFailure [$2] ErrRecordUpdateInCtr *> pure (RecordPun $ unexpectedName $ lblTok $1) }
- | label ':' binder { RecordField $1 $2 $3 }
-
--- By splitting up the module header from the body, we can incrementally parse
--- just the header, and then continue parsing the body while still sharing work.
-moduleHeader :: { Module () }
- : 'module' moduleName exports 'where' '\{' moduleImports
- { (Module () $1 $2 $3 $4 $6 [] []) }
-
-moduleBody :: { ([Declaration ()], [Comment LineFeed]) }
- : moduleDecls '\}'
- {%^ \(SourceToken ann _) -> pure (snd $1, tokLeadingComments ann) }
-
-moduleImports :: { [ImportDecl ()] }
- : importDecls importDecl '\}'
- {%^ revert $ pushBack $3 *> pure (reverse ($2 : $1)) }
- | importDecls
- {%^ revert $ pure (reverse $1) }
-
-importDecls :: { [ImportDecl ()] }
- : importDecls importDecl '\;' { $2 : $1 }
- | {- empty -} { [] }
-
-moduleDecls :: { ([ImportDecl ()], [Declaration ()]) }
- : manySep(moduleDecl, '\;') {% toModuleDecls $ NE.toList $1 }
- | {- empty -} { ([], []) }
-
-moduleDecl :: { TmpModuleDecl a }
- : importDecl { TmpImport $1 }
- | sep(decl, declElse) { TmpChain $1 }
-
-declElse :: { SourceToken }
- : 'else' { $1 }
- | 'else' '\;' { $1 }
-
-exports :: { Maybe (DelimitedNonEmpty (Export ())) }
- : {- empty -} { Nothing }
- | '(' sep(export, ',') ')' { Just (Wrapped $1 $2 $3) }
-
-export :: { Export () }
- : ident { ExportValue () $1 }
- | symbol { ExportOp () $1 }
- | properName { ExportType () $1 Nothing }
- | properName dataMembers { ExportType () $1 (Just $2) }
- | 'type' symbol { ExportTypeOp () $1 $2 }
- | 'class' properName { ExportClass () $1 $2 }
- | 'kind' properName { ExportKind () $1 $2 }
- | 'module' moduleName { ExportModule () $1 $2 }
-
-dataMembers :: { (DataMembers ()) }
- : '(..)' { DataAll () $1 }
- | '(' ')' { DataEnumerated () (Wrapped $1 Nothing $2) }
- | '(' sep(properName, ',') ')' { DataEnumerated () (Wrapped $1 (Just $2) $3) }
-
-importDecl :: { ImportDecl () }
- : 'import' moduleName imports { ImportDecl () $1 $2 $3 Nothing }
- | 'import' moduleName imports 'as' moduleName { ImportDecl () $1 $2 $3 (Just ($4, $5)) }
-
-imports :: { Maybe (Maybe SourceToken, DelimitedNonEmpty (Import ())) }
- : {- empty -} { Nothing }
- | '(' sep(import, ',') ')' { Just (Nothing, Wrapped $1 $2 $3) }
- | 'hiding' '(' sep(import, ',') ')' { Just (Just $1, Wrapped $2 $3 $4) }
-
-import :: { Import () }
- : ident { ImportValue () $1 }
- | symbol { ImportOp () $1 }
- | properName { ImportType () $1 Nothing }
- | properName dataMembers { ImportType () $1 (Just $2) }
- | 'type' symbol { ImportTypeOp () $1 $2 }
- | 'class' properName { ImportClass () $1 $2 }
- | 'kind' properName { ImportKind () $1 $2 }
-
-decl :: { Declaration () }
- : dataHead { DeclData () $1 Nothing }
- | dataHead '=' sep(dataCtor, '|') { DeclData () $1 (Just ($2, $3)) }
- | typeHead '=' type {% checkNoWildcards $3 *> pure (DeclType () $1 $2 $3) }
- | newtypeHead '=' properName typeAtom {% checkNoWildcards $4 *> pure (DeclNewtype () $1 $2 $3 $4) }
- | classHead {% checkFundeps $1 *> pure (DeclClass () $1 Nothing) }
- | classHead 'where' '\{' manySep(classMember, '\;') '\}' {% checkFundeps $1 *> pure (DeclClass () $1 (Just ($2, $4))) }
- | instHead { DeclInstanceChain () (Separated (Instance $1 Nothing) []) }
- | instHead 'where' '\{' manySep(instBinding, '\;') '\}' { DeclInstanceChain () (Separated (Instance $1 (Just ($2, $4))) []) }
- | 'derive' instHead { DeclDerive () $1 Nothing $2 }
- | 'derive' 'newtype' instHead { DeclDerive () $1 (Just $2) $3 }
- | ident '::' type { DeclSignature () (Labeled $1 $2 $3) }
- | ident manyOrEmpty(binderAtom) guardedDecl { DeclValue () (ValueBindingFields $1 $2 $3) }
- | fixity { DeclFixity () $1 }
- | 'foreign' 'import' foreign { DeclForeign () $1 $2 $3 }
-
-dataHead :: { DataHead () }
- : 'data' properName manyOrEmpty(typeVarBinding) { DataHead $1 $2 $3 }
-
-typeHead :: { DataHead () }
- : 'type' properName manyOrEmpty(typeVarBinding) { DataHead $1 $2 $3 }
-
-newtypeHead :: { DataHead () }
- : 'newtype' properName manyOrEmpty(typeVarBinding) { DataHead $1 $2 $3 }
-
-dataCtor :: { DataCtor () }
- : properName manyOrEmpty(typeAtom)
- {% for_ $2 checkNoWildcards *> pure (DataCtor () $1 $2) }
-
--- Class head syntax requires unbounded lookahead due to a conflict between
--- row syntax and `typeVarBinding`. `(a :: B)` is either a row in `constraint`
--- where `B` is a type or a `typeVarBinding` where `B` is a kind. We must see
--- either a `<=`, `where`, or layout delimiter before deciding which it is.
---
--- classHead
--- : 'class' classNameAndFundeps
--- | 'class' constraints '<=' classNameAndFundeps
---
-classHead :: { ClassHead () }
- : 'class'
- {%% revert $ do
- let
- ctr (super, (name, vars, fundeps)) =
- ClassHead $1 super name vars fundeps
- fmap ctr $ tryPrefix parseClassSuper parseClassNameAndFundeps
- }
-
-classSuper
- : constraints '<=' {%^ revert $ pure ($1, $2) }
-
-classNameAndFundeps :: { (Name (N.ProperName 'N.ClassName), [TypeVarBinding ()], Maybe (SourceToken, Separated ClassFundep)) }
- : properName manyOrEmpty(typeVarBinding) fundeps {%^ revert $ pure ($1, $2, $3) }
-
-fundeps :: { Maybe (SourceToken, Separated ClassFundep) }
- : {- empty -} { Nothing }
- | '|' sep(fundep, ',') { Just ($1, $2) }
-
-fundep :: { ClassFundep }
- : '->' many(ident) { FundepDetermined $1 $2 }
- | many(ident) '->' many(ident) { FundepDetermines $1 $2 $3 }
-
-classMember :: { Labeled (Name Ident) (Type ()) }
- : ident '::' type {% checkNoWildcards $3 *> pure (Labeled $1 $2 $3) }
-
-instHead :: { InstanceHead () }
- : 'instance' ident '::' constraints '=>' qualProperName manyOrEmpty(typeAtom)
- { InstanceHead $1 $2 $3 (Just ($4, $5)) $6 $7 }
- | 'instance' ident '::' qualProperName manyOrEmpty(typeAtom)
- { InstanceHead $1 $2 $3 Nothing $4 $5 }
-
-constraints :: { OneOrDelimited (Constraint ()) }
- : constraint { One $1 }
- | '(' sep(constraint, ',') ')' { Many (Wrapped $1 $2 $3) }
-
-constraint :: { Constraint () }
- : qualProperName manyOrEmpty(typeAtom) {% for_ $2 checkNoWildcards *> for_ $2 checkNoForalls *> pure (Constraint () $1 $2) }
- | '(' constraint ')' { ConstraintParens () (Wrapped $1 $2 $3) }
-
-instBinding :: { InstanceBinding () }
- : ident '::' type { InstanceBindingSignature () (Labeled $1 $2 $3) }
- | ident manyOrEmpty(binderAtom) guardedDecl { InstanceBindingName () (ValueBindingFields $1 $2 $3) }
-
-fixity :: { FixityFields }
- : infix int qualIdent 'as' op { FixityFields $1 $2 (FixityValue (fmap Left $3) $4 $5) }
- | infix int qualProperName 'as' op { FixityFields $1 $2 (FixityValue (fmap Right $3) $4 $5) }
- | infix int 'type' qualProperName 'as' op { FixityFields $1 $2 (FixityType $3 $4 $5 $6) }
-
-infix :: { (SourceToken, Fixity) }
- : 'infix' { ($1, Infix) }
- | 'infixl' { ($1, Infixl) }
- | 'infixr' { ($1, Infixr) }
-
-foreign :: { Foreign () }
- : ident '::' type { ForeignValue (Labeled $1 $2 $3) }
- | 'data' properName '::' kind { ForeignData $1 (Labeled $2 $3 $4) }
- | 'kind' properName { ForeignKind $1 $2 }
-
--- Partial parsers which can be combined with combinators for adhoc use. We need
--- to revert the lookahead token so that it doesn't consume an extra token
--- before succeeding.
-
-importDeclP :: { ImportDecl () }
- : importDecl {%^ revert $ pure $1 }
-
-declP :: { Declaration () }
- : decl {%^ revert $ pure $1 }
-
-exprP :: { Expr () }
- : expr {%^ revert $ pure $1 }
-
-typeP :: { Type () }
- : type {%^ revert $ pure $1 }
-
-moduleNameP :: { Name N.ModuleName }
- : moduleName {%^ revert $ pure $1 }
-
-qualIdentP :: { QualifiedName Ident }
- : qualIdent {%^ revert $ pure $1 }
-
-{
-lexer :: (SourceToken -> Parser a) -> Parser a
-lexer k = munch >>= k
-
-parse :: Text -> Either (NE.NonEmpty ParserError) (Module ())
-parse = resFull <=< parseModule . lex
-
-data PartialResult a = PartialResult
- { resPartial :: a
- , resFull :: Either (NE.NonEmpty ParserError) a
- } deriving (Functor)
-
-parseModule :: [LexResult] -> Either (NE.NonEmpty ParserError) (PartialResult (Module ()))
-parseModule toks = fmap (\header -> PartialResult header (parseFull header)) headerRes
- where
- (st, headerRes) =
- runParser (ParserState (toks) []) parseModuleHeader
-
- parseFull header = do
- (decls, trailing) <- snd $ runParser st parseModuleBody
- pure $ header
- { modDecls = decls
- , modTrailingComments = trailing
- }
-}
diff --git a/src/Language/PureScript/CST/Positions.hs b/src/Language/PureScript/CST/Positions.hs
deleted file mode 100644
index 67f03a0..0000000
--- a/src/Language/PureScript/CST/Positions.hs
+++ /dev/null
@@ -1,352 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE NamedFieldPuns #-}
-
--- | This module contains utilities for calculating positions and offsets. While
--- tokens are annotated with ranges, CST nodes are not, but they can be
--- dynamically derived with the functions in this module, which will return the
--- first and last tokens for a given node.
-
-module Language.PureScript.CST.Positions where
-
-import Prelude
-
-import Data.Foldable (foldl')
-import qualified Data.List.NonEmpty as NE
-import Data.Text (Text)
-import Data.Void (Void)
-import qualified Data.Text as Text
-import Language.PureScript.CST.Types
-
-advanceToken :: SourcePos -> Token -> SourcePos
-advanceToken pos = applyDelta pos . tokenDelta
-
-advanceLeading :: SourcePos -> [Comment LineFeed] -> SourcePos
-advanceLeading pos = foldl' (\a -> applyDelta a . commentDelta lineDelta) pos
-
-advanceTrailing :: SourcePos -> [Comment Void] -> SourcePos
-advanceTrailing pos = foldl' (\a -> applyDelta a . commentDelta (const (0, 0))) pos
-
-tokenDelta :: Token -> (Int, Int)
-tokenDelta = \case
- TokLeftParen -> (0, 1)
- TokRightParen -> (0, 1)
- TokLeftBrace -> (0, 1)
- TokRightBrace -> (0, 1)
- TokLeftSquare -> (0, 1)
- TokRightSquare -> (0, 1)
- TokLeftArrow ASCII -> (0, 2)
- TokLeftArrow Unicode -> (0, 1)
- TokRightArrow ASCII -> (0, 2)
- TokRightArrow Unicode -> (0, 1)
- TokRightFatArrow ASCII -> (0, 2)
- TokRightFatArrow Unicode -> (0, 1)
- TokDoubleColon ASCII -> (0, 2)
- TokDoubleColon Unicode -> (0, 1)
- TokForall ASCII -> (0, 6)
- TokForall Unicode -> (0, 1)
- TokEquals -> (0, 1)
- TokPipe -> (0, 1)
- TokTick -> (0, 1)
- TokDot -> (0, 1)
- TokComma -> (0, 1)
- TokUnderscore -> (0, 1)
- TokBackslash -> (0, 1)
- TokLowerName qual name -> (0, qualDelta qual + Text.length name)
- TokUpperName qual name -> (0, qualDelta qual + Text.length name)
- TokOperator qual sym -> (0, qualDelta qual + Text.length sym)
- TokSymbolName qual sym -> (0, qualDelta qual + Text.length sym + 2)
- TokSymbolArr Unicode -> (0, 3)
- TokSymbolArr ASCII -> (0, 4)
- TokHole hole -> (0, Text.length hole + 1)
- TokChar raw _ -> (0, Text.length raw + 2)
- TokInt raw _ -> (0, Text.length raw)
- TokNumber raw _ -> (0, Text.length raw)
- TokString raw _ -> multiLine 1 $ textDelta raw
- TokRawString raw -> multiLine 3 $ textDelta raw
- TokLayoutStart -> (0, 0)
- TokLayoutSep -> (0, 0)
- TokLayoutEnd -> (0, 0)
- TokEof -> (0, 0)
-
-qualDelta :: [Text] -> Int
-qualDelta = foldr ((+) . (+ 1) . Text.length) 0
-
-multiLine :: Int -> (Int, Int) -> (Int, Int)
-multiLine n (0, c) = (0, c + n + n)
-multiLine n (l, c) = (l, c + n)
-
-commentDelta :: (a -> (Int, Int)) -> Comment a -> (Int, Int)
-commentDelta k = \case
- Comment raw -> textDelta raw
- Space n -> (0, n)
- Line a -> k a
-
-lineDelta :: LineFeed -> (Int, Int)
-lineDelta _ = (1, 1)
-
-textDelta :: Text -> (Int, Int)
-textDelta = Text.foldl' go (0, 0)
- where
- go (!l, !c) = \case
- '\n' -> (l + 1, 1)
- _ -> (l, c + 1)
-
-applyDelta :: SourcePos -> (Int, Int) -> SourcePos
-applyDelta (SourcePos l c) = \case
- (0, n) -> SourcePos l (c + n)
- (k, d) -> SourcePos (l + k) d
-
-sepLast :: Separated a -> a
-sepLast (Separated hd []) = hd
-sepLast (Separated _ tl) = snd $ last tl
-
-type TokenRange = (SourceToken, SourceToken)
-
-toSourceRange :: TokenRange -> SourceRange
-toSourceRange (a, b) = widen (srcRange a) (srcRange b)
-
-widen :: SourceRange -> SourceRange -> SourceRange
-widen (SourceRange s1 _) (SourceRange _ e2) = SourceRange s1 e2
-
-srcRange :: SourceToken -> SourceRange
-srcRange = tokRange . tokAnn
-
-nameRange :: Name a -> TokenRange
-nameRange a = (nameTok a, nameTok a)
-
-qualRange :: QualifiedName a -> TokenRange
-qualRange a = (qualTok a, qualTok a)
-
-labelRange :: Label -> TokenRange
-labelRange a = (lblTok a, lblTok a)
-
-wrappedRange :: Wrapped a -> TokenRange
-wrappedRange (Wrapped { wrpOpen, wrpClose }) = (wrpOpen, wrpClose)
-
-moduleRange :: Module a -> TokenRange
-moduleRange (Module { modKeyword, modWhere, modImports, modDecls }) =
- case (modImports, modDecls) of
- ([], []) -> (modKeyword, modWhere)
- (is, []) -> (modKeyword, snd . importDeclRange $ last is)
- (_, ds) -> (modKeyword, snd . declRange $ last ds)
-
-exportRange :: Export a -> TokenRange
-exportRange = \case
- ExportValue _ a -> nameRange a
- ExportOp _ a -> nameRange a
- ExportType _ a b
- | Just b' <- b -> (nameTok a, snd $ dataMembersRange b')
- | otherwise -> nameRange a
- ExportTypeOp _ a b -> (a, nameTok b)
- ExportClass _ a b -> (a, nameTok b)
- ExportKind _ a b -> (a, nameTok b)
- ExportModule _ a b -> (a, nameTok b)
-
-importDeclRange :: ImportDecl a -> TokenRange
-importDeclRange (ImportDecl { impKeyword, impModule, impNames, impQual })
- | Just (_, modName) <- impQual = (impKeyword, nameTok modName)
- | Just (_, imports) <- impNames = (impKeyword, wrpClose imports)
- | otherwise = (impKeyword, nameTok impModule)
-
-importRange :: Import a -> TokenRange
-importRange = \case
- ImportValue _ a -> nameRange a
- ImportOp _ a -> nameRange a
- ImportType _ a b
- | Just b' <- b -> (nameTok a, snd $ dataMembersRange b')
- | otherwise -> nameRange a
- ImportTypeOp _ a b -> (a, nameTok b)
- ImportClass _ a b -> (a, nameTok b)
- ImportKind _ a b -> (a, nameTok b)
-
-dataMembersRange :: DataMembers a -> TokenRange
-dataMembersRange = \case
- DataAll _ a -> (a, a)
- DataEnumerated _ (Wrapped a _ b) -> (a, b)
-
-declRange :: Declaration a -> TokenRange
-declRange = \case
- DeclData _ hd ctors
- | Just (_, cs) <- ctors -> (fst start, snd . dataCtorRange $ sepLast cs)
- | otherwise -> start
- where start = dataHeadRange hd
- DeclType _ a _ b -> (fst $ dataHeadRange a, snd $ typeRange b)
- DeclNewtype _ a _ _ b -> (fst $ dataHeadRange a, snd $ typeRange b)
- DeclClass _ hd body
- | Just (_, ts) <- body -> (fst start, snd . typeRange . lblValue $ NE.last ts)
- | otherwise -> start
- where start = classHeadRange hd
- DeclInstanceChain _ a -> (fst . instanceRange $ sepHead a, snd . instanceRange $ sepLast a)
- DeclDerive _ a _ b -> (a, snd $ instanceHeadRange b)
- DeclSignature _ (Labeled a _ b) -> (nameTok a, snd $ typeRange b)
- DeclValue _ a -> valueBindingFieldsRange a
- DeclFixity _ (FixityFields a _ (FixityValue _ _ b)) -> (fst a, nameTok b)
- DeclFixity _ (FixityFields a _ (FixityType _ _ _ b)) -> (fst a, nameTok b)
- DeclForeign _ a _ b -> (a, snd $ foreignRange b)
-
-dataHeadRange :: DataHead a -> TokenRange
-dataHeadRange (DataHead kw name vars)
- | [] <- vars = (kw, nameTok name)
- | otherwise = (kw, snd . typeVarBindingRange $ last vars)
-
-dataCtorRange :: DataCtor a -> TokenRange
-dataCtorRange (DataCtor _ name fields)
- | [] <- fields = nameRange name
- | otherwise = (nameTok name, snd . typeRange $ last fields)
-
-classHeadRange :: ClassHead a -> TokenRange
-classHeadRange (ClassHead kw _ name vars fdeps)
- | Just (_, fs) <- fdeps = (kw, snd .classFundepRange $ sepLast fs)
- | [] <- vars = (kw, snd $ nameRange name)
- | otherwise = (kw, snd . typeVarBindingRange $ last vars)
-
-classFundepRange :: ClassFundep -> TokenRange
-classFundepRange = \case
- FundepDetermined arr bs -> (arr, nameTok $ NE.last bs)
- FundepDetermines as _ bs -> (nameTok $ NE.head as, nameTok $ NE.last bs)
-
-instanceRange :: Instance a -> TokenRange
-instanceRange (Instance hd bd)
- | Just (_, ts) <- bd = (fst start, snd . instanceBindingRange $ NE.last ts)
- | otherwise = start
- where start = instanceHeadRange hd
-
-instanceHeadRange :: InstanceHead a -> TokenRange
-instanceHeadRange (InstanceHead kw _ _ _ cls types)
- | [] <- types = (kw, qualTok cls)
- | otherwise = (kw, snd . typeRange $ last types)
-
-instanceBindingRange :: InstanceBinding a -> TokenRange
-instanceBindingRange = \case
- InstanceBindingSignature _ (Labeled a _ b) -> (nameTok a, snd $ typeRange b)
- InstanceBindingName _ a -> valueBindingFieldsRange a
-
-foreignRange :: Foreign a -> TokenRange
-foreignRange = \case
- ForeignValue (Labeled a _ b) -> (nameTok a, snd $ typeRange b)
- ForeignData a (Labeled _ _ b) -> (a, snd $ kindRange b)
- ForeignKind a b -> (a, nameTok b)
-
-valueBindingFieldsRange :: ValueBindingFields a -> TokenRange
-valueBindingFieldsRange (ValueBindingFields a _ b) = (nameTok a, snd $ guardedRange b)
-
-guardedRange :: Guarded a -> TokenRange
-guardedRange = \case
- Unconditional a b -> (a, snd $ whereRange b)
- Guarded as -> (fst . guardedExprRange $ NE.head as, snd . guardedExprRange $ NE.last as)
-
-guardedExprRange :: GuardedExpr a -> TokenRange
-guardedExprRange (GuardedExpr a _ _ b) = (a, snd $ whereRange b)
-
-whereRange :: Where a -> TokenRange
-whereRange (Where a bs)
- | Just (_, ls) <- bs = (fst $ exprRange a, snd . letBindingRange $ NE.last ls)
- | otherwise = exprRange a
-
-kindRange :: Kind a -> TokenRange
-kindRange = \case
- KindName _ a -> qualRange a
- KindArr _ a _ b -> (fst $ kindRange a, snd $ kindRange b)
- KindRow _ a b -> (a, snd $ kindRange b)
- KindParens _ a -> wrappedRange a
-
-typeRange :: Type a -> TokenRange
-typeRange = \case
- TypeVar _ a -> nameRange a
- TypeConstructor _ a -> qualRange a
- TypeWildcard _ a -> (a, a)
- TypeHole _ a -> nameRange a
- TypeString _ a _ -> (a, a)
- TypeRow _ a -> wrappedRange a
- TypeRecord _ a -> wrappedRange a
- TypeForall _ a _ _ b -> (a, snd $ typeRange b)
- TypeKinded _ a _ b -> (fst $ typeRange a, snd $ kindRange b)
- TypeApp _ a b -> (fst $ typeRange a, snd $ typeRange b)
- TypeOp _ a _ b -> (fst $ typeRange a, snd $ typeRange b)
- TypeOpName _ a -> qualRange a
- TypeArr _ a _ b -> (fst $ typeRange a, snd $ typeRange b)
- TypeArrName _ a -> (a, a)
- TypeConstrained _ a _ b -> (fst $ constraintRange a, snd $ typeRange b)
- TypeParens _ a -> wrappedRange a
-
-constraintRange :: Constraint a -> TokenRange
-constraintRange = \case
- Constraint _ name args
- | [] <- args -> qualRange name
- | otherwise -> (qualTok name, snd . typeRange $ last args)
- ConstraintParens _ wrp -> wrappedRange wrp
-
-typeVarBindingRange :: TypeVarBinding a -> TokenRange
-typeVarBindingRange = \case
- TypeVarKinded a -> wrappedRange a
- TypeVarName a -> nameRange a
-
-exprRange :: Expr a -> TokenRange
-exprRange = \case
- ExprHole _ a -> nameRange a
- ExprSection _ a -> (a, a)
- ExprIdent _ a -> qualRange a
- ExprConstructor _ a -> qualRange a
- ExprBoolean _ a _ -> (a, a)
- ExprChar _ a _ -> (a, a)
- ExprString _ a _ -> (a, a)
- ExprNumber _ a _ -> (a, a)
- ExprArray _ a -> wrappedRange a
- ExprRecord _ a -> wrappedRange a
- ExprParens _ a -> wrappedRange a
- ExprTyped _ a _ b -> (fst $ exprRange a, snd $ typeRange b)
- ExprInfix _ a _ b -> (fst $ exprRange a, snd $ exprRange b)
- ExprOp _ a _ b -> (fst $ exprRange a, snd $ exprRange b)
- ExprOpName _ a -> qualRange a
- ExprNegate _ a b -> (a, snd $ exprRange b)
- ExprRecordAccessor _ (RecordAccessor a _ b) -> (fst $ exprRange a, lblTok $ sepLast b)
- ExprRecordUpdate _ a b -> (fst $ exprRange a, snd $ wrappedRange b)
- ExprApp _ a b -> (fst $ exprRange a, snd $ exprRange b)
- ExprLambda _ (Lambda a _ _ b) -> (a, snd $ exprRange b)
- ExprIf _ (IfThenElse a _ _ _ _ b) -> (a, snd $ exprRange b)
- ExprCase _ (CaseOf a _ _ c) -> (a, snd . guardedRange . snd $ NE.last c)
- ExprLet _ (LetIn a _ _ b) -> (a, snd $ exprRange b)
- ExprDo _ (DoBlock a b) -> (a, snd . doStatementRange $ NE.last b)
- ExprAdo _ (AdoBlock a _ _ b) -> (a, snd $ exprRange b)
-
-letBindingRange :: LetBinding a -> TokenRange
-letBindingRange = \case
- LetBindingSignature _ (Labeled a _ b) -> (nameTok a, snd $ typeRange b)
- LetBindingName _ a -> valueBindingFieldsRange a
- LetBindingPattern _ a _ b -> (fst $ binderRange a, snd $ whereRange b)
-
-doStatementRange :: DoStatement a -> TokenRange
-doStatementRange = \case
- DoLet a bs -> (a, snd . letBindingRange $ NE.last bs)
- DoDiscard a -> exprRange a
- DoBind a _ b -> (fst $ binderRange a, snd $ exprRange b)
-
-binderRange :: Binder a -> TokenRange
-binderRange = \case
- BinderWildcard _ a -> (a, a)
- BinderVar _ a -> nameRange a
- BinderNamed _ a _ b -> (nameTok a, snd $ binderRange b)
- BinderConstructor _ a bs
- | [] <- bs -> qualRange a
- | otherwise -> (qualTok a, snd . binderRange $ last bs)
- BinderBoolean _ a _ -> (a, a)
- BinderChar _ a _ -> (a, a)
- BinderString _ a _ -> (a, a)
- BinderNumber _ a b _
- | Just a' <- a -> (a', b)
- | otherwise -> (b, b)
- BinderArray _ a -> wrappedRange a
- BinderRecord _ a -> wrappedRange a
- BinderParens _ a -> wrappedRange a
- BinderTyped _ a _ b -> (fst $ binderRange a, snd $ typeRange b)
- BinderOp _ a _ b -> (fst $ binderRange a, snd $ binderRange b)
-
-recordUpdateRange :: RecordUpdate a -> TokenRange
-recordUpdateRange = \case
- RecordUpdateLeaf a _ b -> (lblTok a, snd $ exprRange b)
- RecordUpdateBranch a (Wrapped _ _ b) -> (lblTok a, b)
-
-recordLabeledExprRange :: RecordLabeled (Expr a) -> TokenRange
-recordLabeledExprRange = \case
- RecordPun a -> nameRange a
- RecordField a _ b -> (fst $ labelRange a, snd $ exprRange b)
diff --git a/src/Language/PureScript/CST/Print.hs b/src/Language/PureScript/CST/Print.hs
deleted file mode 100644
index 16aac58..0000000
--- a/src/Language/PureScript/CST/Print.hs
+++ /dev/null
@@ -1,82 +0,0 @@
--- | This is just a simple token printer. It's not a full fledged formatter, but
--- it is used by the layout golden tests. Printing each token in the tree with
--- this printer will result in the exact input that was given to the lexer.
-
-module Language.PureScript.CST.Print
- ( printToken
- , printTokens
- , printLeadingComment
- , printTrailingComment
- ) where
-
-import Prelude
-
-import Data.Text (Text)
-import qualified Data.Text as Text
-import Language.PureScript.CST.Types
-
-printToken :: Token -> Text
-printToken = \case
- TokLeftParen -> "("
- TokRightParen -> ")"
- TokLeftBrace -> "{"
- TokRightBrace -> "}"
- TokLeftSquare -> "["
- TokRightSquare -> "]"
- TokLeftArrow ASCII -> "<-"
- TokLeftArrow Unicode -> "←"
- TokRightArrow ASCII -> "->"
- TokRightArrow Unicode -> "→"
- TokRightFatArrow ASCII -> "=>"
- TokRightFatArrow Unicode -> "⇒"
- TokDoubleColon ASCII -> "::"
- TokDoubleColon Unicode -> "∷"
- TokForall ASCII -> "forall"
- TokForall Unicode -> "∀"
- TokEquals -> "="
- TokPipe -> "|"
- TokTick -> "`"
- TokDot -> "."
- TokComma -> ","
- TokUnderscore -> "_"
- TokBackslash -> "\\"
- TokLowerName qual name -> printQual qual <> name
- TokUpperName qual name -> printQual qual <> name
- TokOperator qual sym -> printQual qual <> sym
- TokSymbolName qual sym -> printQual qual <> "(" <> sym <> ")"
- TokSymbolArr Unicode -> "(→)"
- TokSymbolArr ASCII -> "(->)"
- TokHole hole -> "?" <> hole
- TokChar raw _ -> "'" <> raw <> "'"
- TokString raw _ -> "\"" <> raw <> "\""
- TokRawString raw -> "\"\"\"" <> raw <> "\"\"\""
- TokInt raw _ -> raw
- TokNumber raw _ -> raw
- TokLayoutStart -> "{"
- TokLayoutSep -> ";"
- TokLayoutEnd -> "}"
- TokEof -> "<eof>"
-
-printQual :: [Text] -> Text
-printQual = Text.concat . map (<> ".")
-
-printTokens :: [SourceToken] -> Text
-printTokens toks = Text.concat (map pp toks)
- where
- pp (SourceToken (TokenAnn _ leading trailing) tok) =
- Text.concat (map printLeadingComment leading)
- <> printToken tok
- <> Text.concat (map printTrailingComment trailing)
-
-printLeadingComment :: Comment LineFeed -> Text
-printLeadingComment = \case
- Comment raw -> raw
- Space n -> Text.replicate n " "
- Line LF -> "\n"
- Line CRLF -> "\r\n"
-
-printTrailingComment :: Comment void -> Text
-printTrailingComment = \case
- Comment raw -> raw
- Space n -> Text.replicate n " "
- Line _ -> ""
diff --git a/src/Language/PureScript/CST/Traversals.hs b/src/Language/PureScript/CST/Traversals.hs
deleted file mode 100644
index 6d5627f..0000000
--- a/src/Language/PureScript/CST/Traversals.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module Language.PureScript.CST.Traversals where
-
-import Prelude
-
-import Language.PureScript.CST.Types
-
-everythingOnSeparated :: (r -> r -> r) -> (a -> r) -> Separated a -> r
-everythingOnSeparated op k (Separated hd tl) = go hd tl
- where
- go a [] = k a
- go a (b : bs) = k a `op` go (snd b) bs
diff --git a/src/Language/PureScript/CST/Traversals/Type.hs b/src/Language/PureScript/CST/Traversals/Type.hs
deleted file mode 100644
index 9e84718..0000000
--- a/src/Language/PureScript/CST/Traversals/Type.hs
+++ /dev/null
@@ -1,39 +0,0 @@
-module Language.PureScript.CST.Traversals.Type where
-
-import Prelude
-
-import Language.PureScript.CST.Types
-import Language.PureScript.CST.Traversals
-
-everythingOnTypes :: (r -> r -> r) -> (Type a -> r) -> Type a -> r
-everythingOnTypes op k = goTy
- where
- goTy ty = case ty of
- TypeVar _ _ -> k ty
- TypeConstructor _ _ -> k ty
- TypeWildcard _ _ -> k ty
- TypeHole _ _ -> k ty
- TypeString _ _ _ -> k ty
- TypeRow _ (Wrapped _ row _) -> goRow ty row
- TypeRecord _ (Wrapped _ row _) -> goRow ty row
- TypeForall _ _ _ _ ty2 -> k ty `op` goTy ty2
- TypeKinded _ ty2 _ _ -> k ty `op` goTy ty2
- TypeApp _ ty2 ty3 -> k ty `op` (goTy ty2 `op` goTy ty3)
- TypeOp _ ty2 _ ty3 -> k ty `op` (goTy ty2 `op` goTy ty3)
- TypeOpName _ _ -> k ty
- TypeArr _ ty2 _ ty3 -> k ty `op` (goTy ty2 `op` goTy ty3)
- TypeArrName _ _ -> k ty
- TypeConstrained _ (constraintTys -> ty2) _ ty3
- | null ty2 -> k ty `op` goTy ty3
- | otherwise -> k ty `op` (foldr1 op (k <$> ty2) `op` goTy ty3)
- TypeParens _ (Wrapped _ ty2 _) -> k ty `op` goTy ty2
-
- goRow ty = \case
- Row Nothing Nothing -> k ty
- Row Nothing (Just (_, ty2)) -> k ty `op` goTy ty2
- Row (Just lbls) Nothing -> k ty `op` everythingOnSeparated op (goTy . lblValue) lbls
- Row (Just lbls) (Just (_, ty2)) -> k ty `op` (everythingOnSeparated op (goTy . lblValue) lbls `op` goTy ty2)
-
- constraintTys = \case
- Constraint _ _ tys -> tys
- ConstraintParens _ (Wrapped _ c _) -> constraintTys c
diff --git a/src/Language/PureScript/CST/Types.hs b/src/Language/PureScript/CST/Types.hs
deleted file mode 100644
index 7768b96..0000000
--- a/src/Language/PureScript/CST/Types.hs
+++ /dev/null
@@ -1,437 +0,0 @@
--- | This module contains data types for the entire PureScript surface language. Every
--- token is represented in the tree, and every token is annotated with
--- whitespace and comments (both leading and trailing). This means one can write
--- an exact printer so that `print . parse = id`. Every constructor is laid out
--- with tokens in left-to-right order. The core productions are given a slot for
--- arbitrary annotations, however this is not used by the parser.
-
-module Language.PureScript.CST.Types where
-
-import Prelude
-
-import Data.List.NonEmpty (NonEmpty)
-import Data.Text (Text)
-import Data.Void (Void)
-import GHC.Generics (Generic)
-import qualified Language.PureScript.Names as N
-import Language.PureScript.PSString (PSString)
-
-data SourcePos = SourcePos
- { srcLine :: {-# UNPACK #-} !Int
- , srcColumn :: {-# UNPACK #-} !Int
- } deriving (Show, Eq, Ord, Generic)
-
-data SourceRange = SourceRange
- { srcStart :: !SourcePos
- , srcEnd :: !SourcePos
- } deriving (Show, Eq, Ord, Generic)
-
-data Comment l
- = Comment !Text
- | Space {-# UNPACK #-} !Int
- | Line !l
- deriving (Show, Eq, Ord, Generic, Functor)
-
-data LineFeed = LF | CRLF
- deriving (Show, Eq, Ord, Generic)
-
-data TokenAnn = TokenAnn
- { tokRange :: !SourceRange
- , tokLeadingComments :: ![Comment LineFeed]
- , tokTrailingComments :: ![Comment Void]
- } deriving (Show, Eq, Ord, Generic)
-
-data SourceStyle = ASCII | Unicode
- deriving (Show, Eq, Ord, Generic)
-
-data Token
- = TokLeftParen
- | TokRightParen
- | TokLeftBrace
- | TokRightBrace
- | TokLeftSquare
- | TokRightSquare
- | TokLeftArrow !SourceStyle
- | TokRightArrow !SourceStyle
- | TokRightFatArrow !SourceStyle
- | TokDoubleColon !SourceStyle
- | TokForall !SourceStyle
- | TokEquals
- | TokPipe
- | TokTick
- | TokDot
- | TokComma
- | TokUnderscore
- | TokBackslash
- | TokLowerName ![Text] !Text
- | TokUpperName ![Text] !Text
- | TokOperator ![Text] !Text
- | TokSymbolName ![Text] !Text
- | TokSymbolArr !SourceStyle
- | TokHole !Text
- | TokChar !Text !Char
- | TokString !Text !PSString
- | TokRawString !Text
- | TokInt !Text !Integer
- | TokNumber !Text !Double
- | TokLayoutStart
- | TokLayoutSep
- | TokLayoutEnd
- | TokEof
- deriving (Show, Eq, Ord, Generic)
-
-data SourceToken = SourceToken
- { tokAnn :: !TokenAnn
- , tokValue :: !Token
- } deriving (Show, Eq, Ord, Generic)
-
-data Ident = Ident
- { getIdent :: Text
- } deriving (Show, Eq, Ord, Generic)
-
-data Name a = Name
- { nameTok :: SourceToken
- , nameValue :: a
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data QualifiedName a = QualifiedName
- { qualTok :: SourceToken
- , qualModule :: Maybe N.ModuleName
- , qualName :: a
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data Label = Label
- { lblTok :: SourceToken
- , lblName :: PSString
- } deriving (Show, Eq, Ord, Generic)
-
-data Wrapped a = Wrapped
- { wrpOpen :: SourceToken
- , wrpValue :: a
- , wrpClose :: SourceToken
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data Separated a = Separated
- { sepHead :: a
- , sepTail :: [(SourceToken, a)]
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data Labeled a b = Labeled
- { lblLabel :: a
- , lblSep :: SourceToken
- , lblValue :: b
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-type Delimited a = Wrapped (Maybe (Separated a))
-type DelimitedNonEmpty a = Wrapped (Separated a)
-
-data OneOrDelimited a
- = One a
- | Many (DelimitedNonEmpty a)
- deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data Kind a
- = KindName a (QualifiedName (N.ProperName 'N.KindName))
- | KindArr a (Kind a) SourceToken (Kind a)
- | KindRow a SourceToken (Kind a)
- | KindParens a (Wrapped (Kind a))
- deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data Type a
- = TypeVar a (Name Ident)
- | TypeConstructor a (QualifiedName (N.ProperName 'N.TypeName))
- | TypeWildcard a SourceToken
- | TypeHole a (Name Ident)
- | TypeString a SourceToken PSString
- | TypeRow a (Wrapped (Row a))
- | TypeRecord a (Wrapped (Row a))
- | TypeForall a SourceToken (NonEmpty (TypeVarBinding a)) SourceToken (Type a)
- | TypeKinded a (Type a) SourceToken (Kind a)
- | TypeApp a (Type a) (Type a)
- | TypeOp a (Type a) (QualifiedName (N.OpName 'N.TypeOpName)) (Type a)
- | TypeOpName a (QualifiedName (N.OpName 'N.TypeOpName))
- | TypeArr a (Type a) SourceToken (Type a)
- | TypeArrName a SourceToken
- | TypeConstrained a (Constraint a) SourceToken (Type a)
- | TypeParens a (Wrapped (Type a))
- deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data TypeVarBinding a
- = TypeVarKinded (Wrapped (Labeled (Name Ident) (Kind a)))
- | TypeVarName (Name Ident)
- deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data Constraint a
- = Constraint a (QualifiedName (N.ProperName 'N.ClassName)) [Type a]
- | ConstraintParens a (Wrapped (Constraint a))
- deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data Row a = Row
- { rowLabels :: Maybe (Separated (Labeled Label (Type a)))
- , rowTail :: Maybe (SourceToken, Type a)
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data Module a = Module
- { modAnn :: a
- , modKeyword :: SourceToken
- , modNamespace :: Name N.ModuleName
- , modExports :: Maybe (DelimitedNonEmpty (Export a))
- , modWhere :: SourceToken
- , modImports :: [ImportDecl a]
- , modDecls :: [Declaration a]
- , modTrailingComments :: [Comment LineFeed]
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data Export a
- = ExportValue a (Name Ident)
- | ExportOp a (Name (N.OpName 'N.ValueOpName))
- | ExportType a (Name (N.ProperName 'N.TypeName)) (Maybe (DataMembers a))
- | ExportTypeOp a SourceToken (Name (N.OpName 'N.TypeOpName))
- | ExportClass a SourceToken (Name (N.ProperName 'N.ClassName))
- | ExportKind a SourceToken (Name (N.ProperName 'N.KindName))
- | ExportModule a SourceToken (Name N.ModuleName)
- deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data DataMembers a
- = DataAll a SourceToken
- | DataEnumerated a (Delimited (Name (N.ProperName 'N.ConstructorName)))
- deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data Declaration a
- = DeclData a (DataHead a) (Maybe (SourceToken, Separated (DataCtor a)))
- | DeclType a (DataHead a) SourceToken (Type a)
- | DeclNewtype a (DataHead a) SourceToken (Name (N.ProperName 'N.ConstructorName)) (Type a)
- | DeclClass a (ClassHead a) (Maybe (SourceToken, NonEmpty (Labeled (Name Ident) (Type a))))
- | DeclInstanceChain a (Separated (Instance a))
- | DeclDerive a SourceToken (Maybe SourceToken) (InstanceHead a)
- | DeclSignature a (Labeled (Name Ident) (Type a))
- | DeclValue a (ValueBindingFields a)
- | DeclFixity a FixityFields
- | DeclForeign a SourceToken SourceToken (Foreign a)
- deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data Instance a = Instance
- { instHead :: InstanceHead a
- , instBody :: Maybe (SourceToken, NonEmpty (InstanceBinding a))
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data InstanceBinding a
- = InstanceBindingSignature a (Labeled (Name Ident) (Type a))
- | InstanceBindingName a (ValueBindingFields a)
- deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data ImportDecl a = ImportDecl
- { impAnn :: a
- , impKeyword :: SourceToken
- , impModule :: Name N.ModuleName
- , impNames :: Maybe (Maybe SourceToken, DelimitedNonEmpty (Import a))
- , impQual :: Maybe (SourceToken, Name N.ModuleName)
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data Import a
- = ImportValue a (Name Ident)
- | ImportOp a (Name (N.OpName 'N.ValueOpName))
- | ImportType a (Name (N.ProperName 'N.TypeName)) (Maybe (DataMembers a))
- | ImportTypeOp a SourceToken (Name (N.OpName 'N.TypeOpName))
- | ImportClass a SourceToken (Name (N.ProperName 'N.ClassName))
- | ImportKind a SourceToken (Name (N.ProperName 'N.KindName))
- deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data DataHead a = DataHead
- { dataHdKeyword :: SourceToken
- , dataHdName :: Name (N.ProperName 'N.TypeName)
- , dataHdVars :: [TypeVarBinding a]
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data DataCtor a = DataCtor
- { dataCtorAnn :: a
- , dataCtorName :: Name (N.ProperName 'N.ConstructorName)
- , dataCtorFields :: [Type a]
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data ClassHead a = ClassHead
- { clsKeyword :: SourceToken
- , clsSuper :: Maybe (OneOrDelimited (Constraint a), SourceToken)
- , clsName :: Name (N.ProperName 'N.ClassName)
- , clsVars :: [TypeVarBinding a]
- , clsFundeps :: Maybe (SourceToken, Separated ClassFundep)
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data ClassFundep
- = FundepDetermined SourceToken (NonEmpty (Name Ident))
- | FundepDetermines (NonEmpty (Name Ident)) SourceToken (NonEmpty (Name Ident))
- deriving (Show, Eq, Ord, Generic)
-
-data InstanceHead a = InstanceHead
- { instKeyword :: SourceToken
- , instName :: Name Ident
- , instSep :: SourceToken
- , instConstraints :: Maybe (OneOrDelimited (Constraint a), SourceToken)
- , instClass :: QualifiedName (N.ProperName 'N.ClassName)
- , instTypes :: [Type a]
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data Fixity
- = Infix
- | Infixl
- | Infixr
- deriving (Show, Eq, Ord, Generic)
-
-data FixityOp
- = FixityValue (QualifiedName (Either Ident (N.ProperName 'N.ConstructorName))) SourceToken (Name (N.OpName 'N.ValueOpName))
- | FixityType SourceToken (QualifiedName (N.ProperName 'N.TypeName)) SourceToken (Name (N.OpName 'N.TypeOpName))
- deriving (Show, Eq, Ord, Generic)
-
-data FixityFields = FixityFields
- { fxtKeyword :: (SourceToken, Fixity)
- , fxtPrec :: (SourceToken, Integer)
- , fxtOp :: FixityOp
- } deriving (Show, Eq, Ord, Generic)
-
-data ValueBindingFields a = ValueBindingFields
- { valName :: Name Ident
- , valBinders :: [Binder a]
- , valGuarded :: Guarded a
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data Guarded a
- = Unconditional SourceToken (Where a)
- | Guarded (NonEmpty (GuardedExpr a))
- deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data GuardedExpr a = GuardedExpr
- { grdBar :: SourceToken
- , grdPatterns :: Separated (PatternGuard a)
- , grdSep :: SourceToken
- , grdWhere :: Where a
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data PatternGuard a = PatternGuard
- { patBinder :: Maybe (Binder a, SourceToken)
- , patExpr :: Expr a
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data Foreign a
- = ForeignValue (Labeled (Name Ident) (Type a))
- | ForeignData SourceToken (Labeled (Name (N.ProperName 'N.TypeName)) (Kind a))
- | ForeignKind SourceToken (Name (N.ProperName 'N.KindName))
- deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data Expr a
- = ExprHole a (Name Ident)
- | ExprSection a SourceToken
- | ExprIdent a (QualifiedName Ident)
- | ExprConstructor a (QualifiedName (N.ProperName 'N.ConstructorName))
- | ExprBoolean a SourceToken Bool
- | ExprChar a SourceToken Char
- | ExprString a SourceToken PSString
- | ExprNumber a SourceToken (Either Integer Double)
- | ExprArray a (Delimited (Expr a))
- | ExprRecord a (Delimited (RecordLabeled (Expr a)))
- | ExprParens a (Wrapped (Expr a))
- | ExprTyped a (Expr a) SourceToken (Type a)
- | ExprInfix a (Expr a) (Wrapped (Expr a)) (Expr a)
- | ExprOp a (Expr a) (QualifiedName (N.OpName 'N.ValueOpName)) (Expr a)
- | ExprOpName a (QualifiedName (N.OpName 'N.ValueOpName))
- | ExprNegate a SourceToken (Expr a)
- | ExprRecordAccessor a (RecordAccessor a)
- | ExprRecordUpdate a (Expr a) (DelimitedNonEmpty (RecordUpdate a))
- | ExprApp a (Expr a) (Expr a)
- | ExprLambda a (Lambda a)
- | ExprIf a (IfThenElse a)
- | ExprCase a (CaseOf a)
- | ExprLet a (LetIn a)
- | ExprDo a (DoBlock a)
- | ExprAdo a (AdoBlock a)
- deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data RecordLabeled a
- = RecordPun (Name Ident)
- | RecordField Label SourceToken a
- deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data RecordUpdate a
- = RecordUpdateLeaf Label SourceToken (Expr a)
- | RecordUpdateBranch Label (DelimitedNonEmpty (RecordUpdate a))
- deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data RecordAccessor a = RecordAccessor
- { recExpr :: Expr a
- , recDot :: SourceToken
- , recPath :: Separated Label
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data Lambda a = Lambda
- { lmbSymbol :: SourceToken
- , lmbBinders :: NonEmpty (Binder a)
- , lmbArr :: SourceToken
- , lmbBody :: Expr a
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data IfThenElse a = IfThenElse
- { iteIf :: SourceToken
- , iteCond :: Expr a
- , iteThen :: SourceToken
- , iteTrue :: Expr a
- , iteElse :: SourceToken
- , iteFalse :: Expr a
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data CaseOf a = CaseOf
- { caseKeyword :: SourceToken
- , caseHead :: Separated (Expr a)
- , caseOf :: SourceToken
- , caseBranches :: NonEmpty (Separated (Binder a), Guarded a)
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data LetIn a = LetIn
- { letKeyword :: SourceToken
- , letBindings :: NonEmpty (LetBinding a)
- , letIn :: SourceToken
- , letBody :: Expr a
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data Where a = Where
- { whereExpr :: Expr a
- , whereBindings :: Maybe (SourceToken, NonEmpty (LetBinding a))
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data LetBinding a
- = LetBindingSignature a (Labeled (Name Ident) (Type a))
- | LetBindingName a (ValueBindingFields a)
- | LetBindingPattern a (Binder a) SourceToken (Where a)
- deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data DoBlock a = DoBlock
- { doKeyword :: SourceToken
- , doStatements :: NonEmpty (DoStatement a)
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data DoStatement a
- = DoLet SourceToken (NonEmpty (LetBinding a))
- | DoDiscard (Expr a)
- | DoBind (Binder a) SourceToken (Expr a)
- deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data AdoBlock a = AdoBlock
- { adoKeyword :: SourceToken
- , adoStatements :: [DoStatement a]
- , adoIn :: SourceToken
- , adoResult :: Expr a
- } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-
-data Binder a
- = BinderWildcard a SourceToken
- | BinderVar a (Name Ident)
- | BinderNamed a (Name Ident) SourceToken (Binder a)
- | BinderConstructor a (QualifiedName (N.ProperName 'N.ConstructorName)) [Binder a]
- | BinderBoolean a SourceToken Bool
- | BinderChar a SourceToken Char
- | BinderString a SourceToken PSString
- | BinderNumber a (Maybe SourceToken) SourceToken (Either Integer Double)
- | BinderArray a (Delimited (Binder a))
- | BinderRecord a (Delimited (RecordLabeled (Binder a)))
- | BinderParens a (Wrapped (Binder a))
- | BinderTyped a (Binder a) SourceToken (Type a)
- | BinderOp a (Binder a) (QualifiedName (N.OpName 'N.ValueOpName)) (Binder a)
- deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
diff --git a/src/Language/PureScript/CST/Utils.hs b/src/Language/PureScript/CST/Utils.hs
deleted file mode 100644
index 185e984..0000000
--- a/src/Language/PureScript/CST/Utils.hs
+++ /dev/null
@@ -1,315 +0,0 @@
-{-# LANGUAGE MonoLocalBinds #-}
-module Language.PureScript.CST.Utils where
-
-import Prelude
-
-import Control.Monad (when)
-import Data.Coerce (coerce)
-import Data.Foldable (for_)
-import Data.Functor (($>))
-import qualified Data.List.NonEmpty as NE
-import Data.Set (Set)
-import qualified Data.Set as Set
-import Data.Text (Text)
-import qualified Data.Text as Text
-import Language.PureScript.CST.Errors
-import Language.PureScript.CST.Monad
-import Language.PureScript.CST.Positions
-import Language.PureScript.CST.Traversals.Type
-import Language.PureScript.CST.Types
-import qualified Language.PureScript.Names as N
-import Language.PureScript.PSString (PSString, mkString)
-
-placeholder :: SourceToken
-placeholder = SourceToken
- { tokAnn = TokenAnn (SourceRange (SourcePos 0 0) (SourcePos 0 0)) [] []
- , tokValue = TokLowerName [] "<placeholder>"
- }
-
-unexpectedName :: SourceToken -> Name Ident
-unexpectedName tok = Name tok (Ident "<unexpected>")
-
-unexpectedQual :: SourceToken -> QualifiedName Ident
-unexpectedQual tok = QualifiedName tok Nothing (Ident "<unexpected>")
-
-unexpectedLabel :: SourceToken -> Label
-unexpectedLabel tok = Label tok "<unexpected>"
-
-unexpectedExpr :: Monoid a => [SourceToken] -> Expr a
-unexpectedExpr toks = ExprIdent mempty (unexpectedQual (head toks))
-
-unexpectedDecl :: Monoid a => [SourceToken] -> Declaration a
-unexpectedDecl toks = DeclValue mempty (ValueBindingFields (unexpectedName (head toks)) [] (error "<unexpected"))
-
-unexpectedBinder :: Monoid a => [SourceToken] -> Binder a
-unexpectedBinder toks = BinderVar mempty (unexpectedName (head toks))
-
-unexpectedLetBinding :: Monoid a => [SourceToken] -> LetBinding a
-unexpectedLetBinding toks = LetBindingName mempty (ValueBindingFields (unexpectedName (head toks)) [] (error "<unexpected>"))
-
-unexpectedInstBinding :: Monoid a => [SourceToken] -> InstanceBinding a
-unexpectedInstBinding toks = InstanceBindingName mempty (ValueBindingFields (unexpectedName (head toks)) [] (error "<unexpected>"))
-
-unexpectedRecordUpdate :: Monoid a => [SourceToken] -> RecordUpdate a
-unexpectedRecordUpdate toks = RecordUpdateLeaf (unexpectedLabel (head toks)) (head toks) (unexpectedExpr toks)
-
-unexpectedRecordLabeled :: [SourceToken] -> RecordLabeled a
-unexpectedRecordLabeled toks = RecordPun (unexpectedName (head toks))
-
-rangeToks :: TokenRange -> [SourceToken]
-rangeToks (a, b) = [a, b]
-
-unexpectedToks :: (a -> TokenRange) -> ([SourceToken] -> b) -> ParserErrorType -> (a -> Parser b)
-unexpectedToks toRange toCst err old = do
- let toks = rangeToks $ toRange old
- addFailure toks err
- pure $ toCst toks
-
-separated :: [(SourceToken, a)] -> Separated a
-separated = go []
- where
- go accum ((_, a) : []) = Separated a accum
- go accum (x : xs) = go (x : accum) xs
- go _ [] = internalError "Separated should not be empty"
-
-consSeparated :: a -> SourceToken -> Separated a -> Separated a
-consSeparated x sep (Separated {..}) = Separated x ((sep, sepHead) : sepTail)
-
-internalError :: String -> a
-internalError = error . ("Internal parser error: " <>)
-
-toModuleName :: SourceToken -> [Text] -> Parser (Maybe N.ModuleName)
-toModuleName _ [] = pure Nothing
-toModuleName tok ns = do
- when (not (all isValidModuleNamespace ns)) $ addFailure [tok] ErrModuleName
- pure . Just . N.ModuleName $ Text.intercalate "." ns
-
-upperToModuleName :: SourceToken -> Parser (Name N.ModuleName)
-upperToModuleName tok = case tokValue tok of
- TokUpperName q a -> do
- let ns = q <> [a]
- when (not (all isValidModuleNamespace ns)) $ addFailure [tok] ErrModuleName
- pure . Name tok . N.ModuleName $ Text.intercalate "." ns
- _ -> internalError $ "Invalid upper name: " <> show tok
-
-toQualifiedName :: (Text -> a) -> SourceToken -> Parser (QualifiedName a)
-toQualifiedName k tok = case tokValue tok of
- TokLowerName q a
- | not (Set.member a reservedNames) -> flip (QualifiedName tok) (k a) <$> toModuleName tok q
- | otherwise -> addFailure [tok] ErrKeywordVar $> QualifiedName tok Nothing (k "<unexpected>")
- TokUpperName q a -> flip (QualifiedName tok) (k a) <$> toModuleName tok q
- TokSymbolName q a -> flip (QualifiedName tok) (k a) <$> toModuleName tok q
- TokOperator q a -> flip (QualifiedName tok) (k a) <$> toModuleName tok q
- _ -> internalError $ "Invalid qualified name: " <> show tok
-
-toName :: (Text -> a) -> SourceToken -> Parser (Name a)
-toName k tok = case tokValue tok of
- TokLowerName [] a
- | not (Set.member a reservedNames) -> pure $ Name tok (k a)
- | otherwise -> addFailure [tok] ErrKeywordVar $> Name tok (k "<unexpected>")
- TokString _ _ -> parseFail tok ErrQuotedPun
- TokRawString _ -> parseFail tok ErrQuotedPun
- TokUpperName [] a -> pure $ Name tok (k a)
- TokSymbolName [] a -> pure $ Name tok (k a)
- TokOperator [] a -> pure $ Name tok (k a)
- TokHole a -> pure $ Name tok (k a)
- _ -> internalError $ "Invalid name: " <> show tok
-
-toLabel :: SourceToken -> Label
-toLabel tok = case tokValue tok of
- TokLowerName [] a -> Label tok $ mkString a
- TokString _ a -> Label tok a
- TokRawString a -> Label tok $ mkString a
- TokForall ASCII -> Label tok $ mkString "forall"
- _ -> internalError $ "Invalid label: " <> show tok
-
-labelToIdent :: Label -> Parser (Name Ident)
-labelToIdent (Label tok _) = toName Ident tok
-
-toString :: SourceToken -> (SourceToken, PSString)
-toString tok = case tokValue tok of
- TokString _ a -> (tok, a)
- TokRawString a -> (tok, mkString a)
- _ -> internalError $ "Invalid string literal: " <> show tok
-
-toChar :: SourceToken -> (SourceToken, Char)
-toChar tok = case tokValue tok of
- TokChar _ a -> (tok, a)
- _ -> internalError $ "Invalid char literal: " <> show tok
-
-toNumber :: SourceToken -> (SourceToken, Either Integer Double)
-toNumber tok = case tokValue tok of
- TokInt _ a -> (tok, Left a)
- TokNumber _ a -> (tok, Right a)
- _ -> internalError $ "Invalid number literal: " <> show tok
-
-toInt :: SourceToken -> (SourceToken, Integer)
-toInt tok = case tokValue tok of
- TokInt _ a -> (tok, a)
- _ -> internalError $ "Invalid integer literal: " <> show tok
-
-toBoolean :: SourceToken -> (SourceToken, Bool)
-toBoolean tok = case tokValue tok of
- TokLowerName [] "true" -> (tok, True)
- TokLowerName [] "false" -> (tok, False)
- _ -> internalError $ "Invalid boolean literal: " <> show tok
-
-toConstraint :: forall a. Monoid a => Type a -> Parser (Constraint a)
-toConstraint = convertParens
- where
- convertParens :: Type a -> Parser (Constraint a)
- convertParens = \case
- TypeParens a (Wrapped b c d) -> do
- c' <- convertParens c
- pure $ ConstraintParens a (Wrapped b c' d)
- ty -> convert mempty [] ty
-
- convert :: a -> [Type a] -> Type a -> Parser (Constraint a)
- convert ann acc = \case
- TypeApp a lhs rhs -> convert (a <> ann) (rhs : acc) lhs
- TypeConstructor a name -> do
- for_ acc checkNoForalls
- pure $ Constraint (a <> ann) (coerce name) acc
- ty -> do
- let (tok1, tok2) = typeRange ty
- addFailure [tok1, tok2] ErrTypeInConstraint
- pure $ Constraint mempty (QualifiedName tok1 Nothing (N.ProperName "<unexpected")) []
-
-toBinderConstructor :: Monoid a => NE.NonEmpty (Binder a) -> Parser (Binder a)
-toBinderConstructor = \case
- BinderConstructor a name [] NE.:| bs ->
- pure $ BinderConstructor a name bs
- a NE.:| [] -> pure a
- a NE.:| _ -> unexpectedToks binderRange (unexpectedBinder) ErrExprInBinder a
-
-toRecordFields
- :: Monoid a
- => Separated (Either (RecordLabeled (Expr a)) (RecordUpdate a))
- -> Parser (Either (Separated (RecordLabeled (Expr a))) (Separated (RecordUpdate a)))
-toRecordFields = \case
- Separated (Left a) as ->
- Left . Separated a <$> traverse (traverse unLeft) as
- Separated (Right a) as ->
- Right . Separated a <$> traverse (traverse unRight) as
- where
- unLeft (Left tok) = pure tok
- unLeft (Right tok) =
- unexpectedToks recordUpdateRange unexpectedRecordLabeled ErrRecordUpdateInCtr tok
-
- unRight (Right tok) = pure tok
- unRight (Left (RecordPun (Name tok _))) = do
- addFailure [tok] ErrRecordPunInUpdate
- pure $ unexpectedRecordUpdate [tok]
- unRight (Left (RecordField _ tok _)) = do
- addFailure [tok] ErrRecordCtrInUpdate
- pure $ unexpectedRecordUpdate [tok]
-
-checkFundeps :: ClassHead a -> Parser ()
-checkFundeps (ClassHead _ _ _ _ Nothing) = pure ()
-checkFundeps (ClassHead _ _ _ vars (Just (_, fundeps))) = do
- let
- k (TypeVarKinded (Wrapped _ (Labeled a _ _) _)) = getIdent $ nameValue a
- k (TypeVarName a) = getIdent $ nameValue a
- names = k <$> vars
- check a
- | getIdent (nameValue a) `elem` names = pure ()
- | otherwise = addFailure [nameTok a] ErrUnknownFundep
- for_ fundeps $ \case
- FundepDetermined _ bs -> for_ bs check
- FundepDetermines as _ bs -> do
- for_ as check
- for_ bs check
-
-data TmpModuleDecl a
- = TmpImport (ImportDecl a)
- | TmpChain (Separated (Declaration a))
- deriving (Show)
-
-toModuleDecls :: Monoid a => [TmpModuleDecl a] -> Parser ([ImportDecl a], [Declaration a])
-toModuleDecls = goImport []
- where
- goImport acc (TmpImport x : xs) = goImport (x : acc) xs
- goImport acc xs = (reverse acc,) <$> goDecl [] xs
-
- goDecl acc [] = pure $ reverse acc
- goDecl acc (TmpChain (Separated x []) : xs) = goDecl (x : acc) xs
- goDecl acc (TmpChain (Separated (DeclInstanceChain a (Separated h t)) t') : xs) = do
- (a', instances) <- goChain (getName h) a [] t'
- goDecl (DeclInstanceChain a' (Separated h (t <> instances)) : acc) xs
- goDecl acc (TmpChain (Separated _ t) : xs) = do
- for_ t $ \(tok, _) -> addFailure [tok] ErrElseInDecl
- goDecl acc xs
- goDecl acc (TmpImport imp : xs) = do
- unexpectedToks importDeclRange (const ()) ErrImportInDecl imp
- goDecl acc xs
-
- goChain _ ann acc [] = pure (ann, reverse acc)
- goChain name ann acc ((tok, DeclInstanceChain a (Separated h t)) : xs)
- | eqName (getName h) name = goChain name (ann <> a) (reverse ((tok, h) : t) <> acc) xs
- | otherwise = do
- addFailure [qualTok $ getName h] ErrInstanceNameMismatch
- goChain name ann acc xs
- goChain name ann acc ((tok, _) : xs) = do
- addFailure [tok] ErrElseInDecl
- goChain name ann acc xs
-
- getName = instClass . instHead
- eqName (QualifiedName _ a b) (QualifiedName _ c d) = a == c && b == d
-
-checkNoWildcards :: Type a -> Parser ()
-checkNoWildcards ty = do
- let
- k = \case
- TypeWildcard _ a -> [addFailure [a] ErrWildcardInType]
- TypeHole _ a -> [addFailure [nameTok a] ErrHoleInType]
- _ -> []
- sequence_ $ everythingOnTypes (<>) k ty
-
-checkNoForalls :: Type a -> Parser ()
-checkNoForalls ty = do
- let
- k = \case
- TypeForall _ a _ _ _ -> [addFailure [a] ErrToken]
- _ -> []
- sequence_ $ everythingOnTypes (<>) k ty
-
-revert :: Parser a -> SourceToken -> Parser a
-revert p lk = pushBack lk *> p
-
-reservedNames :: Set Text
-reservedNames = Set.fromList
- [ "ado"
- , "case"
- , "class"
- , "data"
- , "derive"
- , "do"
- , "else"
- , "false"
- , "forall"
- , "foreign"
- , "import"
- , "if"
- , "in"
- , "infix"
- , "infixl"
- , "infixr"
- , "instance"
- , "let"
- , "module"
- , "newtype"
- , "of"
- , "true"
- , "type"
- , "where"
- ]
-
-isValidModuleNamespace :: Text -> Bool
-isValidModuleNamespace = Text.null . snd . Text.span (\c -> c /= '_' && c /= '\'')
-
--- | This is to keep the @Parser.y@ file ASCII, otherwise @happy@ will break
--- in non-unicode locales.
---
--- Related GHC issue: https://gitlab.haskell.org/ghc/ghc/issues/8167
-isLeftFatArrow :: Text -> Bool
-isLeftFatArrow str = str == "<=" || str == "⇐"
diff --git a/src/Language/PureScript/CodeGen/JS.hs b/src/Language/PureScript/CodeGen/JS.hs
index f4ee742..f3d0253 100644
--- a/src/Language/PureScript/CodeGen/JS.hs
+++ b/src/Language/PureScript/CodeGen/JS.hs
@@ -38,7 +38,7 @@ import Language.PureScript.Names
import Language.PureScript.Options
import Language.PureScript.PSString (PSString, mkString)
import Language.PureScript.Traversals (sndM)
-import qualified Language.PureScript.Constants as C
+import qualified Language.PureScript.Constants.Prim as C
import System.FilePath.Posix ((</>))
@@ -50,7 +50,7 @@ moduleToJs
=> Module Ann
-> Maybe AST
-> m [AST]
-moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ =
+moduleToJs (Module _ coms mn _ imps exps reExps foreigns decls) foreign_ =
rethrow (addHint (ErrorInModule mn)) $ do
let usedNames = concatMap getNames decls
let mnLookup = renameImports usedNames imps
@@ -59,6 +59,7 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ =
optimized <- traverse (traverse optimize) jsDecls
let mnReverseLookup = M.fromList $ map (\(origName, (_, safeName)) -> (moduleNameToJs safeName, origName)) $ M.toList mnLookup
let usedModuleNames = foldMap (foldMap (findModules mnReverseLookup)) optimized
+ `S.union` M.keysSet reExps
jsImports <- traverse (importToJs mnLookup)
. filter (flip S.member usedModuleNames)
. (\\ (mn : C.primModules)) $ ordNub $ map snd imps
@@ -70,8 +71,10 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ =
let moduleBody = header : foreign' ++ jsImports ++ concat optimized
let foreignExps = exps `intersect` foreigns
let standardExps = exps \\ foreignExps
+ let reExps' = M.toList (M.withoutKeys reExps (S.fromList C.primModules))
let exps' = AST.ObjectLiteral Nothing $ map (mkString . runIdent &&& AST.Var Nothing . identToJs) standardExps
++ map (mkString . runIdent &&& foreignIdent) foreignExps
+ ++ concatMap (reExportPairs mnLookup) reExps'
return $ moduleBody ++ [AST.Assignment Nothing (accessorString "exports" (AST.Var Nothing "module")) exps']
where
@@ -81,6 +84,21 @@ moduleToJs (Module _ coms mn _ imps exps foreigns decls) foreign_ =
getNames (NonRec _ ident _) = [ident]
getNames (Rec vals) = map (snd . fst) vals
+ -- | Generate code in the JavaScript IR for re-exported declarations, prepending
+ -- the module name from whence it was imported.
+ reExportPairs :: M.Map ModuleName (Ann, ModuleName) -> (ModuleName, [Ident]) -> [(PSString, AST)]
+ reExportPairs mnLookup (mn', idents) =
+ let toExportedMember :: Ident -> AST
+ toExportedMember =
+ maybe
+ (AST.Var Nothing . identToJs)
+ (flip accessor . AST.Var Nothing . moduleNameToJs . snd)
+ (M.lookup mn' mnLookup)
+ in
+ map
+ (mkString . runIdent &&& toExportedMember)
+ idents
+
-- | Creates alternative names for each module to ensure they don't collide
-- with declaration names.
renameImports :: [Ident] -> [(Ann, ModuleName)] -> M.Map ModuleName (Ann, ModuleName)
diff --git a/src/Language/PureScript/Comments.hs b/src/Language/PureScript/Comments.hs
deleted file mode 100644
index 61d3acd..0000000
--- a/src/Language/PureScript/Comments.hs
+++ /dev/null
@@ -1,25 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE DeriveGeneric #-}
-
--- |
--- Defines the types of source code comments
---
-module Language.PureScript.Comments where
-
-import Prelude.Compat
-import Codec.Serialise (Serialise)
-import Control.DeepSeq (NFData)
-import Data.Text (Text)
-import GHC.Generics (Generic)
-
-import Data.Aeson.TH
-
-data Comment
- = LineComment Text
- | BlockComment Text
- deriving (Show, Eq, Ord, Generic)
-
-instance NFData Comment
-instance Serialise Comment
-
-$(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''Comment)
diff --git a/src/Language/PureScript/Constants/Data/Generic/Rep.hs b/src/Language/PureScript/Constants/Data/Generic/Rep.hs
new file mode 100644
index 0000000..c432790
--- /dev/null
+++ b/src/Language/PureScript/Constants/Data/Generic/Rep.hs
@@ -0,0 +1,40 @@
+module Language.PureScript.Constants.Data.Generic.Rep where
+
+import Prelude.Compat
+import Language.PureScript.Names
+
+pattern DataGenericRep :: ModuleName
+pattern DataGenericRep = ModuleName "Data.Generic.Rep"
+
+pattern Generic :: Qualified (ProperName 'ClassName)
+pattern Generic = Qualified (Just DataGenericRep) (ProperName "Generic")
+
+to :: Qualified Ident
+to = Qualified (Just DataGenericRep) (Ident "to")
+
+from :: Qualified Ident
+from = Qualified (Just DataGenericRep) (Ident "from")
+
+pattern NoConstructors :: Qualified (ProperName a)
+pattern NoConstructors = Qualified (Just DataGenericRep) (ProperName "NoConstructors")
+
+pattern NoArguments :: Qualified (ProperName a)
+pattern NoArguments = Qualified (Just DataGenericRep) (ProperName "NoArguments")
+
+pattern Sum :: Qualified (ProperName a)
+pattern Sum = Qualified (Just DataGenericRep) (ProperName "Sum")
+
+pattern Inl :: Qualified (ProperName a)
+pattern Inl = Qualified (Just DataGenericRep) (ProperName "Inl")
+
+pattern Inr :: Qualified (ProperName a)
+pattern Inr = Qualified (Just DataGenericRep) (ProperName "Inr")
+
+pattern Product :: Qualified (ProperName a)
+pattern Product = Qualified (Just DataGenericRep) (ProperName "Product")
+
+pattern Constructor :: Qualified (ProperName a)
+pattern Constructor = Qualified (Just DataGenericRep) (ProperName "Constructor")
+
+pattern Argument :: Qualified (ProperName a)
+pattern Argument = Qualified (Just DataGenericRep) (ProperName "Argument")
diff --git a/src/Language/PureScript/Constants/Data/Newtype.hs b/src/Language/PureScript/Constants/Data/Newtype.hs
new file mode 100644
index 0000000..fcb51ba
--- /dev/null
+++ b/src/Language/PureScript/Constants/Data/Newtype.hs
@@ -0,0 +1,7 @@
+module Language.PureScript.Constants.Data.Newtype where
+
+import Prelude.Compat
+import Language.PureScript.Names
+
+pattern Newtype :: Qualified (ProperName 'ClassName)
+pattern Newtype = Qualified (Just (ModuleName "Data.Newtype")) (ProperName "Newtype")
diff --git a/src/Language/PureScript/Constants.hs b/src/Language/PureScript/Constants/Prelude.hs
index ca85992..4a29425 100644
--- a/src/Language/PureScript/Constants.hs
+++ b/src/Language/PureScript/Constants/Prelude.hs
@@ -1,5 +1,5 @@
-- | Various constants which refer to things in the Prelude
-module Language.PureScript.Constants where
+module Language.PureScript.Constants.Prelude where
import Prelude.Compat
@@ -240,11 +240,6 @@ mkEffectFn = "mkEffectFn"
runEffectFn :: forall a. (IsString a) => a
runEffectFn = "runEffectFn"
--- Prim values
-
-undefined :: forall a. (IsString a) => a
-undefined = "undefined"
-
-- Type Class Dictionary Names
data EffectDictionaries = EffectDictionaries
@@ -373,104 +368,6 @@ toSignature = "toSignature"
main :: forall a. (IsString a) => a
main = "main"
--- Prim
-
-partial :: forall a. (IsString a) => a
-partial = "Partial"
-
-pattern Prim :: ModuleName
-pattern Prim = ModuleName "Prim"
-
-pattern Partial :: Qualified (ProperName 'ClassName)
-pattern Partial = Qualified (Just Prim) (ProperName "Partial")
-
-pattern Record :: Qualified (ProperName 'TypeName)
-pattern Record = Qualified (Just Prim) (ProperName "Record")
-
--- Prim.Boolean
-
-pattern PrimBoolean :: ModuleName
-pattern PrimBoolean = ModuleName "Prim.Boolean"
-
-booleanTrue :: Qualified (ProperName 'TypeName)
-booleanTrue = Qualified (Just PrimBoolean) (ProperName "True")
-
-booleanFalse :: Qualified (ProperName 'TypeName)
-booleanFalse = Qualified (Just PrimBoolean) (ProperName "False")
-
--- Prim.Ordering
-
-pattern PrimOrdering :: ModuleName
-pattern PrimOrdering = ModuleName "Prim.Ordering"
-
-orderingLT :: Qualified (ProperName 'TypeName)
-orderingLT = Qualified (Just PrimOrdering) (ProperName "LT")
-
-orderingEQ :: Qualified (ProperName 'TypeName)
-orderingEQ = Qualified (Just PrimOrdering) (ProperName "EQ")
-
-orderingGT :: Qualified (ProperName 'TypeName)
-orderingGT = Qualified (Just PrimOrdering) (ProperName "GT")
-
--- Prim.Row
-
-pattern PrimRow :: ModuleName
-pattern PrimRow = ModuleName "Prim.Row"
-
-pattern RowUnion :: Qualified (ProperName 'ClassName)
-pattern RowUnion = Qualified (Just PrimRow) (ProperName "Union")
-
-pattern RowNub :: Qualified (ProperName 'ClassName)
-pattern RowNub = Qualified (Just PrimRow) (ProperName "Nub")
-
-pattern RowCons :: Qualified (ProperName 'ClassName)
-pattern RowCons = Qualified (Just PrimRow) (ProperName "Cons")
-
-pattern RowLacks :: Qualified (ProperName 'ClassName)
-pattern RowLacks = Qualified (Just PrimRow) (ProperName "Lacks")
-
--- Prim.RowList
-
-pattern PrimRowList :: ModuleName
-pattern PrimRowList = ModuleName "Prim.RowList"
-
-pattern RowToList :: Qualified (ProperName 'ClassName)
-pattern RowToList = Qualified (Just PrimRowList) (ProperName "RowToList")
-
-pattern RowListNil :: Qualified (ProperName 'TypeName)
-pattern RowListNil = Qualified (Just PrimRowList) (ProperName "Nil")
-
-pattern RowListCons :: Qualified (ProperName 'TypeName)
-pattern RowListCons = Qualified (Just PrimRowList) (ProperName "Cons")
-
--- Prim.Symbol
-
-pattern PrimSymbol :: ModuleName
-pattern PrimSymbol = ModuleName "Prim.Symbol"
-
-pattern SymbolCompare :: Qualified (ProperName 'ClassName)
-pattern SymbolCompare = Qualified (Just PrimSymbol) (ProperName "Compare")
-
-pattern SymbolAppend :: Qualified (ProperName 'ClassName)
-pattern SymbolAppend = Qualified (Just PrimSymbol) (ProperName "Append")
-
-pattern SymbolCons :: Qualified (ProperName 'ClassName)
-pattern SymbolCons = Qualified (Just PrimSymbol) (ProperName "Cons")
-
--- Prim.TypeError
-
-pattern PrimTypeError :: ModuleName
-pattern PrimTypeError = ModuleName "Prim.TypeError"
-
-pattern Fail :: Qualified (ProperName 'ClassName)
-pattern Fail = Qualified (Just PrimTypeError) (ProperName "Fail")
-
-pattern Warn :: Qualified (ProperName 'ClassName)
-pattern Warn = Qualified (Just PrimTypeError) (ProperName "Warn")
-
-primModules :: [ModuleName]
-primModules = [Prim, PrimBoolean, PrimOrdering, PrimRow, PrimRowList, PrimSymbol, PrimTypeError]
-
-- Data.Symbol
pattern DataSymbol :: ModuleName
@@ -479,47 +376,6 @@ pattern DataSymbol = ModuleName "Data.Symbol"
pattern IsSymbol :: Qualified (ProperName 'ClassName)
pattern IsSymbol = Qualified (Just DataSymbol) (ProperName "IsSymbol")
-typ :: forall a. (IsString a) => a
-typ = "Type"
-
-kindBoolean :: forall a. (IsString a) => a
-kindBoolean = "Boolean"
-
-kindOrdering :: forall a. (IsString a) => a
-kindOrdering = "Ordering"
-
-kindRowList :: forall a. (IsString a) => a
-kindRowList = "RowList"
-
-symbol :: forall a. (IsString a) => a
-symbol = "Symbol"
-
-doc :: forall a. (IsString a) => a
-doc = "Doc"
-
--- Modules
-
-prim :: forall a. (IsString a) => a
-prim = "Prim"
-
-moduleBoolean :: forall a. (IsString a) => a
-moduleBoolean = "Boolean"
-
-moduleOrdering :: forall a. (IsString a) => a
-moduleOrdering = "Ordering"
-
-moduleRow :: forall a. (IsString a) => a
-moduleRow = "Row"
-
-moduleRowList :: forall a. (IsString a) => a
-moduleRowList = "RowList"
-
-moduleSymbol :: forall a. (IsString a) => a
-moduleSymbol = "Symbol"
-
-typeError :: forall a. (IsString a) => a
-typeError = "TypeError"
-
prelude :: forall a. (IsString a) => a
prelude = "Prelude"
diff --git a/src/Language/PureScript/CoreFn/Desugar.hs b/src/Language/PureScript/CoreFn/Desugar.hs
index 547fe31..0285fa2 100644
--- a/src/Language/PureScript/CoreFn/Desugar.hs
+++ b/src/Language/PureScript/CoreFn/Desugar.hs
@@ -28,7 +28,7 @@ import Language.PureScript.Sugar.TypeClasses (typeClassMemberName, superClassDic
import Language.PureScript.Types
import Language.PureScript.PSString (mkString)
import qualified Language.PureScript.AST as A
-import qualified Language.PureScript.Constants as C
+import qualified Language.PureScript.Constants.Prim as C
-- | Desugars a module from AST to CoreFn representation.
moduleToCoreFn :: Environment -> A.Module -> Module Ann
@@ -38,11 +38,22 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) =
let imports = mapMaybe importToCoreFn decls ++ fmap (ssAnn modSS,) (findQualModules decls)
imports' = dedupeImports imports
exps' = ordNub $ concatMap exportToCoreFn exps
+ reExps = M.map ordNub $ M.unionsWith (++) (mapMaybe (fmap reExportsToCoreFn . toReExportRef) exps)
externs = ordNub $ mapMaybe externToCoreFn decls
decls' = concatMap declToCoreFn decls
- in Module modSS coms mn (spanName modSS) imports' exps' externs decls'
-
+ in Module modSS coms mn (spanName modSS) imports' exps' reExps externs decls'
where
+ -- | Creates a map from a module name to the re-export references defined in
+ -- that module.
+ reExportsToCoreFn :: (ModuleName, A.DeclarationRef) -> M.Map ModuleName [Ident]
+ reExportsToCoreFn (mn', ref') = M.singleton mn' (exportToCoreFn ref')
+
+ toReExportRef :: A.DeclarationRef -> Maybe (ModuleName, A.DeclarationRef)
+ toReExportRef (A.ReExportRef _ src ref) =
+ fmap
+ (, ref)
+ (A.exportSourceImportedFrom src)
+ toReExportRef _ = Nothing
-- | Remove duplicate imports
dedupeImports :: [(Ann, ModuleName)] -> [(Ann, ModuleName)]
@@ -238,10 +249,14 @@ externToCoreFn _ = Nothing
-- constructor, instances and values are flattened into one list.
exportToCoreFn :: A.DeclarationRef -> [Ident]
exportToCoreFn (A.TypeRef _ _ (Just dctors)) = fmap properToIdent dctors
+exportToCoreFn (A.TypeRef _ _ Nothing) = []
+exportToCoreFn (A.TypeOpRef _ _) = []
exportToCoreFn (A.ValueRef _ name) = [name]
+exportToCoreFn (A.ValueOpRef _ _) = []
exportToCoreFn (A.TypeClassRef _ name) = [properToIdent name]
exportToCoreFn (A.TypeInstanceRef _ name) = [name]
-exportToCoreFn _ = []
+exportToCoreFn (A.ModuleRef _ _) = []
+exportToCoreFn (A.ReExportRef _ _ _) = []
-- | Makes a typeclass dictionary constructor function. The returned expression
-- is a function that accepts the superclass instances and member
diff --git a/src/Language/PureScript/CoreFn/FromJSON.hs b/src/Language/PureScript/CoreFn/FromJSON.hs
index 798ce2b..8ed85cf 100644
--- a/src/Language/PureScript/CoreFn/FromJSON.hs
+++ b/src/Language/PureScript/CoreFn/FromJSON.hs
@@ -11,6 +11,7 @@ import Prelude.Compat
import Data.Aeson
import Data.Aeson.Types (Parser, Value, listParser)
+import qualified Data.Map.Strict as M
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V
@@ -124,6 +125,7 @@ moduleFromJSON = withObject "Module" moduleFromObj
moduleSourceSpan <- o .: "sourceSpan" >>= sourceSpanFromJSON modulePath
moduleImports <- o .: "imports" >>= listParser (importFromJSON modulePath)
moduleExports <- o .: "exports" >>= listParser identFromJSON
+ moduleReExports <- o .: "reExports" >>= reExportsFromJSON
moduleDecls <- o .: "decls" >>= listParser (bindFromJSON modulePath)
moduleForeign <- o .: "foreign" >>= listParser identFromJSON
moduleComments <- o .: "comments" >>= listParser parseJSON
@@ -142,6 +144,9 @@ moduleFromJSON = withObject "Module" moduleFromObj
mn <- o .: "moduleName" >>= moduleNameFromJSON
return (ann, mn))
+ reExportsFromJSON :: Value -> Parser (M.Map ModuleName [Ident])
+ reExportsFromJSON = fmap (M.map (map Ident)) . parseJSON
+
bindFromJSON :: FilePath -> Value -> Parser (Bind Ann)
bindFromJSON modulePath = withObject "Bind" bindFromObj
where
diff --git a/src/Language/PureScript/CoreFn/Meta.hs b/src/Language/PureScript/CoreFn/Meta.hs
index 9a84347..a656c92 100644
--- a/src/Language/PureScript/CoreFn/Meta.hs
+++ b/src/Language/PureScript/CoreFn/Meta.hs
@@ -38,10 +38,10 @@ data Meta
--
data ConstructorType
-- |
- -- The constructor is for a type with a single construcor
+ -- The constructor is for a type with a single constructor
--
= ProductType
-- |
- -- The constructor is for a type with multiple construcors
+ -- The constructor is for a type with multiple constructors
--
| SumType deriving (Show, Eq, Ord)
diff --git a/src/Language/PureScript/CoreFn/Module.hs b/src/Language/PureScript/CoreFn/Module.hs
index 76559af..ac8b0f8 100644
--- a/src/Language/PureScript/CoreFn/Module.hs
+++ b/src/Language/PureScript/CoreFn/Module.hs
@@ -2,6 +2,8 @@ module Language.PureScript.CoreFn.Module where
import Prelude.Compat
+import Data.Map.Strict (Map)
+
import Language.PureScript.AST.SourcePos
import Language.PureScript.Comments
import Language.PureScript.CoreFn.Expr
@@ -10,9 +12,6 @@ import Language.PureScript.Names
-- |
-- The CoreFn module representation
--
--- The json CoreFn representation does not contain type information. When
--- parsing it one gets back `ModuleT () Ann` rathern than `ModuleT Type Ann`,
--- which is enough for `moduleToJs`.
data Module a = Module
{ moduleSourceSpan :: SourceSpan
, moduleComments :: [Comment]
@@ -20,6 +19,7 @@ data Module a = Module
, modulePath :: FilePath
, moduleImports :: [(a, ModuleName)]
, moduleExports :: [Ident]
+ , moduleReExports :: Map ModuleName [Ident]
, moduleForeign :: [Ident]
, moduleDecls :: [Bind a]
} deriving (Show)
diff --git a/src/Language/PureScript/CoreFn/Optimizer.hs b/src/Language/PureScript/CoreFn/Optimizer.hs
index 4456702..e28870c 100644
--- a/src/Language/PureScript/CoreFn/Optimizer.hs
+++ b/src/Language/PureScript/CoreFn/Optimizer.hs
@@ -12,7 +12,7 @@ import Language.PureScript.CoreFn.Traversals
import Language.PureScript.Names (Ident(UnusedIdent), Qualified(Qualified))
import Language.PureScript.Label
import Language.PureScript.Types
-import qualified Language.PureScript.Constants as C
+import qualified Language.PureScript.Constants.Prim as C
-- |
-- CoreFn optimization pass.
@@ -42,7 +42,7 @@ closedRecordFields (TypeApp _ (TypeConstructor _ C.Record) row) =
collect row
where
collect :: Type a -> Maybe [Label]
- collect (REmpty _) = Just []
+ collect (REmptyKinded _ _) = Just []
collect (RCons _ l _ r) = collect r >>= return . (l :)
collect _ = Nothing
closedRecordFields _ = Nothing
diff --git a/src/Language/PureScript/CoreFn/ToJSON.hs b/src/Language/PureScript/CoreFn/ToJSON.hs
index ec54c1e..ddd8b77 100644
--- a/src/Language/PureScript/CoreFn/ToJSON.hs
+++ b/src/Language/PureScript/CoreFn/ToJSON.hs
@@ -11,6 +11,7 @@ import Prelude.Compat
import Control.Arrow ((***))
import Data.Either (isLeft)
+import qualified Data.Map.Strict as M
import Data.Maybe (maybe)
import Data.Aeson
import Data.Version (Version, showVersion)
@@ -109,6 +110,7 @@ moduleToJSON v m = object
, T.pack "modulePath" .= toJSON (modulePath m)
, T.pack "imports" .= map importToJSON (moduleImports m)
, T.pack "exports" .= map identToJSON (moduleExports m)
+ , T.pack "reExports" .= reExportsToJSON (moduleReExports m)
, T.pack "foreign" .= map identToJSON (moduleForeign m)
, T.pack "decls" .= map bindToJSON (moduleDecls m)
, T.pack "builtWith" .= toJSON (showVersion v)
@@ -121,6 +123,9 @@ moduleToJSON v m = object
, T.pack "moduleName" .= moduleNameToJSON mn
]
+ reExportsToJSON :: M.Map ModuleName [Ident] -> Value
+ reExportsToJSON = toJSON . M.map (map runIdent)
+
bindToJSON :: Bind Ann -> Value
bindToJSON (NonRec ann n e)
= object
diff --git a/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs b/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs
index 4b627ab..6c367e9 100644
--- a/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs
+++ b/src/Language/PureScript/CoreImp/Optimizer/Inliner.hs
@@ -25,7 +25,8 @@ import Language.PureScript.PSString (PSString)
import Language.PureScript.CoreImp.AST
import Language.PureScript.CoreImp.Optimizer.Common
import Language.PureScript.AST (SourceSpan(..))
-import qualified Language.PureScript.Constants as C
+import qualified Language.PureScript.Constants.Prelude as C
+import qualified Language.PureScript.Constants.Prim as C
-- TODO: Potential bug:
-- Shouldn't just inline this case: { var x = 0; x.toFixed(10); }
diff --git a/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs b/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs
index c14988f..59dc7bc 100644
--- a/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs
+++ b/src/Language/PureScript/CoreImp/Optimizer/MagicDo.hs
@@ -11,7 +11,7 @@ import Data.Text (Text)
import Language.PureScript.CoreImp.AST
import Language.PureScript.CoreImp.Optimizer.Common
import Language.PureScript.PSString (mkString)
-import qualified Language.PureScript.Constants as C
+import qualified Language.PureScript.Constants.Prelude as C
-- | Inline type class dictionaries for >>= and return for the Eff monad
--
diff --git a/src/Language/PureScript/CoreImp/Optimizer/TCO.hs b/src/Language/PureScript/CoreImp/Optimizer/TCO.hs
index 2b0f077..6aa5390 100644
--- a/src/Language/PureScript/CoreImp/Optimizer/TCO.hs
+++ b/src/Language/PureScript/CoreImp/Optimizer/TCO.hs
@@ -4,7 +4,7 @@ module Language.PureScript.CoreImp.Optimizer.TCO (tco) where
import Prelude.Compat
import Data.Text (Text)
-import qualified Language.PureScript.Constants as C
+import qualified Language.PureScript.Constants.Prim as C
import Language.PureScript.CoreImp.AST
import Language.PureScript.AST.SourcePos (SourceSpan)
import Safe (headDef, tailSafe)
diff --git a/src/Language/PureScript/CoreImp/Optimizer/Unused.hs b/src/Language/PureScript/CoreImp/Optimizer/Unused.hs
index 4dc5ceb..54ef0fc 100644
--- a/src/Language/PureScript/CoreImp/Optimizer/Unused.hs
+++ b/src/Language/PureScript/CoreImp/Optimizer/Unused.hs
@@ -8,7 +8,7 @@ import Prelude.Compat
import Language.PureScript.CoreImp.AST
import Language.PureScript.CoreImp.Optimizer.Common
-import qualified Language.PureScript.Constants as C
+import qualified Language.PureScript.Constants.Prim as C
removeCodeAfterReturnStatements :: AST -> AST
removeCodeAfterReturnStatements = everywhere (removeFromBlock go)
diff --git a/src/Language/PureScript/Crash.hs b/src/Language/PureScript/Crash.hs
deleted file mode 100644
index fe72169..0000000
--- a/src/Language/PureScript/Crash.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ImplicitParams #-}
-
-module Language.PureScript.Crash where
-
-import Prelude.Compat
-
-import qualified GHC.Stack
-
--- | A compatibility wrapper for the @GHC.Stack.HasCallStack@ constraint.
-#if __GLASGOW_HASKELL__ >= 800
-type HasCallStack = GHC.Stack.HasCallStack
-#elif MIN_VERSION_GLASGOW_HASKELL(7,10,2,0)
-type HasCallStack = (?callStack :: GHC.Stack.CallStack)
-#else
-import GHC.Exts (Constraint)
--- CallStack wasn't present in GHC 7.10.1
-type HasCallStack = (() :: Constraint)
-#endif
-
--- | Exit with an error message and a crash report link.
-internalError :: HasCallStack => String -> a
-internalError =
- error
- . ("An internal error occurred during compilation: " ++)
- . (++ "\nPlease report this at https://github.com/purescript/purescript/issues")
diff --git a/src/Language/PureScript/Docs/AsHtml.hs b/src/Language/PureScript/Docs/AsHtml.hs
index 563de1e..3fc7074 100644
--- a/src/Language/PureScript/Docs/AsHtml.hs
+++ b/src/Language/PureScript/Docs/AsHtml.hs
@@ -17,7 +17,7 @@ module Language.PureScript.Docs.AsHtml (
import Prelude
import Control.Category ((>>>))
import Control.Monad (unless)
-import Data.Bifunctor (first)
+import Data.Bifunctor (bimap)
import Data.Char (isUpper)
import Data.Either (isRight)
import qualified Data.List.NonEmpty as NE
@@ -225,7 +225,7 @@ codeAsHtml r = outputWith elemAsHtml
runParser :: CST.Parser a -> Text -> Either String a
runParser p' =
- first (CST.prettyPrintError . NE.head)
+ bimap (CST.prettyPrintError . NE.head) snd
. CST.runTokenParser p'
. CST.lex
@@ -248,7 +248,6 @@ makeFragment ns = (prefix <>) . escape
prefix = case ns of
TypeLevel -> "#t:"
ValueLevel -> "#v:"
- KindLevel -> "#k:"
-- TODO
escape = id
diff --git a/src/Language/PureScript/Docs/Convert.hs b/src/Language/PureScript/Docs/Convert.hs
index a7af113..987a41d 100644
--- a/src/Language/PureScript/Docs/Convert.hs
+++ b/src/Language/PureScript/Docs/Convert.hs
@@ -39,10 +39,8 @@ convertModule ::
P.Environment ->
P.Module ->
m Module
-convertModule externs env checkEnv m =
- partiallyDesugar externs env [m] >>= \case
- [m'] -> pure (insertValueTypes checkEnv (convertSingleModule m'))
- _ -> P.internalError "partiallyDesugar did not return a singleton"
+convertModule externs env checkEnv =
+ fmap (insertValueTypes checkEnv . convertSingleModule) . partiallyDesugar externs env
-- |
-- Updates all the types of the ValueDeclarations inside the module based on
@@ -78,7 +76,7 @@ insertValueTypes env m =
runParser :: CST.Parser a -> Text -> Either String a
runParser p =
- first (CST.prettyPrintError . NE.head)
+ bimap (CST.prettyPrintError . NE.head) snd
. CST.runTokenParser p
. CST.lex
@@ -90,17 +88,17 @@ partiallyDesugar ::
(MonadError P.MultipleErrors m) =>
[P.ExternsFile] ->
P.Env ->
- [P.Module] ->
- m [P.Module]
+ P.Module ->
+ m P.Module
partiallyDesugar externs env = evalSupplyT 0 . desugar'
where
desugar' =
- traverse P.desugarDoModule
- >=> traverse P.desugarAdoModule
- >=> map P.desugarLetPatternModule
- >>> traverse P.desugarCasesModule
- >=> traverse P.desugarTypeDeclarationsModule
- >=> fmap fst . runWriterT . P.desugarImports env
+ P.desugarDoModule
+ >=> P.desugarAdoModule
+ >=> P.desugarLetPatternModule
+ >>> P.desugarCasesModule
+ >=> P.desugarTypeDeclarationsModule
+ >=> fmap fst . runWriterT . flip evalStateT (env, mempty) . P.desugarImports
>=> P.rebracketFiltered isInstanceDecl externs
isInstanceDecl (P.TypeInstanceDeclaration {}) = True
diff --git a/src/Language/PureScript/Docs/Convert/ReExports.hs b/src/Language/PureScript/Docs/Convert/ReExports.hs
index 9651bfb..5c9526a 100644
--- a/src/Language/PureScript/Docs/Convert/ReExports.hs
+++ b/src/Language/PureScript/Docs/Convert/ReExports.hs
@@ -68,7 +68,7 @@ updateReExports externs withPackage = execState action
traversalOrder :: [P.ModuleName]
traversalOrder =
- case P.sortModules externsSignature externs of
+ case P.sortModules P.Transitive externsSignature externs of
Right (es, _) -> map P.efModuleName es
Left errs -> internalError $
"failed to sortModules: " ++
@@ -135,14 +135,13 @@ collectDeclarations reExports = do
typeClasses <- collect lookupTypeClassDeclaration expTCs
types <- collect lookupTypeDeclaration expTypes
typeOps <- collect lookupTypeOpDeclaration expTypeOps
- kinds <- collect lookupKindDeclaration expKinds
(vals, classes) <- handleTypeClassMembers valsAndMembers typeClasses
let filteredTypes = filterDataConstructors expCtors types
let filteredClasses = filterTypeClassMembers (Map.keys expVals) classes
- pure (Map.toList (Map.unionsWith (<>) [filteredTypes, filteredClasses, vals, valOps, typeOps, kinds]))
+ pure (Map.toList (Map.unionsWith (<>) [filteredTypes, filteredClasses, vals, valOps, typeOps]))
where
@@ -171,9 +170,6 @@ collectDeclarations reExports = do
expTypeOps :: Map (P.OpName 'P.TypeOpName) P.ExportSource
expTypeOps = mkExportMap P.getTypeOpRef
- expKinds :: Map (P.ProperName 'P.KindName) P.ExportSource
- expKinds = mkExportMap P.getKindRef
-
mkExportMap :: Ord name => (P.DeclarationRef -> Maybe name) -> Map name P.ExportSource
mkExportMap f =
Map.fromList $
@@ -183,6 +179,7 @@ collectDeclarations reExports = do
expCtors = concatMap (fromMaybe [] . (>>= snd) . P.getTypeRef . snd) reExports
lookupValueDeclaration ::
+ forall m.
(MonadState (Map P.ModuleName Module) m,
MonadReader P.ModuleName m) =>
P.ModuleName ->
@@ -194,6 +191,7 @@ lookupValueDeclaration importedFrom ident = do
rs =
filter (\d -> declTitle d == P.showIdent ident
&& (isValue d || isValueAlias d)) decls
+ errOther :: Show a => a -> m b
errOther other =
internalErrorInModule
("lookupValueDeclaration: unexpected result:\n" ++
@@ -312,24 +310,6 @@ lookupTypeClassDeclaration importedFrom tyClass = do
++ show tyClass ++ ": "
++ (unlines . map show) other)
-lookupKindDeclaration
- :: (MonadState (Map P.ModuleName Module) m, MonadReader P.ModuleName m)
- => P.ModuleName
- -> P.ProperName 'P.KindName
- -> m (P.ModuleName, [Declaration])
-lookupKindDeclaration importedFrom kind = do
- decls <- lookupModuleDeclarations "lookupKindDeclaration" importedFrom
- let
- ds = filter (\d -> declTitle d == P.runProperName kind
- && isKind d)
- decls
- case ds of
- [d] ->
- pure (importedFrom, [d])
- other ->
- internalErrorInModule
- ("lookupKindDeclaration: unexpected result: " ++ show other)
-
-- |
-- Get the full list of declarations for a particular module out of the
-- state, or raise an internal error if it is not there.
@@ -530,7 +510,7 @@ typeClassConstraintFor :: Declaration -> Maybe Constraint'
typeClassConstraintFor Declaration{..} =
case declInfo of
TypeClassDeclaration tyArgs _ _ ->
- Just (P.Constraint () (P.Qualified Nothing (P.ProperName declTitle)) (mkConstraint tyArgs) Nothing)
+ 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 60e2ddb..6300ae9 100644
--- a/src/Language/PureScript/Docs/Convert/Single.hs
+++ b/src/Language/PureScript/Docs/Convert/Single.hs
@@ -93,7 +93,6 @@ getDeclarationTitle (P.ValueDeclaration vd) = Just (P.showIdent (P.valdeclIdent
getDeclarationTitle (P.ExternDeclaration _ name _) = Just (P.showIdent name)
getDeclarationTitle (P.DataDeclaration _ _ name _ _) = Just (P.runProperName name)
getDeclarationTitle (P.ExternDataDeclaration _ name _) = Just (P.runProperName name)
-getDeclarationTitle (P.ExternKindDeclaration _ name) = Just (P.runProperName name)
getDeclarationTitle (P.TypeSynonymDeclaration _ name _ _) = Just (P.runProperName name)
getDeclarationTitle (P.TypeClassDeclaration _ name _ _ _ _) = Just (P.runProperName name)
getDeclarationTitle (P.TypeInstanceDeclaration _ _ _ name _ _ _ _) = Just (P.showIdent name)
@@ -133,8 +132,6 @@ convertDeclaration (P.DataDeclaration sa dtype _ args ctors) title =
ChildDeclaration (P.runProperName dataCtorName) (convertComments $ snd dataCtorAnn) Nothing (ChildDataConstructor (fmap (($> ()) . snd) dataCtorFields))
convertDeclaration (P.ExternDataDeclaration sa _ kind') title =
basicDeclaration sa title (ExternDataDeclaration (kind' $> ()))
-convertDeclaration (P.ExternKindDeclaration sa _) title =
- basicDeclaration sa title ExternKindDeclaration
convertDeclaration (P.TypeSynonymDeclaration sa _ args ty) title =
basicDeclaration sa title (TypeSynonymDeclaration (fmap (fmap (fmap ($> ()))) args) (ty $> ()))
convertDeclaration (P.TypeClassDeclaration sa _ args implies fundeps ds) title =
diff --git a/src/Language/PureScript/Docs/Prim.hs b/src/Language/PureScript/Docs/Prim.hs
index 3fabafa..df2b403 100644
--- a/src/Language/PureScript/Docs/Prim.hs
+++ b/src/Language/PureScript/Docs/Prim.hs
@@ -11,7 +11,6 @@ import Data.Functor (($>))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Map as Map
-import qualified Data.Set as Set
import Language.PureScript.Docs.Types
import qualified Language.PureScript.Crash as P
@@ -22,6 +21,7 @@ primModules :: [Module]
primModules =
[ primDocsModule
, primBooleanDocsModule
+ , primCoerceDocsModule
, primOrderingDocsModule
, primRowDocsModule
, primRowListDocsModule
@@ -35,7 +35,7 @@ primDocsModule = Module
, modComments = Just $ T.unlines
[ "The `Prim` module is embedded in the PureScript compiler in order to provide compiler support for certain types &mdash; for example, value literals, or syntax sugar. It is implicitly imported unqualified in every module except those that list it as a qualified import."
, ""
- , "`Prim` does not include additional built-in types and kinds that are defined deeper in the compiler. For example, row kinds (e.g. `# Type`, which is the kind of types such as `(name :: String, age :: Int)`), Type wildcards (e.g. `f :: _ -> Int`), and Quantified Types. Rather, these are documented in [the PureScript language reference](https://github.com/purescript/documentation/blob/master/language/Types.md)."
+ , "`Prim` does not include additional built-in types and kinds that are defined deeper in the compiler such as Type wildcards (e.g. `f :: _ -> Int`) and Quantified Types. Rather, these are documented in [the PureScript language reference](https://github.com/purescript/documentation/blob/master/language/Types.md)."
]
, modDeclarations =
[ function
@@ -48,7 +48,9 @@ primDocsModule = Module
, boolean
, partial
, kindType
+ , kindConstraint
, kindSymbol
+ , kindRow
]
, modReExports = []
}
@@ -58,13 +60,22 @@ primBooleanDocsModule = Module
{ modName = P.moduleNameFromString "Prim.Boolean"
, modComments = Just "The Prim.Boolean module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains a type level `Boolean` data structure."
, modDeclarations =
- [ kindBoolean
- , booleanTrue
+ [ booleanTrue
, booleanFalse
]
, modReExports = []
}
+primCoerceDocsModule :: Module
+primCoerceDocsModule = Module
+ { modName = P.moduleNameFromString "Prim.Coerce"
+ , modComments = Just "The Prim.Coerce module is embedded in the PureScript compiler. Unlike `Prim`, it is not imported implicitly. It contains an automatically solved type class for coercing types that have provably-identical runtime representations with [purescript-safe-coerce](https://pursuit.purescript.org/packages/purescript-safe-coerce)."
+ , modDeclarations =
+ [ coercible
+ ]
+ , modReExports = []
+ }
+
primOrderingDocsModule :: Module
primOrderingDocsModule = Module
{ modName = P.moduleNameFromString "Prim.Ordering"
@@ -149,29 +160,10 @@ unsafeLookupOf k m errorMsg name = go name
fromJust' (Just x) = x
fromJust' _ = P.internalError $ errorMsg ++ show name
-primKindOf
- :: NameGen 'P.KindName
- -> Text
- -> Text
- -> Declaration
-primKindOf g title comments =
- if Set.member (g title) P.allPrimKinds
- then Declaration
- { declTitle = title
- , declComments = Just comments
- , declSourceSpan = Nothing
- , declChildren = []
- , declInfo = ExternKindDeclaration
- }
- else P.internalError $ "Docs.Prim: No such Prim kind: " ++ T.unpack title
-
-primKind :: Text -> Text -> Declaration
-primKind = primKindOf P.primName
-
lookupPrimTypeKindOf
:: NameGen 'P.TypeName
-> Text
- -> Kind'
+ -> Type'
lookupPrimTypeKindOf k = ($> ()) . fst . unsafeLookupOf k
( P.primTypes <>
P.primBooleanTypes <>
@@ -198,6 +190,7 @@ primTypeOf gen title comments = Declaration
lookupPrimClassOf :: NameGen 'P.ClassName -> Text -> P.TypeClassData
lookupPrimClassOf g = unsafeLookupOf g
( P.primClasses <>
+ P.primCoerceClasses <>
P.primRowClasses <>
P.primRowListClasses <>
P.primSymbolClasses <>
@@ -224,19 +217,38 @@ primClassOf gen title comments = Declaration
}
kindType :: Declaration
-kindType = primKind "Type" $ T.unlines
+kindType = primType "Type" $ T.unlines
[ "`Type` is the kind of all proper types: those that classify value-level terms."
, "For example the type `Boolean` has kind `Type`; denoted by `Boolean :: Type`."
]
+kindConstraint :: Declaration
+kindConstraint = primType "Constraint" $ T.unlines
+ [ "`Constraint` is the kind of type class constraints."
+ , "For example, a type class declaration like this:"
+ , ""
+ , " class Semigroup a where"
+ , " append :: a -> a -> a"
+ , ""
+ , "has the kind signature:"
+ , ""
+ , " class Semigroup :: Type -> Constraint"
+ ]
+
kindSymbol :: Declaration
-kindSymbol = primKind "Symbol" $ T.unlines
+kindSymbol = primType "Symbol" $ T.unlines
[ "`Symbol` is the kind of type-level strings."
, ""
, "Construct types of this kind using the same literal syntax as documented"
, "for strings."
]
+kindRow :: Declaration
+kindRow = primType "Row" $ T.unlines
+ [ "`Row` is the kind constructor of label-indexed types which map type-level strings to other types."
+ , "For example, the kind of `Record` is `Row Type -> Type`, mapping field names to values."
+ ]
+
function :: Declaration
function = primType "Function" $ T.unlines
[ "A function, which takes values of the type specified by the first type"
@@ -351,11 +363,6 @@ partial = primClass "Partial" $ T.unlines
, "[purescript-partial](https://pursuit.purescript.org/packages/purescript-partial/)."
]
-kindBoolean :: Declaration
-kindBoolean = primKindOf (P.primSubName "Boolean") "Boolean" $ T.unlines
- [ "The `Boolean` kind provides True/False types at the type level"
- ]
-
booleanTrue :: Declaration
booleanTrue = primTypeOf (P.primSubName "Boolean") "True" $ T.unlines
[ "The 'True' boolean type."
@@ -366,9 +373,65 @@ booleanFalse = primTypeOf (P.primSubName "Boolean") "False" $ T.unlines
[ "The 'False' boolean type."
]
+coercible :: Declaration
+coercible = primClassOf (P.primSubName "Coerce") "Coercible" $ T.unlines
+ [ "Coercible is a two-parameter type class that has instances for types `a`"
+ , "and `b` if the compiler can infer that they have the same representation."
+ , "Coercible constraints are solved according to the following rules:"
+ , ""
+ , "* _reflexivity_, any type has the same representation as itself:"
+ , "`Coercible a a` holds."
+ , ""
+ , "* _symmetry_, if a type `a` can be coerced to some other type `b`, then `b`"
+ , "can also be coerced back to `a`: `Coercible a b` implies `Coercible b a`."
+ , ""
+ , "* _transitivity_, if a type `a` can be coerced to some other type `b` which"
+ , "can be coerced to some other type `c`, then `a` can also be coerced to `c`:"
+ , "`Coercible a b` and `Coercible b c` imply `Coercible a c`."
+ , ""
+ , "* Newtypes can be freely wrapped and unwrapped when their constructor is"
+ , "in scope:"
+ , ""
+ , " newtype Age = Age Int"
+ , ""
+ , "`Coercible Int Age` and `Coercible Age Int` hold since `Age` has the same"
+ , "runtime representation than `Int`."
+ , ""
+ , "Newtype constructors have to be in scope to preserve abstraction. It's"
+ , "common to declare a newtype to encode some invariants (non emptiness of"
+ , "arrays with `Data.Array.NonEmpty.NonEmptyArray` for example), hide its"
+ , "constructor and export smart constructors instead. Without this restriction,"
+ , "the guarantees provided by such newtypes would be void."
+ , ""
+ , "* If none of the above are applicable, two types of kind `Type` may be"
+ , "coercible, but only if their heads are the same. For example,"
+ , "`Coercible (Maybe a) (Either a b)` does not hold because `Maybe` and"
+ , "`Either` are different. Those types don't share a common runtime"
+ , "representation so coercing between them would be unsafe. In addition their"
+ , "arguments may need to be identical or coercible, depending on the _roles_"
+ , "of the head's type parameters. Roles are documented in [the PureScript"
+ , "language reference](https://github.com/purescript/documentation/blob/master/language/Roles.md)."
+ , ""
+ , "Coercible being polykinded, we can also coerce more than types of kind `Type`:"
+ , ""
+ , "* Rows are coercible when they have the same labels, when the corresponding"
+ , "pairs of types are coercible and when their tails are coercible:"
+ , "`Coercible ( label :: a | r ) ( label :: b | s )` holds when"
+ , "`Coercible a b` and `Coercible r s` do. Closed rows cannot be coerced to"
+ , "open rows."
+ , ""
+ , "* Higher kinded types are coercible if they are coercible when fully"
+ , "saturated: `Coercible (f :: _ -> Type) (g :: _ -> Type)` holds when"
+ , "`Coercible (f a) (g a)` does."
+ , ""
+ , "This rule may seem puzzling since there is no term of type `_ -> Type` to"
+ , "apply `coerce` to, but it is necessary when coercing types with higher"
+ , "kinded parameters."
+ ]
+
kindOrdering :: Declaration
-kindOrdering = primKindOf (P.primSubName "Ordering") "Ordering" $ T.unlines
- [ "The `Ordering` kind represents the three possibilites of comparing two"
+kindOrdering = primTypeOf (P.primSubName "Ordering") "Ordering" $ T.unlines
+ [ "The `Ordering` kind represents the three possibilities of comparing two"
, "types of the same kind: `LT` (less than), `EQ` (equal to), and"
, "`GT` (greater than)."
]
@@ -414,7 +477,7 @@ rowCons = primClassOf (P.primSubName "Row") "Cons" $ T.unlines
]
kindRowList :: Declaration
-kindRowList = primKindOf (P.primSubName "RowList") "RowList" $ T.unlines
+kindRowList = primTypeOf (P.primSubName "RowList") "RowList" $ T.unlines
[ "A type level list representation of a row of types."
]
@@ -474,10 +537,10 @@ warn = primClassOf (P.primSubName "TypeError") "Warn" $ T.unlines
]
kindDoc :: Declaration
-kindDoc = primKindOf (P.primSubName "TypeError") "Doc" $ T.unlines
+kindDoc = primTypeOf (P.primSubName "TypeError") "Doc" $ T.unlines
[ "`Doc` is the kind of type-level documents."
, ""
- , "This kind is used with the `Fail` and `Warn` type clases."
+ , "This kind is used with the `Fail` and `Warn` type classes."
, "Build up a `Doc` with `Text`, `Quote`, `QuoteLabel`, `Beside`, and `Above`."
]
diff --git a/src/Language/PureScript/Docs/Render.hs b/src/Language/PureScript/Docs/Render.hs
index 603aadf..46c2fc7 100644
--- a/src/Language/PureScript/Docs/Render.hs
+++ b/src/Language/PureScript/Docs/Render.hs
@@ -40,7 +40,7 @@ renderDeclaration Declaration{..} =
[ keywordData
, renderType (P.TypeConstructor () (notQualified declTitle))
, syntax "::"
- , renderKind kind'
+ , renderType kind'
]
TypeSynonymDeclaration args ty ->
[ keywordType
@@ -80,11 +80,6 @@ renderDeclaration Declaration{..} =
, aliasName for declTitle
]
- ExternKindDeclaration ->
- [ keywordKind
- , kind (notQualified declTitle)
- ]
-
renderChildDeclaration :: ChildDeclaration -> RenderedCode
renderChildDeclaration ChildDeclaration{..} =
mintersperse sp $ case cdeclInfo of
@@ -101,8 +96,8 @@ renderChildDeclaration ChildDeclaration{..} =
]
renderConstraint :: Constraint' -> RenderedCode
-renderConstraint (P.Constraint ann pn tys _) =
- renderType $ foldl (P.TypeApp ann) (P.TypeConstructor ann (fmap P.coerceProperName pn)) tys
+renderConstraint (P.Constraint ann pn kinds tys _) =
+ renderType $ foldl (P.TypeApp ann) (foldl (P.KindApp ann) (P.TypeConstructor ann (fmap P.coerceProperName pn)) kinds) tys
renderConstraints :: [Constraint'] -> Maybe RenderedCode
renderConstraints constraints
@@ -125,12 +120,12 @@ ident' = ident . P.Qualified Nothing . P.Ident
dataCtor' :: Text -> RenderedCode
dataCtor' = dataCtor . notQualified
-typeApp :: Text -> [(Text, Maybe Kind')] -> Type'
+typeApp :: Text -> [(Text, Maybe Type')] -> Type'
typeApp title typeArgs =
foldl (P.TypeApp ())
(P.TypeConstructor () (notQualified title))
(map toTypeVar typeArgs)
-toTypeVar :: (Text, Maybe Kind') -> Type'
+toTypeVar :: (Text, Maybe Type') -> Type'
toTypeVar (s, Nothing) = P.TypeVar () s
toTypeVar (s, Just k) = P.KindedType () (P.TypeVar () s) k
diff --git a/src/Language/PureScript/Docs/RenderedCode.hs b/src/Language/PureScript/Docs/RenderedCode.hs
index 216eba3..2d8d025 100644
--- a/src/Language/PureScript/Docs/RenderedCode.hs
+++ b/src/Language/PureScript/Docs/RenderedCode.hs
@@ -6,4 +6,3 @@ module Language.PureScript.Docs.RenderedCode (module RenderedCode) where
import Language.PureScript.Docs.RenderedCode.Types as RenderedCode
import Language.PureScript.Docs.RenderedCode.RenderType as RenderedCode
-import Language.PureScript.Docs.RenderedCode.RenderKind as RenderedCode
diff --git a/src/Language/PureScript/Docs/RenderedCode/RenderKind.hs b/src/Language/PureScript/Docs/RenderedCode/RenderKind.hs
deleted file mode 100644
index f4c3862..0000000
--- a/src/Language/PureScript/Docs/RenderedCode/RenderKind.hs
+++ /dev/null
@@ -1,57 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
--- | Functions for producing RenderedCode values from PureScript Kind values.
---
-module Language.PureScript.Docs.RenderedCode.RenderKind
- ( renderKind
- ) where
-
--- TODO: This is pretty much copied from Language.PureScript.Pretty.Kinds.
--- Ideally we would unify the two.
-
-import Prelude.Compat
-
-import Control.Arrow (ArrowPlus(..))
-import Control.PatternArrows as PA
-
-import Data.Maybe (fromMaybe)
-import qualified Data.Text as T
-
-import Language.PureScript.Crash
-import Language.PureScript.Kinds
-
-import Language.PureScript.Docs.RenderedCode.Types
-
-typeLiterals :: Pattern () (Kind a) RenderedCode
-typeLiterals = mkPattern match
- where
- match (KUnknown _ u) =
- Just $ typeVar $ T.cons 'k' (T.pack (show u))
- match (NamedKind _ n) =
- Just $ kind n
- match _ = Nothing
-
-matchRow :: Pattern () (Kind a) ((), Kind a)
-matchRow = mkPattern match
- where
- match (Row _ k) = Just ((), k)
- match _ = Nothing
-
-funKind :: Pattern () (Kind a) (Kind a, Kind a)
-funKind = mkPattern match
- where
- match (FunKind _ arg ret) = Just (arg, ret)
- match _ = Nothing
-
--- | Generate RenderedCode value representing a Kind
-renderKind :: forall a. Kind a -> RenderedCode
-renderKind
- = fromMaybe (internalError "Incomplete pattern")
- . PA.pattern matchKind ()
- where
- matchKind :: Pattern () (Kind a) RenderedCode
- matchKind = buildPrettyPrinter operators (typeLiterals <+> fmap parens matchKind)
-
- operators :: OperatorTable () (Kind a) RenderedCode
- operators =
- OperatorTable [ [ Wrap matchRow $ \_ k -> syntax "#" <> sp <> k]
- , [ AssocR funKind $ \arg ret -> arg <> sp <> syntax "->" <> sp <> ret ] ]
diff --git a/src/Language/PureScript/Docs/RenderedCode/RenderType.hs b/src/Language/PureScript/Docs/RenderedCode/RenderType.hs
index 242f8a4..4eed847 100644
--- a/src/Language/PureScript/Docs/RenderedCode/RenderType.hs
+++ b/src/Language/PureScript/Docs/RenderedCode/RenderType.hs
@@ -17,7 +17,6 @@ import Control.Arrow ((<+>))
import Control.PatternArrows as PA
import Language.PureScript.Crash
-import Language.PureScript.Kinds
import Language.PureScript.Label
import Language.PureScript.Names
import Language.PureScript.Pretty.Types
@@ -26,7 +25,6 @@ import Language.PureScript.PSString (prettyPrintString)
import Language.PureScript.Docs.RenderedCode.Types
import Language.PureScript.Docs.Utils.MonoidExtras
-import Language.PureScript.Docs.RenderedCode.RenderKind (renderKind)
typeLiterals :: Pattern () PrettyPrintType RenderedCode
typeLiterals = mkPattern match
@@ -55,8 +53,8 @@ typeLiterals = mkPattern match
Nothing
renderConstraint :: PrettyPrintConstraint -> RenderedCode
-renderConstraint (pn, tys) =
- let instApp = foldl PPTypeApp (PPTypeConstructor (fmap coerceProperName pn)) tys
+renderConstraint (pn, ks, tys) =
+ let instApp = foldl PPTypeApp (foldl (\a b -> PPTypeApp a (PPKindArg b)) (PPTypeConstructor (fmap coerceProperName pn)) ks) tys
in renderType' instApp
renderConstraints :: PrettyPrintConstraint -> RenderedCode -> RenderedCode
@@ -94,16 +92,22 @@ typeApp = mkPattern match
match (PPTypeApp f x) = Just (f, x)
match _ = Nothing
+kindArg :: Pattern () PrettyPrintType ((), PrettyPrintType)
+kindArg = mkPattern match
+ where
+ match (PPKindArg ty) = Just ((), ty)
+ match _ = Nothing
+
appliedFunction :: Pattern () PrettyPrintType (PrettyPrintType, PrettyPrintType)
appliedFunction = mkPattern match
where
match (PPFunction arg ret) = Just (arg, ret)
match _ = Nothing
-kinded :: Pattern () PrettyPrintType (Kind (), PrettyPrintType)
+kinded :: Pattern () PrettyPrintType (PrettyPrintType, PrettyPrintType)
kinded = mkPattern match
where
- match (PPKindedType t k) = Just (k, t)
+ match (PPKindedType t k) = Just (t, k)
match _ = Nothing
constrained :: Pattern () PrettyPrintType (PrettyPrintConstraint, PrettyPrintType)
@@ -128,15 +132,16 @@ matchType = buildPrettyPrinter operators matchTypeAtom
where
operators :: OperatorTable () PrettyPrintType RenderedCode
operators =
- OperatorTable [ [ AssocL typeApp $ \f x -> f <> sp <> x ]
+ OperatorTable [ [ Wrap kindArg $ \_ ty -> syntax "@" <> ty ]
+ , [ AssocL typeApp $ \f x -> f <> sp <> x ]
, [ AssocR appliedFunction $ \arg ret -> mintersperse sp [arg, syntax "->", ret] ]
, [ Wrap constrained $ \deps ty -> renderConstraints deps ty ]
, [ Wrap forall_ $ \tyVars ty -> mconcat [ keywordForall, sp, renderTypeVars tyVars, syntax ".", sp, ty ] ]
- , [ Wrap kinded $ \k ty -> mintersperse sp [ty, syntax "::", renderKind k] ]
+ , [ Wrap kinded $ \ty k -> mintersperse sp [renderType' ty, syntax "::", k] ]
, [ Wrap explicitParens $ \_ ty -> ty ]
]
-forall_ :: Pattern () PrettyPrintType ([(Text, Maybe (Kind ()))], PrettyPrintType)
+forall_ :: Pattern () PrettyPrintType ([(Text, Maybe PrettyPrintType)], PrettyPrintType)
forall_ = mkPattern match
where
match (PPForAll mbKindedIdents ty) = Just (mbKindedIdents, ty)
@@ -153,13 +158,13 @@ renderType'
= fromMaybe (internalError "Incomplete pattern")
. PA.pattern matchType ()
-renderTypeVars :: [(Text, Maybe (Kind a))] -> RenderedCode
+renderTypeVars :: [(Text, Maybe PrettyPrintType)] -> RenderedCode
renderTypeVars tyVars = mintersperse sp (map renderTypeVar tyVars)
-renderTypeVar :: (Text, Maybe (Kind a)) -> RenderedCode
+renderTypeVar :: (Text, Maybe PrettyPrintType) -> RenderedCode
renderTypeVar (v, mbK) = case mbK of
Nothing -> typeVar v
- Just k -> mintersperse sp [ mconcat [syntax "(", typeVar v], syntax "::", mconcat [renderKind k, syntax ")"] ]
+ Just k -> mintersperse sp [ mconcat [syntax "(", typeVar v], syntax "::", mconcat [renderType' k, syntax ")"] ]
-- |
-- Render code representing a Type, as it should appear inside parentheses
diff --git a/src/Language/PureScript/Docs/RenderedCode/Types.hs b/src/Language/PureScript/Docs/RenderedCode/Types.hs
index ecf1b0a..8eefbe1 100644
--- a/src/Language/PureScript/Docs/RenderedCode/Types.hs
+++ b/src/Language/PureScript/Docs/RenderedCode/Types.hs
@@ -38,7 +38,6 @@ module Language.PureScript.Docs.RenderedCode.Types
, typeCtor
, typeOp
, typeVar
- , kind
, alias
, aliasName
) where
@@ -58,7 +57,6 @@ import qualified Data.Text.Encoding as TE
import Language.PureScript.Names
import Language.PureScript.AST (Associativity(..))
-import Language.PureScript.Crash (internalError)
-- | Given a list of actions, attempt them all, returning the first success.
-- If all the actions fail, 'tryAll' returns the first argument.
@@ -170,7 +168,6 @@ instance A.FromJSON Link where
data Namespace
= ValueLevel
| TypeLevel
- | KindLevel
deriving (Show, Eq, Ord, Generic)
instance NFData Namespace
@@ -184,7 +181,6 @@ asNamespace =
[ withText $ \case
"ValueLevel" -> Right ValueLevel
"TypeLevel" -> Right TypeLevel
- "KindLevel" -> Right KindLevel
_ -> Left ""
]
@@ -234,12 +230,10 @@ asRenderedCodeElement =
backwardsCompat =
[ oldAsIdent
, oldAsCtor
- , oldAsKind
]
oldAsIdent = firstEq "ident" (Symbol ValueLevel <$> nth 1 asText <*> nth 2 (Link <$> asContainingModule))
oldAsCtor = firstEq "ctor" (Symbol TypeLevel <$> nth 1 asText <*> nth 2 (Link <$> asContainingModule))
- oldAsKind = firstEq "kind" (Symbol KindLevel <$> nth 1 asText <*> pure (Link ThisModule))
-- |
-- A type representing a highly simplified version of PureScript code, intended
@@ -335,10 +329,6 @@ typeOp (fromQualified -> (mn, name)) =
typeVar :: Text -> RenderedCode
typeVar x = RC [Symbol TypeLevel x NoLink]
-kind :: Qualified (ProperName 'KindName) -> RenderedCode
-kind (fromQualified -> (mn, name)) =
- RC [Symbol KindLevel (runProperName name) (Link mn)]
-
type FixityAlias = Qualified (Either (ProperName 'TypeName) (Either Ident (ProperName 'ConstructorName)))
alias :: FixityAlias -> RenderedCode
@@ -364,8 +354,6 @@ aliasName for name' =
ident (Qualified Nothing (Ident name))
TypeLevel ->
typeCtor (Qualified Nothing (ProperName name))
- KindLevel ->
- internalError "Kind aliases are not supported"
-- | Converts a FixityAlias into a different representation which is more
-- useful to other functions in this module.
diff --git a/src/Language/PureScript/Docs/Types.hs b/src/Language/PureScript/Docs/Types.hs
index cc46fdc..1170f0f 100644
--- a/src/Language/PureScript/Docs/Types.hs
+++ b/src/Language/PureScript/Docs/Types.hs
@@ -31,7 +31,6 @@ import qualified Language.PureScript.AST as P
import qualified Language.PureScript.CoreFn.FromJSON as P
import qualified Language.PureScript.Crash as P
import qualified Language.PureScript.Environment as P
-import qualified Language.PureScript.Kinds as P
import qualified Language.PureScript.Names as P
import qualified Language.PureScript.Types as P
import qualified Paths_purescript as Paths
@@ -45,7 +44,6 @@ import Language.PureScript.Docs.RenderedCode as ReExports
Namespace(..), FixityAlias)
type Type' = P.Type ()
-type Kind' = P.Kind ()
type Constraint' = P.Constraint ()
--------------------
@@ -163,39 +161,34 @@ data DeclarationInfo
-- newtype) and its type arguments. Constructors are represented as child
-- declarations.
--
- | DataDeclaration P.DataDeclType [(Text, Maybe Kind')]
+ | DataDeclaration P.DataDeclType [(Text, Maybe Type')]
-- |
-- A data type foreign import, with its kind.
--
- | ExternDataDeclaration Kind'
+ | ExternDataDeclaration Type'
-- |
-- A type synonym, with its type arguments and its type.
--
- | TypeSynonymDeclaration [(Text, Maybe Kind')] Type'
+ | TypeSynonymDeclaration [(Text, Maybe Type')] Type'
-- |
-- A type class, with its type arguments, its superclasses and functional
-- dependencies. Instances and members are represented as child declarations.
--
- | TypeClassDeclaration [(Text, Maybe Kind')] [Constraint'] [([Text], [Text])]
+ | TypeClassDeclaration [(Text, Maybe Type')] [Constraint'] [([Text], [Text])]
-- |
-- An operator alias declaration, with the member the alias is for and the
-- operator's fixity.
--
| AliasDeclaration P.Fixity FixityAlias
-
- -- |
- -- A kind declaration
- --
- | ExternKindDeclaration
deriving (Show, Eq, Ord, Generic)
instance NFData DeclarationInfo
-convertFundepsToStrings :: [(Text, Maybe Kind')] -> [P.FunctionalDependency] -> [([Text], [Text])]
+convertFundepsToStrings :: [(Text, Maybe Type')] -> [P.FunctionalDependency] -> [([Text], [Text])]
convertFundepsToStrings args fundeps =
map (\(P.FunctionalDependency from to) -> toArgs from to) fundeps
where
@@ -220,7 +213,6 @@ declInfoToString (ExternDataDeclaration _) = "externData"
declInfoToString (TypeSynonymDeclaration _ _) = "typeSynonym"
declInfoToString (TypeClassDeclaration _ _ _) = "typeClass"
declInfoToString (AliasDeclaration _ _) = "alias"
-declInfoToString ExternKindDeclaration = "kind"
declInfoNamespace :: DeclarationInfo -> Namespace
declInfoNamespace = \case
@@ -236,8 +228,6 @@ declInfoNamespace = \case
TypeLevel
AliasDeclaration _ alias ->
either (const TypeLevel) (const ValueLevel) (P.disqualify alias)
- ExternKindDeclaration{} ->
- KindLevel
isTypeClass :: Declaration -> Bool
isTypeClass Declaration{..} =
@@ -271,12 +261,6 @@ isTypeAlias Declaration{..} =
AliasDeclaration _ (P.Qualified _ d) -> isLeft d
_ -> False
-isKind :: Declaration -> Bool
-isKind Declaration{..} =
- case declInfo of
- ExternKindDeclaration{} -> True
- _ -> False
-
-- | Discard any children which do not satisfy the given predicate.
filterChildren :: (ChildDeclaration -> Bool) -> Declaration -> Declaration
filterChildren p decl =
@@ -634,7 +618,7 @@ asDeclarationInfo = do
DataDeclaration <$> key "dataDeclType" asDataDeclType
<*> key "typeArguments" asTypeArguments
"externData" ->
- ExternDataDeclaration <$> key "kind" asKind
+ ExternDataDeclaration <$> key "kind" asType
"typeSynonym" ->
TypeSynonymDeclaration <$> key "arguments" asTypeArguments
<*> key "type" asType
@@ -645,18 +629,16 @@ asDeclarationInfo = do
"alias" ->
AliasDeclaration <$> key "fixity" asFixity
<*> key "alias" asFixityAlias
+ -- Backwards compat: kinds are extern data
"kind" ->
- pure ExternKindDeclaration
+ pure $ ExternDataDeclaration (P.kindType $> ())
other ->
throwCustomError (InvalidDeclarationType other)
-asTypeArguments :: Parse PackageError [(Text, Maybe Kind')]
+asTypeArguments :: Parse PackageError [(Text, Maybe Type')]
asTypeArguments = eachInArray asTypeArgument
where
- asTypeArgument = (,) <$> nth 0 asText <*> nth 1 (perhaps asKind)
-
-asKind :: Parse PackageError Kind'
-asKind = fromAesonParser .! InvalidKind
+ asTypeArgument = (,) <$> nth 0 asText <*> nth 1 (perhaps asType)
asType :: Parse e Type'
asType = fromAesonParser
@@ -700,6 +682,7 @@ asSourcePos = P.SourcePos <$> nth 0 asIntegral
asConstraint :: Parse PackageError Constraint'
asConstraint = P.Constraint () <$> key "constraintClass" asQualifiedProperName
+ <*> keyOrDefault "constraintKindArgs" [] (eachInArray asType)
<*> key "constraintArgs" (eachInArray asType)
<*> pure Nothing
@@ -818,7 +801,6 @@ instance A.ToJSON DeclarationInfo where
TypeSynonymDeclaration args ty -> ["arguments" .= args, "type" .= ty]
TypeClassDeclaration args super fundeps -> ["arguments" .= args, "superclasses" .= super, "fundeps" .= fundeps]
AliasDeclaration fixity alias -> ["fixity" .= fixity, "alias" .= alias]
- ExternKindDeclaration -> []
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
deleted file mode 100644
index 5401991..0000000
--- a/src/Language/PureScript/Environment.hs
+++ /dev/null
@@ -1,622 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Language.PureScript.Environment where
-
-import Prelude.Compat
-import Protolude (ordNub)
-
-import GHC.Generics (Generic)
-import Control.DeepSeq (NFData)
-import Codec.Serialise (Serialise)
-import Data.Aeson ((.=), (.:))
-import qualified Data.Aeson as A
-import qualified Data.Map as M
-import qualified Data.Set as S
-import Data.Maybe (fromMaybe, mapMaybe)
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Tree (Tree, rootLabel)
-import qualified Data.Graph as G
-import Data.Foldable (toList, fold)
-import qualified Data.List.NonEmpty as NEL
-
-import Language.PureScript.AST.SourcePos
-import Language.PureScript.Crash
-import Language.PureScript.Kinds
-import Language.PureScript.Names
-import Language.PureScript.TypeClassDictionaries
-import Language.PureScript.Types
-import qualified Language.PureScript.Constants as C
-
--- | The @Environment@ defines all values and types which are currently in scope:
-data Environment = Environment
- { names :: M.Map (Qualified Ident) (SourceType, NameKind, NameVisibility)
- -- ^ Values currently in scope
- , types :: M.Map (Qualified (ProperName 'TypeName)) (SourceKind, TypeKind)
- -- ^ Type names currently in scope
- , dataConstructors :: M.Map (Qualified (ProperName 'ConstructorName)) (DataDeclType, ProperName 'TypeName, SourceType, [Ident])
- -- ^ Data constructors currently in scope, along with their associated type
- -- constructor name, argument types and return type.
- , typeSynonyms :: M.Map (Qualified (ProperName 'TypeName)) ([(Text, Maybe SourceKind)], SourceType)
- -- ^ Type synonyms currently in scope
- , typeClassDictionaries :: M.Map (Maybe ModuleName) (M.Map (Qualified (ProperName 'ClassName)) (M.Map (Qualified Ident) (NEL.NonEmpty NamedDict)))
- -- ^ Available type class dictionaries. When looking up 'Nothing' in the
- -- outer map, this returns the map of type class dictionaries in local
- -- scope (ie dictionaries brought in by a constrained type).
- , typeClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
- -- ^ Type classes
- , kinds :: S.Set (Qualified (ProperName 'KindName))
- -- ^ Kinds in scope
- } deriving (Show, Generic)
-
-instance NFData Environment
-
--- | Information about a type class
-data TypeClassData = TypeClassData
- { typeClassArguments :: [(Text, Maybe SourceKind)]
- -- ^ A list of type argument names, and their kinds, where kind annotations
- -- were provided.
- , typeClassMembers :: [(Ident, SourceType)]
- -- ^ A list of type class members and their types. Type arguments listed above
- -- are considered bound in these types.
- , typeClassSuperclasses :: [SourceConstraint]
- -- ^ A list of superclasses of this type class. Type arguments listed above
- -- are considered bound in the types appearing in these constraints.
- , typeClassDependencies :: [FunctionalDependency]
- -- ^ A list of functional dependencies for the type arguments of this class.
- , typeClassDeterminedArguments :: S.Set Int
- -- ^ A set of indexes of type argument that are fully determined by other
- -- arguments via functional dependencies. This can be computed from both
- -- typeClassArguments and typeClassDependencies.
- , typeClassCoveringSets :: S.Set (S.Set Int)
- -- ^ A sets of arguments that can be used to infer all other arguments.
- , typeClassIsEmpty :: Bool
- -- ^ Whether or not dictionaries for this type class are necessarily empty.
- } deriving (Show, Generic)
-
-instance NFData TypeClassData
-
--- | A functional dependency indicates a relationship between two sets of
--- type arguments in a class declaration.
-data FunctionalDependency = FunctionalDependency
- { fdDeterminers :: [Int]
- -- ^ the type arguments which determine the determined type arguments
- , fdDetermined :: [Int]
- -- ^ the determined type arguments
- } deriving (Show, Generic)
-
-instance NFData FunctionalDependency
-instance Serialise FunctionalDependency
-
-instance A.FromJSON FunctionalDependency where
- parseJSON = A.withObject "FunctionalDependency" $ \o ->
- FunctionalDependency
- <$> o .: "determiners"
- <*> o .: "determined"
-
-instance A.ToJSON FunctionalDependency where
- toJSON FunctionalDependency{..} =
- A.object [ "determiners" .= fdDeterminers
- , "determined" .= fdDetermined
- ]
-
--- | The initial environment with no values and only the default javascript types defined
-initEnvironment :: Environment
-initEnvironment = Environment M.empty allPrimTypes M.empty M.empty M.empty allPrimClasses allPrimKinds
-
--- | A constructor for TypeClassData that computes which type class arguments are fully determined
--- and argument covering sets.
--- Fully determined means that this argument cannot be used when selecting a type class instance.
--- A covering set is a minimal collection of arguments that can be used to find an instance and
--- therefore determine all other type arguments.
---
--- An example of the difference between determined and fully determined would be with the class:
--- ```class C a b c | a -> b, b -> a, b -> c```
--- In this case, `a` must differ when `b` differs, and vice versa - each is determined by the other.
--- Both `a` and `b` can be used in selecting a type class instance. However, `c` cannot - it is
--- fully determined by `a` and `b`.
---
--- Define a graph of type class arguments with edges being fundep determiners to determined. Each
--- argument also has a self looping edge.
--- An argument is fully determined if doesn't appear at the start of a path of strongly connected components.
--- An argument is not fully determined otherwise.
---
--- The way we compute this is by saying: an argument X is fully determined if there are arguments that
--- determine X that X does not determine. This is the same thing: everything X determines includes everything
--- in its SCC, and everything determining X is either before it in an SCC path, or in the same SCC.
-makeTypeClassData
- :: [(Text, Maybe SourceKind)]
- -> [(Ident, SourceType)]
- -> [SourceConstraint]
- -> [FunctionalDependency]
- -> Bool
- -> TypeClassData
-makeTypeClassData args m s deps tcIsEmpty = TypeClassData args m s deps determinedArgs coveringSets tcIsEmpty
- where
- argumentIndicies = [0 .. length args - 1]
-
- -- each argument determines themselves
- identities = (\i -> (i, [i])) <$> argumentIndicies
-
- -- list all the edges in the graph: for each fundep an edge exists for each determiner to each determined
- contributingDeps = M.fromListWith (++) $ identities ++ do
- fd <- deps
- src <- fdDeterminers fd
- (src, fdDetermined fd) : map (, []) (fdDetermined fd)
-
- -- build a graph of which arguments determine other arguments
- (depGraph, fromVertex, fromKey) = G.graphFromEdges ((\(n, v) -> (n, n, ordNub v)) <$> M.toList contributingDeps)
-
- -- do there exist any arguments that contribute to `arg` that `arg` doesn't contribute to
- isFunDepDetermined :: Int -> Bool
- isFunDepDetermined arg = case fromKey arg of
- Nothing -> internalError "Unknown argument index in makeTypeClassData"
- Just v -> let contributesToVar = G.reachable (G.transposeG depGraph) v
- varContributesTo = G.reachable depGraph v
- in any (\r -> not (r `elem` varContributesTo)) contributesToVar
-
- -- find all the arguments that are determined
- determinedArgs :: S.Set Int
- determinedArgs = S.fromList $ filter isFunDepDetermined argumentIndicies
-
- argFromVertex :: G.Vertex -> Int
- argFromVertex index = let (_, arg, _) = fromVertex index in arg
-
- isVertexDetermined :: G.Vertex -> Bool
- isVertexDetermined = isFunDepDetermined . argFromVertex
-
- -- from an scc find the non-determined args
- sccNonDetermined :: Tree G.Vertex -> Maybe [Int]
- sccNonDetermined tree
- -- if any arg in an scc is determined then all of them are
- | isVertexDetermined (rootLabel tree) = Nothing
- | otherwise = Just (argFromVertex <$> toList tree)
-
- -- find the covering sets
- coveringSets :: S.Set (S.Set Int)
- coveringSets = let funDepSets = sequence (mapMaybe sccNonDetermined (G.scc depGraph))
- in S.fromList (S.fromList <$> funDepSets)
-
--- | The visibility of a name in scope
-data NameVisibility
- = Undefined
- -- ^ The name is defined in the current binding group, but is not visible
- | Defined
- -- ^ The name is defined in the another binding group, or has been made visible by a function binder
- deriving (Show, Eq, Generic)
-
-instance NFData NameVisibility
-instance Serialise NameVisibility
-
--- | A flag for whether a name is for an private or public value - only public values will be
--- included in a generated externs file.
-data NameKind
- = Private
- -- ^ A private value introduced as an artifact of code generation (class instances, class member
- -- accessors, etc.)
- | Public
- -- ^ A public value for a module member or foreing import declaration
- | External
- -- ^ A name for member introduced by foreign import
- deriving (Show, Eq, Generic)
-
-instance NFData NameKind
-instance Serialise NameKind
-
--- | The kinds of a type
-data TypeKind
- = DataType [(Text, Maybe SourceKind)] [(ProperName 'ConstructorName, [SourceType])]
- -- ^ Data type
- | TypeSynonym
- -- ^ Type synonym
- | ExternData
- -- ^ Foreign data
- | LocalTypeVariable
- -- ^ A local type variable
- | ScopedTypeVar
- -- ^ A scoped type variable
- deriving (Show, Eq, Generic)
-
-instance NFData TypeKind
-instance Serialise TypeKind
-
-instance A.ToJSON TypeKind where
- toJSON (DataType args ctors) =
- A.object [ T.pack "DataType" .= A.object ["args" .= args, "ctors" .= ctors] ]
- toJSON TypeSynonym = A.toJSON (T.pack "TypeSynonym")
- toJSON ExternData = A.toJSON (T.pack "ExternData")
- toJSON LocalTypeVariable = A.toJSON (T.pack "LocalTypeVariable")
- toJSON ScopedTypeVar = A.toJSON (T.pack "ScopedTypeVar")
-
-instance A.FromJSON TypeKind where
- parseJSON (A.Object o) = do
- args <- o .: "DataType"
- A.withObject "args" (\o1 ->
- DataType <$> o1 .: "args"
- <*> o1 .: "ctors") args
- parseJSON (A.String s) =
- case s of
- "TypeSynonym" -> pure TypeSynonym
- "ExternData" -> pure ExternData
- "LocalTypeVariable" -> pure LocalTypeVariable
- "ScopedTypeVar" -> pure ScopedTypeVar
- _ -> fail "Unknown TypeKind"
- parseJSON _ = fail "Invalid TypeKind"
-
--- | The type ('data' or 'newtype') of a data type declaration
-data DataDeclType
- = Data
- -- ^ A standard data constructor
- | Newtype
- -- ^ A newtype constructor
- deriving (Show, Eq, Ord, Generic)
-
-instance NFData DataDeclType
-instance Serialise DataDeclType
-
-showDataDeclType :: DataDeclType -> Text
-showDataDeclType Data = "data"
-showDataDeclType Newtype = "newtype"
-
-instance A.ToJSON DataDeclType where
- toJSON = A.toJSON . showDataDeclType
-
-instance A.FromJSON DataDeclType where
- parseJSON = A.withText "DataDeclType" $ \str ->
- case str of
- "data" -> return Data
- "newtype" -> return Newtype
- other -> fail $ "invalid type: '" ++ T.unpack other ++ "'"
-
--- | Construct a ProperName in the Prim module
-primName :: Text -> Qualified (ProperName a)
-primName = Qualified (Just C.Prim) . ProperName
-
--- | Construct a 'ProperName' in the @Prim.NAME@ module.
-primSubName :: Text -> Text -> Qualified (ProperName a)
-primSubName sub =
- Qualified (Just $ ModuleName $ C.prim <> "." <> sub) . ProperName
-
-primKind :: Text -> SourceKind
-primKind = NamedKind nullSourceAnn . primName
-
-primSubKind :: Text -> Text -> SourceKind
-primSubKind sub = NamedKind nullSourceAnn . primSubName sub
-
--- | Kind of ground types
-kindType :: SourceKind
-kindType = primKind C.typ
-
-kindConstraint :: SourceKind
-kindConstraint = kindType
-
-isKindType :: Kind a -> Bool
-isKindType (NamedKind _ n) = n == primName C.typ
-isKindType _ = False
-
--- To make reading the kind signatures below easier
-(-:>) :: SourceKind -> SourceKind -> SourceKind
-(-:>) = FunKind nullSourceAnn
-infixr 4 -:>
-
-kindSymbol :: SourceKind
-kindSymbol = primKind C.symbol
-
-kindDoc :: SourceKind
-kindDoc = primSubKind C.typeError C.doc
-
-kindBoolean :: SourceKind
-kindBoolean = primSubKind C.moduleBoolean C.kindBoolean
-
-kindOrdering :: SourceKind
-kindOrdering = primSubKind C.moduleOrdering C.kindOrdering
-
-kindRowList :: SourceKind
-kindRowList = primSubKind C.moduleRowList C.kindRowList
-
-kindRow :: SourceKind -> SourceKind
-kindRow = Row nullSourceAnn
-
--- | Construct a type in the Prim module
-primTy :: Text -> SourceType
-primTy = TypeConstructor nullSourceAnn . primName
-
--- | Type constructor for functions
-tyFunction :: SourceType
-tyFunction = primTy "Function"
-
--- | Type constructor for strings
-tyString :: SourceType
-tyString = primTy "String"
-
--- | Type constructor for strings
-tyChar :: SourceType
-tyChar = primTy "Char"
-
--- | Type constructor for numbers
-tyNumber :: SourceType
-tyNumber = primTy "Number"
-
--- | Type constructor for integers
-tyInt :: SourceType
-tyInt = primTy "Int"
-
--- | Type constructor for booleans
-tyBoolean :: SourceType
-tyBoolean = primTy "Boolean"
-
--- | Type constructor for arrays
-tyArray :: SourceType
-tyArray = primTy "Array"
-
--- | Type constructor for records
-tyRecord :: SourceType
-tyRecord = primTy "Record"
-
--- | Check whether a type is a record
-isObject :: Type a -> Bool
-isObject = isTypeOrApplied tyRecord
-
--- | Check whether a type is a function
-isFunction :: Type a -> Bool
-isFunction = isTypeOrApplied tyFunction
-
-isTypeOrApplied :: Type a -> Type b -> Bool
-isTypeOrApplied t1 (TypeApp _ t2 _) = eqType t1 t2
-isTypeOrApplied t1 t2 = eqType t1 t2
-
--- | Smart constructor for function types
-function :: SourceType -> SourceType -> SourceType
-function t1 t2 = TypeApp nullSourceAnn (TypeApp nullSourceAnn tyFunction t1) t2
-
--- | Kinds in @Prim@
-primKinds :: S.Set (Qualified (ProperName 'KindName))
-primKinds = S.fromList
- [ primName C.typ
- , primName C.symbol
- ]
-
--- | Kinds in @Prim.Boolean@
-primBooleanKinds :: S.Set (Qualified (ProperName 'KindName))
-primBooleanKinds = S.fromList
- [ primSubName C.moduleBoolean C.kindBoolean
- ]
-
--- | Kinds in @Prim.Ordering@
-primOrderingKinds :: S.Set (Qualified (ProperName 'KindName))
-primOrderingKinds = S.fromList
- [ primSubName C.moduleOrdering C.kindOrdering
- ]
-
--- | Kinds in @Prim.RowList@
-primRowListKinds :: S.Set (Qualified (ProperName 'KindName))
-primRowListKinds = S.fromList
- [ primSubName C.moduleRowList C.kindRowList
- ]
-
--- | Kinds in @Prim.TypeError@
-primTypeErrorKinds :: S.Set (Qualified (ProperName 'KindName))
-primTypeErrorKinds = S.fromList
- [ primSubName C.typeError C.doc
- ]
-
--- | All primitive kinds
-allPrimKinds :: S.Set (Qualified (ProperName 'KindName))
-allPrimKinds = fold
- [ primKinds
- , primBooleanKinds
- , primOrderingKinds
- , primRowListKinds
- , primTypeErrorKinds
- ]
-
--- | The primitive types in the external javascript environment with their
--- associated kinds. There are also pseudo `Fail`, `Warn`, and `Partial` types
--- that correspond to the classes with the same names.
-primTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceKind, TypeKind)
-primTypes = M.fromList
- [ (primName "Function", (kindType -:> kindType -:> kindType, ExternData))
- , (primName "Array", (kindType -:> kindType, ExternData))
- , (primName "Record", (kindRow kindType -:> kindType, ExternData))
- , (primName "String", (kindType, ExternData))
- , (primName "Char", (kindType, ExternData))
- , (primName "Number", (kindType, ExternData))
- , (primName "Int", (kindType, ExternData))
- , (primName "Boolean", (kindType, ExternData))
- , (primName "Partial", (kindConstraint, ExternData))
- ]
-
--- | This 'Map' contains all of the prim types from all Prim modules.
-allPrimTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceKind, TypeKind)
-allPrimTypes = M.unions
- [ primTypes
- , primBooleanTypes
- , primOrderingTypes
- , primRowTypes
- , primRowListTypes
- , primSymbolTypes
- , primTypeErrorTypes
- ]
-
-primBooleanTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceKind, TypeKind)
-primBooleanTypes =
- M.fromList
- [ (primSubName C.moduleBoolean "True", (kindBoolean, ExternData))
- , (primSubName C.moduleBoolean "False", (kindBoolean, ExternData))
- ]
-
-primOrderingTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceKind, TypeKind)
-primOrderingTypes =
- M.fromList
- [ (primSubName C.moduleOrdering "LT", (kindOrdering, ExternData))
- , (primSubName C.moduleOrdering "EQ", (kindOrdering, ExternData))
- , (primSubName C.moduleOrdering "GT", (kindOrdering, ExternData))
- ]
-
-primRowTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceKind, TypeKind)
-primRowTypes =
- M.fromList
- [ (primSubName C.moduleRow "Union", (kindRow kindType -:> kindRow kindType -:> kindRow kindType -:> kindConstraint, ExternData))
- , (primSubName C.moduleRow "Nub", (kindRow kindType -:> kindRow kindType -:> kindConstraint, ExternData))
- , (primSubName C.moduleRow "Lacks", (kindSymbol -:> kindRow kindType -:> kindConstraint, ExternData))
- , (primSubName C.moduleRow "Cons", (kindSymbol -:> kindType -:> kindRow kindType -:> kindRow kindType -:> kindConstraint, ExternData))
- ]
-
-primRowListTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceKind, TypeKind)
-primRowListTypes =
- M.fromList
- [ (primSubName C.moduleRowList "Cons", (kindSymbol -:> kindType -:> kindRowList -:> kindRowList, ExternData))
- , (primSubName C.moduleRowList "Nil", (kindRowList, ExternData))
- , (primSubName C.moduleRowList "RowToList", (kindRow kindType -:> kindRowList -:> kindConstraint, ExternData))
- ]
-
-primSymbolTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceKind, TypeKind)
-primSymbolTypes =
- M.fromList
- [ (primSubName C.moduleSymbol "Append", (kindSymbol -:> kindSymbol -:> kindSymbol -:> kindConstraint, ExternData))
- , (primSubName C.moduleSymbol "Compare", (kindSymbol -:> kindSymbol -:> kindOrdering -:> kindConstraint, ExternData))
- , (primSubName C.moduleSymbol "Cons", (kindSymbol -:> kindSymbol -:> kindSymbol -:> kindConstraint, ExternData))
- ]
-
-primTypeErrorTypes :: M.Map (Qualified (ProperName 'TypeName)) (SourceKind, TypeKind)
-primTypeErrorTypes =
- M.fromList
- [ (primSubName C.typeError "Fail", (kindDoc -:> kindConstraint, ExternData))
- , (primSubName C.typeError "Warn", (kindDoc -:> kindConstraint, ExternData))
- , (primSubName C.typeError "Text", (kindSymbol -:> kindDoc, ExternData))
- , (primSubName C.typeError "Quote", (kindType -:> kindDoc, ExternData))
- , (primSubName C.typeError "QuoteLabel", (kindSymbol -:> kindDoc, ExternData))
- , (primSubName C.typeError "Beside", (kindDoc -:> kindDoc -:> kindDoc, ExternData))
- , (primSubName C.typeError "Above", (kindDoc -:> kindDoc -:> kindDoc, ExternData))
- ]
-
--- | The primitive class map. This just contains the `Partial` class.
--- `Partial` is used as a kind of magic constraint for partial functions.
-primClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
-primClasses =
- M.fromList
- [ (primName "Partial", (makeTypeClassData [] [] [] [] True))
- ]
-
--- | This contains all of the type classes from all Prim modules.
-allPrimClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
-allPrimClasses = M.unions
- [ primClasses
- , primRowClasses
- , primRowListClasses
- , primSymbolClasses
- , primTypeErrorClasses
- ]
-
-primRowClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
-primRowClasses =
- M.fromList
- -- class Union (left :: # Type) (right :: # Type) (union :: # Type) | left right -> union, right union -> left, union left -> right
- [ (primSubName C.moduleRow "Union", makeTypeClassData
- [ ("left", Just (kindRow kindType))
- , ("right", Just (kindRow kindType))
- , ("union", Just (kindRow kindType))
- ] [] []
- [ FunctionalDependency [0, 1] [2]
- , FunctionalDependency [1, 2] [0]
- , FunctionalDependency [2, 0] [1]
- ] True)
-
- -- class Nub (original :: # Type) (nubbed :: # Type) | i -> o
- , (primSubName C.moduleRow "Nub", makeTypeClassData
- [ ("original", Just (kindRow kindType))
- , ("nubbed", Just (kindRow kindType))
- ] [] []
- [ FunctionalDependency [0] [1]
- ] True)
-
- -- class Lacks (label :: Symbol) (row :: # Type)
- , (primSubName C.moduleRow "Lacks", makeTypeClassData
- [ ("label", Just kindSymbol)
- , ("row", Just (kindRow kindType))
- ] [] [] [] True)
-
- -- class RowCons (label :: Symbol) (a :: Type) (tail :: # Type) (row :: # Type) | label tail a -> row, label row -> tail a
- , (primSubName C.moduleRow "Cons", makeTypeClassData
- [ ("label", Just kindSymbol)
- , ("a", Just kindType)
- , ("tail", Just (kindRow kindType))
- , ("row", Just (kindRow kindType))
- ] [] []
- [ FunctionalDependency [0, 1, 2] [3]
- , FunctionalDependency [0, 3] [1, 2]
- ] True)
- ]
-
-primRowListClasses :: M.Map (Qualified (ProperName 'ClassName)) TypeClassData
-primRowListClasses =
- M.fromList
- -- class RowToList (row :: # Type) (list :: RowList) | row -> list
- [ (primSubName C.moduleRowList "RowToList", makeTypeClassData
- [ ("row", Just (kindRow kindType))
- , ("list", Just kindRowList)
- ] [] []
- [ FunctionalDependency [0] [1]
- ] True)
- ]</