diff --git a/bin/docs-search-app.js.map b/bin/docs-search-app.js.map new file mode 100644 index 000000000..82d102dc0 --- /dev/null +++ b/bin/docs-search-app.js.map @@ -0,0 +1,7 @@ +{ + "version": 3, + "sources": ["../output/Data.Functor/foreign.js", "../.spago/p/prelude-6.0.1/src/Control/Semigroupoid.purs", "../.spago/p/prelude-6.0.1/src/Control/Category.purs", "../.spago/p/prelude-6.0.1/src/Data/Boolean.purs", "../.spago/p/prelude-6.0.1/src/Data/Function.purs", "../.spago/p/prelude-6.0.1/src/Type/Proxy.purs", "../.spago/p/prelude-6.0.1/src/Data/Functor.purs", "../output/Data.Semigroup/foreign.js", "../.spago/p/prelude-6.0.1/src/Data/Symbol.purs", "../output/Record.Unsafe/foreign.js", "../.spago/p/prelude-6.0.1/src/Data/Semigroup.purs", "../.spago/p/control-6.0.0/src/Control/Alt.purs", "../output/Control.Apply/foreign.js", "../.spago/p/prelude-6.0.1/src/Control/Apply.purs", "../.spago/p/prelude-6.0.1/src/Control/Applicative.purs", "../output/Control.Bind/foreign.js", "../.spago/p/prelude-6.0.1/src/Control/Bind.purs", "../output/Data.Eq/foreign.js", "../.spago/p/prelude-6.0.1/src/Data/Eq.purs", "../output/Data.Foldable/foreign.js", "../.spago/p/control-6.0.0/src/Control/Plus.purs", "../output/Data.Bounded/foreign.js", "../output/Data.Ord/foreign.js", "../.spago/p/prelude-6.0.1/src/Data/Ordering.purs", "../output/Data.Ring/foreign.js", "../output/Data.Semiring/foreign.js", "../.spago/p/prelude-6.0.1/src/Data/Semiring.purs", "../.spago/p/prelude-6.0.1/src/Data/Ring.purs", "../.spago/p/prelude-6.0.1/src/Data/Ord.purs", "../.spago/p/prelude-6.0.1/src/Data/Bounded.purs", "../output/Data.Show/foreign.js", "../.spago/p/prelude-6.0.1/src/Data/Show.purs", "../.spago/p/maybe-6.0.0/src/Data/Maybe.purs", "../.spago/p/either-6.1.0/src/Data/Either.purs", "../.spago/p/control-6.0.0/src/Control/Lazy.purs", "../output/Data.HeytingAlgebra/foreign.js", "../.spago/p/prelude-6.0.1/src/Data/HeytingAlgebra.purs", "../output/Data.EuclideanRing/foreign.js", "../.spago/p/prelude-6.0.1/src/Data/CommutativeRing.purs", "../.spago/p/prelude-6.0.1/src/Data/EuclideanRing.purs", "../.spago/p/prelude-6.0.1/src/Data/Monoid.purs", "../.spago/p/tuples-7.0.0/src/Data/Tuple.purs", "../.spago/p/bifunctors-6.0.0/src/Data/Bifunctor.purs", "../.spago/p/maybe-6.0.0/src/Data/Maybe/First.purs", "../.spago/p/prelude-6.0.1/src/Data/Monoid/Disj.purs", "../output/Unsafe.Coerce/foreign.js", "../.spago/p/safe-coerce-2.0.0/src/Safe/Coerce.purs", "../.spago/p/newtype-5.0.0/src/Data/Newtype.purs", "../.spago/p/foldable-traversable-6.0.0/src/Data/Foldable.purs", "../output/Data.FunctorWithIndex/foreign.js", "../.spago/p/identity-6.0.0/src/Data/Identity.purs", "../.spago/p/foldable-traversable-6.0.0/src/Data/FunctorWithIndex.purs", "../.spago/p/foldable-traversable-6.0.0/src/Data/FoldableWithIndex.purs", "../output/Data.Traversable/foreign.js", "../.spago/p/foldable-traversable-6.0.0/src/Data/Traversable.purs", "../.spago/p/foldable-traversable-6.0.0/src/Data/TraversableWithIndex.purs", "../output/Data.Unfoldable/foreign.js", "../output/Data.Unfoldable1/foreign.js", "../.spago/p/unfoldable-6.0.0/src/Data/Unfoldable1.purs", "../.spago/p/unfoldable-6.0.0/src/Data/Unfoldable.purs", "../.spago/p/nonempty-7.0.0/src/Data/NonEmpty.purs", "../.spago/p/lists-7.0.0/src/Data/List/Types.purs", "../.spago/p/ordered-collections-3.2.0/src/Data/Map/Internal.purs", "../output/Foreign/foreign.js", "../output/Effect/foreign.js", "../.spago/p/prelude-6.0.1/src/Control/Monad.purs", "../.spago/p/effect-4.0.0/src/Effect.purs", "../output/Effect.Exception/foreign.js", "../.spago/p/exceptions-6.1.0/src/Effect/Exception.purs", "../.spago/p/transformers-6.1.0/src/Control/Monad/Error/Class.purs", "../output/Effect.Ref/foreign.js", "../.spago/p/refs-6.0.0/src/Effect/Ref.purs", "../.spago/p/tailrec-6.1.0/src/Control/Monad/Rec/Class.purs", "../output/Control.Monad.ST.Internal/foreign.js", "../.spago/p/st-6.2.0/src/Control/Monad/ST/Internal.purs", "../.spago/p/transformers-6.1.0/src/Control/Monad/State/Class.purs", "../.spago/p/transformers-6.1.0/src/Control/Monad/Writer/Class.purs", "../.spago/p/effect-4.0.0/src/Effect/Class.purs", "../.spago/p/transformers-6.1.0/src/Control/Monad/Except/Trans.purs", "../output/Data.Int/foreign.js", "../output/Data.Number/foreign.js", "../.spago/p/integers-6.0.0/src/Data/Int.purs", "../.spago/p/lists-7.0.0/src/Data/List.purs", "../output/Partial.Unsafe/foreign.js", "../output/Partial/foreign.js", "../.spago/p/partial-4.0.0/src/Partial.purs", "../.spago/p/partial-4.0.0/src/Partial/Unsafe.purs", "../.spago/p/lists-7.0.0/src/Data/List/NonEmpty.purs", "../output/Data.String.CodeUnits/foreign.js", "../output/Data.String.Unsafe/foreign.js", "../.spago/p/strings-6.0.1/src/Data/String/CodeUnits.purs", "../.spago/p/foreign-7.0.0/src/Foreign.purs", "../output/Foreign.Object/foreign.js", "../output/Data.Array/foreign.js", "../output/Data.Array.ST/foreign.js", "../output/Control.Monad.ST.Uncurried/foreign.js", "../.spago/p/arrays-7.3.0/src/Data/Array/ST.purs", "../output/Data.Function.Uncurried/foreign.js", "../.spago/p/arrays-7.3.0/src/Data/Array.purs", "../output/Foreign.Object.ST/foreign.js", "../.spago/p/foreign-object-4.1.0/src/Foreign/Object.purs", "../.spago/p/options-7.0.0/src/Data/Options.purs", "../.spago/p/css-6.0.0/src/CSS/String.purs", "../output/Data.String.CodePoints/foreign.js", "../output/Data.Enum/foreign.js", "../.spago/p/enums-6.0.1/src/Data/Enum.purs", "../output/Data.String.Common/foreign.js", "../.spago/p/strings-6.0.1/src/Data/String/Common.purs", "../.spago/p/strings-6.0.1/src/Data/String/CodePoints.purs", "../.spago/p/colors-7.0.1/src/Color.purs", "../.spago/p/profunctor-6.0.1/src/Data/Profunctor.purs", "../.spago/p/profunctor-6.0.1/src/Data/Profunctor/Strong.purs", "../.spago/p/css-6.0.0/src/CSS/Property.purs", "../.spago/p/css-6.0.0/src/CSS/Common.purs", "../.spago/p/exists-6.0.0/src/Data/Exists.purs", "../.spago/p/css-6.0.0/src/CSS/Size.purs", "../.spago/p/transformers-6.1.0/src/Control/Monad/Writer/Trans.purs", "../.spago/p/transformers-6.1.0/src/Control/Monad/Writer.purs", "../.spago/p/css-6.0.0/src/CSS/Stylesheet.purs", "../.spago/p/css-6.0.0/src/CSS/Border.purs", "../.spago/p/css-6.0.0/src/CSS/Display.purs", "../.spago/p/css-6.0.0/src/CSS/Font.purs", "../.spago/p/css-6.0.0/src/CSS/Geometry.purs", "../.spago/p/dom-indexed-12.0.0/src/DOM/HTML/Indexed/InputType.purs", "../output/Docs.Search.URIHash/foreign.js", "../output/JSURI/foreign.js", "../.spago/p/js-uri-3.1.0/src/JSURI.purs", "../output/Web.HTML/foreign.js", "../output/Web.Internal.FFI/foreign.js", "../.spago/p/web-events-4.0.0/src/Web/Internal/FFI.purs", "../output/Data.Nullable/foreign.js", "../.spago/p/nullable-6.0.0/src/Data/Nullable.purs", "../.spago/p/web-html-4.1.0/src/Web/HTML/HTMLDocument.purs", "../output/Web.HTML.HTMLElement/foreign.js", "../.spago/p/web-html-4.1.0/src/Web/HTML/HTMLElement.purs", "../output/Effect.Uncurried/foreign.js", "../output/Web.HTML.HTMLInputElement/foreign.js", "../.spago/p/web-html-4.1.0/src/Web/HTML/HTMLInputElement.purs", "../output/Web.HTML.Location/foreign.js", "../output/Web.HTML.Window/foreign.js", "../.spago/p/web-html-4.1.0/src/Web/HTML/Window.purs", "../docs-search/client-halogen/src/Docs/Search/URIHash.purs", "../output/Effect.Aff/foreign.js", "../.spago/p/type-equality-4.0.1/src/Type/Equality.purs", "../.spago/p/parallel-7.0.0/src/Control/Parallel/Class.purs", "../.spago/p/parallel-7.0.0/src/Control/Parallel.purs", "../output/Effect.Unsafe/foreign.js", "../.spago/p/aff-7.1.0/src/Effect/Aff.purs", "../.spago/p/free-7.1.0/src/Data/Coyoneda.purs", "../.spago/p/halogen-7.0.0/src/Halogen/Data/Slot.purs", "../.spago/p/halogen-7.0.0/src/Halogen/Query/Input.purs", "../.spago/p/halogen-vdom-8.0.0/src/Halogen/VDom/Machine.purs", "../.spago/p/halogen-vdom-8.0.0/src/Halogen/VDom/Types.purs", "../output/Halogen.VDom.Util/foreign.js", "../.spago/p/halogen-vdom-8.0.0/src/Halogen/VDom/Util.purs", "../output/Web.DOM.Element/foreign.js", "../output/Web.DOM.ParentNode/foreign.js", "../.spago/p/web-dom-6.0.0/src/Web/DOM/ParentNode.purs", "../.spago/p/web-dom-6.0.0/src/Web/DOM/Element.purs", "../.spago/p/halogen-vdom-8.0.0/src/Halogen/VDom/DOM.purs", "../output/Web.Event.EventTarget/foreign.js", "../.spago/p/halogen-vdom-8.0.0/src/Halogen/VDom/DOM/Prop.purs", "../.spago/p/halogen-7.0.0/src/Halogen/HTML/Core.purs", "../.spago/p/freeap-7.0.0/src/Control/Applicative/Free.purs", "../.spago/p/catenable-lists-7.0.0/src/Data/CatQueue.purs", "../.spago/p/catenable-lists-7.0.0/src/Data/CatList.purs", "../.spago/p/free-7.1.0/src/Control/Monad/Free.purs", "../.spago/p/transformers-6.1.0/src/Control/Monad/State/Trans.purs", "../.spago/p/aff-7.1.0/src/Effect/Aff/Class.purs", "../.spago/p/halogen-7.0.0/src/Halogen/Query/ChildQuery.purs", "../output/Unsafe.Reference/foreign.js", "../.spago/p/unsafe-reference-5.0.0/src/Unsafe/Reference.purs", "../.spago/p/halogen-subscriptions-2.0.0/src/Halogen/Subscription.purs", "../.spago/p/halogen-7.0.0/src/Halogen/Query/HalogenM.purs", "../.spago/p/halogen-7.0.0/src/Halogen/Query/HalogenQ.purs", "../.spago/p/halogen-vdom-8.0.0/src/Halogen/VDom/Thunk.purs", "../.spago/p/halogen-7.0.0/src/Halogen/Component.purs", "../output/Effect.Console/foreign.js", "../.spago/p/css-6.0.0/src/CSS/Render.purs", "../.spago/p/halogen-7.0.0/src/Halogen/HTML/Elements.purs", "../.spago/p/halogen-7.0.0/src/Halogen/HTML/Properties.purs", "../.spago/p/halogen-css-10.0.0/src/Halogen/HTML/CSS.purs", "../.spago/p/transformers-6.1.0/src/Control/Monad/Except.purs", "../output/Foreign.Index/foreign.js", "../.spago/p/foreign-7.0.0/src/Foreign/Index.purs", "../output/Web.Event.Event/foreign.js", "../.spago/p/web-events-4.0.0/src/Web/Event/Event.purs", "../.spago/p/web-html-4.1.0/src/Web/HTML/Event/EventTypes.purs", "../.spago/p/web-uievents-5.0.0/src/Web/UIEvent/FocusEvent/EventTypes.purs", "../.spago/p/web-uievents-5.0.0/src/Web/UIEvent/KeyboardEvent/EventTypes.purs", "../.spago/p/web-uievents-5.0.0/src/Web/UIEvent/MouseEvent/EventTypes.purs", "../.spago/p/halogen-7.0.0/src/Halogen/HTML/Events.purs", "../.spago/p/halogen-7.0.0/src/Halogen/Query/Event.purs", "../output/Web.DOM.Document/foreign.js", "../.spago/p/web-dom-6.0.0/src/Web/DOM/Document.purs", "../output/Web.UIEvent.KeyboardEvent/foreign.js", "../.spago/p/web-uievents-5.0.0/src/Web/UIEvent/KeyboardEvent.purs", "../docs-search/client-halogen/src/Docs/Search/App/SearchField.purs", "../output/Docs.Search.BrowserEngine/foreign.js", "../output/Control.Promise/foreign.js", "../.spago/p/aff-promise-4.0.0/src/Control/Promise.purs", "../output/JSON/foreign.js", "../output/JSON.Internal/foreign.js", "../.spago/p/json-1.1.0/src/JSON.purs", "../.spago/p/json-1.1.0/src/JSON/Array.purs", "../.spago/p/json-1.1.0/src/JSON/Object.purs", "../.spago/p/json-1.1.0/src/JSON/Path.purs", "../.spago/p/codec-json-2.0.0/src/Data/Codec/JSON/DecodeError.purs", "../.spago/p/codec-6.1.0/src/Data/Codec.purs", "../.spago/p/codec-json-2.0.0/src/Data/Codec/JSON.purs", "../.spago/p/ordered-collections-3.2.0/src/Data/Set.purs", "../.spago/p/codec-json-2.0.0/src/Data/Codec/JSON/Common.purs", "../.spago/p/search-trie/e7f7f22486a1dba22171ec885dbc2149dc815119/src/Data/Search/Trie/Internal.purs", "../.spago/p/strings-6.0.1/src/Data/Char.purs", "../.spago/p/variant-8.0.0/src/Data/Variant.purs", "../.spago/p/record-4.0.0/src/Record.purs", "../.spago/p/codec-json-2.0.0/src/Data/Codec/JSON/Variant.purs", "../output/Data.Argonaut.Core/foreign.js", "../.spago/p/argonaut-core-7.0.0/src/Data/Argonaut/Core.purs", "../.spago/p/json-codecs-4.0.0/src/Codec/Json/Unidirectional/Value.purs", "../docs-search/common/src/Docs/Search/JsonCodec.purs", "../.spago/p/language-purescript/db4377dea03ba9c5273a93a8368a53f1d87882c1/src/Language/PureScript/AST/SourcePos.purs", "../.spago/p/language-purescript/db4377dea03ba9c5273a93a8368a53f1d87882c1/src/Language/PureScript/Names.purs", "../.spago/p/language-purescript/db4377dea03ba9c5273a93a8368a53f1d87882c1/src/Web/Bower/PackageMeta.purs", "../docs-search/common/src/Docs/Search/Types.purs", "../docs-search/common/src/Docs/Search/Config.purs", "../output/Docs.Search.ModuleIndex/foreign.js", "../.spago/p/transformers-6.1.0/src/Control/Monad/State.purs", "../.spago/p/profunctor-lenses-8.0.0/src/Data/Lens/Lens.purs", "../.spago/p/profunctor-lenses-8.0.0/src/Data/Lens/Record.purs", "../.spago/p/profunctor-lenses-8.0.0/src/Data/Lens/Setter.purs", "../docs-search/common/src/Docs/Search/Extra.purs", "../docs-search/common/src/Docs/Search/Score.purs", "../docs-search/common/src/Docs/Search/ModuleIndex.purs", "../.spago/p/codec-json-2.0.0/src/Data/Codec/JSON/Record.purs", "../output/Docs.Search.Loader/foreign.js", "../docs-search/common/src/Docs/Search/Loader.purs", "../docs-search/common/src/Docs/Search/PackageIndex.purs", "../docs-search/common/src/Docs/Search/DocsJson.purs", "../.spago/p/language-purescript/db4377dea03ba9c5273a93a8368a53f1d87882c1/src/Language/PureScript/Constants/Prim.purs", "../output/Language.PureScript.PSString/foreign.js", "../.spago/p/language-purescript/db4377dea03ba9c5273a93a8368a53f1d87882c1/src/Data/CodeUnit.purs", "../.spago/p/language-purescript/db4377dea03ba9c5273a93a8368a53f1d87882c1/src/Language/PureScript/PSString.purs", "../.spago/p/language-purescript/db4377dea03ba9c5273a93a8368a53f1d87882c1/src/Language/PureScript/Label.purs", "../.spago/p/language-purescript/db4377dea03ba9c5273a93a8368a53f1d87882c1/src/Language/PureScript/Types.purs", "../.spago/p/language-purescript/db4377dea03ba9c5273a93a8368a53f1d87882c1/src/Language/PureScript/Environment.purs", "../docs-search/common/src/Docs/Search/TypeDecoder.purs", "../docs-search/common/src/Docs/Search/SearchResult.purs", "../output/Docs.Search.TypeIndex/foreign.js", "../.spago/p/string-parsers-8.0.0/src/StringParser/Parser.purs", "../.spago/p/string-parsers-8.0.0/src/StringParser/Combinators.purs", "../.spago/p/string-parsers-8.0.0/src/StringParser/CodeUnits.purs", "../.spago/p/string-parsers-8.0.0/src/StringParser/CodePoints.purs", "../docs-search/common/src/Docs/Search/TypeQuery.purs", "../docs-search/common/src/Docs/Search/Declarations.purs", "../output/Docs.Search.TypeShape/foreign.js", "../docs-search/common/src/Docs/Search/TypeShape.purs", "../docs-search/common/src/Docs/Search/TypeIndex.purs", "../docs-search/client-halogen/src/Docs/Search/BrowserEngine.purs", "../docs-search/common/src/Docs/Search/Engine.purs", "../output/Html.Parser/foreign.js", "../.spago/p/html-parser-halogen/035a51d02ba9f8b70c3ffd9fe31a3f5bed19941c/src/Html/Parser.purs", "../.spago/p/html-parser-halogen/035a51d02ba9f8b70c3ffd9fe31a3f5bed19941c/src/Html/Renderer/Halogen.purs", "../node_modules/markdown-it/lib/common/utils.mjs", "../node_modules/mdurl/index.mjs", "../node_modules/mdurl/lib/decode.mjs", "../node_modules/mdurl/lib/encode.mjs", "../node_modules/mdurl/lib/format.mjs", "../node_modules/mdurl/lib/parse.mjs", "../node_modules/uc.micro/index.mjs", "../node_modules/uc.micro/properties/Any/regex.mjs", "../node_modules/uc.micro/categories/Cc/regex.mjs", "../node_modules/uc.micro/categories/Cf/regex.mjs", "../node_modules/uc.micro/categories/P/regex.mjs", "../node_modules/uc.micro/categories/S/regex.mjs", "../node_modules/uc.micro/categories/Z/regex.mjs", "../node_modules/entities/lib/esm/generated/generated/decode-data-html.ts", "../node_modules/entities/lib/esm/generated/generated/decode-data-xml.ts", "../node_modules/entities/lib/esm/decode_codepoint.ts", "../node_modules/entities/lib/esm/decode.ts", "../node_modules/entities/lib/esm/generated/generated/encode-html.ts", "../node_modules/entities/lib/esm/escape.ts", "../node_modules/entities/lib/esm/index.ts", "../node_modules/markdown-it/lib/helpers/index.mjs", "../node_modules/markdown-it/lib/helpers/parse_link_label.mjs", "../node_modules/markdown-it/lib/helpers/parse_link_destination.mjs", "../node_modules/markdown-it/lib/helpers/parse_link_title.mjs", "../node_modules/markdown-it/lib/renderer.mjs", "../node_modules/markdown-it/lib/ruler.mjs", "../node_modules/markdown-it/lib/token.mjs", "../node_modules/markdown-it/lib/rules_core/state_core.mjs", "../node_modules/markdown-it/lib/rules_core/normalize.mjs", "../node_modules/markdown-it/lib/rules_core/block.mjs", "../node_modules/markdown-it/lib/rules_core/inline.mjs", "../node_modules/markdown-it/lib/rules_core/linkify.mjs", "../node_modules/markdown-it/lib/rules_core/replacements.mjs", "../node_modules/markdown-it/lib/rules_core/smartquotes.mjs", "../node_modules/markdown-it/lib/rules_core/text_join.mjs", "../node_modules/markdown-it/lib/parser_core.mjs", "../node_modules/markdown-it/lib/rules_block/state_block.mjs", "../node_modules/markdown-it/lib/rules_block/table.mjs", "../node_modules/markdown-it/lib/rules_block/code.mjs", "../node_modules/markdown-it/lib/rules_block/fence.mjs", "../node_modules/markdown-it/lib/rules_block/blockquote.mjs", "../node_modules/markdown-it/lib/rules_block/hr.mjs", "../node_modules/markdown-it/lib/rules_block/list.mjs", "../node_modules/markdown-it/lib/rules_block/reference.mjs", "../node_modules/markdown-it/lib/common/html_blocks.mjs", "../node_modules/markdown-it/lib/common/html_re.mjs", "../node_modules/markdown-it/lib/rules_block/html_block.mjs", "../node_modules/markdown-it/lib/rules_block/heading.mjs", "../node_modules/markdown-it/lib/rules_block/lheading.mjs", "../node_modules/markdown-it/lib/rules_block/paragraph.mjs", "../node_modules/markdown-it/lib/parser_block.mjs", "../node_modules/markdown-it/lib/rules_inline/state_inline.mjs", "../node_modules/markdown-it/lib/rules_inline/text.mjs", "../node_modules/markdown-it/lib/rules_inline/linkify.mjs", "../node_modules/markdown-it/lib/rules_inline/newline.mjs", "../node_modules/markdown-it/lib/rules_inline/escape.mjs", "../node_modules/markdown-it/lib/rules_inline/backticks.mjs", "../node_modules/markdown-it/lib/rules_inline/strikethrough.mjs", "../node_modules/markdown-it/lib/rules_inline/emphasis.mjs", "../node_modules/markdown-it/lib/rules_inline/link.mjs", "../node_modules/markdown-it/lib/rules_inline/image.mjs", "../node_modules/markdown-it/lib/rules_inline/autolink.mjs", "../node_modules/markdown-it/lib/rules_inline/html_inline.mjs", "../node_modules/markdown-it/lib/rules_inline/entity.mjs", "../node_modules/markdown-it/lib/rules_inline/balance_pairs.mjs", "../node_modules/markdown-it/lib/rules_inline/fragments_join.mjs", "../node_modules/markdown-it/lib/parser_inline.mjs", "../node_modules/linkify-it/lib/re.mjs", "../node_modules/linkify-it/index.mjs", "../node_modules/punycode.js/punycode.es6.js", "../node_modules/markdown-it/lib/presets/default.mjs", "../node_modules/markdown-it/lib/presets/zero.mjs", "../node_modules/markdown-it/lib/presets/commonmark.mjs", "../node_modules/markdown-it/lib/index.mjs", "../output/MarkdownIt/foreign.js", "../.spago/p/markdown-it/f6e8ee91298f2fc13c4277e75a19e0538de5f7a2/src/MarkdownIt.purs", "../.spago/p/markdown-it-halogen/08c9625015bf04214be14e45230e8ce12f3fa2bf/src/MarkdownIt/Renderer/Halogen.purs", "../docs-search/client-halogen/src/Docs/Search/App/SearchResults.purs", "../output/Web.DOM.Node/foreign.js", "../.spago/p/web-dom-6.0.0/src/Web/DOM/Node.purs", "../output/Web.Storage.Storage/foreign.js", "../.spago/p/web-storage-5.0.0/src/Web/Storage/Storage.purs", "../docs-search/client-halogen/src/Docs/Search/App/Sidebar.purs", "../docs-search/common/src/Docs/Search/Meta.purs", "../.spago/p/halogen-7.0.0/src/Halogen/Aff/Util.purs", "../.spago/p/fork-6.0.0/src/Control/Monad/Fork/Class.purs", "../.spago/p/halogen-7.0.0/src/Halogen/Aff/Driver/State.purs", "../.spago/p/halogen-7.0.0/src/Halogen/Aff/Driver/Eval.purs", "../.spago/p/halogen-7.0.0/src/Halogen/Aff/Driver.purs", "../.spago/p/halogen-7.0.0/src/Halogen/VDom/Driver.purs", "../output/Web.DOM.ChildNode/foreign.js", "../.spago/p/web-dom-6.0.0/src/Web/DOM/Text.purs", "../.spago/p/web-html-4.1.0/src/Web/HTML/Event/HashChangeEvent/EventTypes.purs", "../docs-search/client-halogen/src/Docs/Search/App.purs", ""], + "sourcesContent": ["export const arrayMap = function (f) {\n return function (arr) {\n var l = arr.length;\n var result = new Array(l);\n for (var i = 0; i < l; i++) {\n result[i] = f(arr[i]);\n }\n return result;\n };\n};\n", "module Control.Semigroupoid where\n\n-- | A `Semigroupoid` is similar to a [`Category`](#category) but does not\n-- | require an identity element `identity`, just composable morphisms.\n-- |\n-- | `Semigroupoid`s must satisfy the following law:\n-- |\n-- | - Associativity: `p <<< (q <<< r) = (p <<< q) <<< r`\n-- |\n-- | One example of a `Semigroupoid` is the function type constructor `(->)`,\n-- | with `(<<<)` defined as function composition.\nclass Semigroupoid :: forall k. (k -> k -> Type) -> Constraint\nclass Semigroupoid a where\n compose :: forall b c d. a c d -> a b c -> a b d\n\ninstance semigroupoidFn :: Semigroupoid (->) where\n compose f g x = f (g x)\n\ninfixr 9 compose as <<<\n\n-- | Forwards composition, or `compose` with its arguments reversed.\ncomposeFlipped :: forall a b c d. Semigroupoid a => a b c -> a c d -> a b d\ncomposeFlipped f g = compose g f\n\ninfixr 9 composeFlipped as >>>\n", "module Control.Category\n ( class Category\n , identity\n , module Control.Semigroupoid\n ) where\n\nimport Control.Semigroupoid (class Semigroupoid, compose, (<<<), (>>>))\n\n-- | `Category`s consist of objects and composable morphisms between them, and\n-- | as such are [`Semigroupoids`](#semigroupoid), but unlike `semigroupoids`\n-- | must have an identity element.\n-- |\n-- | Instances must satisfy the following law in addition to the\n-- | `Semigroupoid` law:\n-- |\n-- | - Identity: `identity <<< p = p <<< identity = p`\nclass Category :: forall k. (k -> k -> Type) -> Constraint\nclass Semigroupoid a <= Category a where\n identity :: forall t. a t t\n\ninstance categoryFn :: Category (->) where\n identity x = x\n", "module Data.Boolean where\n\n-- | An alias for `true`, which can be useful in guard clauses:\n-- |\n-- | ```purescript\n-- | max x y | x >= y = x\n-- | | otherwise = y\n-- | ```\notherwise :: Boolean\notherwise = true\n", "module Data.Function\n ( flip\n , const\n , apply\n , ($)\n , applyFlipped\n , (#)\n , applyN\n , on\n , module Control.Category\n ) where\n\nimport Control.Category (identity, compose, (<<<), (>>>))\nimport Data.Boolean (otherwise)\nimport Data.Ord ((<=))\nimport Data.Ring ((-))\n\n-- | Given a function that takes two arguments, applies the arguments\n-- | to the function in a swapped order.\n-- |\n-- | ```purescript\n-- | flip append \"1\" \"2\" == append \"2\" \"1\" == \"21\"\n-- |\n-- | const 1 \"two\" == 1\n-- |\n-- | flip const 1 \"two\" == const \"two\" 1 == \"two\"\n-- | ```\nflip :: forall a b c. (a -> b -> c) -> b -> a -> c\nflip f b a = f a b\n\n-- | Returns its first argument and ignores its second.\n-- |\n-- | ```purescript\n-- | const 1 \"hello\" = 1\n-- | ```\n-- |\n-- | It can also be thought of as creating a function that ignores its argument:\n-- |\n-- | ```purescript\n-- | const 1 = \\_ -> 1\n-- | ```\nconst :: forall a b. a -> b -> a\nconst a _ = a\n\n-- | Applies a function to an argument. This is primarily used as the operator\n-- | `($)` which allows parentheses to be omitted in some cases, or as a\n-- | natural way to apply a chain of composed functions to a value.\napply :: forall a b. (a -> b) -> a -> b\napply f x = f x\n\n-- | Applies a function to an argument: the reverse of `(#)`.\n-- |\n-- | ```purescript\n-- | length $ groupBy productCategory $ filter isInStock $ products\n-- | ```\n-- |\n-- | is equivalent to:\n-- |\n-- | ```purescript\n-- | length (groupBy productCategory (filter isInStock products))\n-- | ```\n-- |\n-- | Or another alternative equivalent, applying chain of composed functions to\n-- | a value:\n-- |\n-- | ```purescript\n-- | length <<< groupBy productCategory <<< filter isInStock $ products\n-- | ```\ninfixr 0 apply as $\n\n-- | Applies an argument to a function. This is primarily used as the `(#)`\n-- | operator, which allows parentheses to be omitted in some cases, or as a\n-- | natural way to apply a value to a chain of composed functions.\napplyFlipped :: forall a b. a -> (a -> b) -> b\napplyFlipped x f = f x\n\n-- | Applies an argument to a function: the reverse of `($)`.\n-- |\n-- | ```purescript\n-- | products # filter isInStock # groupBy productCategory # length\n-- | ```\n-- |\n-- | is equivalent to:\n-- |\n-- | ```purescript\n-- | length (groupBy productCategory (filter isInStock products))\n-- | ```\n-- |\n-- | Or another alternative equivalent, applying a value to a chain of composed\n-- | functions:\n-- |\n-- | ```purescript\n-- | products # filter isInStock >>> groupBy productCategory >>> length\n-- | ```\ninfixl 1 applyFlipped as #\n\n-- | `applyN f n` applies the function `f` to its argument `n` times.\n-- |\n-- | If n is less than or equal to 0, the function is not applied.\n-- |\n-- | ```purescript\n-- | applyN (_ + 1) 10 0 == 10\n-- | ```\napplyN :: forall a. (a -> a) -> Int -> a -> a\napplyN f = go\n where\n go n acc\n | n <= 0 = acc\n | otherwise = go (n - 1) (f acc)\n\n-- | The `on` function is used to change the domain of a binary operator.\n-- |\n-- | For example, we can create a function which compares two records based on the values of their `x` properties:\n-- |\n-- | ```purescript\n-- | compareX :: forall r. { x :: Number | r } -> { x :: Number | r } -> Ordering\n-- | compareX = compare `on` _.x\n-- | ```\non :: forall a b c. (b -> b -> c) -> (a -> b) -> a -> a -> c\non f g x y = g x `f` g y\n", "-- | The `Proxy` type and values are for situations where type information is\n-- | required for an input to determine the type of an output, but where it is\n-- | not possible or convenient to provide a _value_ for the input.\n-- |\n-- | A hypothetical example: if you have a class that is used to handle the\n-- | result of an AJAX request, you may want to use this information to set the\n-- | expected content type of the request, so you might have a class something\n-- | like this:\n-- |\n-- | ``` purescript\n-- | class AjaxResponse a where\n-- | responseType :: a -> ResponseType\n-- | fromResponse :: Foreign -> a\n-- | ```\n-- |\n-- | The problem here is `responseType` requires a value of type `a`, but we\n-- | won't have a value of that type until the request has been completed. The\n-- | solution is to use a `Proxy` type instead:\n-- |\n-- | ``` purescript\n-- | class AjaxResponse a where\n-- | responseType :: Proxy a -> ResponseType\n-- | fromResponse :: Foreign -> a\n-- | ```\n-- |\n-- | We can now call `responseType (Proxy :: Proxy SomeContentType)` to produce\n-- | a `ResponseType` for `SomeContentType` without having to construct some\n-- | empty version of `SomeContentType` first. In situations like this where\n-- | the `Proxy` type can be statically determined, it is recommended to pull\n-- | out the definition to the top level and make a declaration like:\n-- |\n-- | ``` purescript\n-- | _SomeContentType :: Proxy SomeContentType\n-- | _SomeContentType = Proxy\n-- | ```\n-- |\n-- | That way the proxy value can be used as `responseType _SomeContentType`\n-- | for improved readability. However, this is not always possible, sometimes\n-- | the type required will be determined by a type variable. As PureScript has\n-- | scoped type variables, we can do things like this:\n-- |\n-- | ``` purescript\n-- | makeRequest :: URL -> ResponseType -> Aff _ Foreign\n-- | makeRequest = ...\n-- |\n-- | fetchData :: forall a. (AjaxResponse a) => URL -> Aff _ a\n-- | fetchData url = fromResponse <$> makeRequest url (responseType (Proxy :: Proxy a))\n-- | ```\nmodule Type.Proxy where\n\n-- | Proxy type for all `kind`s.\ndata Proxy :: forall k. k -> Type\ndata Proxy a = Proxy\n", "module Data.Functor\n ( class Functor\n , map\n , (<$>)\n , mapFlipped\n , (<#>)\n , void\n , voidRight\n , (<$)\n , voidLeft\n , ($>)\n , flap\n , (<@>)\n ) where\n\nimport Data.Function (const, compose)\nimport Data.Unit (Unit, unit)\nimport Type.Proxy (Proxy(..))\n\n-- | A `Functor` is a type constructor which supports a mapping operation\n-- | `map`.\n-- |\n-- | `map` can be used to turn functions `a -> b` into functions\n-- | `f a -> f b` whose argument and return types use the type constructor `f`\n-- | to represent some computational context.\n-- |\n-- | Instances must satisfy the following laws:\n-- |\n-- | - Identity: `map identity = identity`\n-- | - Composition: `map (f <<< g) = map f <<< map g`\nclass Functor f where\n map :: forall a b. (a -> b) -> f a -> f b\n\ninfixl 4 map as <$>\n\n-- | `mapFlipped` is `map` with its arguments reversed. For example:\n-- |\n-- | ```purescript\n-- | [1, 2, 3] <#> \\n -> n * n\n-- | ```\nmapFlipped :: forall f a b. Functor f => f a -> (a -> b) -> f b\nmapFlipped fa f = f <$> fa\n\ninfixl 1 mapFlipped as <#>\n\ninstance functorFn :: Functor ((->) r) where\n map = compose\n\ninstance functorArray :: Functor Array where\n map = arrayMap\n\ninstance functorProxy :: Functor Proxy where\n map _ _ = Proxy\n\nforeign import arrayMap :: forall a b. (a -> b) -> Array a -> Array b\n\n-- | The `void` function is used to ignore the type wrapped by a\n-- | [`Functor`](#functor), replacing it with `Unit` and keeping only the type\n-- | information provided by the type constructor itself.\n-- |\n-- | `void` is often useful when using `do` notation to change the return type\n-- | of a monadic computation:\n-- |\n-- | ```purescript\n-- | main = forE 1 10 \\n -> void do\n-- | print n\n-- | print (n * n)\n-- | ```\nvoid :: forall f a. Functor f => f a -> f Unit\nvoid = map (const unit)\n\n-- | Ignore the return value of a computation, using the specified return value\n-- | instead.\nvoidRight :: forall f a b. Functor f => a -> f b -> f a\nvoidRight x = map (const x)\n\ninfixl 4 voidRight as <$\n\n-- | A version of `voidRight` with its arguments flipped.\nvoidLeft :: forall f a b. Functor f => f a -> b -> f b\nvoidLeft f x = const x <$> f\n\ninfixl 4 voidLeft as $>\n\n-- | Apply a value in a computational context to a value in no context.\n-- |\n-- | Generalizes `flip`.\n-- |\n-- | ```purescript\n-- | longEnough :: String -> Bool\n-- | hasSymbol :: String -> Bool\n-- | hasDigit :: String -> Bool\n-- | password :: String\n-- |\n-- | validate :: String -> Array Bool\n-- | validate = flap [longEnough, hasSymbol, hasDigit]\n-- | ```\n-- |\n-- | ```purescript\n-- | flap (-) 3 4 == 1\n-- | threeve <$> Just 1 <@> 'a' <*> Just true == Just (threeve 1 'a' true)\n-- | ```\nflap :: forall f a b. Functor f => f (a -> b) -> a -> f b\nflap ff x = map (\\f -> f x) ff\n\ninfixl 4 flap as <@>\n", "export const concatString = function (s1) {\n return function (s2) {\n return s1 + s2;\n };\n};\n\nexport const concatArray = function (xs) {\n return function (ys) {\n if (xs.length === 0) return ys;\n if (ys.length === 0) return xs;\n return xs.concat(ys);\n };\n};\n", "module Data.Symbol\n ( class IsSymbol\n , reflectSymbol\n , reifySymbol\n ) where\n\nimport Type.Proxy (Proxy(..))\n\n-- | A class for known symbols\nclass IsSymbol (sym :: Symbol) where\n reflectSymbol :: Proxy sym -> String\n\n-- local definition for use in `reifySymbol`\nforeign import unsafeCoerce :: forall a b. a -> b\n\nreifySymbol :: forall r. String -> (forall sym. IsSymbol sym => Proxy sym -> r) -> r\nreifySymbol s f = coerce f { reflectSymbol: \\_ -> s } Proxy\n where\n coerce\n :: (forall sym1. IsSymbol sym1 => Proxy sym1 -> r)\n -> { reflectSymbol :: Proxy \"\" -> String }\n -> Proxy \"\"\n -> r\n coerce = unsafeCoerce\n", "export const unsafeHas = function (label) {\n return function (rec) {\n return {}.hasOwnProperty.call(rec, label);\n };\n};\n\nexport const unsafeGet = function (label) {\n return function (rec) {\n return rec[label];\n };\n};\n\nexport const unsafeSet = function (label) {\n return function (value) {\n return function (rec) {\n var copy = {};\n for (var key in rec) {\n if ({}.hasOwnProperty.call(rec, key)) {\n copy[key] = rec[key];\n }\n }\n copy[label] = value;\n return copy;\n };\n };\n};\n\nexport const unsafeDelete = function (label) {\n return function (rec) {\n var copy = {};\n for (var key in rec) {\n if (key !== label && {}.hasOwnProperty.call(rec, key)) {\n copy[key] = rec[key];\n }\n }\n return copy;\n };\n};\n", "module Data.Semigroup\n ( class Semigroup\n , append\n , (<>)\n , class SemigroupRecord\n , appendRecord\n ) where\n\nimport Data.Symbol (class IsSymbol, reflectSymbol)\nimport Data.Unit (Unit, unit)\nimport Data.Void (Void, absurd)\nimport Prim.Row as Row\nimport Prim.RowList as RL\nimport Record.Unsafe (unsafeGet, unsafeSet)\nimport Type.Proxy (Proxy(..))\n\n-- | The `Semigroup` type class identifies an associative operation on a type.\n-- |\n-- | Instances are required to satisfy the following law:\n-- |\n-- | - Associativity: `(x <> y) <> z = x <> (y <> z)`\n-- |\n-- | One example of a `Semigroup` is `String`, with `(<>)` defined as string\n-- | concatenation. Another example is `List a`, with `(<>)` defined as\n-- | list concatenation.\n-- |\n-- | ### Newtypes for Semigroup\n-- |\n-- | There are two other ways to implement an instance for this type class\n-- | regardless of which type is used. These instances can be used by\n-- | wrapping the values in one of the two newtypes below:\n-- | 1. `First` - Use the first argument every time: `append first _ = first`.\n-- | 2. `Last` - Use the last argument every time: `append _ last = last`.\nclass Semigroup a where\n append :: a -> a -> a\n\ninfixr 5 append as <>\n\ninstance semigroupString :: Semigroup String where\n append = concatString\n\ninstance semigroupUnit :: Semigroup Unit where\n append _ _ = unit\n\ninstance semigroupVoid :: Semigroup Void where\n append _ = absurd\n\ninstance semigroupFn :: Semigroup s' => Semigroup (s -> s') where\n append f g x = f x <> g x\n\ninstance semigroupArray :: Semigroup (Array a) where\n append = concatArray\n\ninstance semigroupProxy :: Semigroup (Proxy a) where\n append _ _ = Proxy\n\ninstance semigroupRecord :: (RL.RowToList row list, SemigroupRecord list row row) => Semigroup (Record row) where\n append = appendRecord (Proxy :: Proxy list)\n\nforeign import concatString :: String -> String -> String\nforeign import concatArray :: forall a. Array a -> Array a -> Array a\n\n-- | A class for records where all fields have `Semigroup` instances, used to\n-- | implement the `Semigroup` instance for records.\nclass SemigroupRecord :: RL.RowList Type -> Row Type -> Row Type -> Constraint\nclass SemigroupRecord rowlist row subrow | rowlist -> subrow where\n appendRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow\n\ninstance semigroupRecordNil :: SemigroupRecord RL.Nil row () where\n appendRecord _ _ _ = {}\n\ninstance semigroupRecordCons ::\n ( IsSymbol key\n , Row.Cons key focus subrowTail subrow\n , SemigroupRecord rowlistTail row subrowTail\n , Semigroup focus\n ) =>\n SemigroupRecord (RL.Cons key focus rowlistTail) row subrow where\n appendRecord _ ra rb = insert (get ra <> get rb) tail\n where\n key = reflectSymbol (Proxy :: Proxy key)\n get = unsafeGet key :: Record row -> focus\n insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow\n tail = appendRecord (Proxy :: Proxy rowlistTail) ra rb\n", "module Control.Alt\n ( class Alt, alt, (<|>)\n , module Data.Functor\n ) where\n\nimport Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>))\nimport Data.Semigroup (append)\n\n-- | The `Alt` type class identifies an associative operation on a type\n-- | constructor. It is similar to `Semigroup`, except that it applies to\n-- | types of kind `* -> *`, like `Array` or `List`, rather than concrete types\n-- | `String` or `Number`.\n-- |\n-- | `Alt` instances are required to satisfy the following laws:\n-- |\n-- | - Associativity: `(x <|> y) <|> z == x <|> (y <|> z)`\n-- | - Distributivity: `f <$> (x <|> y) == (f <$> x) <|> (f <$> y)`\n-- |\n-- | For example, the `Array` (`[]`) type is an instance of `Alt`, where\n-- | `(<|>)` is defined to be concatenation.\n-- |\n-- | A common use case is to select the first \"valid\" item, or, if all items\n-- | are \"invalid\", the last \"invalid\" item.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | import Control.Alt ((<|>))\n-- | import Data.Maybe (Maybe(..)\n-- | import Data.Either (Either(..))\n-- |\n-- | Nothing <|> Just 1 <|> Just 2 == Just 1\n-- | Left \"err\" <|> Right 1 <|> Right 2 == Right 1\n-- | Left \"err 1\" <|> Left \"err 2\" <|> Left \"err 3\" == Left \"err 3\"\n-- | ```\nclass Functor f <= Alt f where\n alt :: forall a. f a -> f a -> f a\n\ninfixr 3 alt as <|>\n\ninstance altArray :: Alt Array where\n alt = append\n", "export const arrayApply = function (fs) {\n return function (xs) {\n var l = fs.length;\n var k = xs.length;\n var result = new Array(l*k);\n var n = 0;\n for (var i = 0; i < l; i++) {\n var f = fs[i];\n for (var j = 0; j < k; j++) {\n result[n++] = f(xs[j]);\n }\n }\n return result;\n };\n};\n", "module Control.Apply\n ( class Apply\n , apply\n , (<*>)\n , applyFirst\n , (<*)\n , applySecond\n , (*>)\n , lift2\n , lift3\n , lift4\n , lift5\n , module Data.Functor\n ) where\n\nimport Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>))\nimport Data.Function (const)\nimport Control.Category (identity)\nimport Type.Proxy (Proxy(..))\n\n-- | The `Apply` class provides the `(<*>)` which is used to apply a function\n-- | to an argument under a type constructor.\n-- |\n-- | `Apply` can be used to lift functions of two or more arguments to work on\n-- | values wrapped with the type constructor `f`. It might also be understood\n-- | in terms of the `lift2` function:\n-- |\n-- | ```purescript\n-- | lift2 :: forall f a b c. Apply f => (a -> b -> c) -> f a -> f b -> f c\n-- | lift2 f a b = f <$> a <*> b\n-- | ```\n-- |\n-- | `(<*>)` is recovered from `lift2` as `lift2 ($)`. That is, `(<*>)` lifts\n-- | the function application operator `($)` to arguments wrapped with the\n-- | type constructor `f`.\n-- |\n-- | Put differently...\n-- | ```\n-- | foo =\n-- | functionTakingNArguments <$> computationProducingArg1\n-- | <*> computationProducingArg2\n-- | <*> ...\n-- | <*> computationProducingArgN\n-- | ```\n-- |\n-- | Instances must satisfy the following law in addition to the `Functor`\n-- | laws:\n-- |\n-- | - Associative composition: `(<<<) <$> f <*> g <*> h = f <*> (g <*> h)`\n-- |\n-- | Formally, `Apply` represents a strong lax semi-monoidal endofunctor.\nclass Functor f <= Apply f where\n apply :: forall a b. f (a -> b) -> f a -> f b\n\ninfixl 4 apply as <*>\n\ninstance applyFn :: Apply ((->) r) where\n apply f g x = f x (g x)\n\ninstance applyArray :: Apply Array where\n apply = arrayApply\n\nforeign import arrayApply :: forall a b. Array (a -> b) -> Array a -> Array b\n\ninstance applyProxy :: Apply Proxy where\n apply _ _ = Proxy\n\n-- | Combine two effectful actions, keeping only the result of the first.\napplyFirst :: forall a b f. Apply f => f a -> f b -> f a\napplyFirst a b = const <$> a <*> b\n\ninfixl 4 applyFirst as <*\n\n-- | Combine two effectful actions, keeping only the result of the second.\napplySecond :: forall a b f. Apply f => f a -> f b -> f b\napplySecond a b = const identity <$> a <*> b\n\ninfixl 4 applySecond as *>\n\n-- | Lift a function of two arguments to a function which accepts and returns\n-- | values wrapped with the type constructor `f`.\n-- |\n-- | ```purescript\n-- | lift2 add (Just 1) (Just 2) == Just 3\n-- | lift2 add Nothing (Just 2) == Nothing\n-- |```\n-- |\nlift2 :: forall a b c f. Apply f => (a -> b -> c) -> f a -> f b -> f c\nlift2 f a b = f <$> a <*> b\n\n-- | Lift a function of three arguments to a function which accepts and returns\n-- | values wrapped with the type constructor `f`.\nlift3 :: forall a b c d f. Apply f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d\nlift3 f a b c = f <$> a <*> b <*> c\n\n-- | Lift a function of four arguments to a function which accepts and returns\n-- | values wrapped with the type constructor `f`.\nlift4 :: forall a b c d e f. Apply f => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e\nlift4 f a b c d = f <$> a <*> b <*> c <*> d\n\n-- | Lift a function of five arguments to a function which accepts and returns\n-- | values wrapped with the type constructor `f`.\nlift5 :: forall a b c d e f g. Apply f => (a -> b -> c -> d -> e -> g) -> f a -> f b -> f c -> f d -> f e -> f g\nlift5 f a b c d e = f <$> a <*> b <*> c <*> d <*> e\n", "module Control.Applicative\n ( class Applicative\n , pure\n , liftA1\n , unless\n , when\n , module Control.Apply\n , module Data.Functor\n ) where\n\nimport Control.Apply (class Apply, apply, (*>), (<*), (<*>))\n\nimport Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>))\nimport Data.Unit (Unit, unit)\nimport Type.Proxy (Proxy(..))\n\n-- | The `Applicative` type class extends the [`Apply`](#apply) type class\n-- | with a `pure` function, which can be used to create values of type `f a`\n-- | from values of type `a`.\n-- |\n-- | Where [`Apply`](#apply) provides the ability to lift functions of two or\n-- | more arguments to functions whose arguments are wrapped using `f`, and\n-- | [`Functor`](#functor) provides the ability to lift functions of one\n-- | argument, `pure` can be seen as the function which lifts functions of\n-- | _zero_ arguments. That is, `Applicative` functors support a lifting\n-- | operation for any number of function arguments.\n-- |\n-- | Instances must satisfy the following laws in addition to the `Apply`\n-- | laws:\n-- |\n-- | - Identity: `(pure identity) <*> v = v`\n-- | - Composition: `pure (<<<) <*> f <*> g <*> h = f <*> (g <*> h)`\n-- | - Homomorphism: `(pure f) <*> (pure x) = pure (f x)`\n-- | - Interchange: `u <*> (pure y) = (pure (_ $ y)) <*> u`\nclass Apply f <= Applicative f where\n pure :: forall a. a -> f a\n\ninstance applicativeFn :: Applicative ((->) r) where\n pure x _ = x\n\ninstance applicativeArray :: Applicative Array where\n pure x = [ x ]\n\ninstance applicativeProxy :: Applicative Proxy where\n pure _ = Proxy\n\n-- | `liftA1` provides a default implementation of `(<$>)` for any\n-- | [`Applicative`](#applicative) functor, without using `(<$>)` as provided\n-- | by the [`Functor`](#functor)-[`Applicative`](#applicative) superclass\n-- | relationship.\n-- |\n-- | `liftA1` can therefore be used to write [`Functor`](#functor) instances\n-- | as follows:\n-- |\n-- | ```purescript\n-- | instance functorF :: Functor F where\n-- | map = liftA1\n-- | ```\nliftA1 :: forall f a b. Applicative f => (a -> b) -> f a -> f b\nliftA1 f a = pure f <*> a\n\n-- | Perform an applicative action when a condition is true.\nwhen :: forall m. Applicative m => Boolean -> m Unit -> m Unit\nwhen true m = m\nwhen false _ = pure unit\n\n-- | Perform an applicative action unless a condition is true.\nunless :: forall m. Applicative m => Boolean -> m Unit -> m Unit\nunless false m = m\nunless true _ = pure unit\n", "export const arrayBind = function (arr) {\n return function (f) {\n var result = [];\n for (var i = 0, l = arr.length; i < l; i++) {\n Array.prototype.push.apply(result, f(arr[i]));\n }\n return result;\n };\n};\n", "module Control.Bind\n ( class Bind\n , bind\n , (>>=)\n , bindFlipped\n , (=<<)\n , class Discard\n , discard\n , join\n , composeKleisli\n , (>=>)\n , composeKleisliFlipped\n , (<=<)\n , ifM\n , module Data.Functor\n , module Control.Apply\n , module Control.Applicative\n ) where\n\nimport Control.Applicative (class Applicative, liftA1, pure, unless, when)\nimport Control.Apply (class Apply, apply, (*>), (<*), (<*>))\nimport Control.Category (identity)\n\nimport Data.Function (flip)\nimport Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>))\nimport Data.Unit (Unit)\nimport Type.Proxy (Proxy(..))\n\n-- | The `Bind` type class extends the [`Apply`](#apply) type class with a\n-- | \"bind\" operation `(>>=)` which composes computations in sequence, using\n-- | the return value of one computation to determine the next computation.\n-- |\n-- | The `>>=` operator can also be expressed using `do` notation, as follows:\n-- |\n-- | ```purescript\n-- | x >>= f = do y <- x\n-- | f y\n-- | ```\n-- |\n-- | where the function argument of `f` is given the name `y`.\n-- |\n-- | Instances must satisfy the following laws in addition to the `Apply`\n-- | laws:\n-- |\n-- | - Associativity: `(x >>= f) >>= g = x >>= (\\k -> f k >>= g)`\n-- | - Apply Superclass: `apply f x = f >>= \\f\u2019 -> map f\u2019 x`\n-- |\n-- | Associativity tells us that we can regroup operations which use `do`\n-- | notation so that we can unambiguously write, for example:\n-- |\n-- | ```purescript\n-- | do x <- m1\n-- | y <- m2 x\n-- | m3 x y\n-- | ```\nclass Apply m <= Bind m where\n bind :: forall a b. m a -> (a -> m b) -> m b\n\ninfixl 1 bind as >>=\n\n-- | `bindFlipped` is `bind` with its arguments reversed. For example:\n-- |\n-- | ```purescript\n-- | print =<< random\n-- | ```\nbindFlipped :: forall m a b. Bind m => (a -> m b) -> m a -> m b\nbindFlipped = flip bind\n\ninfixr 1 bindFlipped as =<<\n\ninstance bindFn :: Bind ((->) r) where\n bind m f x = f (m x) x\n\n-- | The `bind`/`>>=` function for `Array` works by applying a function to\n-- | each element in the array, and flattening the results into a single,\n-- | new array.\n-- |\n-- | Array's `bind`/`>>=` works like a nested for loop. Each `bind` adds\n-- | another level of nesting in the loop. For example:\n-- | ```\n-- | foo :: Array String\n-- | foo =\n-- | [\"a\", \"b\"] >>= \\eachElementInArray1 ->\n-- | [\"c\", \"d\"] >>= \\eachElementInArray2\n-- | pure (eachElementInArray1 <> eachElementInArray2)\n-- |\n-- | -- In other words...\n-- | foo\n-- | -- ... is the same as...\n-- | [ (\"a\" <> \"c\"), (\"a\" <> \"d\"), (\"b\" <> \"c\"), (\"b\" <> \"d\") ]\n-- | -- which simplifies to...\n-- | [ \"ac\", \"ad\", \"bc\", \"bd\" ]\n-- | ```\ninstance bindArray :: Bind Array where\n bind = arrayBind\n\nforeign import arrayBind :: forall a b. Array a -> (a -> Array b) -> Array b\n\ninstance bindProxy :: Bind Proxy where\n bind _ _ = Proxy\n\n-- | A class for types whose values can safely be discarded\n-- | in a `do` notation block.\n-- |\n-- | An example is the `Unit` type, since there is only one\n-- | possible value which can be returned.\nclass Discard a where\n discard :: forall f b. Bind f => f a -> (a -> f b) -> f b\n\ninstance discardUnit :: Discard Unit where\n discard = bind\n\ninstance discardProxy :: Discard (Proxy a) where\n discard = bind\n\n-- | Collapse two applications of a monadic type constructor into one.\njoin :: forall a m. Bind m => m (m a) -> m a\njoin m = m >>= identity\n\n-- | Forwards Kleisli composition.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | import Data.Array (head, tail)\n-- |\n-- | third = tail >=> tail >=> head\n-- | ```\ncomposeKleisli :: forall a b c m. Bind m => (a -> m b) -> (b -> m c) -> a -> m c\ncomposeKleisli f g a = f a >>= g\n\ninfixr 1 composeKleisli as >=>\n\n-- | Backwards Kleisli composition.\ncomposeKleisliFlipped :: forall a b c m. Bind m => (b -> m c) -> (a -> m b) -> a -> m c\ncomposeKleisliFlipped f g a = f =<< g a\n\ninfixr 1 composeKleisliFlipped as <=<\n\n-- | Execute a monadic action if a condition holds.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | main = ifM ((< 0.5) <$> random)\n-- | (trace \"Heads\")\n-- | (trace \"Tails\")\n-- | ```\nifM :: forall a m. Bind m => m Boolean -> m a -> m a -> m a\nifM cond t f = cond >>= \\cond' -> if cond' then t else f\n", "var refEq = function (r1) {\n return function (r2) {\n return r1 === r2;\n };\n};\n\nexport const eqBooleanImpl = refEq;\nexport const eqIntImpl = refEq;\nexport const eqNumberImpl = refEq;\nexport const eqCharImpl = refEq;\nexport const eqStringImpl = refEq;\n\nexport const eqArrayImpl = function (f) {\n return function (xs) {\n return function (ys) {\n if (xs.length !== ys.length) return false;\n for (var i = 0; i < xs.length; i++) {\n if (!f(xs[i])(ys[i])) return false;\n }\n return true;\n };\n };\n};\n", "module Data.Eq\n ( class Eq\n , eq\n , (==)\n , notEq\n , (/=)\n , class Eq1\n , eq1\n , notEq1\n , class EqRecord\n , eqRecord\n ) where\n\nimport Data.HeytingAlgebra ((&&))\nimport Data.Symbol (class IsSymbol, reflectSymbol)\nimport Data.Unit (Unit)\nimport Data.Void (Void)\nimport Prim.Row as Row\nimport Prim.RowList as RL\nimport Record.Unsafe (unsafeGet)\nimport Type.Proxy (Proxy(..))\n\n-- | The `Eq` type class represents types which support decidable equality.\n-- |\n-- | `Eq` instances should satisfy the following laws:\n-- |\n-- | - Reflexivity: `x == x = true`\n-- | - Symmetry: `x == y = y == x`\n-- | - Transitivity: if `x == y` and `y == z` then `x == z`\n-- |\n-- | **Note:** The `Number` type is not an entirely law abiding member of this\n-- | class due to the presence of `NaN`, since `NaN /= NaN`. Additionally,\n-- | computing with `Number` can result in a loss of precision, so sometimes\n-- | values that should be equivalent are not.\nclass Eq a where\n eq :: a -> a -> Boolean\n\ninfix 4 eq as ==\n\n-- | `notEq` tests whether one value is _not equal_ to another. Shorthand for\n-- | `not (eq x y)`.\nnotEq :: forall a. Eq a => a -> a -> Boolean\nnotEq x y = (x == y) == false\n\ninfix 4 notEq as /=\n\ninstance eqBoolean :: Eq Boolean where\n eq = eqBooleanImpl\n\ninstance eqInt :: Eq Int where\n eq = eqIntImpl\n\ninstance eqNumber :: Eq Number where\n eq = eqNumberImpl\n\ninstance eqChar :: Eq Char where\n eq = eqCharImpl\n\ninstance eqString :: Eq String where\n eq = eqStringImpl\n\ninstance eqUnit :: Eq Unit where\n eq _ _ = true\n\ninstance eqVoid :: Eq Void where\n eq _ _ = true\n\ninstance eqArray :: Eq a => Eq (Array a) where\n eq = eqArrayImpl eq\n\ninstance eqRec :: (RL.RowToList row list, EqRecord list row) => Eq (Record row) where\n eq = eqRecord (Proxy :: Proxy list)\n\ninstance eqProxy :: Eq (Proxy a) where\n eq _ _ = true\n\nforeign import eqBooleanImpl :: Boolean -> Boolean -> Boolean\nforeign import eqIntImpl :: Int -> Int -> Boolean\nforeign import eqNumberImpl :: Number -> Number -> Boolean\nforeign import eqCharImpl :: Char -> Char -> Boolean\nforeign import eqStringImpl :: String -> String -> Boolean\n\nforeign import eqArrayImpl :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Boolean\n\n-- | The `Eq1` type class represents type constructors with decidable equality.\nclass Eq1 f where\n eq1 :: forall a. Eq a => f a -> f a -> Boolean\n\ninstance eq1Array :: Eq1 Array where\n eq1 = eq\n\nnotEq1 :: forall f a. Eq1 f => Eq a => f a -> f a -> Boolean\nnotEq1 x y = (x `eq1` y) == false\n\n-- | A class for records where all fields have `Eq` instances, used to implement\n-- | the `Eq` instance for records.\nclass EqRecord :: RL.RowList Type -> Row Type -> Constraint\nclass EqRecord rowlist row where\n eqRecord :: Proxy rowlist -> Record row -> Record row -> Boolean\n\ninstance eqRowNil :: EqRecord RL.Nil row where\n eqRecord _ _ _ = true\n\ninstance eqRowCons ::\n ( EqRecord rowlistTail row\n , Row.Cons key focus rowTail row\n , IsSymbol key\n , Eq focus\n ) =>\n EqRecord (RL.Cons key focus rowlistTail) row where\n eqRecord _ ra rb = (get ra == get rb) && tail\n where\n key = reflectSymbol (Proxy :: Proxy key)\n get = unsafeGet key :: Record row -> focus\n tail = eqRecord (Proxy :: Proxy rowlistTail) ra rb\n", "export const foldrArray = function (f) {\n return function (init) {\n return function (xs) {\n var acc = init;\n var len = xs.length;\n for (var i = len - 1; i >= 0; i--) {\n acc = f(xs[i])(acc);\n }\n return acc;\n };\n };\n};\n\nexport const foldlArray = function (f) {\n return function (init) {\n return function (xs) {\n var acc = init;\n var len = xs.length;\n for (var i = 0; i < len; i++) {\n acc = f(acc)(xs[i]);\n }\n return acc;\n };\n };\n};\n", "module Control.Plus\n ( class Plus, empty\n , module Control.Alt\n , module Data.Functor\n ) where\n\nimport Control.Alt (class Alt, alt, (<|>))\n\nimport Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>))\n\n-- | The `Plus` type class extends the `Alt` type class with a value that\n-- | should be the left and right identity for `(<|>)`.\n-- |\n-- | It is similar to `Monoid`, except that it applies to types of\n-- | kind `* -> *`, like `Array` or `List`, rather than concrete types like\n-- | `String` or `Number`.\n-- |\n-- | `Plus` instances should satisfy the following laws:\n-- |\n-- | - Left identity: `empty <|> x == x`\n-- | - Right identity: `x <|> empty == x`\n-- | - Annihilation: `f <$> empty == empty`\nclass Alt f <= Plus f where\n empty :: forall a. f a\n\ninstance plusArray :: Plus Array where\n empty = []\n", "export const topInt = 2147483647;\nexport const bottomInt = -2147483648;\n\nexport const topChar = String.fromCharCode(65535);\nexport const bottomChar = String.fromCharCode(0);\n\nexport const topNumber = Number.POSITIVE_INFINITY;\nexport const bottomNumber = Number.NEGATIVE_INFINITY;\n", "var unsafeCompareImpl = function (lt) {\n return function (eq) {\n return function (gt) {\n return function (x) {\n return function (y) {\n return x < y ? lt : x === y ? eq : gt;\n };\n };\n };\n };\n};\n\nexport const ordBooleanImpl = unsafeCompareImpl;\nexport const ordIntImpl = unsafeCompareImpl;\nexport const ordNumberImpl = unsafeCompareImpl;\nexport const ordStringImpl = unsafeCompareImpl;\nexport const ordCharImpl = unsafeCompareImpl;\n\nexport const ordArrayImpl = function (f) {\n return function (xs) {\n return function (ys) {\n var i = 0;\n var xlen = xs.length;\n var ylen = ys.length;\n while (i < xlen && i < ylen) {\n var x = xs[i];\n var y = ys[i];\n var o = f(x)(y);\n if (o !== 0) {\n return o;\n }\n i++;\n }\n if (xlen === ylen) {\n return 0;\n } else if (xlen > ylen) {\n return -1;\n } else {\n return 1;\n }\n };\n };\n};\n", "module Data.Ordering (Ordering(..), invert) where\n\nimport Data.Eq (class Eq)\nimport Data.Semigroup (class Semigroup)\nimport Data.Show (class Show)\n\n-- | The `Ordering` data type represents the three possible outcomes of\n-- | comparing two values:\n-- |\n-- | `LT` - The first value is _less than_ the second.\n-- | `GT` - The first value is _greater than_ the second.\n-- | `EQ` - The first value is _equal to_ the second.\ndata Ordering = LT | GT | EQ\n\ninstance eqOrdering :: Eq Ordering where\n eq LT LT = true\n eq GT GT = true\n eq EQ EQ = true\n eq _ _ = false\n\ninstance semigroupOrdering :: Semigroup Ordering where\n append LT _ = LT\n append GT _ = GT\n append EQ y = y\n\ninstance showOrdering :: Show Ordering where\n show LT = \"LT\"\n show GT = \"GT\"\n show EQ = \"EQ\"\n\n-- | Reverses an `Ordering` value, flipping greater than for less than while\n-- | preserving equality.\ninvert :: Ordering -> Ordering\ninvert GT = LT\ninvert EQ = EQ\ninvert LT = GT\n", "export const intSub = function (x) {\n return function (y) {\n /* jshint bitwise: false */\n return x - y | 0;\n };\n};\n\nexport const numSub = function (n1) {\n return function (n2) {\n return n1 - n2;\n };\n};\n", "export const intAdd = function (x) {\n return function (y) {\n /* jshint bitwise: false */\n return x + y | 0;\n };\n};\n\nexport const intMul = function (x) {\n return function (y) {\n /* jshint bitwise: false */\n return x * y | 0;\n };\n};\n\nexport const numAdd = function (n1) {\n return function (n2) {\n return n1 + n2;\n };\n};\n\nexport const numMul = function (n1) {\n return function (n2) {\n return n1 * n2;\n };\n};\n", "module Data.Semiring\n ( class Semiring\n , add\n , (+)\n , zero\n , mul\n , (*)\n , one\n , class SemiringRecord\n , addRecord\n , mulRecord\n , oneRecord\n , zeroRecord\n ) where\n\nimport Data.Symbol (class IsSymbol, reflectSymbol)\nimport Data.Unit (Unit, unit)\nimport Prim.Row as Row\nimport Prim.RowList as RL\nimport Record.Unsafe (unsafeGet, unsafeSet)\nimport Type.Proxy (Proxy(..))\n\n-- | The `Semiring` class is for types that support an addition and\n-- | multiplication operation.\n-- |\n-- | Instances must satisfy the following laws:\n-- |\n-- | - Commutative monoid under addition:\n-- | - Associativity: `(a + b) + c = a + (b + c)`\n-- | - Identity: `zero + a = a + zero = a`\n-- | - Commutative: `a + b = b + a`\n-- | - Monoid under multiplication:\n-- | - Associativity: `(a * b) * c = a * (b * c)`\n-- | - Identity: `one * a = a * one = a`\n-- | - Multiplication distributes over addition:\n-- | - Left distributivity: `a * (b + c) = (a * b) + (a * c)`\n-- | - Right distributivity: `(a + b) * c = (a * c) + (b * c)`\n-- | - Annihilation: `zero * a = a * zero = zero`\n-- |\n-- | **Note:** The `Number` and `Int` types are not fully law abiding\n-- | members of this class hierarchy due to the potential for arithmetic\n-- | overflows, and in the case of `Number`, the presence of `NaN` and\n-- | `Infinity` values. The behaviour is unspecified in these cases.\nclass Semiring a where\n add :: a -> a -> a\n zero :: a\n mul :: a -> a -> a\n one :: a\n\ninfixl 6 add as +\ninfixl 7 mul as *\n\ninstance semiringInt :: Semiring Int where\n add = intAdd\n zero = 0\n mul = intMul\n one = 1\n\ninstance semiringNumber :: Semiring Number where\n add = numAdd\n zero = 0.0\n mul = numMul\n one = 1.0\n\ninstance semiringFn :: Semiring b => Semiring (a -> b) where\n add f g x = f x + g x\n zero = \\_ -> zero\n mul f g x = f x * g x\n one = \\_ -> one\n\ninstance semiringUnit :: Semiring Unit where\n add _ _ = unit\n zero = unit\n mul _ _ = unit\n one = unit\n\ninstance semiringProxy :: Semiring (Proxy a) where\n add _ _ = Proxy\n mul _ _ = Proxy\n one = Proxy\n zero = Proxy\n\ninstance semiringRecord :: (RL.RowToList row list, SemiringRecord list row row) => Semiring (Record row) where\n add = addRecord (Proxy :: Proxy list)\n mul = mulRecord (Proxy :: Proxy list)\n one = oneRecord (Proxy :: Proxy list) (Proxy :: Proxy row)\n zero = zeroRecord (Proxy :: Proxy list) (Proxy :: Proxy row)\n\nforeign import intAdd :: Int -> Int -> Int\nforeign import intMul :: Int -> Int -> Int\nforeign import numAdd :: Number -> Number -> Number\nforeign import numMul :: Number -> Number -> Number\n\n-- | A class for records where all fields have `Semiring` instances, used to\n-- | implement the `Semiring` instance for records.\nclass SemiringRecord :: RL.RowList Type -> Row Type -> Row Type -> Constraint\nclass SemiringRecord rowlist row subrow | rowlist -> subrow where\n addRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow\n mulRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow\n oneRecord :: Proxy rowlist -> Proxy row -> Record subrow\n zeroRecord :: Proxy rowlist -> Proxy row -> Record subrow\n\ninstance semiringRecordNil :: SemiringRecord RL.Nil row () where\n addRecord _ _ _ = {}\n mulRecord _ _ _ = {}\n oneRecord _ _ = {}\n zeroRecord _ _ = {}\n\ninstance semiringRecordCons ::\n ( IsSymbol key\n , Row.Cons key focus subrowTail subrow\n , SemiringRecord rowlistTail row subrowTail\n , Semiring focus\n ) =>\n SemiringRecord (RL.Cons key focus rowlistTail) row subrow where\n addRecord _ ra rb = insert (get ra + get rb) tail\n where\n key = reflectSymbol (Proxy :: Proxy key)\n get = unsafeGet key :: Record row -> focus\n tail = addRecord (Proxy :: Proxy rowlistTail) ra rb\n insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow\n\n mulRecord _ ra rb = insert (get ra * get rb) tail\n where\n key = reflectSymbol (Proxy :: Proxy key)\n get = unsafeGet key :: Record row -> focus\n tail = mulRecord (Proxy :: Proxy rowlistTail) ra rb\n insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow\n\n oneRecord _ _ = insert one tail\n where\n key = reflectSymbol (Proxy :: Proxy key)\n tail = oneRecord (Proxy :: Proxy rowlistTail) (Proxy :: Proxy row)\n insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow\n\n zeroRecord _ _ = insert zero tail\n where\n key = reflectSymbol (Proxy :: Proxy key)\n tail = zeroRecord (Proxy :: Proxy rowlistTail) (Proxy :: Proxy row)\n insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow\n", "module Data.Ring\n ( class Ring\n , sub\n , negate\n , (-)\n , module Data.Semiring\n , class RingRecord\n , subRecord\n ) where\n\nimport Data.Semiring (class Semiring, class SemiringRecord, add, mul, one, zero, (*), (+))\nimport Data.Symbol (class IsSymbol, reflectSymbol)\nimport Data.Unit (Unit, unit)\nimport Prim.Row as Row\nimport Prim.RowList as RL\nimport Record.Unsafe (unsafeGet, unsafeSet)\nimport Type.Proxy (Proxy(..))\n\n-- | The `Ring` class is for types that support addition, multiplication,\n-- | and subtraction operations.\n-- |\n-- | Instances must satisfy the following laws in addition to the `Semiring`\n-- | laws:\n-- |\n-- | - Additive inverse: `a - a = zero`\n-- | - Compatibility of `sub` and `negate`: `a - b = a + (zero - b)`\nclass Semiring a <= Ring a where\n sub :: a -> a -> a\n\ninfixl 6 sub as -\n\ninstance ringInt :: Ring Int where\n sub = intSub\n\ninstance ringNumber :: Ring Number where\n sub = numSub\n\ninstance ringUnit :: Ring Unit where\n sub _ _ = unit\n\ninstance ringFn :: Ring b => Ring (a -> b) where\n sub f g x = f x - g x\n\ninstance ringProxy :: Ring (Proxy a) where\n sub _ _ = Proxy\n\ninstance ringRecord :: (RL.RowToList row list, RingRecord list row row) => Ring (Record row) where\n sub = subRecord (Proxy :: Proxy list)\n\n-- | `negate x` can be used as a shorthand for `zero - x`.\nnegate :: forall a. Ring a => a -> a\nnegate a = zero - a\n\nforeign import intSub :: Int -> Int -> Int\nforeign import numSub :: Number -> Number -> Number\n\n-- | A class for records where all fields have `Ring` instances, used to\n-- | implement the `Ring` instance for records.\nclass RingRecord :: RL.RowList Type -> Row Type -> Row Type -> Constraint\nclass SemiringRecord rowlist row subrow <= RingRecord rowlist row subrow | rowlist -> subrow where\n subRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow\n\ninstance ringRecordNil :: RingRecord RL.Nil row () where\n subRecord _ _ _ = {}\n\ninstance ringRecordCons ::\n ( IsSymbol key\n , Row.Cons key focus subrowTail subrow\n , RingRecord rowlistTail row subrowTail\n , Ring focus\n ) =>\n RingRecord (RL.Cons key focus rowlistTail) row subrow where\n subRecord _ ra rb = insert (get ra - get rb) tail\n where\n insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow\n key = reflectSymbol (Proxy :: Proxy key)\n get = unsafeGet key :: Record row -> focus\n tail = subRecord (Proxy :: Proxy rowlistTail) ra rb\n", "module Data.Ord\n ( class Ord\n , compare\n , class Ord1\n , compare1\n , lessThan\n , (<)\n , lessThanOrEq\n , (<=)\n , greaterThan\n , (>)\n , greaterThanOrEq\n , (>=)\n , comparing\n , min\n , max\n , clamp\n , between\n , abs\n , signum\n , module Data.Ordering\n , class OrdRecord\n , compareRecord\n ) where\n\nimport Data.Eq (class Eq, class Eq1, class EqRecord, (/=))\nimport Data.Symbol (class IsSymbol, reflectSymbol)\nimport Data.Ordering (Ordering(..))\nimport Data.Ring (class Ring, zero, one, negate)\nimport Data.Unit (Unit)\nimport Data.Void (Void)\nimport Prim.Row as Row\nimport Prim.RowList as RL\nimport Record.Unsafe (unsafeGet)\nimport Type.Proxy (Proxy(..))\n\n-- | The `Ord` type class represents types which support comparisons with a\n-- | _total order_.\n-- |\n-- | `Ord` instances should satisfy the laws of total orderings:\n-- |\n-- | - Reflexivity: `a <= a`\n-- | - Antisymmetry: if `a <= b` and `b <= a` then `a == b`\n-- | - Transitivity: if `a <= b` and `b <= c` then `a <= c`\n-- |\n-- | **Note:** The `Number` type is not an entirely law abiding member of this\n-- | class due to the presence of `NaN`, since `NaN <= NaN` evaluates to `false`\nclass Eq a <= Ord a where\n compare :: a -> a -> Ordering\n\ninstance ordBoolean :: Ord Boolean where\n compare = ordBooleanImpl LT EQ GT\n\ninstance ordInt :: Ord Int where\n compare = ordIntImpl LT EQ GT\n\ninstance ordNumber :: Ord Number where\n compare = ordNumberImpl LT EQ GT\n\ninstance ordString :: Ord String where\n compare = ordStringImpl LT EQ GT\n\ninstance ordChar :: Ord Char where\n compare = ordCharImpl LT EQ GT\n\ninstance ordUnit :: Ord Unit where\n compare _ _ = EQ\n\ninstance ordVoid :: Ord Void where\n compare _ _ = EQ\n\ninstance ordProxy :: Ord (Proxy a) where\n compare _ _ = EQ\n\ninstance ordArray :: Ord a => Ord (Array a) where\n compare = \\xs ys -> compare 0 (ordArrayImpl toDelta xs ys)\n where\n toDelta x y =\n case compare x y of\n EQ -> 0\n LT -> 1\n GT -> -1\n\nforeign import ordBooleanImpl\n :: Ordering\n -> Ordering\n -> Ordering\n -> Boolean\n -> Boolean\n -> Ordering\n\nforeign import ordIntImpl\n :: Ordering\n -> Ordering\n -> Ordering\n -> Int\n -> Int\n -> Ordering\n\nforeign import ordNumberImpl\n :: Ordering\n -> Ordering\n -> Ordering\n -> Number\n -> Number\n -> Ordering\n\nforeign import ordStringImpl\n :: Ordering\n -> Ordering\n -> Ordering\n -> String\n -> String\n -> Ordering\n\nforeign import ordCharImpl\n :: Ordering\n -> Ordering\n -> Ordering\n -> Char\n -> Char\n -> Ordering\n\nforeign import ordArrayImpl :: forall a. (a -> a -> Int) -> Array a -> Array a -> Int\n\ninstance ordOrdering :: Ord Ordering where\n compare LT LT = EQ\n compare EQ EQ = EQ\n compare GT GT = EQ\n compare LT _ = LT\n compare EQ LT = GT\n compare EQ GT = LT\n compare GT _ = GT\n\n-- | Test whether one value is _strictly less than_ another.\nlessThan :: forall a. Ord a => a -> a -> Boolean\nlessThan a1 a2 = case a1 `compare` a2 of\n LT -> true\n _ -> false\n\n-- | Test whether one value is _strictly greater than_ another.\ngreaterThan :: forall a. Ord a => a -> a -> Boolean\ngreaterThan a1 a2 = case a1 `compare` a2 of\n GT -> true\n _ -> false\n\n-- | Test whether one value is _non-strictly less than_ another.\nlessThanOrEq :: forall a. Ord a => a -> a -> Boolean\nlessThanOrEq a1 a2 = case a1 `compare` a2 of\n GT -> false\n _ -> true\n\n-- | Test whether one value is _non-strictly greater than_ another.\ngreaterThanOrEq :: forall a. Ord a => a -> a -> Boolean\ngreaterThanOrEq a1 a2 = case a1 `compare` a2 of\n LT -> false\n _ -> true\n\ninfixl 4 lessThan as <\ninfixl 4 lessThanOrEq as <=\ninfixl 4 greaterThan as >\ninfixl 4 greaterThanOrEq as >=\n\n-- | Compares two values by mapping them to a type with an `Ord` instance.\ncomparing :: forall a b. Ord b => (a -> b) -> (a -> a -> Ordering)\ncomparing f x y = compare (f x) (f y)\n\n-- | Take the minimum of two values. If they are considered equal, the first\n-- | argument is chosen.\nmin :: forall a. Ord a => a -> a -> a\nmin x y =\n case compare x y of\n LT -> x\n EQ -> x\n GT -> y\n\n-- | Take the maximum of two values. If they are considered equal, the first\n-- | argument is chosen.\nmax :: forall a. Ord a => a -> a -> a\nmax x y =\n case compare x y of\n LT -> y\n EQ -> x\n GT -> x\n\n-- | Clamp a value between a minimum and a maximum. For example:\n-- |\n-- | ``` purescript\n-- | let f = clamp 0 10\n-- | f (-5) == 0\n-- | f 5 == 5\n-- | f 15 == 10\n-- | ```\nclamp :: forall a. Ord a => a -> a -> a -> a\nclamp low hi x = min hi (max low x)\n\n-- | Test whether a value is between a minimum and a maximum (inclusive).\n-- | For example:\n-- |\n-- | ``` purescript\n-- | let f = between 0 10\n-- | f 0 == true\n-- | f (-5) == false\n-- | f 5 == true\n-- | f 10 == true\n-- | f 15 == false\n-- | ```\nbetween :: forall a. Ord a => a -> a -> a -> Boolean\nbetween low hi x\n | x < low = false\n | x > hi = false\n | true = true\n\n-- | The absolute value function. `abs x` is defined as `if x >= zero then x\n-- | else negate x`.\nabs :: forall a. Ord a => Ring a => a -> a\nabs x = if x >= zero then x else negate x\n\n-- | The sign function; returns `one` if the argument is positive,\n-- | `negate one` if the argument is negative, or `zero` if the argument is `zero`.\n-- | For floating point numbers with signed zeroes, when called with a zero,\n-- | this function returns the argument in order to preserve the sign.\n-- | For any `x`, we should have `signum x * abs x == x`.\nsignum :: forall a. Ord a => Ring a => a -> a\nsignum x =\n if x < zero then negate one\n else if x > zero then one\n else x\n\n-- | The `Ord1` type class represents totally ordered type constructors.\nclass Eq1 f <= Ord1 f where\n compare1 :: forall a. Ord a => f a -> f a -> Ordering\n\ninstance ord1Array :: Ord1 Array where\n compare1 = compare\n\nclass OrdRecord :: RL.RowList Type -> Row Type -> Constraint\nclass EqRecord rowlist row <= OrdRecord rowlist row where\n compareRecord :: Proxy rowlist -> Record row -> Record row -> Ordering\n\ninstance ordRecordNil :: OrdRecord RL.Nil row where\n compareRecord _ _ _ = EQ\n\ninstance ordRecordCons ::\n ( OrdRecord rowlistTail row\n , Row.Cons key focus rowTail row\n , IsSymbol key\n , Ord focus\n ) =>\n OrdRecord (RL.Cons key focus rowlistTail) row where\n compareRecord _ ra rb =\n if left /= EQ then left\n else compareRecord (Proxy :: Proxy rowlistTail) ra rb\n where\n key = reflectSymbol (Proxy :: Proxy key)\n unsafeGet' = unsafeGet :: String -> Record row -> focus\n left = unsafeGet' key ra `compare` unsafeGet' key rb\n\ninstance ordRecord ::\n ( RL.RowToList row list\n , OrdRecord list row\n ) =>\n Ord (Record row) where\n compare = compareRecord (Proxy :: Proxy list)\n", "module Data.Bounded\n ( class Bounded\n , bottom\n , top\n , module Data.Ord\n , class BoundedRecord\n , bottomRecord\n , topRecord\n ) where\n\nimport Data.Ord (class Ord, class OrdRecord, Ordering(..), compare, (<), (<=), (>), (>=))\nimport Data.Symbol (class IsSymbol, reflectSymbol)\nimport Data.Unit (Unit, unit)\nimport Prim.Row as Row\nimport Prim.RowList as RL\nimport Record.Unsafe (unsafeSet)\nimport Type.Proxy (Proxy(..))\n\n-- | The `Bounded` type class represents totally ordered types that have an\n-- | upper and lower boundary.\n-- |\n-- | Instances should satisfy the following law in addition to the `Ord` laws:\n-- |\n-- | - Bounded: `bottom <= a <= top`\nclass Ord a <= Bounded a where\n top :: a\n bottom :: a\n\ninstance boundedBoolean :: Bounded Boolean where\n top = true\n bottom = false\n\n-- | The `Bounded` `Int` instance has `top :: Int` equal to 2^31 - 1,\n-- | and `bottom :: Int` equal to -2^31, since these are the largest and smallest\n-- | integers representable by twos-complement 32-bit integers, respectively.\ninstance boundedInt :: Bounded Int where\n top = topInt\n bottom = bottomInt\n\nforeign import topInt :: Int\nforeign import bottomInt :: Int\n\n-- | Characters fall within the Unicode range.\ninstance boundedChar :: Bounded Char where\n top = topChar\n bottom = bottomChar\n\nforeign import topChar :: Char\nforeign import bottomChar :: Char\n\ninstance boundedOrdering :: Bounded Ordering where\n top = GT\n bottom = LT\n\ninstance boundedUnit :: Bounded Unit where\n top = unit\n bottom = unit\n\nforeign import topNumber :: Number\nforeign import bottomNumber :: Number\n\ninstance boundedNumber :: Bounded Number where\n top = topNumber\n bottom = bottomNumber\n\ninstance boundedProxy :: Bounded (Proxy a) where\n bottom = Proxy\n top = Proxy\n\nclass BoundedRecord :: RL.RowList Type -> Row Type -> Row Type -> Constraint\nclass OrdRecord rowlist row <= BoundedRecord rowlist row subrow | rowlist -> subrow where\n topRecord :: Proxy rowlist -> Proxy row -> Record subrow\n bottomRecord :: Proxy rowlist -> Proxy row -> Record subrow\n\ninstance boundedRecordNil :: BoundedRecord RL.Nil row () where\n topRecord _ _ = {}\n bottomRecord _ _ = {}\n\ninstance boundedRecordCons ::\n ( IsSymbol key\n , Bounded focus\n , Row.Cons key focus rowTail row\n , Row.Cons key focus subrowTail subrow\n , BoundedRecord rowlistTail row subrowTail\n ) =>\n BoundedRecord (RL.Cons key focus rowlistTail) row subrow where\n topRecord _ rowProxy = insert top tail\n where\n key = reflectSymbol (Proxy :: Proxy key)\n insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow\n tail = topRecord (Proxy :: Proxy rowlistTail) rowProxy\n\n bottomRecord _ rowProxy = insert bottom tail\n where\n key = reflectSymbol (Proxy :: Proxy key)\n insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow\n tail = bottomRecord (Proxy :: Proxy rowlistTail) rowProxy\n\ninstance boundedRecord ::\n ( RL.RowToList row list\n , BoundedRecord list row row\n ) =>\n Bounded (Record row) where\n top = topRecord (Proxy :: Proxy list) (Proxy :: Proxy row)\n bottom = bottomRecord (Proxy :: Proxy list) (Proxy :: Proxy row)\n", "export const showIntImpl = function (n) {\n return n.toString();\n};\n\nexport const showNumberImpl = function (n) {\n var str = n.toString();\n return isNaN(str + \".0\") ? str : str + \".0\";\n};\n\nexport const showCharImpl = function (c) {\n var code = c.charCodeAt(0);\n if (code < 0x20 || code === 0x7F) {\n switch (c) {\n case \"\\x07\": return \"'\\\\a'\";\n case \"\\b\": return \"'\\\\b'\";\n case \"\\f\": return \"'\\\\f'\";\n case \"\\n\": return \"'\\\\n'\";\n case \"\\r\": return \"'\\\\r'\";\n case \"\\t\": return \"'\\\\t'\";\n case \"\\v\": return \"'\\\\v'\";\n }\n return \"'\\\\\" + code.toString(10) + \"'\";\n }\n return c === \"'\" || c === \"\\\\\" ? \"'\\\\\" + c + \"'\" : \"'\" + c + \"'\";\n};\n\nexport const showStringImpl = function (s) {\n var l = s.length;\n return \"\\\"\" + s.replace(\n /[\\0-\\x1F\\x7F\"\\\\]/g, // eslint-disable-line no-control-regex\n function (c, i) {\n switch (c) {\n case \"\\\"\":\n case \"\\\\\":\n return \"\\\\\" + c;\n case \"\\x07\": return \"\\\\a\";\n case \"\\b\": return \"\\\\b\";\n case \"\\f\": return \"\\\\f\";\n case \"\\n\": return \"\\\\n\";\n case \"\\r\": return \"\\\\r\";\n case \"\\t\": return \"\\\\t\";\n case \"\\v\": return \"\\\\v\";\n }\n var k = i + 1;\n var empty = k < l && s[k] >= \"0\" && s[k] <= \"9\" ? \"\\\\&\" : \"\";\n return \"\\\\\" + c.charCodeAt(0).toString(10) + empty;\n }\n ) + \"\\\"\";\n};\n\nexport const showArrayImpl = function (f) {\n return function (xs) {\n var ss = [];\n for (var i = 0, l = xs.length; i < l; i++) {\n ss[i] = f(xs[i]);\n }\n return \"[\" + ss.join(\",\") + \"]\";\n };\n};\n", "module Data.Show\n ( class Show\n , show\n , class ShowRecordFields\n , showRecordFields\n ) where\n\nimport Data.Semigroup ((<>))\nimport Data.Symbol (class IsSymbol, reflectSymbol)\nimport Data.Unit (Unit)\nimport Data.Void (Void, absurd)\nimport Prim.Row (class Nub)\nimport Prim.RowList as RL\nimport Record.Unsafe (unsafeGet)\nimport Type.Proxy (Proxy(..))\n\n-- | The `Show` type class represents those types which can be converted into\n-- | a human-readable `String` representation.\n-- |\n-- | While not required, it is recommended that for any expression `x`, the\n-- | string `show x` be executable PureScript code which evaluates to the same\n-- | value as the expression `x`.\nclass Show a where\n show :: a -> String\n\ninstance showUnit :: Show Unit where\n show _ = \"unit\"\n\ninstance showBoolean :: Show Boolean where\n show true = \"true\"\n show false = \"false\"\n\ninstance showInt :: Show Int where\n show = showIntImpl\n\ninstance showNumber :: Show Number where\n show = showNumberImpl\n\ninstance showChar :: Show Char where\n show = showCharImpl\n\ninstance showString :: Show String where\n show = showStringImpl\n\ninstance showArray :: Show a => Show (Array a) where\n show = showArrayImpl show\n\ninstance showProxy :: Show (Proxy a) where\n show _ = \"Proxy\"\n\ninstance showVoid :: Show Void where\n show = absurd\n\ninstance showRecord ::\n ( Nub rs rs\n , RL.RowToList rs ls\n , ShowRecordFields ls rs\n ) =>\n Show (Record rs) where\n show record = \"{\" <> showRecordFields (Proxy :: Proxy ls) record <> \"}\"\n\n-- | A class for records where all fields have `Show` instances, used to\n-- | implement the `Show` instance for records.\nclass ShowRecordFields :: RL.RowList Type -> Row Type -> Constraint\nclass ShowRecordFields rowlist row where\n showRecordFields :: Proxy rowlist -> Record row -> String\n\ninstance showRecordFieldsNil :: ShowRecordFields RL.Nil row where\n showRecordFields _ _ = \"\"\nelse\ninstance showRecordFieldsConsNil ::\n ( IsSymbol key\n , Show focus\n ) =>\n ShowRecordFields (RL.Cons key focus RL.Nil) row where\n showRecordFields _ record = \" \" <> key <> \": \" <> show focus <> \" \"\n where\n key = reflectSymbol (Proxy :: Proxy key)\n focus = unsafeGet key record :: focus\nelse\ninstance showRecordFieldsCons ::\n ( IsSymbol key\n , ShowRecordFields rowlistTail row\n , Show focus\n ) =>\n ShowRecordFields (RL.Cons key focus rowlistTail) row where\n showRecordFields _ record = \" \" <> key <> \": \" <> show focus <> \",\" <> tail\n where\n key = reflectSymbol (Proxy :: Proxy key)\n focus = unsafeGet key record :: focus\n tail = showRecordFields (Proxy :: Proxy rowlistTail) record\n\nforeign import showIntImpl :: Int -> String\nforeign import showNumberImpl :: Number -> String\nforeign import showCharImpl :: Char -> String\nforeign import showStringImpl :: String -> String\nforeign import showArrayImpl :: forall a. (a -> String) -> Array a -> String\n", "module Data.Maybe where\n\nimport Prelude\n\nimport Control.Alt (class Alt, (<|>))\nimport Control.Alternative (class Alternative)\nimport Control.Extend (class Extend)\nimport Control.Plus (class Plus)\n\nimport Data.Eq (class Eq1)\nimport Data.Functor.Invariant (class Invariant, imapF)\nimport Data.Generic.Rep (class Generic)\nimport Data.Ord (class Ord1)\n\n-- | The `Maybe` type is used to represent optional values and can be seen as\n-- | something like a type-safe `null`, where `Nothing` is `null` and `Just x`\n-- | is the non-null value `x`.\ndata Maybe a = Nothing | Just a\n\n-- | The `Functor` instance allows functions to transform the contents of a\n-- | `Just` with the `<$>` operator:\n-- |\n-- | ``` purescript\n-- | f <$> Just x == Just (f x)\n-- | ```\n-- |\n-- | `Nothing` values are left untouched:\n-- |\n-- | ``` purescript\n-- | f <$> Nothing == Nothing\n-- | ```\ninstance functorMaybe :: Functor Maybe where\n map fn (Just x) = Just (fn x)\n map _ _ = Nothing\n\n-- | The `Apply` instance allows functions contained within a `Just` to\n-- | transform a value contained within a `Just` using the `apply` operator:\n-- |\n-- | ``` purescript\n-- | Just f <*> Just x == Just (f x)\n-- | ```\n-- |\n-- | `Nothing` values are left untouched:\n-- |\n-- | ``` purescript\n-- | Just f <*> Nothing == Nothing\n-- | Nothing <*> Just x == Nothing\n-- | ```\n-- |\n-- | Combining `Functor`'s `<$>` with `Apply`'s `<*>` can be used transform a\n-- | pure function to take `Maybe`-typed arguments so `f :: a -> b -> c`\n-- | becomes `f :: Maybe a -> Maybe b -> Maybe c`:\n-- |\n-- | ``` purescript\n-- | f <$> Just x <*> Just y == Just (f x y)\n-- | ```\n-- |\n-- | The `Nothing`-preserving behaviour of both operators means the result of\n-- | an expression like the above but where any one of the values is `Nothing`\n-- | means the whole result becomes `Nothing` also:\n-- |\n-- | ``` purescript\n-- | f <$> Nothing <*> Just y == Nothing\n-- | f <$> Just x <*> Nothing == Nothing\n-- | f <$> Nothing <*> Nothing == Nothing\n-- | ```\ninstance applyMaybe :: Apply Maybe where\n apply (Just fn) x = fn <$> x\n apply Nothing _ = Nothing\n\n-- | The `Applicative` instance enables lifting of values into `Maybe` with the\n-- | `pure` function:\n-- |\n-- | ``` purescript\n-- | pure x :: Maybe _ == Just x\n-- | ```\n-- |\n-- | Combining `Functor`'s `<$>` with `Apply`'s `<*>` and `Applicative`'s\n-- | `pure` can be used to pass a mixture of `Maybe` and non-`Maybe` typed\n-- | values to a function that does not usually expect them, by using `pure`\n-- | for any value that is not already `Maybe` typed:\n-- |\n-- | ``` purescript\n-- | f <$> Just x <*> pure y == Just (f x y)\n-- | ```\n-- |\n-- | Even though `pure = Just` it is recommended to use `pure` in situations\n-- | like this as it allows the choice of `Applicative` to be changed later\n-- | without having to go through and replace `Just` with a new constructor.\ninstance applicativeMaybe :: Applicative Maybe where\n pure = Just\n\n-- | The `Alt` instance allows for a choice to be made between two `Maybe`\n-- | values with the `<|>` operator, where the first `Just` encountered\n-- | is taken.\n-- |\n-- | ``` purescript\n-- | Just x <|> Just y == Just x\n-- | Nothing <|> Just y == Just y\n-- | Nothing <|> Nothing == Nothing\n-- | ```\ninstance altMaybe :: Alt Maybe where\n alt Nothing r = r\n alt l _ = l\n\n-- | The `Plus` instance provides a default `Maybe` value:\n-- |\n-- | ``` purescript\n-- | empty :: Maybe _ == Nothing\n-- | ```\ninstance plusMaybe :: Plus Maybe where\n empty = Nothing\n\n-- | The `Alternative` instance guarantees that there are both `Applicative` and\n-- | `Plus` instances for `Maybe`.\ninstance alternativeMaybe :: Alternative Maybe\n\n-- | The `Bind` instance allows sequencing of `Maybe` values and functions that\n-- | return a `Maybe` by using the `>>=` operator:\n-- |\n-- | ``` purescript\n-- | Just x >>= f = f x\n-- | Nothing >>= f = Nothing\n-- | ```\ninstance bindMaybe :: Bind Maybe where\n bind (Just x) k = k x\n bind Nothing _ = Nothing\n\n-- | The `Monad` instance guarantees that there are both `Applicative` and\n-- | `Bind` instances for `Maybe`. This also enables the `do` syntactic sugar:\n-- |\n-- | ``` purescript\n-- | do\n-- | x' <- x\n-- | y' <- y\n-- | pure (f x' y')\n-- | ```\n-- |\n-- | Which is equivalent to:\n-- |\n-- | ``` purescript\n-- | x >>= (\\x' -> y >>= (\\y' -> pure (f x' y')))\n-- | ```\n-- |\n-- | Which is equivalent to:\n-- |\n-- | ``` purescript\n-- | case x of\n-- | Nothing -> Nothing\n-- | Just x' -> case y of\n-- | Nothing -> Nothing\n-- | Just y' -> Just (f x' y')\n-- | ```\ninstance monadMaybe :: Monad Maybe\n\n-- | The `Extend` instance allows sequencing of `Maybe` values and functions\n-- | that accept a `Maybe a` and return a non-`Maybe` result using the\n-- | `<<=` operator.\n-- |\n-- | ``` purescript\n-- | f <<= Nothing = Nothing\n-- | f <<= x = Just (f x)\n-- | ```\ninstance extendMaybe :: Extend Maybe where\n extend _ Nothing = Nothing\n extend f x = Just (f x)\n\ninstance invariantMaybe :: Invariant Maybe where\n imap = imapF\n\n-- | The `Semigroup` instance enables use of the operator `<>` on `Maybe` values\n-- | whenever there is a `Semigroup` instance for the type the `Maybe` contains.\n-- | The exact behaviour of `<>` depends on the \"inner\" `Semigroup` instance,\n-- | but generally captures the notion of appending or combining things.\n-- |\n-- | ``` purescript\n-- | Just x <> Just y = Just (x <> y)\n-- | Just x <> Nothing = Just x\n-- | Nothing <> Just y = Just y\n-- | Nothing <> Nothing = Nothing\n-- | ```\ninstance semigroupMaybe :: Semigroup a => Semigroup (Maybe a) where\n append Nothing y = y\n append x Nothing = x\n append (Just x) (Just y) = Just (x <> y)\n\ninstance monoidMaybe :: Semigroup a => Monoid (Maybe a) where\n mempty = Nothing\n\ninstance semiringMaybe :: Semiring a => Semiring (Maybe a) where\n zero = Nothing\n one = Just one\n\n add Nothing y = y\n add x Nothing = x\n add (Just x) (Just y) = Just (add x y)\n\n mul x y = mul <$> x <*> y\n\n-- | The `Eq` instance allows `Maybe` values to be checked for equality with\n-- | `==` and inequality with `/=` whenever there is an `Eq` instance for the\n-- | type the `Maybe` contains.\nderive instance eqMaybe :: Eq a => Eq (Maybe a)\n\ninstance eq1Maybe :: Eq1 Maybe where eq1 = eq\n\n-- | The `Ord` instance allows `Maybe` values to be compared with\n-- | `compare`, `>`, `>=`, `<` and `<=` whenever there is an `Ord` instance for\n-- | the type the `Maybe` contains.\n-- |\n-- | `Nothing` is considered to be less than any `Just` value.\nderive instance ordMaybe :: Ord a => Ord (Maybe a)\n\ninstance ord1Maybe :: Ord1 Maybe where compare1 = compare\n\ninstance boundedMaybe :: Bounded a => Bounded (Maybe a) where\n top = Just top\n bottom = Nothing\n\n-- | The `Show` instance allows `Maybe` values to be rendered as a string with\n-- | `show` whenever there is an `Show` instance for the type the `Maybe`\n-- | contains.\ninstance showMaybe :: Show a => Show (Maybe a) where\n show (Just x) = \"(Just \" <> show x <> \")\"\n show Nothing = \"Nothing\"\n\nderive instance genericMaybe :: Generic (Maybe a) _\n\n-- | Takes a default value, a function, and a `Maybe` value. If the `Maybe`\n-- | value is `Nothing` the default value is returned, otherwise the function\n-- | is applied to the value inside the `Just` and the result is returned.\n-- |\n-- | ``` purescript\n-- | maybe x f Nothing == x\n-- | maybe x f (Just y) == f y\n-- | ```\nmaybe :: forall a b. b -> (a -> b) -> Maybe a -> b\nmaybe b _ Nothing = b\nmaybe _ f (Just a) = f a\n\n-- | Similar to `maybe` but for use in cases where the default value may be\n-- | expensive to compute. As PureScript is not lazy, the standard `maybe` has\n-- | to evaluate the default value before returning the result, whereas here\n-- | the value is only computed when the `Maybe` is known to be `Nothing`.\n-- |\n-- | ``` purescript\n-- | maybe' (\\_ -> x) f Nothing == x\n-- | maybe' (\\_ -> x) f (Just y) == f y\n-- | ```\nmaybe' :: forall a b. (Unit -> b) -> (a -> b) -> Maybe a -> b\nmaybe' g _ Nothing = g unit\nmaybe' _ f (Just a) = f a\n\n-- | Takes a default value, and a `Maybe` value. If the `Maybe` value is\n-- | `Nothing` the default value is returned, otherwise the value inside the\n-- | `Just` is returned.\n-- |\n-- | ``` purescript\n-- | fromMaybe x Nothing == x\n-- | fromMaybe x (Just y) == y\n-- | ```\nfromMaybe :: forall a. a -> Maybe a -> a\nfromMaybe a = maybe a identity\n\n-- | Similar to `fromMaybe` but for use in cases where the default value may be\n-- | expensive to compute. As PureScript is not lazy, the standard `fromMaybe`\n-- | has to evaluate the default value before returning the result, whereas here\n-- | the value is only computed when the `Maybe` is known to be `Nothing`.\n-- |\n-- | ``` purescript\n-- | fromMaybe' (\\_ -> x) Nothing == x\n-- | fromMaybe' (\\_ -> x) (Just y) == y\n-- | ```\nfromMaybe' :: forall a. (Unit -> a) -> Maybe a -> a\nfromMaybe' a = maybe' a identity\n\n-- | Returns `true` when the `Maybe` value was constructed with `Just`.\nisJust :: forall a. Maybe a -> Boolean\nisJust = maybe false (const true)\n\n-- | Returns `true` when the `Maybe` value is `Nothing`.\nisNothing :: forall a. Maybe a -> Boolean\nisNothing = maybe true (const false)\n\n-- | A partial function that extracts the value from the `Just` data\n-- | constructor. Passing `Nothing` to `fromJust` will throw an error at\n-- | runtime.\nfromJust :: forall a. Partial => Maybe a -> a\nfromJust (Just x) = x\n\n-- | One or none.\n-- |\n-- | ```purescript\n-- | optional empty = pure Nothing\n-- | ```\n-- |\n-- | The behaviour of `optional (pure x)` depends on whether the `Alt` instance\n-- | satisfy the left catch law (`pure a <|> b = pure a`).\n-- |\n-- | `Either e` does:\n-- |\n-- | ```purescript\n-- | optional (Right x) = Right (Just x)\n-- | ```\n-- |\n-- | But `Array` does not:\n-- |\n-- | ```purescript\n-- | optional [x] = [Just x, Nothing]\n-- | ```\noptional :: forall f a. Alt f => Applicative f => f a -> f (Maybe a)\noptional a = map Just a <|> pure Nothing\n", "module Data.Either where\n\nimport Prelude\n\nimport Control.Alt (class Alt, (<|>))\nimport Control.Extend (class Extend)\nimport Data.Eq (class Eq1)\nimport Data.Functor.Invariant (class Invariant, imapF)\nimport Data.Generic.Rep (class Generic)\nimport Data.Maybe (Maybe(..), maybe, maybe')\nimport Data.Ord (class Ord1)\n\n-- | The `Either` type is used to represent a choice between two types of value.\n-- |\n-- | A common use case for `Either` is error handling, where `Left` is used to\n-- | carry an error value and `Right` is used to carry a success value.\ndata Either a b = Left a | Right b\n\n-- | The `Functor` instance allows functions to transform the contents of a\n-- | `Right` with the `<$>` operator:\n-- |\n-- | ``` purescript\n-- | f <$> Right x == Right (f x)\n-- | ```\n-- |\n-- | `Left` values are untouched:\n-- |\n-- | ``` purescript\n-- | f <$> Left y == Left y\n-- | ```\nderive instance functorEither :: Functor (Either a)\n\nderive instance genericEither :: Generic (Either a b) _\n\ninstance invariantEither :: Invariant (Either a) where\n imap = imapF\n\n-- | The `Apply` instance allows functions contained within a `Right` to\n-- | transform a value contained within a `Right` using the `(<*>)` operator:\n-- |\n-- | ``` purescript\n-- | Right f <*> Right x == Right (f x)\n-- | ```\n-- |\n-- | `Left` values are left untouched:\n-- |\n-- | ``` purescript\n-- | Left f <*> Right x == Left f\n-- | Right f <*> Left y == Left y\n-- | ```\n-- |\n-- | Combining `Functor`'s `<$>` with `Apply`'s `<*>` can be used to transform a\n-- | pure function to take `Either`-typed arguments so `f :: a -> b -> c`\n-- | becomes `f :: Either l a -> Either l b -> Either l c`:\n-- |\n-- | ``` purescript\n-- | f <$> Right x <*> Right y == Right (f x y)\n-- | ```\n-- |\n-- | The `Left`-preserving behaviour of both operators means the result of\n-- | an expression like the above but where any one of the values is `Left`\n-- | means the whole result becomes `Left` also, taking the first `Left` value\n-- | found:\n-- |\n-- | ``` purescript\n-- | f <$> Left x <*> Right y == Left x\n-- | f <$> Right x <*> Left y == Left y\n-- | f <$> Left x <*> Left y == Left x\n-- | ```\ninstance applyEither :: Apply (Either e) where\n apply (Left e) _ = Left e\n apply (Right f) r = f <$> r\n\n-- | The `Applicative` instance enables lifting of values into `Either` with the\n-- | `pure` function:\n-- |\n-- | ``` purescript\n-- | pure x :: Either _ _ == Right x\n-- | ```\n-- |\n-- | Combining `Functor`'s `<$>` with `Apply`'s `<*>` and `Applicative`'s\n-- | `pure` can be used to pass a mixture of `Either` and non-`Either` typed\n-- | values to a function that does not usually expect them, by using `pure`\n-- | for any value that is not already `Either` typed:\n-- |\n-- | ``` purescript\n-- | f <$> Right x <*> pure y == Right (f x y)\n-- | ```\n-- |\n-- | Even though `pure = Right` it is recommended to use `pure` in situations\n-- | like this as it allows the choice of `Applicative` to be changed later\n-- | without having to go through and replace `Right` with a new constructor.\ninstance applicativeEither :: Applicative (Either e) where\n pure = Right\n\n-- | The `Alt` instance allows for a choice to be made between two `Either`\n-- | values with the `<|>` operator, where the first `Right` encountered\n-- | is taken.\n-- |\n-- | ``` purescript\n-- | Right x <|> Right y == Right x\n-- | Left x <|> Right y == Right y\n-- | Left x <|> Left y == Left y\n-- | ```\ninstance altEither :: Alt (Either e) where\n alt (Left _) r = r\n alt l _ = l\n\n-- | The `Bind` instance allows sequencing of `Either` values and functions that\n-- | return an `Either` by using the `>>=` operator:\n-- |\n-- | ``` purescript\n-- | Left x >>= f = Left x\n-- | Right x >>= f = f x\n-- | ```\n-- |\n-- | `Either`'s \"do notation\" can be understood to work like this:\n-- | ``` purescript\n-- | x :: forall e a. Either e a\n-- | x = --\n-- |\n-- | y :: forall e b. Either e b\n-- | y = --\n-- |\n-- | foo :: forall e a. (a -> b -> c) -> Either e c\n-- | foo f = do\n-- | x' <- x\n-- | y' <- y\n-- | pure (f x' y')\n-- | ```\n-- |\n-- | ...which is equivalent to...\n-- |\n-- | ``` purescript\n-- | x >>= (\\x' -> y >>= (\\y' -> pure (f x' y')))\n-- | ```\n-- |\n-- | ...and is the same as writing...\n-- |\n-- | ```\n-- | foo :: forall e a. (a -> b -> c) -> Either e c\n-- | foo f = case x of\n-- | Left e ->\n-- | Left e\n-- | Right x -> case y of\n-- | Left e ->\n-- | Left e\n-- | Right y ->\n-- | Right (f x y)\n-- | ```\ninstance bindEither :: Bind (Either e) where\n bind = either (\\e _ -> Left e) (\\a f -> f a)\n\n-- | The `Monad` instance guarantees that there are both `Applicative` and\n-- | `Bind` instances for `Either`.\ninstance monadEither :: Monad (Either e)\n\n-- | The `Extend` instance allows sequencing of `Either` values and functions\n-- | that accept an `Either` and return a non-`Either` result using the\n-- | `<<=` operator.\n-- |\n-- | ``` purescript\n-- | f <<= Left x = Left x\n-- | f <<= Right x = Right (f (Right x))\n-- | ```\ninstance extendEither :: Extend (Either e) where\n extend _ (Left y) = Left y\n extend f x = Right (f x)\n\n-- | The `Show` instance allows `Either` values to be rendered as a string with\n-- | `show` whenever there is an `Show` instance for both type the `Either` can\n-- | contain.\ninstance showEither :: (Show a, Show b) => Show (Either a b) where\n show (Left x) = \"(Left \" <> show x <> \")\"\n show (Right y) = \"(Right \" <> show y <> \")\"\n\n-- | The `Eq` instance allows `Either` values to be checked for equality with\n-- | `==` and inequality with `/=` whenever there is an `Eq` instance for both\n-- | types the `Either` can contain.\nderive instance eqEither :: (Eq a, Eq b) => Eq (Either a b)\n\nderive instance eq1Either :: Eq a => Eq1 (Either a)\n\n-- | The `Ord` instance allows `Either` values to be compared with\n-- | `compare`, `>`, `>=`, `<` and `<=` whenever there is an `Ord` instance for\n-- | both types the `Either` can contain.\n-- |\n-- | Any `Left` value is considered to be less than a `Right` value.\nderive instance ordEither :: (Ord a, Ord b) => Ord (Either a b)\n\nderive instance ord1Either :: Ord a => Ord1 (Either a)\n\ninstance boundedEither :: (Bounded a, Bounded b) => Bounded (Either a b) where\n top = Right top\n bottom = Left bottom\n\ninstance semigroupEither :: (Semigroup b) => Semigroup (Either a b) where\n append x y = append <$> x <*> y\n\n-- | Takes two functions and an `Either` value, if the value is a `Left` the\n-- | inner value is applied to the first function, if the value is a `Right`\n-- | the inner value is applied to the second function.\n-- |\n-- | ``` purescript\n-- | either f g (Left x) == f x\n-- | either f g (Right y) == g y\n-- | ```\neither :: forall a b c. (a -> c) -> (b -> c) -> Either a b -> c\neither f _ (Left a) = f a\neither _ g (Right b) = g b\n\n-- | Combine two alternatives.\nchoose :: forall m a b. Alt m => m a -> m b -> m (Either a b)\nchoose a b = Left <$> a <|> Right <$> b\n\n-- | Returns `true` when the `Either` value was constructed with `Left`.\nisLeft :: forall a b. Either a b -> Boolean\nisLeft = either (const true) (const false)\n\n-- | Returns `true` when the `Either` value was constructed with `Right`.\nisRight :: forall a b. Either a b -> Boolean\nisRight = either (const false) (const true)\n\n-- | A function that extracts the value from the `Left` data constructor.\n-- | The first argument is a default value, which will be returned in the\n-- | case where a `Right` is passed to `fromLeft`.\nfromLeft :: forall a b. a -> Either a b -> a\nfromLeft _ (Left a) = a\nfromLeft default _ = default\n\n-- | Similar to `fromLeft` but for use in cases where the default value may be\n-- | expensive to compute. As PureScript is not lazy, the standard `fromLeft`\n-- | has to evaluate the default value before returning the result,\n-- | whereas here the value is only computed when the `Either` is known\n-- | to be `Right`.\nfromLeft' :: forall a b. (Unit -> a) -> Either a b -> a\nfromLeft' _ (Left a) = a\nfromLeft' default _ = default unit\n\n-- | A function that extracts the value from the `Right` data constructor.\n-- | The first argument is a default value, which will be returned in the\n-- | case where a `Left` is passed to `fromRight`.\nfromRight :: forall a b. b -> Either a b -> b\nfromRight _ (Right b) = b\nfromRight default _ = default\n\n-- | Similar to `fromRight` but for use in cases where the default value may be\n-- | expensive to compute. As PureScript is not lazy, the standard `fromRight`\n-- | has to evaluate the default value before returning the result,\n-- | whereas here the value is only computed when the `Either` is known\n-- | to be `Left`.\nfromRight' :: forall a b. (Unit -> b) -> Either a b -> b\nfromRight' _ (Right b) = b\nfromRight' default _ = default unit\n\n-- | Takes a default and a `Maybe` value, if the value is a `Just`, turn it into\n-- | a `Right`, if the value is a `Nothing` use the provided default as a `Left`\n-- |\n-- | ```purescript\n-- | note \"default\" Nothing = Left \"default\"\n-- | note \"default\" (Just 1) = Right 1\n-- | ```\nnote :: forall a b. a -> Maybe b -> Either a b\nnote a = maybe (Left a) Right\n\n-- | Similar to `note`, but for use in cases where the default value may be\n-- | expensive to compute.\n-- |\n-- | ```purescript\n-- | note' (\\_ -> \"default\") Nothing = Left \"default\"\n-- | note' (\\_ -> \"default\") (Just 1) = Right 1\n-- | ```\nnote' :: forall a b. (Unit -> a) -> Maybe b -> Either a b\nnote' f = maybe' (Left <<< f) Right\n\n-- | Turns an `Either` into a `Maybe`, by throwing potential `Left` values away and converting\n-- | them into `Nothing`. `Right` values get turned into `Just`s.\n-- |\n-- | ```purescript\n-- | hush (Left \"ParseError\") = Nothing\n-- | hush (Right 42) = Just 42\n-- | ```\nhush :: forall a b. Either a b -> Maybe b\nhush = either (const Nothing) Just\n\n-- | Turns an `Either` into a `Maybe`, by throwing potential `Right` values away and converting\n-- | them into `Nothing`. `Left` values get turned into `Just`s.\n-- |\n-- | ```purescript\n-- | blush (Left \"ParseError\") = Just \"Parse Error\"\n-- | blush (Right 42) = Nothing\n-- | ```\nblush :: forall a b. Either a b -> Maybe a\nblush = either Just (const Nothing)\n", "module Control.Lazy where\n\nimport Data.Unit (Unit, unit)\n\n-- | The `Lazy` class represents types which allow evaluation of values\n-- | to be _deferred_.\n-- |\n-- | Usually, this means that a type contains a function arrow which can\n-- | be used to delay evaluation.\nclass Lazy l where\n defer :: (Unit -> l) -> l\n\ninstance lazyFn :: Lazy (a -> b) where\n defer f = \\x -> f unit x\n\ninstance lazyUnit :: Lazy Unit where\n defer _ = unit\n\n-- | `fix` defines a value as the fixed point of a function.\n-- |\n-- | The `Lazy` instance allows us to generate the result lazily.\nfix :: forall l. Lazy l => (l -> l) -> l\nfix f = go\n where\n go = defer \\_ -> f go\n", "export const boolConj = function (b1) {\n return function (b2) {\n return b1 && b2;\n };\n};\n\nexport const boolDisj = function (b1) {\n return function (b2) {\n return b1 || b2;\n };\n};\n\nexport const boolNot = function (b) {\n return !b;\n};\n", "module Data.HeytingAlgebra\n ( class HeytingAlgebra\n , tt\n , ff\n , implies\n , conj\n , disj\n , not\n , (&&)\n , (||)\n , class HeytingAlgebraRecord\n , ffRecord\n , ttRecord\n , impliesRecord\n , conjRecord\n , disjRecord\n , notRecord\n ) where\n\nimport Data.Symbol (class IsSymbol, reflectSymbol)\nimport Data.Unit (Unit, unit)\nimport Prim.Row as Row\nimport Prim.RowList as RL\nimport Record.Unsafe (unsafeGet, unsafeSet)\nimport Type.Proxy (Proxy(..))\n\n-- | The `HeytingAlgebra` type class represents types that are bounded lattices with\n-- | an implication operator such that the following laws hold:\n-- |\n-- | - Associativity:\n-- | - `a || (b || c) = (a || b) || c`\n-- | - `a && (b && c) = (a && b) && c`\n-- | - Commutativity:\n-- | - `a || b = b || a`\n-- | - `a && b = b && a`\n-- | - Absorption:\n-- | - `a || (a && b) = a`\n-- | - `a && (a || b) = a`\n-- | - Idempotent:\n-- | - `a || a = a`\n-- | - `a && a = a`\n-- | - Identity:\n-- | - `a || ff = a`\n-- | - `a && tt = a`\n-- | - Implication:\n-- | - ``a `implies` a = tt``\n-- | - ``a && (a `implies` b) = a && b``\n-- | - ``b && (a `implies` b) = b``\n-- | - ``a `implies` (b && c) = (a `implies` b) && (a `implies` c)``\n-- | - Complemented:\n-- | - ``not a = a `implies` ff``\nclass HeytingAlgebra a where\n ff :: a\n tt :: a\n implies :: a -> a -> a\n conj :: a -> a -> a\n disj :: a -> a -> a\n not :: a -> a\n\ninfixr 3 conj as &&\ninfixr 2 disj as ||\n\ninstance heytingAlgebraBoolean :: HeytingAlgebra Boolean where\n ff = false\n tt = true\n implies a b = not a || b\n conj = boolConj\n disj = boolDisj\n not = boolNot\n\ninstance heytingAlgebraUnit :: HeytingAlgebra Unit where\n ff = unit\n tt = unit\n implies _ _ = unit\n conj _ _ = unit\n disj _ _ = unit\n not _ = unit\n\ninstance heytingAlgebraFunction :: HeytingAlgebra b => HeytingAlgebra (a -> b) where\n ff _ = ff\n tt _ = tt\n implies f g a = f a `implies` g a\n conj f g a = f a && g a\n disj f g a = f a || g a\n not f a = not (f a)\n\ninstance heytingAlgebraProxy :: HeytingAlgebra (Proxy a) where\n conj _ _ = Proxy\n disj _ _ = Proxy\n implies _ _ = Proxy\n ff = Proxy\n not _ = Proxy\n tt = Proxy\n\ninstance heytingAlgebraRecord :: (RL.RowToList row list, HeytingAlgebraRecord list row row) => HeytingAlgebra (Record row) where\n ff = ffRecord (Proxy :: Proxy list) (Proxy :: Proxy row)\n tt = ttRecord (Proxy :: Proxy list) (Proxy :: Proxy row)\n conj = conjRecord (Proxy :: Proxy list)\n disj = disjRecord (Proxy :: Proxy list)\n implies = impliesRecord (Proxy :: Proxy list)\n not = notRecord (Proxy :: Proxy list)\n\nforeign import boolConj :: Boolean -> Boolean -> Boolean\nforeign import boolDisj :: Boolean -> Boolean -> Boolean\nforeign import boolNot :: Boolean -> Boolean\n\n-- | A class for records where all fields have `HeytingAlgebra` instances, used\n-- | to implement the `HeytingAlgebra` instance for records.\nclass HeytingAlgebraRecord :: RL.RowList Type -> Row Type -> Row Type -> Constraint\nclass HeytingAlgebraRecord rowlist row subrow | rowlist -> subrow where\n ffRecord :: Proxy rowlist -> Proxy row -> Record subrow\n ttRecord :: Proxy rowlist -> Proxy row -> Record subrow\n impliesRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow\n disjRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow\n conjRecord :: Proxy rowlist -> Record row -> Record row -> Record subrow\n notRecord :: Proxy rowlist -> Record row -> Record subrow\n\ninstance heytingAlgebraRecordNil :: HeytingAlgebraRecord RL.Nil row () where\n conjRecord _ _ _ = {}\n disjRecord _ _ _ = {}\n ffRecord _ _ = {}\n impliesRecord _ _ _ = {}\n notRecord _ _ = {}\n ttRecord _ _ = {}\n\ninstance heytingAlgebraRecordCons ::\n ( IsSymbol key\n , Row.Cons key focus subrowTail subrow\n , HeytingAlgebraRecord rowlistTail row subrowTail\n , HeytingAlgebra focus\n ) =>\n HeytingAlgebraRecord (RL.Cons key focus rowlistTail) row subrow where\n conjRecord _ ra rb = insert (conj (get ra) (get rb)) tail\n where\n key = reflectSymbol (Proxy :: Proxy key)\n get = unsafeGet key :: Record row -> focus\n insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow\n tail = conjRecord (Proxy :: Proxy rowlistTail) ra rb\n\n disjRecord _ ra rb = insert (disj (get ra) (get rb)) tail\n where\n key = reflectSymbol (Proxy :: Proxy key)\n get = unsafeGet key :: Record row -> focus\n insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow\n tail = disjRecord (Proxy :: Proxy rowlistTail) ra rb\n\n impliesRecord _ ra rb = insert (implies (get ra) (get rb)) tail\n where\n key = reflectSymbol (Proxy :: Proxy key)\n get = unsafeGet key :: Record row -> focus\n insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow\n tail = impliesRecord (Proxy :: Proxy rowlistTail) ra rb\n\n ffRecord _ row = insert ff tail\n where\n key = reflectSymbol (Proxy :: Proxy key)\n insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow\n tail = ffRecord (Proxy :: Proxy rowlistTail) row\n\n notRecord _ row = insert (not (get row)) tail\n where\n key = reflectSymbol (Proxy :: Proxy key)\n get = unsafeGet key :: Record row -> focus\n insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow\n tail = notRecord (Proxy :: Proxy rowlistTail) row\n\n ttRecord _ row = insert tt tail\n where\n key = reflectSymbol (Proxy :: Proxy key)\n insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow\n tail = ttRecord (Proxy :: Proxy rowlistTail) row\n", "export const intDegree = function (x) {\n return Math.min(Math.abs(x), 2147483647);\n};\n\n// See the Euclidean definition in\n// https://en.m.wikipedia.org/wiki/Modulo_operation.\nexport const intDiv = function (x) {\n return function (y) {\n if (y === 0) return 0;\n return y > 0 ? Math.floor(x / y) : -Math.floor(x / -y);\n };\n};\n\nexport const intMod = function (x) {\n return function (y) {\n if (y === 0) return 0;\n var yy = Math.abs(y);\n return ((x % yy) + yy) % yy;\n };\n};\n\nexport const numDiv = function (n1) {\n return function (n2) {\n return n1 / n2;\n };\n};\n", "module Data.CommutativeRing\n ( class CommutativeRing\n , module Data.Ring\n , module Data.Semiring\n , class CommutativeRingRecord\n ) where\n\nimport Data.Ring (class Ring, class RingRecord)\nimport Data.Semiring (class Semiring, add, mul, one, zero, (*), (+))\nimport Data.Symbol (class IsSymbol)\nimport Data.Unit (Unit)\nimport Prim.Row as Row\nimport Prim.RowList as RL\nimport Type.Proxy (Proxy)\n\n-- | The `CommutativeRing` class is for rings where multiplication is\n-- | commutative.\n-- |\n-- | Instances must satisfy the following law in addition to the `Ring`\n-- | laws:\n-- |\n-- | - Commutative multiplication: `a * b = b * a`\nclass Ring a <= CommutativeRing a\n\ninstance commutativeRingInt :: CommutativeRing Int\ninstance commutativeRingNumber :: CommutativeRing Number\ninstance commutativeRingUnit :: CommutativeRing Unit\ninstance commutativeRingFn :: CommutativeRing b => CommutativeRing (a -> b)\ninstance commutativeRingRecord :: (RL.RowToList row list, CommutativeRingRecord list row row) => CommutativeRing (Record row)\ninstance commutativeRingProxy :: CommutativeRing (Proxy a)\n\n-- | A class for records where all fields have `CommutativeRing` instances, used\n-- | to implement the `CommutativeRing` instance for records.\nclass RingRecord rowlist row subrow <= CommutativeRingRecord rowlist row subrow | rowlist -> subrow\n\ninstance commutativeRingRecordNil :: CommutativeRingRecord RL.Nil row ()\n\ninstance commutativeRingRecordCons ::\n ( IsSymbol key\n , Row.Cons key focus subrowTail subrow\n , CommutativeRingRecord rowlistTail row subrowTail\n , CommutativeRing focus\n ) =>\n CommutativeRingRecord (RL.Cons key focus rowlistTail) row subrow\n", "module Data.EuclideanRing\n ( class EuclideanRing\n , degree\n , div\n , mod\n , (/)\n , gcd\n , lcm\n , module Data.CommutativeRing\n , module Data.Ring\n , module Data.Semiring\n ) where\n\nimport Data.BooleanAlgebra ((||))\nimport Data.CommutativeRing (class CommutativeRing)\nimport Data.Eq (class Eq, (==))\nimport Data.Ring (class Ring, sub, (-))\nimport Data.Semiring (class Semiring, add, mul, one, zero, (*), (+))\n\n-- | The `EuclideanRing` class is for commutative rings that support division.\n-- | The mathematical structure this class is based on is sometimes also called\n-- | a *Euclidean domain*.\n-- |\n-- | Instances must satisfy the following laws in addition to the `Ring`\n-- | laws:\n-- |\n-- | - Integral domain: `one /= zero`, and if `a` and `b` are both nonzero then\n-- | so is their product `a * b`\n-- | - Euclidean function `degree`:\n-- | - Nonnegativity: For all nonzero `a`, `degree a >= 0`\n-- | - Quotient/remainder: For all `a` and `b`, where `b` is nonzero,\n-- | let `q = a / b` and ``r = a `mod` b``; then `a = q*b + r`, and also\n-- | either `r = zero` or `degree r < degree b`\n-- | - Submultiplicative euclidean function:\n-- | - For all nonzero `a` and `b`, `degree a <= degree (a * b)`\n-- |\n-- | The behaviour of division by `zero` is unconstrained by these laws,\n-- | meaning that individual instances are free to choose how to behave in this\n-- | case. Similarly, there are no restrictions on what the result of\n-- | `degree zero` is; it doesn't make sense to ask for `degree zero` in the\n-- | same way that it doesn't make sense to divide by `zero`, so again,\n-- | individual instances may choose how to handle this case.\n-- |\n-- | For any `EuclideanRing` which is also a `Field`, one valid choice\n-- | for `degree` is simply `const 1`. In fact, unless there's a specific\n-- | reason not to, `Field` types should normally use this definition of\n-- | `degree`.\n-- |\n-- | The `EuclideanRing Int` instance is one of the most commonly used\n-- | `EuclideanRing` instances and deserves a little more discussion. In\n-- | particular, there are a few different sensible law-abiding implementations\n-- | to choose from, with slightly different behaviour in the presence of\n-- | negative dividends or divisors. The most common definitions are \"truncating\"\n-- | division, where the result of `a / b` is rounded towards 0, and \"Knuthian\"\n-- | or \"flooring\" division, where the result of `a / b` is rounded towards\n-- | negative infinity. A slightly less common, but arguably more useful, option\n-- | is \"Euclidean\" division, which is defined so as to ensure that ``a `mod` b``\n-- | is always nonnegative. With Euclidean division, `a / b` rounds towards\n-- | negative infinity if the divisor is positive, and towards positive infinity\n-- | if the divisor is negative. Note that all three definitions are identical if\n-- | we restrict our attention to nonnegative dividends and divisors.\n-- |\n-- | In versions 1.x, 2.x, and 3.x of the Prelude, the `EuclideanRing Int`\n-- | instance used truncating division. As of 4.x, the `EuclideanRing Int`\n-- | instance uses Euclidean division. Additional functions `quot` and `rem` are\n-- | supplied if truncating division is desired.\nclass CommutativeRing a <= EuclideanRing a where\n degree :: a -> Int\n div :: a -> a -> a\n mod :: a -> a -> a\n\ninfixl 7 div as /\n\ninstance euclideanRingInt :: EuclideanRing Int where\n degree = intDegree\n div = intDiv\n mod = intMod\n\ninstance euclideanRingNumber :: EuclideanRing Number where\n degree _ = 1\n div = numDiv\n mod _ _ = 0.0\n\nforeign import intDegree :: Int -> Int\nforeign import intDiv :: Int -> Int -> Int\nforeign import intMod :: Int -> Int -> Int\n\nforeign import numDiv :: Number -> Number -> Number\n\n-- | The *greatest common divisor* of two values.\ngcd :: forall a. Eq a => EuclideanRing a => a -> a -> a\ngcd a b =\n if b == zero then a\n else gcd b (a `mod` b)\n\n-- | The *least common multiple* of two values.\nlcm :: forall a. Eq a => EuclideanRing a => a -> a -> a\nlcm a b =\n if a == zero || b == zero then zero\n else a * b / gcd a b\n", "module Data.Monoid\n ( class Monoid\n , mempty\n , power\n , guard\n , module Data.Semigroup\n , class MonoidRecord\n , memptyRecord\n ) where\n\nimport Data.Boolean (otherwise)\nimport Data.Eq ((==))\nimport Data.EuclideanRing (mod, (/))\nimport Data.Ord ((<=))\nimport Data.Ordering (Ordering(..))\nimport Data.Semigroup (class Semigroup, class SemigroupRecord, (<>))\nimport Data.Symbol (class IsSymbol, reflectSymbol)\nimport Data.Unit (Unit, unit)\nimport Prim.Row as Row\nimport Prim.RowList as RL\nimport Record.Unsafe (unsafeSet)\nimport Type.Proxy (Proxy(..))\n\n-- | A `Monoid` is a `Semigroup` with a value `mempty`, which is both a\n-- | left and right unit for the associative operation `<>`:\n-- |\n-- | - Left unit: `(mempty <> x) = x`\n-- | - Right unit: `(x <> mempty) = x`\n-- |\n-- | `Monoid`s are commonly used as the result of fold operations, where\n-- | `<>` is used to combine individual results, and `mempty` gives the result\n-- | of folding an empty collection of elements.\n-- |\n-- | ### Newtypes for Monoid\n-- |\n-- | Some types (e.g. `Int`, `Boolean`) can implement multiple law-abiding\n-- | instances for `Monoid`. Let's use `Int` as an example\n-- | 1. `<>` could be `+` and `mempty` could be `0`\n-- | 2. `<>` could be `*` and `mempty` could be `1`.\n-- |\n-- | To clarify these ambiguous situations, one should use the newtypes\n-- | defined in `Data.Monoid.` modules.\n-- |\n-- | In the above ambiguous situation, we could use `Additive`\n-- | for the first situation or `Multiplicative` for the second one.\nclass Semigroup m <= Monoid m where\n mempty :: m\n\ninstance monoidUnit :: Monoid Unit where\n mempty = unit\n\ninstance monoidOrdering :: Monoid Ordering where\n mempty = EQ\n\ninstance monoidFn :: Monoid b => Monoid (a -> b) where\n mempty _ = mempty\n\ninstance monoidString :: Monoid String where\n mempty = \"\"\n\ninstance monoidArray :: Monoid (Array a) where\n mempty = []\n\ninstance monoidRecord :: (RL.RowToList row list, MonoidRecord list row row) => Monoid (Record row) where\n mempty = memptyRecord (Proxy :: Proxy list)\n\n-- | Append a value to itself a certain number of times. For the\n-- | `Multiplicative` type, and for a non-negative power, this is the same as\n-- | normal number exponentiation.\n-- |\n-- | If the second argument is negative this function will return `mempty`\n-- | (*unlike* normal number exponentiation). The `Monoid` constraint alone\n-- | is not enough to write a `power` function with the property that `power x\n-- | n` cancels with `power x (-n)`, i.e. `power x n <> power x (-n) = mempty`.\n-- | For that, we would additionally need the ability to invert elements, i.e.\n-- | a Group.\n-- |\n-- | ```purescript\n-- | power [1,2] 3 == [1,2,1,2,1,2]\n-- | power [1,2] 1 == [1,2]\n-- | power [1,2] 0 == []\n-- | power [1,2] (-3) == []\n-- | ```\n-- |\npower :: forall m. Monoid m => m -> Int -> m\npower x = go\n where\n go :: Int -> m\n go p\n | p <= 0 = mempty\n | p == 1 = x\n | p `mod` 2 == 0 = let x' = go (p / 2) in x' <> x'\n | otherwise = let x' = go (p / 2) in x' <> x' <> x\n\n-- | Allow or \"truncate\" a Monoid to its `mempty` value based on a condition.\nguard :: forall m. Monoid m => Boolean -> m -> m\nguard true a = a\nguard false _ = mempty\n\n-- | A class for records where all fields have `Monoid` instances, used to\n-- | implement the `Monoid` instance for records.\nclass MonoidRecord :: RL.RowList Type -> Row Type -> Row Type -> Constraint\nclass SemigroupRecord rowlist row subrow <= MonoidRecord rowlist row subrow | rowlist -> row subrow where\n memptyRecord :: Proxy rowlist -> Record subrow\n\ninstance monoidRecordNil :: MonoidRecord RL.Nil row () where\n memptyRecord _ = {}\n\ninstance monoidRecordCons ::\n ( IsSymbol key\n , Monoid focus\n , Row.Cons key focus subrowTail subrow\n , MonoidRecord rowlistTail row subrowTail\n ) =>\n MonoidRecord (RL.Cons key focus rowlistTail) row subrow where\n memptyRecord _ = insert mempty tail\n where\n key = reflectSymbol (Proxy :: Proxy key)\n insert = unsafeSet key :: focus -> Record subrowTail -> Record subrow\n tail = memptyRecord (Proxy :: Proxy rowlistTail)\n", "-- | A data type and functions for working with ordered pairs.\nmodule Data.Tuple where\n\nimport Prelude\n\nimport Control.Comonad (class Comonad)\nimport Control.Extend (class Extend)\nimport Control.Lazy (class Lazy, defer)\nimport Data.Eq (class Eq1)\nimport Data.Functor.Invariant (class Invariant, imapF)\nimport Data.Generic.Rep (class Generic)\nimport Data.HeytingAlgebra (implies, ff, tt)\nimport Data.Ord (class Ord1)\n\n-- | A simple product type for wrapping a pair of component values.\ndata Tuple a b = Tuple a b\n\n-- | Allows `Tuple`s to be rendered as a string with `show` whenever there are\n-- | `Show` instances for both component types.\ninstance showTuple :: (Show a, Show b) => Show (Tuple a b) where\n show (Tuple a b) = \"(Tuple \" <> show a <> \" \" <> show b <> \")\"\n\n-- | Allows `Tuple`s to be checked for equality with `==` and `/=` whenever\n-- | there are `Eq` instances for both component types.\nderive instance eqTuple :: (Eq a, Eq b) => Eq (Tuple a b)\n\nderive instance eq1Tuple :: Eq a => Eq1 (Tuple a)\n\n-- | Allows `Tuple`s to be compared with `compare`, `>`, `>=`, `<` and `<=`\n-- | whenever there are `Ord` instances for both component types. To obtain\n-- | the result, the `fst`s are `compare`d, and if they are `EQ`ual, the\n-- | `snd`s are `compare`d.\nderive instance ordTuple :: (Ord a, Ord b) => Ord (Tuple a b)\n\nderive instance ord1Tuple :: Ord a => Ord1 (Tuple a)\n\ninstance boundedTuple :: (Bounded a, Bounded b) => Bounded (Tuple a b) where\n top = Tuple top top\n bottom = Tuple bottom bottom\n\ninstance semigroupoidTuple :: Semigroupoid Tuple where\n compose (Tuple _ c) (Tuple a _) = Tuple a c\n\n-- | The `Semigroup` instance enables use of the associative operator `<>` on\n-- | `Tuple`s whenever there are `Semigroup` instances for the component\n-- | types. The `<>` operator is applied pairwise, so:\n-- | ```purescript\n-- | (Tuple a1 b1) <> (Tuple a2 b2) = Tuple (a1 <> a2) (b1 <> b2)\n-- | ```\ninstance semigroupTuple :: (Semigroup a, Semigroup b) => Semigroup (Tuple a b) where\n append (Tuple a1 b1) (Tuple a2 b2) = Tuple (a1 <> a2) (b1 <> b2)\n\ninstance monoidTuple :: (Monoid a, Monoid b) => Monoid (Tuple a b) where\n mempty = Tuple mempty mempty\n\ninstance semiringTuple :: (Semiring a, Semiring b) => Semiring (Tuple a b) where\n add (Tuple x1 y1) (Tuple x2 y2) = Tuple (add x1 x2) (add y1 y2)\n one = Tuple one one\n mul (Tuple x1 y1) (Tuple x2 y2) = Tuple (mul x1 x2) (mul y1 y2)\n zero = Tuple zero zero\n\ninstance ringTuple :: (Ring a, Ring b) => Ring (Tuple a b) where\n sub (Tuple x1 y1) (Tuple x2 y2) = Tuple (sub x1 x2) (sub y1 y2)\n\ninstance commutativeRingTuple :: (CommutativeRing a, CommutativeRing b) => CommutativeRing (Tuple a b)\n\ninstance heytingAlgebraTuple :: (HeytingAlgebra a, HeytingAlgebra b) => HeytingAlgebra (Tuple a b) where\n tt = Tuple tt tt\n ff = Tuple ff ff\n implies (Tuple x1 y1) (Tuple x2 y2) = Tuple (x1 `implies` x2) (y1 `implies` y2)\n conj (Tuple x1 y1) (Tuple x2 y2) = Tuple (conj x1 x2) (conj y1 y2)\n disj (Tuple x1 y1) (Tuple x2 y2) = Tuple (disj x1 x2) (disj y1 y2)\n not (Tuple x y) = Tuple (not x) (not y)\n\ninstance booleanAlgebraTuple :: (BooleanAlgebra a, BooleanAlgebra b) => BooleanAlgebra (Tuple a b)\n\n-- | The `Functor` instance allows functions to transform the contents of a\n-- | `Tuple` with the `<$>` operator, applying the function to the second\n-- | component, so:\n-- | ```purescript\n-- | f <$> (Tuple x y) = Tuple x (f y)\n-- | ````\nderive instance functorTuple :: Functor (Tuple a)\n\nderive instance genericTuple :: Generic (Tuple a b) _\n\ninstance invariantTuple :: Invariant (Tuple a) where\n imap = imapF\n\n-- | The `Apply` instance allows functions to transform the contents of a\n-- | `Tuple` with the `<*>` operator whenever there is a `Semigroup` instance\n-- | for the `fst` component, so:\n-- | ```purescript\n-- | (Tuple a1 f) <*> (Tuple a2 x) == Tuple (a1 <> a2) (f x)\n-- | ```\ninstance applyTuple :: (Semigroup a) => Apply (Tuple a) where\n apply (Tuple a1 f) (Tuple a2 x) = Tuple (a1 <> a2) (f x)\n\ninstance applicativeTuple :: (Monoid a) => Applicative (Tuple a) where\n pure = Tuple mempty\n\ninstance bindTuple :: (Semigroup a) => Bind (Tuple a) where\n bind (Tuple a1 b) f = case f b of\n Tuple a2 c -> Tuple (a1 <> a2) c\n\ninstance monadTuple :: (Monoid a) => Monad (Tuple a)\n\ninstance extendTuple :: Extend (Tuple a) where\n extend f t@(Tuple a _) = Tuple a (f t)\n\ninstance comonadTuple :: Comonad (Tuple a) where\n extract = snd\n\ninstance lazyTuple :: (Lazy a, Lazy b) => Lazy (Tuple a b) where\n defer f = Tuple (defer $ \\_ -> fst (f unit)) (defer $ \\_ -> snd (f unit))\n\n-- | Returns the first component of a tuple.\nfst :: forall a b. Tuple a b -> a\nfst (Tuple a _) = a\n\n-- | Returns the second component of a tuple.\nsnd :: forall a b. Tuple a b -> b\nsnd (Tuple _ b) = b\n\n-- | Turn a function that expects a tuple into a function of two arguments.\ncurry :: forall a b c. (Tuple a b -> c) -> a -> b -> c\ncurry f a b = f (Tuple a b)\n\n-- | Turn a function of two arguments into a function that expects a tuple.\nuncurry :: forall a b c. (a -> b -> c) -> Tuple a b -> c\nuncurry f (Tuple a b) = f a b\n\n-- | Exchange the first and second components of a tuple.\nswap :: forall a b. Tuple a b -> Tuple b a\nswap (Tuple a b) = Tuple b a\n", "module Data.Bifunctor where\n\nimport Control.Category (identity)\nimport Data.Const (Const(..))\nimport Data.Either (Either(..))\nimport Data.Tuple (Tuple(..))\n\n-- | A `Bifunctor` is a `Functor` from the pair category `(Type, Type)` to `Type`.\n-- |\n-- | A type constructor with two type arguments can be made into a `Bifunctor` if\n-- | both of its type arguments are covariant.\n-- |\n-- | The `bimap` function maps a pair of functions over the two type arguments\n-- | of the bifunctor.\n-- |\n-- | Laws:\n-- |\n-- | - Identity: `bimap identity identity == identity`\n-- | - Composition: `bimap f1 g1 <<< bimap f2 g2 == bimap (f1 <<< f2) (g1 <<< g2)`\n-- |\nclass Bifunctor f where\n bimap :: forall a b c d. (a -> b) -> (c -> d) -> f a c -> f b d\n\n-- | Map a function over the first type argument of a `Bifunctor`.\nlmap :: forall f a b c. Bifunctor f => (a -> b) -> f a c -> f b c\nlmap f = bimap f identity\n\n-- | Map a function over the second type arguments of a `Bifunctor`.\nrmap :: forall f a b c. Bifunctor f => (b -> c) -> f a b -> f a c\nrmap = bimap identity\n\ninstance bifunctorEither :: Bifunctor Either where\n bimap f _ (Left l) = Left (f l)\n bimap _ g (Right r) = Right (g r)\n\ninstance bifunctorTuple :: Bifunctor Tuple where\n bimap f g (Tuple x y) = Tuple (f x) (g y)\n\ninstance bifunctorConst :: Bifunctor Const where\n bimap f _ (Const a) = Const (f a)\n", "module Data.Maybe.First where\n\nimport Prelude\n\nimport Control.Alt (class Alt)\nimport Control.Alternative (class Alternative)\nimport Control.Extend (class Extend)\nimport Control.Plus (class Plus)\n\nimport Data.Eq (class Eq1)\nimport Data.Functor.Invariant (class Invariant)\nimport Data.Maybe (Maybe(..))\nimport Data.Newtype (class Newtype)\nimport Data.Ord (class Ord1)\n\n-- | Monoid returning the first (left-most) non-`Nothing` value.\n-- |\n-- | ``` purescript\n-- | First (Just x) <> First (Just y) == First (Just x)\n-- | First Nothing <> First (Just y) == First (Just y)\n-- | First Nothing <> First Nothing == First Nothing\n-- | mempty :: First _ == First Nothing\n-- | ```\nnewtype First a = First (Maybe a)\n\nderive instance newtypeFirst :: Newtype (First a) _\n\nderive newtype instance eqFirst :: (Eq a) => Eq (First a)\n\nderive newtype instance eq1First :: Eq1 First\n\nderive newtype instance ordFirst :: (Ord a) => Ord (First a)\n\nderive newtype instance ord1First :: Ord1 First\n\nderive newtype instance boundedFirst :: (Bounded a) => Bounded (First a)\n\nderive newtype instance functorFirst :: Functor First\n\nderive newtype instance invariantFirst :: Invariant First\n\nderive newtype instance applyFirst :: Apply First\n\nderive newtype instance applicativeFirst :: Applicative First\n\nderive newtype instance bindFirst :: Bind First\n\nderive newtype instance monadFirst :: Monad First\n\nderive newtype instance extendFirst :: Extend First\n\ninstance showFirst :: (Show a) => Show (First a) where\n show (First a) = \"First (\" <> show a <> \")\"\n\ninstance semigroupFirst :: Semigroup (First a) where\n append first@(First (Just _)) _ = first\n append _ second = second\n\ninstance monoidFirst :: Monoid (First a) where\n mempty = First Nothing\n\ninstance altFirst :: Alt First where\n alt = append\n\ninstance plusFirst :: Plus First where\n empty = mempty\n\ninstance alternativeFirst :: Alternative First\n", "module Data.Monoid.Disj where\n\nimport Prelude\n\nimport Data.Eq (class Eq1)\nimport Data.HeytingAlgebra (ff, tt)\nimport Data.Ord (class Ord1)\n\n-- | Monoid and semigroup for disjunction.\n-- |\n-- | ``` purescript\n-- | Disj x <> Disj y == Disj (x || y)\n-- | (mempty :: Disj _) == Disj bottom\n-- | ```\nnewtype Disj a = Disj a\n\nderive newtype instance eqDisj :: Eq a => Eq (Disj a)\nderive instance eq1Disj :: Eq1 Disj\n\nderive newtype instance ordDisj :: Ord a => Ord (Disj a)\nderive instance ord1Disj :: Ord1 Disj\n\nderive newtype instance boundedDisj :: Bounded a => Bounded (Disj a)\n\ninstance showDisj :: Show a => Show (Disj a) where\n show (Disj a) = \"(Disj \" <> show a <> \")\"\n\nderive instance functorDisj :: Functor Disj\n\ninstance applyDisj :: Apply Disj where\n apply (Disj f) (Disj x) = Disj (f x)\n\ninstance applicativeDisj :: Applicative Disj where\n pure = Disj\n\ninstance bindDisj :: Bind Disj where\n bind (Disj x) f = f x\n\ninstance monadDisj :: Monad Disj\n\ninstance semigroupDisj :: HeytingAlgebra a => Semigroup (Disj a) where\n append (Disj a) (Disj b) = Disj (disj a b)\n\ninstance monoidDisj :: HeytingAlgebra a => Monoid (Disj a) where\n mempty = Disj ff\n\ninstance semiringDisj :: HeytingAlgebra a => Semiring (Disj a) where\n zero = Disj ff\n one = Disj tt\n add (Disj a) (Disj b) = Disj (disj a b)\n mul (Disj a) (Disj b) = Disj (conj a b)\n", "// module Unsafe.Coerce\n\nexport const unsafeCoerce = function (x) {\n return x;\n};\n", "module Safe.Coerce\n ( module Prim.Coerce\n , coerce\n ) where\n\nimport Prim.Coerce (class Coercible)\nimport Unsafe.Coerce (unsafeCoerce)\n\n-- | Coerce a value of one type to a value of some other type, without changing\n-- | its runtime representation. This function behaves identically to\n-- | `unsafeCoerce` at runtime. Unlike `unsafeCoerce`, it is safe, because the\n-- | `Coercible` constraint prevents any use of this function from compiling\n-- | unless the compiler can prove that the two types have the same runtime\n-- | representation.\n-- |\n-- | One application for this function is to avoid doing work that you know is a\n-- | no-op because of newtypes. For example, if you have an `Array (Conj a)` and you\n-- | want an `Array (Disj a)`, you could do `Data.Array.map (un Conj >>> Disj)`, but\n-- | this performs an unnecessary traversal of the array, with O(n) cost.\n-- | `coerce` accomplishes the same with only O(1) cost:\n-- |\n-- | ```purescript\n-- | mapConjToDisj :: forall a. Array (Conj a) -> Array (Disj a)\n-- | mapConjToDisj = coerce\n-- | ```\ncoerce :: forall a b. Coercible a b => a -> b\ncoerce = unsafeCoerce\n", "module Data.Newtype where\n\nimport Data.Monoid.Additive (Additive(..))\nimport Data.Monoid.Conj (Conj(..))\nimport Data.Monoid.Disj (Disj(..))\nimport Data.Monoid.Dual (Dual(..))\nimport Data.Monoid.Endo (Endo(..))\nimport Data.Monoid.Multiplicative (Multiplicative(..))\nimport Data.Semigroup.First (First(..))\nimport Data.Semigroup.Last (Last(..))\nimport Safe.Coerce (class Coercible, coerce)\n\n-- | A type class for `newtype`s to enable convenient wrapping and unwrapping,\n-- | and the use of the other functions in this module.\n-- |\n-- | The compiler can derive instances of `Newtype` automatically:\n-- |\n-- | ``` purescript\n-- | newtype EmailAddress = EmailAddress String\n-- |\n-- | derive instance newtypeEmailAddress :: Newtype EmailAddress _\n-- | ```\n-- |\n-- | Note that deriving for `Newtype` instances requires that the type be\n-- | defined as `newtype` rather than `data` declaration (even if the `data`\n-- | structurally fits the rules of a `newtype`), and the use of a wildcard for\n-- | the wrapped type.\nclass Newtype :: Type -> Type -> Constraint\nclass Coercible t a <= Newtype t a | t -> a\n\nwrap :: forall t a. Newtype t a => a -> t\nwrap = coerce\n\nunwrap :: forall t a. Newtype t a => t -> a\nunwrap = coerce\n\ninstance newtypeAdditive :: Newtype (Additive a) a\n\ninstance newtypeMultiplicative :: Newtype (Multiplicative a) a\n\ninstance newtypeConj :: Newtype (Conj a) a\n\ninstance newtypeDisj :: Newtype (Disj a) a\n\ninstance newtypeDual :: Newtype (Dual a) a\n\ninstance newtypeEndo :: Newtype (Endo c a) (c a a)\n\ninstance newtypeFirst :: Newtype (First a) a\n\ninstance newtypeLast :: Newtype (Last a) a\n\n-- | Given a constructor for a `Newtype`, this returns the appropriate `unwrap`\n-- | function.\nun :: forall t a. Newtype t a => (a -> t) -> t -> a\nun _ = unwrap\n\n-- | This combinator unwraps the newtype, applies a monomorphic function to the \n-- | contained value and wraps the result back in the newtype\nmodify :: forall t a. Newtype t a => (a -> a) -> t -> t\nmodify fn t = wrap (fn (unwrap t))\n\n-- | This combinator is for when you have a higher order function that you want\n-- | to use in the context of some newtype - `foldMap` being a common example:\n-- |\n-- | ``` purescript\n-- | ala Additive foldMap [1,2,3,4] -- 10\n-- | ala Multiplicative foldMap [1,2,3,4] -- 24\n-- | ala Conj foldMap [true, false] -- false\n-- | ala Disj foldMap [true, false] -- true\n-- | ```\nala\n :: forall f t a s b\n . Coercible (f t) (f a)\n => Newtype t a\n => Newtype s b\n => (a -> t)\n -> ((b -> s) -> f t)\n -> f a\nala _ f = coerce (f wrap)\n\n-- | Similar to `ala` but useful for cases where you want to use an additional\n-- | projection with the higher order function:\n-- |\n-- | ``` purescript\n-- | alaF Additive foldMap String.length [\"hello\", \"world\"] -- 10\n-- | alaF Multiplicative foldMap Math.abs [1.0, -2.0, 3.0, -4.0] -- 24.0\n-- | ```\n-- |\n-- | The type admits other possibilities due to the polymorphic `Functor`\n-- | constraints, but the case described above works because ((->) a) is a\n-- | `Functor`.\nalaF\n :: forall f g t a s b\n . Coercible (f t) (f a)\n => Coercible (g s) (g b)\n => Newtype t a\n => Newtype s b\n => (a -> t)\n -> (f t -> g s)\n -> f a\n -> g b\nalaF _ = coerce\n\n-- | Lifts a function operate over newtypes. This can be used to lift a\n-- | function to manipulate the contents of a single newtype, somewhat like\n-- | `map` does for a `Functor`:\n-- |\n-- | ``` purescript\n-- | newtype Label = Label String\n-- | derive instance newtypeLabel :: Newtype Label _\n-- |\n-- | toUpperLabel :: Label -> Label\n-- | toUpperLabel = over Label String.toUpper\n-- | ```\n-- |\n-- | But the result newtype is polymorphic, meaning the result can be returned\n-- | as an alternative newtype:\n-- |\n-- | ``` purescript\n-- | newtype UppercaseLabel = UppercaseLabel String\n-- | derive instance newtypeUppercaseLabel :: Newtype UppercaseLabel _\n-- |\n-- | toUpperLabel' :: Label -> UppercaseLabel\n-- | toUpperLabel' = over Label String.toUpper\n-- | ```\nover\n :: forall t a s b\n . Newtype t a\n => Newtype s b\n => (a -> t)\n -> (a -> b)\n -> t\n -> s\nover _ = coerce\n\n-- | Much like `over`, but where the lifted function operates on values in a\n-- | `Functor`:\n-- |\n-- | ``` purescript\n-- | findLabel :: String -> Array Label -> Maybe Label\n-- | findLabel s = overF Label (Foldable.find (_ == s))\n-- | ```\n-- |\n-- | The above example also demonstrates that the functor type is polymorphic\n-- | here too, the input is an `Array` but the result is a `Maybe`.\noverF\n :: forall f g t a s b\n . Coercible (f a) (f t)\n => Coercible (g b) (g s)\n => Newtype t a\n => Newtype s b\n => (a -> t)\n -> (f a -> g b)\n -> f t\n -> g s\noverF _ = coerce\n\n-- | The opposite of `over`: lowers a function that operates on `Newtype`d\n-- | values to operate on the wrapped value instead.\n-- |\n-- | ``` purescript\n-- | newtype Degrees = Degrees Number\n-- | derive instance newtypeDegrees :: Newtype Degrees _\n-- |\n-- | newtype NormalDegrees = NormalDegrees Number\n-- | derive instance newtypeNormalDegrees :: Newtype NormalDegrees _\n-- |\n-- | normaliseDegrees :: Degrees -> NormalDegrees\n-- | normaliseDegrees (Degrees deg) = NormalDegrees (deg % 360.0)\n-- |\n-- | asNormalDegrees :: Number -> Number\n-- | asNormalDegrees = under Degrees normaliseDegrees\n-- | ```\n-- |\n-- | As with `over` the `Newtype` is polymorphic, as illustrated in the example\n-- | above - both `Degrees` and `NormalDegrees` are instances of `Newtype`,\n-- | so even though `normaliseDegrees` changes the result type we can still put\n-- | a `Number` in and get a `Number` out via `under`.\nunder\n :: forall t a s b\n . Newtype t a\n => Newtype s b\n => (a -> t)\n -> (t -> s)\n -> a\n -> b\nunder _ = coerce\n\n-- | Much like `under`, but where the lifted function operates on values in a\n-- | `Functor`:\n-- |\n-- | ``` purescript\n-- | newtype EmailAddress = EmailAddress String\n-- | derive instance newtypeEmailAddress :: Newtype EmailAddress _\n-- |\n-- | isValid :: EmailAddress -> Boolean\n-- | isValid x = false -- imagine a slightly less strict predicate here\n-- |\n-- | findValidEmailString :: Array String -> Maybe String\n-- | findValidEmailString = underF EmailAddress (Foldable.find isValid)\n-- | ```\n-- |\n-- | The above example also demonstrates that the functor type is polymorphic\n-- | here too, the input is an `Array` but the result is a `Maybe`.\nunderF\n :: forall f g t a s b\n . Coercible (f t) (f a)\n => Coercible (g s) (g b)\n => Newtype t a\n => Newtype s b\n => (a -> t)\n -> (f t -> g s)\n -> f a\n -> g b\nunderF _ = coerce\n\n-- | Lifts a binary function to operate over newtypes.\n-- |\n-- | ``` purescript\n-- | newtype Meter = Meter Int\n-- | derive newtype instance newtypeMeter :: Newtype Meter _\n-- | newtype SquareMeter = SquareMeter Int\n-- | derive newtype instance newtypeSquareMeter :: Newtype SquareMeter _\n-- |\n-- | area :: Meter -> Meter -> SquareMeter\n-- | area = over2 Meter (*)\n-- | ```\n-- |\n-- | The above example also demonstrates that the return type is polymorphic\n-- | here too.\nover2\n :: forall t a s b\n . Newtype t a\n => Newtype s b\n => (a -> t)\n -> (a -> a -> b)\n -> t\n -> t\n -> s\nover2 _ = coerce\n\n-- | Much like `over2`, but where the lifted binary function operates on\n-- | values in a `Functor`.\noverF2\n :: forall f g t a s b\n . Coercible (f a) (f t)\n => Coercible (g b) (g s)\n => Newtype t a\n => Newtype s b\n => (a -> t)\n -> (f a -> f a -> g b)\n -> f t\n -> f t\n -> g s\noverF2 _ = coerce\n\n-- | The opposite of `over2`: lowers a binary function that operates on `Newtype`d\n-- | values to operate on the wrapped value instead.\nunder2\n :: forall t a s b\n . Newtype t a\n => Newtype s b\n => (a -> t)\n -> (t -> t -> s)\n -> a\n -> a\n -> b\nunder2 _ = coerce\n\n-- | Much like `under2`, but where the lifted binary function operates on\n-- | values in a `Functor`.\nunderF2\n :: forall f g t a s b\n . Coercible (f t) (f a)\n => Coercible (g s) (g b)\n => Newtype t a\n => Newtype s b\n => (a -> t)\n -> (f t -> f t -> g s)\n -> f a\n -> f a\n -> g b\nunderF2 _ = coerce\n\n-- | Similar to the function from the `Traversable` class, but operating within\n-- | a newtype instead.\ntraverse\n :: forall f t a\n . Coercible (f a) (f t)\n => Newtype t a\n => (a -> t)\n -> (a -> f a)\n -> t\n -> f t\ntraverse _ = coerce\n\n-- | Similar to the function from the `Distributive` class, but operating within\n-- | a newtype instead.\ncollect\n :: forall f t a\n . Coercible (f a) (f t)\n => Newtype t a\n => (a -> t)\n -> (f a -> a)\n -> f t\n -> t\ncollect _ = coerce\n", "module Data.Foldable\n ( class Foldable, foldr, foldl, foldMap\n , foldrDefault, foldlDefault, foldMapDefaultL, foldMapDefaultR\n , fold\n , foldM\n , traverse_\n , for_\n , sequence_\n , oneOf\n , oneOfMap\n , intercalate\n , surroundMap\n , surround\n , and\n , or\n , all\n , any\n , sum\n , product\n , elem\n , notElem\n , indexl\n , indexr\n , find\n , findMap\n , maximum\n , maximumBy\n , minimum\n , minimumBy\n , null\n , length\n , lookup\n ) where\n\nimport Prelude\n\nimport Control.Plus (class Plus, alt, empty)\nimport Data.Const (Const)\nimport Data.Either (Either(..))\nimport Data.Functor.App (App(..))\nimport Data.Functor.Compose (Compose(..))\nimport Data.Functor.Coproduct (Coproduct, coproduct)\nimport Data.Functor.Product (Product(..))\nimport Data.Identity (Identity(..))\nimport Data.Maybe (Maybe(..))\nimport Data.Maybe.First (First(..))\nimport Data.Maybe.Last (Last(..))\nimport Data.Monoid.Additive (Additive(..))\nimport Data.Monoid.Conj (Conj(..))\nimport Data.Monoid.Disj (Disj(..))\nimport Data.Monoid.Dual (Dual(..))\nimport Data.Monoid.Endo (Endo(..))\nimport Data.Monoid.Multiplicative (Multiplicative(..))\nimport Data.Newtype (alaF, unwrap)\nimport Data.Tuple (Tuple(..))\n\n-- | `Foldable` represents data structures which can be _folded_.\n-- |\n-- | - `foldr` folds a structure from the right\n-- | - `foldl` folds a structure from the left\n-- | - `foldMap` folds a structure by accumulating values in a `Monoid`\n-- |\n-- | Default implementations are provided by the following functions:\n-- |\n-- | - `foldrDefault`\n-- | - `foldlDefault`\n-- | - `foldMapDefaultR`\n-- | - `foldMapDefaultL`\n-- |\n-- | Note: some combinations of the default implementations are unsafe to\n-- | use together - causing a non-terminating mutually recursive cycle.\n-- | These combinations are documented per function.\nclass Foldable f where\n foldr :: forall a b. (a -> b -> b) -> b -> f a -> b\n foldl :: forall a b. (b -> a -> b) -> b -> f a -> b\n foldMap :: forall a m. Monoid m => (a -> m) -> f a -> m\n\n-- | A default implementation of `foldr` using `foldMap`.\n-- |\n-- | Note: when defining a `Foldable` instance, this function is unsafe to use\n-- | in combination with `foldMapDefaultR`.\nfoldrDefault\n :: forall f a b\n . Foldable f\n => (a -> b -> b)\n -> b\n -> f a\n -> b\nfoldrDefault c u xs = unwrap (foldMap (Endo <<< c) xs) u\n\n-- | A default implementation of `foldl` using `foldMap`.\n-- |\n-- | Note: when defining a `Foldable` instance, this function is unsafe to use\n-- | in combination with `foldMapDefaultL`.\nfoldlDefault\n :: forall f a b\n . Foldable f\n => (b -> a -> b)\n -> b\n -> f a\n -> b\nfoldlDefault c u xs = unwrap (unwrap (foldMap (Dual <<< Endo <<< flip c) xs)) u\n\n-- | A default implementation of `foldMap` using `foldr`.\n-- |\n-- | Note: when defining a `Foldable` instance, this function is unsafe to use\n-- | in combination with `foldrDefault`.\nfoldMapDefaultR\n :: forall f a m\n . Foldable f\n => Monoid m\n => (a -> m)\n -> f a\n -> m\nfoldMapDefaultR f = foldr (\\x acc -> f x <> acc) mempty\n\n-- | A default implementation of `foldMap` using `foldl`.\n-- |\n-- | Note: when defining a `Foldable` instance, this function is unsafe to use\n-- | in combination with `foldlDefault`.\nfoldMapDefaultL\n :: forall f a m\n . Foldable f\n => Monoid m\n => (a -> m)\n -> f a\n -> m\nfoldMapDefaultL f = foldl (\\acc x -> acc <> f x) mempty\n\ninstance foldableArray :: Foldable Array where\n foldr = foldrArray\n foldl = foldlArray\n foldMap = foldMapDefaultR\n\nforeign import foldrArray :: forall a b. (a -> b -> b) -> b -> Array a -> b\nforeign import foldlArray :: forall a b. (b -> a -> b) -> b -> Array a -> b\n\ninstance foldableMaybe :: Foldable Maybe where\n foldr _ z Nothing = z\n foldr f z (Just x) = x `f` z\n foldl _ z Nothing = z\n foldl f z (Just x) = z `f` x\n foldMap _ Nothing = mempty\n foldMap f (Just x) = f x\n\ninstance foldableFirst :: Foldable First where\n foldr f z (First x) = foldr f z x\n foldl f z (First x) = foldl f z x\n foldMap f (First x) = foldMap f x\n\ninstance foldableLast :: Foldable Last where\n foldr f z (Last x) = foldr f z x\n foldl f z (Last x) = foldl f z x\n foldMap f (Last x) = foldMap f x\n\ninstance foldableAdditive :: Foldable Additive where\n foldr f z (Additive x) = x `f` z\n foldl f z (Additive x) = z `f` x\n foldMap f (Additive x) = f x\n\ninstance foldableDual :: Foldable Dual where\n foldr f z (Dual x) = x `f` z\n foldl f z (Dual x) = z `f` x\n foldMap f (Dual x) = f x\n\ninstance foldableDisj :: Foldable Disj where\n foldr f z (Disj x) = f x z\n foldl f z (Disj x) = f z x\n foldMap f (Disj x) = f x\n\ninstance foldableConj :: Foldable Conj where\n foldr f z (Conj x) = f x z\n foldl f z (Conj x) = f z x\n foldMap f (Conj x) = f x\n\ninstance foldableMultiplicative :: Foldable Multiplicative where\n foldr f z (Multiplicative x) = x `f` z\n foldl f z (Multiplicative x) = z `f` x\n foldMap f (Multiplicative x) = f x\n\ninstance foldableEither :: Foldable (Either a) where\n foldr _ z (Left _) = z\n foldr f z (Right x) = f x z\n foldl _ z (Left _) = z\n foldl f z (Right x) = f z x\n foldMap _ (Left _) = mempty\n foldMap f (Right x) = f x\n\ninstance foldableTuple :: Foldable (Tuple a) where\n foldr f z (Tuple _ x) = f x z\n foldl f z (Tuple _ x) = f z x\n foldMap f (Tuple _ x) = f x\n\ninstance foldableIdentity :: Foldable Identity where\n foldr f z (Identity x) = f x z\n foldl f z (Identity x) = f z x\n foldMap f (Identity x) = f x\n\ninstance foldableConst :: Foldable (Const a) where\n foldr _ z _ = z\n foldl _ z _ = z\n foldMap _ _ = mempty\n\ninstance foldableProduct :: (Foldable f, Foldable g) => Foldable (Product f g) where\n foldr f z (Product (Tuple fa ga)) = foldr f (foldr f z ga) fa\n foldl f z (Product (Tuple fa ga)) = foldl f (foldl f z fa) ga\n foldMap f (Product (Tuple fa ga)) = foldMap f fa <> foldMap f ga\n\ninstance foldableCoproduct :: (Foldable f, Foldable g) => Foldable (Coproduct f g) where\n foldr f z = coproduct (foldr f z) (foldr f z)\n foldl f z = coproduct (foldl f z) (foldl f z)\n foldMap f = coproduct (foldMap f) (foldMap f)\n\ninstance foldableCompose :: (Foldable f, Foldable g) => Foldable (Compose f g) where\n foldr f i (Compose fga) = foldr (flip (foldr f)) i fga\n foldl f i (Compose fga) = foldl (foldl f) i fga\n foldMap f (Compose fga) = foldMap (foldMap f) fga\n\ninstance foldableApp :: Foldable f => Foldable (App f) where\n foldr f i (App x) = foldr f i x\n foldl f i (App x) = foldl f i x\n foldMap f (App x) = foldMap f x\n\n-- | Fold a data structure, accumulating values in some `Monoid`.\nfold :: forall f m. Foldable f => Monoid m => f m -> m\nfold = foldMap identity\n\n-- | Similar to 'foldl', but the result is encapsulated in a monad.\n-- |\n-- | Note: this function is not generally stack-safe, e.g., for monads which\n-- | build up thunks a la `Eff`.\nfoldM :: forall f m a b. Foldable f => Monad m => (b -> a -> m b) -> b -> f a -> m b\nfoldM f b0 = foldl (\\b a -> b >>= flip f a) (pure b0)\n\n-- | Traverse a data structure, performing some effects encoded by an\n-- | `Applicative` functor at each value, ignoring the final result.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | traverse_ print [1, 2, 3]\n-- | ```\ntraverse_\n :: forall a b f m\n . Applicative m\n => Foldable f\n => (a -> m b)\n -> f a\n -> m Unit\ntraverse_ f = foldr ((*>) <<< f) (pure unit)\n\n-- | A version of `traverse_` with its arguments flipped.\n-- |\n-- | This can be useful when running an action written using do notation\n-- | for every element in a data structure:\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | for_ [1, 2, 3] \\n -> do\n-- | print n\n-- | trace \"squared is\"\n-- | print (n * n)\n-- | ```\nfor_\n :: forall a b f m\n . Applicative m\n => Foldable f\n => f a\n -> (a -> m b)\n -> m Unit\nfor_ = flip traverse_\n\n-- | Perform all of the effects in some data structure in the order\n-- | given by the `Foldable` instance, ignoring the final result.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | sequence_ [ trace \"Hello, \", trace \" world!\" ]\n-- | ```\nsequence_ :: forall a f m. Applicative m => Foldable f => f (m a) -> m Unit\nsequence_ = traverse_ identity\n\n-- | Combines a collection of elements using the `Alt` operation.\noneOf :: forall f g a. Foldable f => Plus g => f (g a) -> g a\noneOf = foldr alt empty\n\n-- | Folds a structure into some `Plus`.\noneOfMap :: forall f g a b. Foldable f => Plus g => (a -> g b) -> f a -> g b\noneOfMap f = foldr (alt <<< f) empty\n\n-- | Fold a data structure, accumulating values in some `Monoid`,\n-- | combining adjacent elements using the specified separator.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | > intercalate \", \" [\"Lorem\", \"ipsum\", \"dolor\"]\n-- | = \"Lorem, ipsum, dolor\"\n-- |\n-- | > intercalate \"*\" [\"a\", \"b\", \"c\"]\n-- | = \"a*b*c\"\n-- |\n-- | > intercalate [1] [[2, 3], [4, 5], [6, 7]]\n-- | = [2, 3, 1, 4, 5, 1, 6, 7]\n-- | ```\nintercalate :: forall f m. Foldable f => Monoid m => m -> f m -> m\nintercalate sep xs = (foldl go { init: true, acc: mempty } xs).acc\n where\n go { init: true } x = { init: false, acc: x }\n go { acc: acc } x = { init: false, acc: acc <> sep <> x }\n\n-- | `foldMap` but with each element surrounded by some fixed value.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | > surroundMap \"*\" show []\n-- | = \"*\"\n-- |\n-- | > surroundMap \"*\" show [1]\n-- | = \"*1*\"\n-- |\n-- | > surroundMap \"*\" show [1, 2]\n-- | = \"*1*2*\"\n-- |\n-- | > surroundMap \"*\" show [1, 2, 3]\n-- | = \"*1*2*3*\"\n-- | ```\nsurroundMap :: forall f a m. Foldable f => Semigroup m => m -> (a -> m) -> f a -> m\nsurroundMap d t f = unwrap (foldMap joined f) d\n where joined a = Endo \\m -> d <> t a <> m\n\n-- | `fold` but with each element surrounded by some fixed value.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | > surround \"*\" []\n-- | = \"*\"\n-- |\n-- | > surround \"*\" [\"1\"]\n-- | = \"*1*\"\n-- |\n-- | > surround \"*\" [\"1\", \"2\"]\n-- | = \"*1*2*\"\n-- |\n-- | > surround \"*\" [\"1\", \"2\", \"3\"]\n-- | = \"*1*2*3*\"\n-- | ```\nsurround :: forall f m. Foldable f => Semigroup m => m -> f m -> m\nsurround d = surroundMap d identity\n\n-- | The conjunction of all the values in a data structure. When specialized\n-- | to `Boolean`, this function will test whether all of the values in a data\n-- | structure are `true`.\nand :: forall a f. Foldable f => HeytingAlgebra a => f a -> a\nand = all identity\n\n-- | The disjunction of all the values in a data structure. When specialized\n-- | to `Boolean`, this function will test whether any of the values in a data\n-- | structure is `true`.\nor :: forall a f. Foldable f => HeytingAlgebra a => f a -> a\nor = any identity\n\n-- | `all f` is the same as `and <<< map f`; map a function over the structure,\n-- | and then get the conjunction of the results.\nall :: forall a b f. Foldable f => HeytingAlgebra b => (a -> b) -> f a -> b\nall = alaF Conj foldMap\n\n-- | `any f` is the same as `or <<< map f`; map a function over the structure,\n-- | and then get the disjunction of the results.\nany :: forall a b f. Foldable f => HeytingAlgebra b => (a -> b) -> f a -> b\nany = alaF Disj foldMap\n\n-- | Find the sum of the numeric values in a data structure.\nsum :: forall a f. Foldable f => Semiring a => f a -> a\nsum = foldl (+) zero\n\n-- | Find the product of the numeric values in a data structure.\nproduct :: forall a f. Foldable f => Semiring a => f a -> a\nproduct = foldl (*) one\n\n-- | Test whether a value is an element of a data structure.\nelem :: forall a f. Foldable f => Eq a => a -> f a -> Boolean\nelem = any <<< (==)\n\n-- | Test whether a value is not an element of a data structure.\nnotElem :: forall a f. Foldable f => Eq a => a -> f a -> Boolean\nnotElem x = not <<< elem x\n\n-- | Try to get nth element from the left in a data structure\nindexl :: forall a f. Foldable f => Int -> f a -> Maybe a\nindexl idx = _.elem <<< foldl go { elem: Nothing, pos: 0 }\n where\n go cursor a =\n case cursor.elem of\n Just _ -> cursor\n _ ->\n if cursor.pos == idx\n then { elem: Just a, pos: cursor.pos }\n else { pos: cursor.pos + 1, elem: cursor.elem }\n\n-- | Try to get nth element from the right in a data structure\nindexr :: forall a f. Foldable f => Int -> f a -> Maybe a\nindexr idx = _.elem <<< foldr go { elem: Nothing, pos: 0 }\n where\n go a cursor =\n case cursor.elem of\n Just _ -> cursor\n _ ->\n if cursor.pos == idx\n then { elem: Just a, pos: cursor.pos }\n else { pos: cursor.pos + 1, elem: cursor.elem }\n\n-- | Try to find an element in a data structure which satisfies a predicate.\nfind :: forall a f. Foldable f => (a -> Boolean) -> f a -> Maybe a\nfind p = foldl go Nothing\n where\n go Nothing x | p x = Just x\n go r _ = r\n\n-- | Try to find an element in a data structure which satisfies a predicate mapping.\nfindMap :: forall a b f. Foldable f => (a -> Maybe b) -> f a -> Maybe b\nfindMap p = foldl go Nothing\n where\n go Nothing x = p x\n go r _ = r\n\n-- | Find the largest element of a structure, according to its `Ord` instance.\nmaximum :: forall a f. Ord a => Foldable f => f a -> Maybe a\nmaximum = maximumBy compare\n\n-- | Find the largest element of a structure, according to a given comparison\n-- | function. The comparison function should represent a total ordering (see\n-- | the `Ord` type class laws); if it does not, the behaviour is undefined.\nmaximumBy :: forall a f. Foldable f => (a -> a -> Ordering) -> f a -> Maybe a\nmaximumBy cmp = foldl max' Nothing\n where\n max' Nothing x = Just x\n max' (Just x) y = Just (if cmp x y == GT then x else y)\n\n-- | Find the smallest element of a structure, according to its `Ord` instance.\nminimum :: forall a f. Ord a => Foldable f => f a -> Maybe a\nminimum = minimumBy compare\n\n-- | Find the smallest element of a structure, according to a given comparison\n-- | function. The comparison function should represent a total ordering (see\n-- | the `Ord` type class laws); if it does not, the behaviour is undefined.\nminimumBy :: forall a f. Foldable f => (a -> a -> Ordering) -> f a -> Maybe a\nminimumBy cmp = foldl min' Nothing\n where\n min' Nothing x = Just x\n min' (Just x) y = Just (if cmp x y == LT then x else y)\n\n-- | Test whether the structure is empty.\n-- | Optimized for structures that are similar to cons-lists, because there\n-- | is no general way to do better.\nnull :: forall a f. Foldable f => f a -> Boolean\nnull = foldr (\\_ _ -> false) true\n\n-- | Returns the size/length of a finite structure.\n-- | Optimized for structures that are similar to cons-lists, because there\n-- | is no general way to do better.\nlength :: forall a b f. Foldable f => Semiring b => f a -> b\nlength = foldl (\\c _ -> add one c) zero\n\n-- | Lookup a value in a data structure of `Tuple`s, generalizing association lists.\nlookup :: forall a b f. Foldable f => Eq a => a -> f (Tuple a b) -> Maybe b\nlookup a = unwrap <<< foldMap \\(Tuple a' b) -> First (if a == a' then Just b else Nothing)\n", "export const mapWithIndexArray = function (f) {\n return function (xs) {\n var l = xs.length;\n var result = Array(l);\n for (var i = 0; i < l; i++) {\n result[i] = f(i)(xs[i]);\n }\n return result;\n };\n};\n", "module Data.Identity where\n\nimport Prelude\n\nimport Control.Alt (class Alt)\nimport Control.Comonad (class Comonad)\nimport Control.Extend (class Extend)\nimport Control.Lazy (class Lazy)\nimport Data.Eq (class Eq1)\nimport Data.Functor.Invariant (class Invariant, imapF)\nimport Data.Newtype (class Newtype)\nimport Data.Ord (class Ord1)\n\nnewtype Identity a = Identity a\n\nderive instance newtypeIdentity :: Newtype (Identity a) _\n\nderive newtype instance eqIdentity :: Eq a => Eq (Identity a)\n\nderive newtype instance ordIdentity :: Ord a => Ord (Identity a)\n\nderive newtype instance boundedIdentity :: Bounded a => Bounded (Identity a)\n\nderive newtype instance heytingAlgebraIdentity :: HeytingAlgebra a => HeytingAlgebra (Identity a)\n\nderive newtype instance booleanAlgebraIdentity :: BooleanAlgebra a => BooleanAlgebra (Identity a)\n\nderive newtype instance semigroupIdentity :: Semigroup a => Semigroup (Identity a)\n\nderive newtype instance monoidIdentity :: Monoid a => Monoid (Identity a)\n\nderive newtype instance semiringIdentity :: Semiring a => Semiring (Identity a)\n\nderive newtype instance euclideanRingIdentity :: EuclideanRing a => EuclideanRing (Identity a)\n\nderive newtype instance ringIdentity :: Ring a => Ring (Identity a)\n\nderive newtype instance commutativeRingIdentity :: CommutativeRing a => CommutativeRing (Identity a)\n\nderive newtype instance lazyIdentity :: Lazy a => Lazy (Identity a)\n\ninstance showIdentity :: Show a => Show (Identity a) where\n show (Identity x) = \"(Identity \" <> show x <> \")\"\n\nderive instance eq1Identity :: Eq1 Identity\n\nderive instance ord1Identity :: Ord1 Identity\n\nderive instance functorIdentity :: Functor Identity\n\ninstance invariantIdentity :: Invariant Identity where\n imap = imapF\n\ninstance altIdentity :: Alt Identity where\n alt x _ = x\n\ninstance applyIdentity :: Apply Identity where\n apply (Identity f) (Identity x) = Identity (f x)\n\ninstance applicativeIdentity :: Applicative Identity where\n pure = Identity\n\ninstance bindIdentity :: Bind Identity where\n bind (Identity m) f = f m\n\ninstance monadIdentity :: Monad Identity\n\ninstance extendIdentity :: Extend Identity where\n extend f m = Identity (f m)\n\ninstance comonadIdentity :: Comonad Identity where\n extract (Identity x) = x\n", "module Data.FunctorWithIndex\n ( class FunctorWithIndex, mapWithIndex, mapDefault\n ) where\n\nimport Prelude\n\nimport Data.Bifunctor (bimap)\nimport Data.Const (Const(..))\nimport Data.Either (Either(..))\nimport Data.Functor.App (App(..))\nimport Data.Functor.Compose (Compose(..))\nimport Data.Functor.Coproduct (Coproduct(..))\nimport Data.Functor.Product (Product(..))\nimport Data.Identity (Identity(..))\nimport Data.Maybe (Maybe)\nimport Data.Maybe.First (First)\nimport Data.Maybe.Last (Last)\nimport Data.Monoid.Additive (Additive)\nimport Data.Monoid.Conj (Conj)\nimport Data.Monoid.Disj (Disj)\nimport Data.Monoid.Dual (Dual)\nimport Data.Monoid.Multiplicative (Multiplicative)\nimport Data.Tuple (Tuple, curry)\n\n-- | A `Functor` with an additional index.\n-- | Instances must satisfy a modified form of the `Functor` laws\n-- | ```purescript\n-- | mapWithIndex (\\_ a -> a) = identity\n-- | mapWithIndex f . mapWithIndex g = mapWithIndex (\\i -> f i <<< g i)\n-- | ```\n-- | and be compatible with the `Functor` instance\n-- | ```purescript\n-- | map f = mapWithIndex (const f)\n-- | ```\nclass Functor f <= FunctorWithIndex i f | f -> i where\n mapWithIndex :: forall a b. (i -> a -> b) -> f a -> f b\n\nforeign import mapWithIndexArray :: forall a b. (Int -> a -> b) -> Array a -> Array b\n\ninstance functorWithIndexArray :: FunctorWithIndex Int Array where\n mapWithIndex = mapWithIndexArray\n\ninstance functorWithIndexMaybe :: FunctorWithIndex Unit Maybe where\n mapWithIndex f = map $ f unit\n\ninstance functorWithIndexFirst :: FunctorWithIndex Unit First where\n mapWithIndex f = map $ f unit\n\ninstance functorWithIndexLast :: FunctorWithIndex Unit Last where\n mapWithIndex f = map $ f unit\n\ninstance functorWithIndexAdditive :: FunctorWithIndex Unit Additive where\n mapWithIndex f = map $ f unit\n\ninstance functorWithIndexDual :: FunctorWithIndex Unit Dual where\n mapWithIndex f = map $ f unit\n\ninstance functorWithIndexConj :: FunctorWithIndex Unit Conj where\n mapWithIndex f = map $ f unit\n\ninstance functorWithIndexDisj :: FunctorWithIndex Unit Disj where\n mapWithIndex f = map $ f unit\n\ninstance functorWithIndexMultiplicative :: FunctorWithIndex Unit Multiplicative where\n mapWithIndex f = map $ f unit\n\ninstance functorWithIndexEither :: FunctorWithIndex Unit (Either a) where\n mapWithIndex f = map $ f unit\n\ninstance functorWithIndexTuple :: FunctorWithIndex Unit (Tuple a) where\n mapWithIndex f = map $ f unit\n\ninstance functorWithIndexIdentity :: FunctorWithIndex Unit Identity where\n mapWithIndex f (Identity a) = Identity (f unit a)\n\ninstance functorWithIndexConst :: FunctorWithIndex Void (Const a) where\n mapWithIndex _ (Const x) = Const x\n\ninstance functorWithIndexProduct :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Either a b) (Product f g) where\n mapWithIndex f (Product fga) = Product (bimap (mapWithIndex (f <<< Left)) (mapWithIndex (f <<< Right)) fga)\n\ninstance functorWithIndexCoproduct :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Either a b) (Coproduct f g) where\n mapWithIndex f (Coproduct e) = Coproduct (bimap (mapWithIndex (f <<< Left)) (mapWithIndex (f <<< Right)) e)\n\ninstance functorWithIndexCompose :: (FunctorWithIndex a f, FunctorWithIndex b g) => FunctorWithIndex (Tuple a b) (Compose f g) where\n mapWithIndex f (Compose fga) = Compose $ mapWithIndex (mapWithIndex <<< curry f) fga\n\ninstance functorWithIndexApp :: FunctorWithIndex a f => FunctorWithIndex a (App f) where\n mapWithIndex f (App x) = App $ mapWithIndex f x\n\n-- | A default implementation of Functor's `map` in terms of `mapWithIndex`\nmapDefault :: forall i f a b. FunctorWithIndex i f => (a -> b) -> f a -> f b\nmapDefault f = mapWithIndex (const f)\n", "module Data.FoldableWithIndex\n ( class FoldableWithIndex, foldrWithIndex, foldlWithIndex, foldMapWithIndex\n , foldrWithIndexDefault\n , foldlWithIndexDefault\n , foldMapWithIndexDefaultR\n , foldMapWithIndexDefaultL\n , foldWithIndexM\n , traverseWithIndex_\n , forWithIndex_\n , surroundMapWithIndex\n , allWithIndex\n , anyWithIndex\n , findWithIndex\n , findMapWithIndex\n , foldrDefault\n , foldlDefault\n , foldMapDefault\n ) where\n\nimport Prelude\n\nimport Data.Const (Const)\nimport Data.Either (Either(..))\nimport Data.Foldable (class Foldable, foldMap, foldl, foldr)\nimport Data.Functor.App (App(..))\nimport Data.Functor.Compose (Compose(..))\nimport Data.Functor.Coproduct (Coproduct, coproduct)\nimport Data.Functor.Product (Product(..))\nimport Data.FunctorWithIndex (mapWithIndex)\nimport Data.Identity (Identity(..))\nimport Data.Maybe (Maybe(..))\nimport Data.Maybe.First (First)\nimport Data.Maybe.Last (Last)\nimport Data.Monoid.Additive (Additive)\nimport Data.Monoid.Conj (Conj(..))\nimport Data.Monoid.Disj (Disj(..))\nimport Data.Monoid.Dual (Dual(..))\nimport Data.Monoid.Endo (Endo(..))\nimport Data.Monoid.Multiplicative (Multiplicative)\nimport Data.Newtype (unwrap)\nimport Data.Tuple (Tuple(..), curry)\n\n-- | A `Foldable` with an additional index.\n-- | A `FoldableWithIndex` instance must be compatible with its `Foldable`\n-- | instance\n-- | ```purescript\n-- | foldr f = foldrWithIndex (const f)\n-- | foldl f = foldlWithIndex (const f)\n-- | foldMap f = foldMapWithIndex (const f)\n-- | ```\n-- |\n-- | Default implementations are provided by the following functions:\n-- |\n-- | - `foldrWithIndexDefault`\n-- | - `foldlWithIndexDefault`\n-- | - `foldMapWithIndexDefaultR`\n-- | - `foldMapWithIndexDefaultL`\n-- |\n-- | Note: some combinations of the default implementations are unsafe to\n-- | use together - causing a non-terminating mutually recursive cycle.\n-- | These combinations are documented per function.\nclass Foldable f <= FoldableWithIndex i f | f -> i where\n foldrWithIndex :: forall a b. (i -> a -> b -> b) -> b -> f a -> b\n foldlWithIndex :: forall a b. (i -> b -> a -> b) -> b -> f a -> b\n foldMapWithIndex :: forall a m. Monoid m => (i -> a -> m) -> f a -> m\n\n-- | A default implementation of `foldrWithIndex` using `foldMapWithIndex`.\n-- |\n-- | Note: when defining a `FoldableWithIndex` instance, this function is\n-- | unsafe to use in combination with `foldMapWithIndexDefaultR`.\nfoldrWithIndexDefault\n :: forall i f a b\n . FoldableWithIndex i f\n => (i -> a -> b -> b)\n -> b\n -> f a\n -> b\nfoldrWithIndexDefault c u xs = unwrap (foldMapWithIndex (\\i -> Endo <<< c i) xs) u\n\n-- | A default implementation of `foldlWithIndex` using `foldMapWithIndex`.\n-- |\n-- | Note: when defining a `FoldableWithIndex` instance, this function is\n-- | unsafe to use in combination with `foldMapWithIndexDefaultL`.\nfoldlWithIndexDefault\n :: forall i f a b\n . FoldableWithIndex i f\n => (i -> b -> a -> b)\n -> b\n -> f a\n -> b\nfoldlWithIndexDefault c u xs = unwrap (unwrap (foldMapWithIndex (\\i -> Dual <<< Endo <<< flip (c i)) xs)) u\n\n-- | A default implementation of `foldMapWithIndex` using `foldrWithIndex`.\n-- |\n-- | Note: when defining a `FoldableWithIndex` instance, this function is\n-- | unsafe to use in combination with `foldrWithIndexDefault`.\nfoldMapWithIndexDefaultR\n :: forall i f a m\n . FoldableWithIndex i f\n => Monoid m\n => (i -> a -> m)\n -> f a\n -> m\nfoldMapWithIndexDefaultR f = foldrWithIndex (\\i x acc -> f i x <> acc) mempty\n\n-- | A default implementation of `foldMapWithIndex` using `foldlWithIndex`.\n-- |\n-- | Note: when defining a `FoldableWithIndex` instance, this function is\n-- | unsafe to use in combination with `foldlWithIndexDefault`.\nfoldMapWithIndexDefaultL\n :: forall i f a m\n . FoldableWithIndex i f\n => Monoid m\n => (i -> a -> m)\n -> f a\n -> m\nfoldMapWithIndexDefaultL f = foldlWithIndex (\\i acc x -> acc <> f i x) mempty\n\ninstance foldableWithIndexArray :: FoldableWithIndex Int Array where\n foldrWithIndex f z = foldr (\\(Tuple i x) y -> f i x y) z <<< mapWithIndex Tuple\n foldlWithIndex f z = foldl (\\y (Tuple i x) -> f i y x) z <<< mapWithIndex Tuple\n foldMapWithIndex = foldMapWithIndexDefaultR\n\ninstance foldableWithIndexMaybe :: FoldableWithIndex Unit Maybe where\n foldrWithIndex f = foldr $ f unit\n foldlWithIndex f = foldl $ f unit\n foldMapWithIndex f = foldMap $ f unit\n\ninstance foldableWithIndexFirst :: FoldableWithIndex Unit First where\n foldrWithIndex f = foldr $ f unit\n foldlWithIndex f = foldl $ f unit\n foldMapWithIndex f = foldMap $ f unit\n\ninstance foldableWithIndexLast :: FoldableWithIndex Unit Last where\n foldrWithIndex f = foldr $ f unit\n foldlWithIndex f = foldl $ f unit\n foldMapWithIndex f = foldMap $ f unit\n\ninstance foldableWithIndexAdditive :: FoldableWithIndex Unit Additive where\n foldrWithIndex f = foldr $ f unit\n foldlWithIndex f = foldl $ f unit\n foldMapWithIndex f = foldMap $ f unit\n\ninstance foldableWithIndexDual :: FoldableWithIndex Unit Dual where\n foldrWithIndex f = foldr $ f unit\n foldlWithIndex f = foldl $ f unit\n foldMapWithIndex f = foldMap $ f unit\n\ninstance foldableWithIndexDisj :: FoldableWithIndex Unit Disj where\n foldrWithIndex f = foldr $ f unit\n foldlWithIndex f = foldl $ f unit\n foldMapWithIndex f = foldMap $ f unit\n\ninstance foldableWithIndexConj :: FoldableWithIndex Unit Conj where\n foldrWithIndex f = foldr $ f unit\n foldlWithIndex f = foldl $ f unit\n foldMapWithIndex f = foldMap $ f unit\n\ninstance foldableWithIndexMultiplicative :: FoldableWithIndex Unit Multiplicative where\n foldrWithIndex f = foldr $ f unit\n foldlWithIndex f = foldl $ f unit\n foldMapWithIndex f = foldMap $ f unit\n\ninstance foldableWithIndexEither :: FoldableWithIndex Unit (Either a) where\n foldrWithIndex _ z (Left _) = z\n foldrWithIndex f z (Right x) = f unit x z\n foldlWithIndex _ z (Left _) = z\n foldlWithIndex f z (Right x) = f unit z x\n foldMapWithIndex _ (Left _) = mempty\n foldMapWithIndex f (Right x) = f unit x\n\ninstance foldableWithIndexTuple :: FoldableWithIndex Unit (Tuple a) where\n foldrWithIndex f z (Tuple _ x) = f unit x z\n foldlWithIndex f z (Tuple _ x) = f unit z x\n foldMapWithIndex f (Tuple _ x) = f unit x\n\ninstance foldableWithIndexIdentity :: FoldableWithIndex Unit Identity where\n foldrWithIndex f z (Identity x) = f unit x z\n foldlWithIndex f z (Identity x) = f unit z x\n foldMapWithIndex f (Identity x) = f unit x\n\ninstance foldableWithIndexConst :: FoldableWithIndex Void (Const a) where\n foldrWithIndex _ z _ = z\n foldlWithIndex _ z _ = z\n foldMapWithIndex _ _ = mempty\n\ninstance foldableWithIndexProduct :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Either a b) (Product f g) where\n foldrWithIndex f z (Product (Tuple fa ga)) = foldrWithIndex (f <<< Left) (foldrWithIndex (f <<< Right) z ga) fa\n foldlWithIndex f z (Product (Tuple fa ga)) = foldlWithIndex (f <<< Right) (foldlWithIndex (f <<< Left) z fa) ga\n foldMapWithIndex f (Product (Tuple fa ga)) = foldMapWithIndex (f <<< Left) fa <> foldMapWithIndex (f <<< Right) ga\n\ninstance foldableWithIndexCoproduct :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Either a b) (Coproduct f g) where\n foldrWithIndex f z = coproduct (foldrWithIndex (f <<< Left) z) (foldrWithIndex (f <<< Right) z)\n foldlWithIndex f z = coproduct (foldlWithIndex (f <<< Left) z) (foldlWithIndex (f <<< Right) z)\n foldMapWithIndex f = coproduct (foldMapWithIndex (f <<< Left)) (foldMapWithIndex (f <<< Right))\n\ninstance foldableWithIndexCompose :: (FoldableWithIndex a f, FoldableWithIndex b g) => FoldableWithIndex (Tuple a b) (Compose f g) where\n foldrWithIndex f i (Compose fga) = foldrWithIndex (\\a -> flip (foldrWithIndex (curry f a))) i fga\n foldlWithIndex f i (Compose fga) = foldlWithIndex (foldlWithIndex <<< curry f) i fga\n foldMapWithIndex f (Compose fga) = foldMapWithIndex (foldMapWithIndex <<< curry f) fga\n\ninstance foldableWithIndexApp :: FoldableWithIndex a f => FoldableWithIndex a (App f) where\n foldrWithIndex f z (App x) = foldrWithIndex f z x\n foldlWithIndex f z (App x) = foldlWithIndex f z x\n foldMapWithIndex f (App x) = foldMapWithIndex f x\n\n\n-- | Similar to 'foldlWithIndex', but the result is encapsulated in a monad.\n-- |\n-- | Note: this function is not generally stack-safe, e.g., for monads which\n-- | build up thunks a la `Eff`.\nfoldWithIndexM\n :: forall i f m a b\n . FoldableWithIndex i f\n => Monad m\n => (i -> a -> b -> m a)\n -> a\n -> f b\n -> m a\nfoldWithIndexM f a0 = foldlWithIndex (\\i ma b -> ma >>= flip (f i) b) (pure a0)\n\n-- | Traverse a data structure with access to the index, performing some\n-- | effects encoded by an `Applicative` functor at each value, ignoring the\n-- | final result.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | > traverseWithIndex_ (curry logShow) [\"a\", \"b\", \"c\"]\n-- | (Tuple 0 \"a\")\n-- | (Tuple 1 \"b\")\n-- | (Tuple 2 \"c\")\n-- | ```\ntraverseWithIndex_\n :: forall i a b f m\n . Applicative m\n => FoldableWithIndex i f\n => (i -> a -> m b)\n -> f a\n -> m Unit\ntraverseWithIndex_ f = foldrWithIndex (\\i -> (*>) <<< f i) (pure unit)\n\n-- | A version of `traverseWithIndex_` with its arguments flipped.\n-- |\n-- | This can be useful when running an action written using do notation\n-- | for every element in a data structure:\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | forWithIndex_ [\"a\", \"b\", \"c\"] \\i x -> do\n-- | logShow i\n-- | log x\n-- | ```\nforWithIndex_\n :: forall i a b f m\n . Applicative m\n => FoldableWithIndex i f\n => f a\n -> (i -> a -> m b)\n -> m Unit\nforWithIndex_ = flip traverseWithIndex_\n\n-- | `foldMapWithIndex` but with each element surrounded by some fixed value.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | > surroundMapWithIndex \"*\" (\\i x -> show i <> x) []\n-- | = \"*\"\n-- |\n-- | > surroundMapWithIndex \"*\" (\\i x -> show i <> x) [\"a\"]\n-- | = \"*0a*\"\n-- |\n-- | > surroundMapWithIndex \"*\" (\\i x -> show i <> x) [\"a\", \"b\"]\n-- | = \"*0a*1b*\"\n-- |\n-- | > surroundMapWithIndex \"*\" (\\i x -> show i <> x) [\"a\", \"b\", \"c\"]\n-- | = \"*0a*1b*2c*\"\n-- | ```\nsurroundMapWithIndex\n :: forall i f a m\n . FoldableWithIndex i f\n => Semigroup m\n => m\n -> (i -> a -> m)\n -> f a\n -> m\nsurroundMapWithIndex d t f = unwrap (foldMapWithIndex joined f) d\n where joined i a = Endo \\m -> d <> t i a <> m\n\n-- | `allWithIndex f` is the same as `and <<< mapWithIndex f`; map a function over the\n-- | structure, and then get the conjunction of the results.\nallWithIndex\n :: forall i a b f\n . FoldableWithIndex i f\n => HeytingAlgebra b\n => (i -> a -> b)\n -> f a\n -> b\nallWithIndex t = unwrap <<< foldMapWithIndex (\\i -> Conj <<< t i)\n\n-- | `anyWithIndex f` is the same as `or <<< mapWithIndex f`; map a function over the\n-- | structure, and then get the disjunction of the results.\nanyWithIndex\n :: forall i a b f\n . FoldableWithIndex i f\n => HeytingAlgebra b\n => (i -> a -> b)\n -> f a\n -> b\nanyWithIndex t = unwrap <<< foldMapWithIndex (\\i -> Disj <<< t i)\n\n-- | Try to find an element in a data structure which satisfies a predicate\n-- | with access to the index.\nfindWithIndex\n :: forall i a f\n . FoldableWithIndex i f\n => (i -> a -> Boolean)\n -> f a\n -> Maybe { index :: i, value :: a }\nfindWithIndex p = foldlWithIndex go Nothing\n where\n go\n :: i\n -> Maybe { index :: i, value :: a }\n -> a\n -> Maybe { index :: i, value :: a }\n go i Nothing x | p i x = Just { index: i, value: x }\n go _ r _ = r\n\n-- | Try to find an element in a data structure which satisfies a predicate mapping\n-- | with access to the index.\nfindMapWithIndex\n :: forall i a b f\n . FoldableWithIndex i f\n => (i -> a -> Maybe b)\n -> f a\n -> Maybe b\nfindMapWithIndex f = foldlWithIndex go Nothing\n where\n go\n :: i\n -> Maybe b\n -> a\n -> Maybe b\n go i Nothing x = f i x\n go _ r _ = r\n\n-- | A default implementation of `foldr` using `foldrWithIndex`\nfoldrDefault\n :: forall i f a b\n . FoldableWithIndex i f\n => (a -> b -> b) -> b -> f a -> b\nfoldrDefault f = foldrWithIndex (const f)\n\n-- | A default implementation of `foldl` using `foldlWithIndex`\nfoldlDefault\n :: forall i f a b\n . FoldableWithIndex i f\n => (b -> a -> b) -> b -> f a -> b\nfoldlDefault f = foldlWithIndex (const f)\n\n-- | A default implementation of `foldMap` using `foldMapWithIndex`\nfoldMapDefault\n :: forall i f a m\n . FoldableWithIndex i f\n => Monoid m\n => (a -> m) -> f a -> m\nfoldMapDefault f = foldMapWithIndex (const f)\n", "// jshint maxparams: 3\n\nexport const traverseArrayImpl = (function () {\n function array1(a) {\n return [a];\n }\n\n function array2(a) {\n return function (b) {\n return [a, b];\n };\n }\n\n function array3(a) {\n return function (b) {\n return function (c) {\n return [a, b, c];\n };\n };\n }\n\n function concat2(xs) {\n return function (ys) {\n return xs.concat(ys);\n };\n }\n\n return function (apply) {\n return function (map) {\n return function (pure) {\n return function (f) {\n return function (array) {\n function go(bot, top) {\n switch (top - bot) {\n case 0: return pure([]);\n case 1: return map(array1)(f(array[bot]));\n case 2: return apply(map(array2)(f(array[bot])))(f(array[bot + 1]));\n case 3: return apply(apply(map(array3)(f(array[bot])))(f(array[bot + 1])))(f(array[bot + 2]));\n default:\n // This slightly tricky pivot selection aims to produce two\n // even-length partitions where possible.\n var pivot = bot + Math.floor((top - bot) / 4) * 2;\n return apply(map(concat2)(go(bot, pivot)))(go(pivot, top));\n }\n }\n return go(0, array.length);\n };\n };\n };\n };\n };\n})();\n", "module Data.Traversable\n ( class Traversable, traverse, sequence\n , traverseDefault, sequenceDefault\n , for\n , scanl\n , scanr\n , mapAccumL\n , mapAccumR\n , module Data.Foldable\n , module Data.Traversable.Accum\n ) where\n\nimport Prelude\n\nimport Control.Apply (lift2)\nimport Data.Const (Const(..))\nimport Data.Either (Either(..))\nimport Data.Foldable (class Foldable, all, and, any, elem, find, fold, foldMap, foldMapDefaultL, foldMapDefaultR, foldl, foldlDefault, foldr, foldrDefault, for_, intercalate, maximum, maximumBy, minimum, minimumBy, notElem, oneOf, or, sequence_, sum, traverse_)\nimport Data.Functor.App (App(..))\nimport Data.Functor.Compose (Compose(..))\nimport Data.Functor.Coproduct (Coproduct(..), coproduct)\nimport Data.Functor.Product (Product(..), product)\nimport Data.Identity (Identity(..))\nimport Data.Maybe (Maybe(..))\nimport Data.Maybe.First (First(..))\nimport Data.Maybe.Last (Last(..))\nimport Data.Monoid.Additive (Additive(..))\nimport Data.Monoid.Conj (Conj(..))\nimport Data.Monoid.Disj (Disj(..))\nimport Data.Monoid.Dual (Dual(..))\nimport Data.Monoid.Multiplicative (Multiplicative(..))\nimport Data.Traversable.Accum (Accum)\nimport Data.Traversable.Accum.Internal (StateL(..), StateR(..), stateL, stateR)\nimport Data.Tuple (Tuple(..))\n\n-- | `Traversable` represents data structures which can be _traversed_,\n-- | accumulating results and effects in some `Applicative` functor.\n-- |\n-- | - `traverse` runs an action for every element in a data structure,\n-- | and accumulates the results.\n-- | - `sequence` runs the actions _contained_ in a data structure,\n-- | and accumulates the results.\n-- |\n-- | ```purescript\n-- | import Data.Traversable\n-- | import Data.Maybe\n-- | import Data.Int (fromNumber)\n-- |\n-- | sequence [Just 1, Just 2, Just 3] == Just [1,2,3]\n-- | sequence [Nothing, Just 2, Just 3] == Nothing\n-- |\n-- | traverse fromNumber [1.0, 2.0, 3.0] == Just [1,2,3]\n-- | traverse fromNumber [1.5, 2.0, 3.0] == Nothing\n-- |\n-- | traverse logShow [1,2,3]\n-- | -- prints:\n-- | 1\n-- | 2\n-- | 3\n-- |\n-- | traverse (\\x -> [x, 0]) [1,2,3] == [[1,2,3],[1,2,0],[1,0,3],[1,0,0],[0,2,3],[0,2,0],[0,0,3],[0,0,0]]\n-- | ```\n-- |\n-- | The `traverse` and `sequence` functions should be compatible in the\n-- | following sense:\n-- |\n-- | - `traverse f xs = sequence (f <$> xs)`\n-- | - `sequence = traverse identity`\n-- |\n-- | `Traversable` instances should also be compatible with the corresponding\n-- | `Foldable` instances, in the following sense:\n-- |\n-- | - `foldMap f = runConst <<< traverse (Const <<< f)`\n-- |\n-- | Default implementations are provided by the following functions:\n-- |\n-- | - `traverseDefault`\n-- | - `sequenceDefault`\nclass (Functor t, Foldable t) <= Traversable t where\n traverse :: forall a b m. Applicative m => (a -> m b) -> t a -> m (t b)\n sequence :: forall a m. Applicative m => t (m a) -> m (t a)\n\n-- | A default implementation of `traverse` using `sequence` and `map`.\ntraverseDefault\n :: forall t a b m\n . Traversable t\n => Applicative m\n => (a -> m b)\n -> t a\n -> m (t b)\ntraverseDefault f ta = sequence (f <$> ta)\n\n-- | A default implementation of `sequence` using `traverse`.\nsequenceDefault\n :: forall t a m\n . Traversable t\n => Applicative m\n => t (m a)\n -> m (t a)\nsequenceDefault = traverse identity\n\ninstance traversableArray :: Traversable Array where\n traverse = traverseArrayImpl apply map pure\n sequence = sequenceDefault\n\nforeign import traverseArrayImpl\n :: forall m a b\n . (forall x y. m (x -> y) -> m x -> m y)\n -> (forall x y. (x -> y) -> m x -> m y)\n -> (forall x. x -> m x)\n -> (a -> m b)\n -> Array a\n -> m (Array b)\n\ninstance traversableMaybe :: Traversable Maybe where\n traverse _ Nothing = pure Nothing\n traverse f (Just x) = Just <$> f x\n sequence Nothing = pure Nothing\n sequence (Just x) = Just <$> x\n\ninstance traversableFirst :: Traversable First where\n traverse f (First x) = First <$> traverse f x\n sequence (First x) = First <$> sequence x\n\ninstance traversableLast :: Traversable Last where\n traverse f (Last x) = Last <$> traverse f x\n sequence (Last x) = Last <$> sequence x\n\ninstance traversableAdditive :: Traversable Additive where\n traverse f (Additive x) = Additive <$> f x\n sequence (Additive x) = Additive <$> x\n\ninstance traversableDual :: Traversable Dual where\n traverse f (Dual x) = Dual <$> f x\n sequence (Dual x) = Dual <$> x\n\ninstance traversableConj :: Traversable Conj where\n traverse f (Conj x) = Conj <$> f x\n sequence (Conj x) = Conj <$> x\n\ninstance traversableDisj :: Traversable Disj where\n traverse f (Disj x) = Disj <$> f x\n sequence (Disj x) = Disj <$> x\n\ninstance traversableMultiplicative :: Traversable Multiplicative where\n traverse f (Multiplicative x) = Multiplicative <$> f x\n sequence (Multiplicative x) = Multiplicative <$> x\n\ninstance traversableEither :: Traversable (Either a) where\n traverse _ (Left x) = pure (Left x)\n traverse f (Right x) = Right <$> f x\n sequence (Left x) = pure (Left x)\n sequence (Right x) = Right <$> x\n\ninstance traversableTuple :: Traversable (Tuple a) where\n traverse f (Tuple x y) = Tuple x <$> f y\n sequence (Tuple x y) = Tuple x <$> y\n\ninstance traversableIdentity :: Traversable Identity where\n traverse f (Identity x) = Identity <$> f x\n sequence (Identity x) = Identity <$> x\n\ninstance traversableConst :: Traversable (Const a) where\n traverse _ (Const x) = pure (Const x)\n sequence (Const x) = pure (Const x)\n\ninstance traversableProduct :: (Traversable f, Traversable g) => Traversable (Product f g) where\n traverse f (Product (Tuple fa ga)) = lift2 product (traverse f fa) (traverse f ga)\n sequence (Product (Tuple fa ga)) = lift2 product (sequence fa) (sequence ga)\n\ninstance traversableCoproduct :: (Traversable f, Traversable g) => Traversable (Coproduct f g) where\n traverse f = coproduct\n (map (Coproduct <<< Left) <<< traverse f)\n (map (Coproduct <<< Right) <<< traverse f)\n sequence = coproduct\n (map (Coproduct <<< Left) <<< sequence)\n (map (Coproduct <<< Right) <<< sequence)\n\ninstance traversableCompose :: (Traversable f, Traversable g) => Traversable (Compose f g) where\n traverse f (Compose fga) = map Compose $ traverse (traverse f) fga\n sequence = traverse identity\n\ninstance traversableApp :: Traversable f => Traversable (App f) where\n traverse f (App x) = App <$> traverse f x\n sequence (App x) = App <$> sequence x\n\n-- | A version of `traverse` with its arguments flipped.\n-- |\n-- |\n-- | This can be useful when running an action written using do notation\n-- | for every element in a data structure:\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | for [1, 2, 3] \\n -> do\n-- | print n\n-- | return (n * n)\n-- | ```\nfor\n :: forall a b m t\n . Applicative m\n => Traversable t\n => t a\n -> (a -> m b)\n -> m (t b)\nfor x f = traverse f x\n\n-- | Fold a data structure from the left, keeping all intermediate results\n-- | instead of only the final result. Note that the initial value does not\n-- | appear in the result (unlike Haskell's `Prelude.scanl`).\n-- |\n-- | ```purescript\n-- | scanl (+) 0 [1,2,3] = [1,3,6]\n-- | scanl (-) 10 [1,2,3] = [9,7,4]\n-- | ```\nscanl :: forall a b f. Traversable f => (b -> a -> b) -> b -> f a -> f b\nscanl f b0 xs = (mapAccumL (\\b a -> let b' = f b a in { accum: b', value: b' }) b0 xs).value\n\n-- | Fold a data structure from the left, keeping all intermediate results\n-- | instead of only the final result.\n-- |\n-- | Unlike `scanl`, `mapAccumL` allows the type of accumulator to differ\n-- | from the element type of the final data structure.\nmapAccumL\n :: forall a b s f\n . Traversable f\n => (s -> a -> Accum s b)\n -> s\n -> f a\n -> Accum s (f b)\nmapAccumL f s0 xs = stateL (traverse (\\a -> StateL \\s -> f s a) xs) s0\n\n-- | Fold a data structure from the right, keeping all intermediate results\n-- | instead of only the final result. Note that the initial value does not\n-- | appear in the result (unlike Haskell's `Prelude.scanr`).\n-- |\n-- | ```purescript\n-- | scanr (+) 0 [1,2,3] = [6,5,3]\n-- | scanr (flip (-)) 10 [1,2,3] = [4,5,7]\n-- | ```\nscanr :: forall a b f. Traversable f => (a -> b -> b) -> b -> f a -> f b\nscanr f b0 xs = (mapAccumR (\\b a -> let b' = f a b in { accum: b', value: b' }) b0 xs).value\n\n-- | Fold a data structure from the right, keeping all intermediate results\n-- | instead of only the final result.\n-- |\n-- | Unlike `scanr`, `mapAccumR` allows the type of accumulator to differ\n-- | from the element type of the final data structure.\nmapAccumR\n :: forall a b s f\n . Traversable f\n => (s -> a -> Accum s b)\n -> s\n -> f a\n -> Accum s (f b)\nmapAccumR f s0 xs = stateR (traverse (\\a -> StateR \\s -> f s a) xs) s0\n", "module Data.TraversableWithIndex \n ( class TraversableWithIndex, traverseWithIndex\n , traverseWithIndexDefault\n , forWithIndex\n , scanlWithIndex\n , mapAccumLWithIndex\n , scanrWithIndex\n , mapAccumRWithIndex\n , traverseDefault\n , module Data.Traversable.Accum\n ) where\n\nimport Prelude\n\nimport Control.Apply (lift2)\nimport Data.Const (Const(..))\nimport Data.Either (Either(..))\nimport Data.FoldableWithIndex (class FoldableWithIndex)\nimport Data.Functor.App (App(..))\nimport Data.Functor.Compose (Compose(..))\nimport Data.Functor.Coproduct (Coproduct(..), coproduct)\nimport Data.Functor.Product (Product(..), product)\nimport Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex)\nimport Data.Identity (Identity(..))\nimport Data.Maybe (Maybe)\nimport Data.Maybe.First (First)\nimport Data.Maybe.Last (Last)\nimport Data.Monoid.Additive (Additive)\nimport Data.Monoid.Conj (Conj)\nimport Data.Monoid.Disj (Disj)\nimport Data.Monoid.Dual (Dual)\nimport Data.Monoid.Multiplicative (Multiplicative)\nimport Data.Traversable (class Traversable, sequence, traverse)\nimport Data.Traversable.Accum (Accum)\nimport Data.Traversable.Accum.Internal (StateL(..), StateR(..), stateL, stateR)\nimport Data.Tuple (Tuple(..), curry)\n\n\n-- | A `Traversable` with an additional index. \n-- | A `TraversableWithIndex` instance must be compatible with its\n-- | `Traversable` instance\n-- | ```purescript\n-- | traverse f = traverseWithIndex (const f)\n-- | ```\n-- | with its `FoldableWithIndex` instance\n-- | ```\n-- | foldMapWithIndex f = unwrap <<< traverseWithIndex (\\i -> Const <<< f i)\n-- | ```\n-- | and with its `FunctorWithIndex` instance\n-- | ```\n-- | mapWithIndex f = unwrap <<< traverseWithIndex (\\i -> Identity <<< f i)\n-- | ```\n-- |\n-- | A default implementation is provided by `traverseWithIndexDefault`.\nclass (FunctorWithIndex i t, FoldableWithIndex i t, Traversable t) <= TraversableWithIndex i t | t -> i where\n traverseWithIndex :: forall a b m. Applicative m => (i -> a -> m b) -> t a -> m (t b)\n\n-- | A default implementation of `traverseWithIndex` using `sequence` and `mapWithIndex`.\ntraverseWithIndexDefault\n :: forall i t a b m\n . TraversableWithIndex i t\n => Applicative m\n => (i -> a -> m b)\n -> t a\n -> m (t b)\ntraverseWithIndexDefault f = sequence <<< mapWithIndex f\n\ninstance traversableWithIndexArray :: TraversableWithIndex Int Array where\n traverseWithIndex = traverseWithIndexDefault\n\ninstance traversableWithIndexMaybe :: TraversableWithIndex Unit Maybe where\n traverseWithIndex f = traverse $ f unit\n\ninstance traversableWithIndexFirst :: TraversableWithIndex Unit First where\n traverseWithIndex f = traverse $ f unit\n\ninstance traversableWithIndexLast :: TraversableWithIndex Unit Last where\n traverseWithIndex f = traverse $ f unit\n\ninstance traversableWithIndexAdditive :: TraversableWithIndex Unit Additive where\n traverseWithIndex f = traverse $ f unit\n\ninstance traversableWithIndexDual :: TraversableWithIndex Unit Dual where\n traverseWithIndex f = traverse $ f unit\n\ninstance traversableWithIndexConj :: TraversableWithIndex Unit Conj where\n traverseWithIndex f = traverse $ f unit\n\ninstance traversableWithIndexDisj :: TraversableWithIndex Unit Disj where\n traverseWithIndex f = traverse $ f unit\n\ninstance traversableWithIndexMultiplicative :: TraversableWithIndex Unit Multiplicative where\n traverseWithIndex f = traverse $ f unit\n\ninstance traversableWithIndexEither :: TraversableWithIndex Unit (Either a) where\n traverseWithIndex _ (Left x) = pure (Left x)\n traverseWithIndex f (Right x) = Right <$> f unit x\n\ninstance traversableWithIndexTuple :: TraversableWithIndex Unit (Tuple a) where\n traverseWithIndex f (Tuple x y) = Tuple x <$> f unit y\n\ninstance traversableWithIndexIdentity :: TraversableWithIndex Unit Identity where\n traverseWithIndex f (Identity x) = Identity <$> f unit x\n\ninstance traversableWithIndexConst :: TraversableWithIndex Void (Const a) where\n traverseWithIndex _ (Const x) = pure (Const x)\n\ninstance traversableWithIndexProduct :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Either a b) (Product f g) where\n traverseWithIndex f (Product (Tuple fa ga)) = lift2 product (traverseWithIndex (f <<< Left) fa) (traverseWithIndex (f <<< Right) ga)\n\ninstance traversableWithIndexCoproduct :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Either a b) (Coproduct f g) where\n traverseWithIndex f = coproduct\n (map (Coproduct <<< Left) <<< traverseWithIndex (f <<< Left))\n (map (Coproduct <<< Right) <<< traverseWithIndex (f <<< Right))\n\ninstance traversableWithIndexCompose :: (TraversableWithIndex a f, TraversableWithIndex b g) => TraversableWithIndex (Tuple a b) (Compose f g) where\n traverseWithIndex f (Compose fga) = map Compose $ traverseWithIndex (traverseWithIndex <<< curry f) fga\n\ninstance traversableWithIndexApp :: TraversableWithIndex a f => TraversableWithIndex a (App f) where\n traverseWithIndex f (App x) = App <$> traverseWithIndex f x\n\n-- | A version of `traverseWithIndex` with its arguments flipped.\n-- |\n-- |\n-- | This can be useful when running an action written using do notation\n-- | for every element in a data structure:\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | for [1, 2, 3] \\i x -> do\n-- | logShow i\n-- | pure (x * x)\n-- | ```\nforWithIndex\n :: forall i a b m t\n . Applicative m\n => TraversableWithIndex i t\n => t a\n -> (i -> a -> m b)\n -> m (t b)\nforWithIndex = flip traverseWithIndex\n\n-- | Fold a data structure from the left with access to the indices, keeping\n-- | all intermediate results instead of only the final result. Note that the\n-- | initial value does not appear in the result (unlike Haskell's\n-- | `Prelude.scanl`).\n-- |\n-- | ```purescript\n-- | scanlWithIndex (\\i y x -> i + y + x) 0 [1, 2, 3] = [1, 4, 9]\n-- | ```\nscanlWithIndex\n :: forall i a b f\n . TraversableWithIndex i f\n => (i -> b -> a -> b)\n -> b\n -> f a\n -> f b\nscanlWithIndex f b0 xs =\n (mapAccumLWithIndex (\\i b a -> let b' = f i b a in { accum: b', value: b' }) b0 xs).value\n\n-- | Fold a data structure from the left with access to the indices, keeping\n-- | all intermediate results instead of only the final result.\n-- |\n-- | Unlike `scanlWithIndex`, `mapAccumLWithIndex` allows the type of accumulator to differ\n-- | from the element type of the final data structure.\nmapAccumLWithIndex\n :: forall i a b s f\n . TraversableWithIndex i f\n => (i -> s -> a -> Accum s b)\n -> s\n -> f a\n -> Accum s (f b)\nmapAccumLWithIndex f s0 xs = stateL (traverseWithIndex (\\i a -> StateL \\s -> f i s a) xs) s0\n\n-- | Fold a data structure from the right with access to the indices, keeping\n-- | all intermediate results instead of only the final result. Note that the\n-- | initial value does not appear in the result (unlike Haskell's `Prelude.scanr`).\n-- |\n-- | ```purescript\n-- | scanrWithIndex (\\i x y -> i + x + y) 0 [1, 2, 3] = [9, 8, 5]\n-- | ```\nscanrWithIndex\n :: forall i a b f\n . TraversableWithIndex i f\n => (i -> a -> b -> b)\n -> b\n -> f a\n -> f b\nscanrWithIndex f b0 xs =\n (mapAccumRWithIndex (\\i b a -> let b' = f i a b in { accum: b', value: b' }) b0 xs).value\n\n-- | Fold a data structure from the right with access to the indices, keeping\n-- | all intermediate results instead of only the final result.\n-- |\n-- | Unlike `scanrWithIndex`, `imapAccumRWithIndex` allows the type of accumulator to differ\n-- | from the element type of the final data structure.\nmapAccumRWithIndex\n :: forall i a b s f\n . TraversableWithIndex i f\n => (i -> s -> a -> Accum s b)\n -> s\n -> f a\n -> Accum s (f b)\nmapAccumRWithIndex f s0 xs = stateR (traverseWithIndex (\\i a -> StateR \\s -> f i s a) xs) s0\n\n-- | A default implementation of `traverse` in terms of `traverseWithIndex`\ntraverseDefault\n :: forall i t a b m\n . TraversableWithIndex i t\n => Applicative m\n => (a -> m b) -> t a -> m (t b)\ntraverseDefault f = traverseWithIndex (const f)\n", "export const unfoldrArrayImpl = function (isNothing) {\n return function (fromJust) {\n return function (fst) {\n return function (snd) {\n return function (f) {\n return function (b) {\n var result = [];\n var value = b;\n while (true) { // eslint-disable-line no-constant-condition\n var maybe = f(value);\n if (isNothing(maybe)) return result;\n var tuple = fromJust(maybe);\n result.push(fst(tuple));\n value = snd(tuple);\n }\n };\n };\n };\n };\n };\n};\n", "export const unfoldr1ArrayImpl = function (isNothing) {\n return function (fromJust) {\n return function (fst) {\n return function (snd) {\n return function (f) {\n return function (b) {\n var result = [];\n var value = b;\n while (true) { // eslint-disable-line no-constant-condition\n var tuple = f(value);\n result.push(fst(tuple));\n var maybe = snd(tuple);\n if (isNothing(maybe)) return result;\n value = fromJust(maybe);\n }\n };\n };\n };\n };\n };\n};\n", "module Data.Unfoldable1\n ( class Unfoldable1, unfoldr1\n , replicate1\n , replicate1A\n , singleton\n , range\n , iterateN\n ) where\n\nimport Prelude\n\nimport Data.Maybe (Maybe(..), fromJust, isNothing)\nimport Data.Semigroup.Traversable (class Traversable1, sequence1)\nimport Data.Tuple (Tuple(..), fst, snd)\nimport Partial.Unsafe (unsafePartial)\n\n-- | This class identifies data structures which can be _unfolded_.\n-- |\n-- | The generating function `f` in `unfoldr1 f` corresponds to the `uncons`\n-- | operation of a non-empty list or array; it always returns a value, and\n-- | then optionally a value to continue unfolding from.\n-- |\n-- | Note that, in order to provide an `Unfoldable1 t` instance, `t` need not\n-- | be a type which is guaranteed to be non-empty. For example, the fact that\n-- | lists can be empty does not prevent us from providing an\n-- | `Unfoldable1 List` instance. However, the result of `unfoldr1` should\n-- | always be non-empty.\n-- |\n-- | Every type which has an `Unfoldable` instance can be given an\n-- | `Unfoldable1` instance (and, in fact, is required to, because\n-- | `Unfoldable1` is a superclass of `Unfoldable`). However, there are types\n-- | which have `Unfoldable1` instances but cannot have `Unfoldable` instances.\n-- | In particular, types which are guaranteed to be non-empty, such as\n-- | `NonEmptyList`, cannot be given `Unfoldable` instances.\n-- |\n-- | The utility of this class, then, is that it provides an `Unfoldable`-like\n-- | interface while still permitting instances for guaranteed-non-empty types\n-- | like `NonEmptyList`.\nclass Unfoldable1 t where\n unfoldr1 :: forall a b. (b -> Tuple a (Maybe b)) -> b -> t a\n\ninstance unfoldable1Array :: Unfoldable1 Array where\n unfoldr1 = unfoldr1ArrayImpl isNothing (unsafePartial fromJust) fst snd\n\ninstance unfoldable1Maybe :: Unfoldable1 Maybe where\n unfoldr1 f b = Just (fst (f b))\n\nforeign import unfoldr1ArrayImpl\n :: forall a b\n . (forall x. Maybe x -> Boolean)\n -> (forall x. Maybe x -> x)\n -> (forall x y. Tuple x y -> x)\n -> (forall x y. Tuple x y -> y)\n -> (b -> Tuple a (Maybe b))\n -> b\n -> Array a\n\n-- | Replicate a value `n` times. At least one value will be produced, so values\n-- | `n` less than 1 will be treated as 1.\n-- |\n-- | ``` purescript\n-- | replicate1 2 \"foo\" == (NEL.cons \"foo\" (NEL.singleton \"foo\") :: NEL.NonEmptyList String)\n-- | replicate1 0 \"foo\" == (NEL.singleton \"foo\" :: NEL.NonEmptyList String)\n-- | ```\nreplicate1 :: forall f a. Unfoldable1 f => Int -> a -> f a\nreplicate1 n v = unfoldr1 step (n - 1)\n where\n step :: Int -> Tuple a (Maybe Int)\n step i\n | i <= 0 = Tuple v Nothing\n | otherwise = Tuple v (Just (i - 1))\n\n-- | Perform an `Apply` action `n` times (at least once, so values `n` less\n-- | than 1 will be treated as 1), and accumulate the results.\n-- |\n-- | ``` purescript\n-- | > replicate1A 2 (randomInt 1 10) :: Effect (NEL.NonEmptyList Int)\n-- | (NonEmptyList (NonEmpty 8 (2 : Nil)))\n-- | > replicate1A 0 (randomInt 1 10) :: Effect (NEL.NonEmptyList Int)\n-- | (NonEmptyList (NonEmpty 4 Nil))\n-- | ```\nreplicate1A\n :: forall m f a\n . Apply m\n => Unfoldable1 f\n => Traversable1 f\n => Int\n -> m a\n -> m (f a)\nreplicate1A n m = sequence1 (replicate1 n m)\n\n-- | Contain a single value. For example:\n-- |\n-- | ``` purescript\n-- | singleton \"foo\" == (NEL.singleton \"foo\" :: NEL.NonEmptyList String)\n-- | ```\nsingleton :: forall f a. Unfoldable1 f => a -> f a\nsingleton = replicate1 1\n\n-- | Create an `Unfoldable1` containing a range of values, including both\n-- | endpoints.\n-- |\n-- | ``` purescript\n-- | range 0 0 == (NEL.singleton 0 :: NEL.NonEmptyList Int)\n-- | range 1 2 == (NEL.cons 1 (NEL.singleton 2) :: NEL.NonEmptyList Int)\n-- | range 2 0 == (NEL.cons 2 (NEL.cons 1 (NEL.singleton 0)) :: NEL.NonEmptyList Int)\n-- | ```\nrange :: forall f. Unfoldable1 f => Int -> Int -> f Int\nrange start end =\n let delta = if end >= start then 1 else -1 in unfoldr1 (go delta) start\n where\n go delta i =\n let i' = i + delta\n in Tuple i (if i == end then Nothing else Just i')\n\n-- | Create an `Unfoldable1` by repeated application of a function to a seed value.\n-- | For example:\n-- |\n-- | ``` purescript\n-- | (iterateN 5 (_ + 1) 0 :: Array Int) == [0, 1, 2, 3, 4]\n-- | (iterateN 5 (_ + 1) 0 :: NonEmptyArray Int) == NonEmptyArray [0, 1, 2, 3, 4]\n-- |\n-- | (iterateN 0 (_ + 1) 0 :: Array Int) == [0]\n-- | (iterateN 0 (_ + 1) 0 :: NonEmptyArray Int) == NonEmptyArray [0]\n-- | ```\niterateN :: forall f a. Unfoldable1 f => Int -> (a -> a) -> a -> f a\niterateN n f s = unfoldr1 go $ Tuple s (n - 1)\n where\n go (Tuple x n') = Tuple x\n if n' > 0 then Just $ Tuple (f x) $ n' - 1\n else Nothing\n", "-- | This module provides a type class for _unfoldable functors_, i.e.\n-- | functors which support an `unfoldr` operation.\n-- |\n-- | This allows us to unify various operations on arrays, lists,\n-- | sequences, etc.\n\nmodule Data.Unfoldable\n ( class Unfoldable, unfoldr\n , replicate\n , replicateA\n , none\n , fromMaybe\n , module Data.Unfoldable1\n ) where\n\nimport Prelude\n\nimport Data.Maybe (Maybe(..), isNothing, fromJust)\nimport Data.Traversable (class Traversable, sequence)\nimport Data.Tuple (Tuple(..), fst, snd)\nimport Data.Unfoldable1 (class Unfoldable1, unfoldr1, singleton, range, iterateN, replicate1, replicate1A)\nimport Partial.Unsafe (unsafePartial)\n\n-- | This class identifies (possibly empty) data structures which can be\n-- | _unfolded_.\n-- |\n-- | The generating function `f` in `unfoldr f` is understood as follows:\n-- |\n-- | - If `f b` is `Nothing`, then `unfoldr f b` should be empty.\n-- | - If `f b` is `Just (Tuple a b1)`, then `unfoldr f b` should consist of `a`\n-- | appended to the result of `unfoldr f b1`.\n-- |\n-- | Note that it is not possible to give `Unfoldable` instances to types which\n-- | represent structures which are guaranteed to be non-empty, such as\n-- | `NonEmptyArray`: consider what `unfoldr (const Nothing)` should produce.\n-- | Structures which are guaranteed to be non-empty can instead be given\n-- | `Unfoldable1` instances.\nclass Unfoldable1 t <= Unfoldable t where\n unfoldr :: forall a b. (b -> Maybe (Tuple a b)) -> b -> t a\n\ninstance unfoldableArray :: Unfoldable Array where\n unfoldr = unfoldrArrayImpl isNothing (unsafePartial fromJust) fst snd\n\ninstance unfoldableMaybe :: Unfoldable Maybe where\n unfoldr f b = fst <$> f b\n\nforeign import unfoldrArrayImpl\n :: forall a b\n . (forall x. Maybe x -> Boolean)\n -> (forall x. Maybe x -> x)\n -> (forall x y. Tuple x y -> x)\n -> (forall x y. Tuple x y -> y)\n -> (b -> Maybe (Tuple a b))\n -> b\n -> Array a\n\n-- | Replicate a value some natural number of times.\n-- | For example:\n-- |\n-- | ``` purescript\n-- | replicate 2 \"foo\" == ([\"foo\", \"foo\"] :: Array String)\n-- | ```\nreplicate :: forall f a. Unfoldable f => Int -> a -> f a\nreplicate n v = unfoldr step n\n where\n step :: Int -> Maybe (Tuple a Int)\n step i =\n if i <= 0 then Nothing\n else Just (Tuple v (i - 1))\n\n-- | Perform an Applicative action `n` times, and accumulate all the results.\n-- |\n-- | ``` purescript\n-- | > replicateA 5 (randomInt 1 10) :: Effect (Array Int)\n-- | [1,3,2,7,5]\n-- | ```\nreplicateA\n :: forall m f a\n . Applicative m\n => Unfoldable f\n => Traversable f\n => Int\n -> m a\n -> m (f a)\nreplicateA n m = sequence (replicate n m)\n\n-- | The container with no elements - unfolded with zero iterations.\n-- | For example:\n-- |\n-- | ``` purescript\n-- | none == ([] :: Array Unit)\n-- | ```\nnone :: forall f a. Unfoldable f => f a\nnone = unfoldr (const Nothing) unit\n\n-- | Convert a Maybe to any Unfoldable, such as lists or arrays.\n-- |\n-- | ``` purescript\n-- | fromMaybe (Nothing :: Maybe Int) == []\n-- | fromMaybe (Just 1) == [1]\n-- | ```\nfromMaybe :: forall f a. Unfoldable f => Maybe a -> f a\nfromMaybe = unfoldr (\\b -> flip Tuple Nothing <$> b)\n", "-- | This module defines a generic non-empty data structure, which adds an\n-- | additional element to any container type.\nmodule Data.NonEmpty\n ( NonEmpty(..)\n , singleton\n , (:|)\n , foldl1\n , fromNonEmpty\n , oneOf\n , head\n , tail\n ) where\n\nimport Prelude\n\nimport Control.Alt ((<|>))\nimport Control.Alternative (class Alternative)\nimport Control.Plus (class Plus, empty)\nimport Data.Eq (class Eq1)\nimport Data.Foldable (class Foldable, foldl, foldr, foldMap)\nimport Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex)\nimport Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex)\nimport Data.Maybe (Maybe(..), maybe)\nimport Data.Ord (class Ord1)\nimport Data.Semigroup.Foldable (class Foldable1)\nimport Data.Semigroup.Foldable (foldl1) as Foldable1\nimport Data.Traversable (class Traversable, traverse, sequence)\nimport Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)\nimport Data.Tuple (uncurry)\nimport Data.Unfoldable (class Unfoldable, unfoldr)\nimport Data.Unfoldable1 (class Unfoldable1)\n\n-- | A non-empty container of elements of type a.\n-- |\n-- | ```purescript\n-- | import Data.NonEmpty\n-- |\n-- | nonEmptyArray :: NonEmpty Array Int\n-- | nonEmptyArray = NonEmpty 1 [2,3]\n-- |\n-- | import Data.List(List(..), (:))\n-- |\n-- | nonEmptyList :: NonEmpty List Int\n-- | nonEmptyList = NonEmpty 1 (2 : 3 : Nil)\n-- | ```\ndata NonEmpty f a = NonEmpty a (f a)\n\n-- | An infix synonym for `NonEmpty`.\n-- |\n-- | ```purescript\n-- | nonEmptyArray :: NonEmpty Array Int\n-- | nonEmptyArray = 1 :| [2,3]\n-- |\n-- | nonEmptyList :: NonEmpty List Int\n-- | nonEmptyList = 1 :| 2 : 3 : Nil\n-- | ```\ninfixr 5 NonEmpty as :|\n\n-- | Create a non-empty structure with a single value.\n-- |\n-- | ```purescript\n-- | import Prelude\n-- |\n-- | singleton 1 == 1 :| []\n-- | singleton 1 == 1 :| Nil\n-- | ```\nsingleton :: forall f a. Plus f => a -> NonEmpty f a\nsingleton a = a :| empty\n\n-- | Fold a non-empty structure, collecting results using a binary operation.\n-- |\n-- | ```purescript\n-- | foldl1 (+) (1 :| [2, 3]) == 6\n-- | ```\nfoldl1 :: forall f a. Foldable f => (a -> a -> a) -> NonEmpty f a -> a\nfoldl1 = Foldable1.foldl1\n\n-- | Apply a function that takes the `first` element and remaining elements\n-- | as arguments to a non-empty container.\n-- |\n-- | For example, return the remaining elements multiplied by the first element:\n-- |\n-- | ```purescript\n-- | fromNonEmpty (\\x xs -> map (_ * x) xs) (3 :| [2, 1]) == [6, 3]\n-- | ```\nfromNonEmpty :: forall f a r. (a -> f a -> r) -> NonEmpty f a -> r\nfromNonEmpty f (a :| fa) = a `f` fa\n\n-- | Returns the `alt` (`<|>`) result of:\n-- | - The first element lifted to the container of the remaining elements.\n-- | - The remaining elements.\n-- |\n-- | ```purescript\n-- | import Data.Maybe(Maybe(..))\n-- |\n-- | oneOf (1 :| Nothing) == Just 1\n-- | oneOf (1 :| Just 2) == Just 1\n-- |\n-- | oneOf (1 :| [2, 3]) == [1,2,3]\n-- | ```\noneOf :: forall f a. Alternative f => NonEmpty f a -> f a\noneOf (a :| fa) = pure a <|> fa\n\n-- | Get the 'first' element of a non-empty container.\n-- |\n-- | ```purescript\n-- | head (1 :| [2, 3]) == 1\n-- | ```\nhead :: forall f a. NonEmpty f a -> a\nhead (x :| _) = x\n\n-- | Get everything but the 'first' element of a non-empty container.\n-- |\n-- | ```purescript\n-- | tail (1 :| [2, 3]) == [2, 3]\n-- | ```\ntail :: forall f a. NonEmpty f a -> f a\ntail (_ :| xs) = xs\n\ninstance showNonEmpty :: (Show a, Show (f a)) => Show (NonEmpty f a) where\n show (a :| fa) = \"(NonEmpty \" <> show a <> \" \" <> show fa <> \")\"\n\nderive instance eqNonEmpty :: (Eq1 f, Eq a) => Eq (NonEmpty f a)\n\nderive instance eq1NonEmpty :: Eq1 f => Eq1 (NonEmpty f)\n\nderive instance ordNonEmpty :: (Ord1 f, Ord a) => Ord (NonEmpty f a)\n\nderive instance ord1NonEmpty :: Ord1 f => Ord1 (NonEmpty f)\n\nderive instance functorNonEmpty :: Functor f => Functor (NonEmpty f)\n\ninstance functorWithIndex\n :: FunctorWithIndex i f\n => FunctorWithIndex (Maybe i) (NonEmpty f) where\n mapWithIndex f (a :| fa) = f Nothing a :| mapWithIndex (f <<< Just) fa\n\ninstance foldableNonEmpty :: Foldable f => Foldable (NonEmpty f) where\n foldMap f (a :| fa) = f a <> foldMap f fa\n foldl f b (a :| fa) = foldl f (f b a) fa\n foldr f b (a :| fa) = f a (foldr f b fa)\n\ninstance foldableWithIndexNonEmpty\n :: (FoldableWithIndex i f)\n => FoldableWithIndex (Maybe i) (NonEmpty f) where\n foldMapWithIndex f (a :| fa) = f Nothing a <> foldMapWithIndex (f <<< Just) fa\n foldlWithIndex f b (a :| fa) = foldlWithIndex (f <<< Just) (f Nothing b a) fa\n foldrWithIndex f b (a :| fa) = f Nothing a (foldrWithIndex (f <<< Just) b fa)\n\ninstance traversableNonEmpty :: Traversable f => Traversable (NonEmpty f) where\n sequence (a :| fa) = NonEmpty <$> a <*> sequence fa\n traverse f (a :| fa) = NonEmpty <$> f a <*> traverse f fa\n\ninstance traversableWithIndexNonEmpty\n :: (TraversableWithIndex i f)\n => TraversableWithIndex (Maybe i) (NonEmpty f) where\n traverseWithIndex f (a :| fa) =\n NonEmpty <$> f Nothing a <*> traverseWithIndex (f <<< Just) fa\n\ninstance foldable1NonEmpty :: Foldable f => Foldable1 (NonEmpty f) where\n foldMap1 f (a :| fa) = foldl (\\s a1 -> s <> f a1) (f a) fa\n foldr1 f (a :| fa) = maybe a (f a) $ foldr (\\a1 -> Just <<< maybe a1 (f a1)) Nothing fa\n foldl1 f (a :| fa) = foldl f a fa\n\ninstance unfoldable1NonEmpty :: Unfoldable f => Unfoldable1 (NonEmpty f) where\n unfoldr1 f b = uncurry (:|) $ unfoldr (map f) <$> f b\n\n-- | This is a lawful `Semigroup` instance that will behave sensibly for common nonempty\n-- | containers like lists and arrays. However, it's not guaranteed that `pure` will behave\n-- | sensibly alongside `<>` for all types, as we don't have any laws which govern their behavior.\ninstance semigroupNonEmpty\n :: (Applicative f, Semigroup (f a))\n => Semigroup (NonEmpty f a) where\n append (a1 :| f1) (a2 :| f2) = a1 :| (f1 <> pure a2 <> f2)\n", "module Data.List.Types\n ( List(..)\n , (:)\n , NonEmptyList(..)\n , toList\n , nelCons\n ) where\n\nimport Prelude\n\nimport Control.Alt (class Alt)\nimport Control.Alternative (class Alternative)\nimport Control.Apply (lift2)\nimport Control.Comonad (class Comonad)\nimport Control.Extend (class Extend)\nimport Control.MonadPlus (class MonadPlus)\nimport Control.Plus (class Plus)\nimport Data.Eq (class Eq1, eq1)\nimport Data.Foldable (class Foldable, foldl, foldr, intercalate)\nimport Data.FoldableWithIndex (class FoldableWithIndex, foldlWithIndex, foldrWithIndex, foldMapWithIndex)\nimport Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex)\nimport Data.Maybe (Maybe(..), maybe)\nimport Data.Newtype (class Newtype)\nimport Data.NonEmpty (NonEmpty, (:|))\nimport Data.NonEmpty as NE\nimport Data.Ord (class Ord1, compare1)\nimport Data.Semigroup.Foldable (class Foldable1)\nimport Data.Semigroup.Traversable (class Traversable1, traverse1)\nimport Data.Traversable (class Traversable, traverse)\nimport Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)\nimport Data.Tuple (Tuple(..), snd)\nimport Data.Unfoldable (class Unfoldable)\nimport Data.Unfoldable1 (class Unfoldable1)\n\ndata List a = Nil | Cons a (List a)\n\ninfixr 6 Cons as :\n\ninstance showList :: Show a => Show (List a) where\n show Nil = \"Nil\"\n show xs = \"(\" <> intercalate \" : \" (show <$> xs) <> \" : Nil)\"\n\ninstance eqList :: Eq a => Eq (List a) where\n eq = eq1\n\ninstance eq1List :: Eq1 List where\n eq1 xs ys = go xs ys true\n where\n go _ _ false = false\n go Nil Nil acc = acc\n go (x : xs') (y : ys') acc = go xs' ys' $ acc && (y == x)\n go _ _ _ = false\n\ninstance ordList :: Ord a => Ord (List a) where\n compare = compare1\n\ninstance ord1List :: Ord1 List where\n compare1 xs ys = go xs ys\n where\n go Nil Nil = EQ\n go Nil _ = LT\n go _ Nil = GT\n go (x : xs') (y : ys') =\n case compare x y of\n EQ -> go xs' ys'\n other -> other\n\ninstance semigroupList :: Semigroup (List a) where\n append xs ys = foldr (:) ys xs\n\ninstance monoidList :: Monoid (List a) where\n mempty = Nil\n\ninstance functorList :: Functor List where\n map = listMap\n\n-- chunked list Functor inspired by OCaml\n-- https://discuss.ocaml.org/t/a-new-list-map-that-is-both-stack-safe-and-fast/865\n-- chunk sizes determined through experimentation\nlistMap :: forall a b. (a -> b) -> List a -> List b\nlistMap f = chunkedRevMap Nil\n where\n chunkedRevMap :: List (List a) -> List a -> List b\n chunkedRevMap chunksAcc chunk@(_ : _ : _ : xs) =\n chunkedRevMap (chunk : chunksAcc) xs\n chunkedRevMap chunksAcc xs =\n reverseUnrolledMap chunksAcc $ unrolledMap xs\n where\n unrolledMap :: List a -> List b\n unrolledMap (x1 : x2 : Nil) = f x1 : f x2 : Nil\n unrolledMap (x1 : Nil) = f x1 : Nil\n unrolledMap _ = Nil\n\n reverseUnrolledMap :: List (List a) -> List b -> List b\n reverseUnrolledMap ((x1 : x2 : x3 : _) : cs) acc =\n reverseUnrolledMap cs (f x1 : f x2 : f x3 : acc)\n reverseUnrolledMap _ acc = acc\n\ninstance functorWithIndexList :: FunctorWithIndex Int List where\n mapWithIndex f = foldrWithIndex (\\i x acc -> f i x : acc) Nil\n\ninstance foldableList :: Foldable List where\n foldr f b = foldl (flip f) b <<< rev\n where\n rev = go Nil\n where\n go acc Nil = acc\n go acc (x : xs) = go (x : acc) xs\n foldl f = go\n where\n go b = case _ of\n Nil -> b\n a : as -> go (f b a) as\n foldMap f = foldl (\\acc -> append acc <<< f) mempty\n\ninstance foldableWithIndexList :: FoldableWithIndex Int List where\n foldrWithIndex f b xs =\n -- as we climb the reversed list, we decrement the index\n snd $ foldl\n (\\(Tuple i b') a -> Tuple (i - 1) (f (i - 1) a b'))\n (Tuple len b)\n revList\n where\n Tuple len revList = rev (Tuple 0 Nil) xs\n where\n -- As we create our reversed list, we count elements.\n rev = foldl (\\(Tuple i acc) a -> Tuple (i + 1) (a : acc))\n foldlWithIndex f acc =\n snd <<< foldl (\\(Tuple i b) a -> Tuple (i + 1) (f i b a)) (Tuple 0 acc)\n foldMapWithIndex f = foldlWithIndex (\\i acc -> append acc <<< f i) mempty\n\ninstance unfoldable1List :: Unfoldable1 List where\n unfoldr1 f b = go b Nil\n where\n go source memo = case f source of\n Tuple one (Just rest) -> go rest (one : memo)\n Tuple one Nothing -> foldl (flip (:)) Nil (one : memo)\n\ninstance unfoldableList :: Unfoldable List where\n unfoldr f b = go b Nil\n where\n go source memo = case f source of\n Nothing -> (foldl (flip (:)) Nil memo)\n Just (Tuple one rest) -> go rest (one : memo)\n\ninstance traversableList :: Traversable List where\n traverse f = map (foldl (flip (:)) Nil) <<< foldl (\\acc -> lift2 (flip (:)) acc <<< f) (pure Nil)\n sequence = traverse identity\n\ninstance traversableWithIndexList :: TraversableWithIndex Int List where\n traverseWithIndex f =\n map rev\n <<< foldlWithIndex (\\i acc -> lift2 (flip (:)) acc <<< f i) (pure Nil)\n where\n rev = foldl (flip Cons) Nil\n\ninstance applyList :: Apply List where\n apply Nil _ = Nil\n apply (f : fs) xs = (f <$> xs) <> (fs <*> xs)\n\ninstance applicativeList :: Applicative List where\n pure a = a : Nil\n\ninstance bindList :: Bind List where\n bind Nil _ = Nil\n bind (x : xs) f = f x <> bind xs f\n\ninstance monadList :: Monad List\n\ninstance altList :: Alt List where\n alt = append\n\ninstance plusList :: Plus List where\n empty = Nil\n\ninstance alternativeList :: Alternative List\n\ninstance monadPlusList :: MonadPlus List\n\ninstance extendList :: Extend List where\n extend _ Nil = Nil\n extend f l@(_ : as) =\n f l : (foldr go { val: Nil, acc: Nil } as).val\n where\n go a' { val, acc } =\n let acc' = a' : acc\n in { val: f acc' : val, acc: acc' }\n\nnewtype NonEmptyList a = NonEmptyList (NonEmpty List a)\n\ntoList :: NonEmptyList ~> List\ntoList (NonEmptyList (x :| xs)) = x : xs\n\nnelCons :: forall a. a -> NonEmptyList a -> NonEmptyList a\nnelCons a (NonEmptyList (b :| bs)) = NonEmptyList (a :| b : bs)\n\nderive instance newtypeNonEmptyList :: Newtype (NonEmptyList a) _\n\nderive newtype instance eqNonEmptyList :: Eq a => Eq (NonEmptyList a)\nderive newtype instance ordNonEmptyList :: Ord a => Ord (NonEmptyList a)\n\nderive newtype instance eq1NonEmptyList :: Eq1 NonEmptyList\nderive newtype instance ord1NonEmptyList :: Ord1 NonEmptyList\n\ninstance showNonEmptyList :: Show a => Show (NonEmptyList a) where\n show (NonEmptyList nel) = \"(NonEmptyList \" <> show nel <> \")\"\n\nderive newtype instance functorNonEmptyList :: Functor NonEmptyList\n\ninstance applyNonEmptyList :: Apply NonEmptyList where\n apply (NonEmptyList (f :| fs)) (NonEmptyList (a :| as)) =\n NonEmptyList (f a :| (fs <*> a : Nil) <> ((f : fs) <*> as))\n\ninstance applicativeNonEmptyList :: Applicative NonEmptyList where\n pure = NonEmptyList <<< NE.singleton\n\ninstance bindNonEmptyList :: Bind NonEmptyList where\n bind (NonEmptyList (a :| as)) f =\n case f a of\n NonEmptyList (b :| bs) ->\n NonEmptyList (b :| bs <> bind as (toList <<< f))\n\ninstance monadNonEmptyList :: Monad NonEmptyList\n\ninstance altNonEmptyList :: Alt NonEmptyList where\n alt = append\n\ninstance extendNonEmptyList :: Extend NonEmptyList where\n extend f w@(NonEmptyList (_ :| as)) =\n NonEmptyList (f w :| (foldr go { val: Nil, acc: Nil } as).val)\n where\n go a { val, acc } = { val: f (NonEmptyList (a :| acc)) : val, acc: a : acc }\n\ninstance comonadNonEmptyList :: Comonad NonEmptyList where\n extract (NonEmptyList (a :| _)) = a\n\ninstance semigroupNonEmptyList :: Semigroup (NonEmptyList a) where\n append (NonEmptyList (a :| as)) as' =\n NonEmptyList (a :| as <> toList as')\n\nderive newtype instance foldableNonEmptyList :: Foldable NonEmptyList\n\nderive newtype instance traversableNonEmptyList :: Traversable NonEmptyList\n\nderive newtype instance foldable1NonEmptyList :: Foldable1 NonEmptyList\n\nderive newtype instance unfoldable1NonEmptyList :: Unfoldable1 NonEmptyList\n\ninstance functorWithIndexNonEmptyList :: FunctorWithIndex Int NonEmptyList where\n mapWithIndex fn (NonEmptyList ne) = NonEmptyList $ mapWithIndex (fn <<< maybe 0 (add 1)) ne\n\ninstance foldableWithIndexNonEmptyList :: FoldableWithIndex Int NonEmptyList where\n foldMapWithIndex f (NonEmptyList ne) = foldMapWithIndex (f <<< maybe 0 (add 1)) ne\n foldlWithIndex f b (NonEmptyList ne) = foldlWithIndex (f <<< maybe 0 (add 1)) b ne\n foldrWithIndex f b (NonEmptyList ne) = foldrWithIndex (f <<< maybe 0 (add 1)) b ne\n\ninstance traversableWithIndexNonEmptyList :: TraversableWithIndex Int NonEmptyList where\n traverseWithIndex f (NonEmptyList ne) = NonEmptyList <$> traverseWithIndex (f <<< maybe 0 (add 1)) ne\n\ninstance traversable1NonEmptyList :: Traversable1 NonEmptyList where\n traverse1 f (NonEmptyList (a :| as)) =\n foldl (\\acc -> lift2 (flip nelCons) acc <<< f) (pure <$> f a) as\n <#> case _ of NonEmptyList (x :| xs) \u2192 foldl (flip nelCons) (pure x) xs\n sequence1 = traverse1 identity\n", "-- | This module defines a type of maps as height-balanced (AVL) binary trees.\n-- | Efficient set operations are implemented in terms of\n-- | \n\nmodule Data.Map.Internal\n ( Map(..)\n , showTree\n , empty\n , isEmpty\n , singleton\n , checkValid\n , insert\n , insertWith\n , lookup\n , lookupLE\n , lookupLT\n , lookupGE\n , lookupGT\n , findMin\n , findMax\n , foldSubmap\n , submap\n , fromFoldable\n , fromFoldableWith\n , fromFoldableWithIndex\n , toUnfoldable\n , toUnfoldableUnordered\n , delete\n , pop\n , member\n , alter\n , update\n , keys\n , values\n , union\n , unionWith\n , unions\n , intersection\n , intersectionWith\n , difference\n , isSubmap\n , size\n , filterWithKey\n , filterKeys\n , filter\n , mapMaybeWithKey\n , mapMaybe\n , catMaybes\n , any\n , anyWithKey\n , MapIter\n , MapIterStep(..)\n , toMapIter\n , stepAsc\n , stepAscCps\n , stepDesc\n , stepDescCps\n , stepUnordered\n , stepUnorderedCps\n , unsafeNode\n , unsafeBalancedNode\n , unsafeJoinNodes\n , unsafeSplit\n , Split(..)\n ) where\n\nimport Prelude\n\nimport Control.Alt (class Alt)\nimport Control.Plus (class Plus)\nimport Data.Eq (class Eq1)\nimport Data.Foldable (class Foldable, foldl, foldr)\nimport Data.FoldableWithIndex (class FoldableWithIndex, foldlWithIndex, foldrWithIndex)\nimport Data.Function.Uncurried (Fn2, Fn3, Fn4, Fn7, mkFn2, mkFn3, mkFn4, mkFn7, runFn2, runFn3, runFn4, runFn7)\nimport Data.FunctorWithIndex (class FunctorWithIndex)\nimport Data.List (List(..), (:))\nimport Data.Maybe (Maybe(..))\nimport Data.Ord (class Ord1, abs)\nimport Data.Traversable (traverse, class Traversable)\nimport Data.TraversableWithIndex (class TraversableWithIndex)\nimport Data.Tuple (Tuple(Tuple))\nimport Data.Unfoldable (class Unfoldable, unfoldr)\nimport Prim.TypeError (class Warn, Text)\n\n-- | `Map k v` represents maps from keys of type `k` to values of type `v`.\ndata Map k v = Leaf | Node Int Int k v (Map k v) (Map k v)\n\ntype role Map nominal representational\n\ninstance eq1Map :: Eq k => Eq1 (Map k) where\n eq1 = eq\n\ninstance eqMap :: (Eq k, Eq v) => Eq (Map k v) where\n eq xs ys = case xs of\n Leaf ->\n case ys of\n Leaf -> true\n _ -> false\n Node _ s1 _ _ _ _ ->\n case ys of\n Node _ s2 _ _ _ _\n | s1 == s2 ->\n toMapIter xs == toMapIter ys\n _ ->\n false\n\ninstance ord1Map :: Ord k => Ord1 (Map k) where\n compare1 = compare\n\ninstance ordMap :: (Ord k, Ord v) => Ord (Map k v) where\n compare xs ys = case xs of\n Leaf ->\n case ys of\n Leaf -> EQ\n _ -> LT\n _ ->\n case ys of\n Leaf -> GT\n _ -> compare (toMapIter xs) (toMapIter ys)\n\ninstance showMap :: (Show k, Show v) => Show (Map k v) where\n show as = \"(fromFoldable \" <> show (toUnfoldable as :: Array _) <> \")\"\n\ninstance semigroupMap ::\n ( Warn (Text \"Data.Map's `Semigroup` instance is now unbiased and differs from the left-biased instance defined in PureScript releases <= 0.13.x.\")\n , Ord k\n , Semigroup v\n ) => Semigroup (Map k v) where\n append = unionWith append\n\ninstance monoidSemigroupMap ::\n ( Warn (Text \"Data.Map's `Semigroup` instance is now unbiased and differs from the left-biased instance defined in PureScript releases <= 0.13.x.\")\n , Ord k\n , Semigroup v\n ) => Monoid (Map k v) where\n mempty = empty\n\ninstance altMap :: Ord k => Alt (Map k) where\n alt = union\n\ninstance plusMap :: Ord k => Plus (Map k) where\n empty = empty\n\ninstance functorMap :: Functor (Map k) where\n map f = go\n where\n go = case _ of\n Leaf -> Leaf\n Node h s k v l r ->\n Node h s k (f v) (go l) (go r)\n\ninstance functorWithIndexMap :: FunctorWithIndex k (Map k) where\n mapWithIndex f = go\n where\n go = case _ of\n Leaf -> Leaf\n Node h s k v l r ->\n Node h s k (f k v) (go l) (go r)\n\ninstance applyMap :: Ord k => Apply (Map k) where\n apply = intersectionWith identity\n\ninstance bindMap :: Ord k => Bind (Map k) where\n bind m f = mapMaybeWithKey (\\k -> lookup k <<< f) m\n\ninstance foldableMap :: Foldable (Map k) where\n foldr f z = \\m -> runFn2 go m z\n where\n go = mkFn2 \\m' z' -> case m' of\n Leaf -> z'\n Node _ _ _ v l r ->\n runFn2 go l (f v (runFn2 go r z'))\n foldl f z = \\m -> runFn2 go z m\n where\n go = mkFn2 \\z' m' -> case m' of\n Leaf -> z'\n Node _ _ _ v l r ->\n runFn2 go (f (runFn2 go z' l) v) r\n foldMap f = go\n where\n go = case _ of\n Leaf -> mempty\n Node _ _ _ v l r ->\n go l <> f v <> go r\n\ninstance foldableWithIndexMap :: FoldableWithIndex k (Map k) where\n foldrWithIndex f z = \\m -> runFn2 go m z\n where\n go = mkFn2 \\m' z' -> case m' of\n Leaf -> z'\n Node _ _ k v l r ->\n runFn2 go l (f k v (runFn2 go r z'))\n foldlWithIndex f z = \\m -> runFn2 go z m\n where\n go = mkFn2 \\z' m' -> case m' of\n Leaf -> z'\n Node _ _ k v l r ->\n runFn2 go (f k (runFn2 go z' l) v) r\n foldMapWithIndex f = go\n where\n go = case _ of\n Leaf -> mempty\n Node _ _ k v l r ->\n go l <> f k v <> go r\n\ninstance traversableMap :: Traversable (Map k) where\n traverse f = go\n where\n go = case _ of\n Leaf -> pure Leaf\n Node h s k v l r ->\n (\\l' v' r' -> Node h s k v' l' r')\n <$> go l\n <*> f v\n <*> go r\n sequence = traverse identity\n\ninstance traversableWithIndexMap :: TraversableWithIndex k (Map k) where\n traverseWithIndex f = go\n where\n go = case _ of\n Leaf -> pure Leaf\n Node h s k v l r ->\n (\\l' v' r' -> Node h s k v' l' r')\n <$> go l\n <*> f k v\n <*> go r\n\n-- | Render a `Map` as a `String`\nshowTree :: forall k v. Show k => Show v => Map k v -> String\nshowTree = go \"\"\n where\n go ind = case _ of\n Leaf -> ind <> \"Leaf\"\n Node h _ k v l r ->\n (ind <> \"[\" <> show h <> \"] \" <> show k <> \" => \" <> show v <> \"\\n\")\n <> (go (ind <> \" \") l <> \"\\n\")\n <> (go (ind <> \" \") r)\n\n-- | An empty map\nempty :: forall k v. Map k v\nempty = Leaf\n\n-- | Test if a map is empty\nisEmpty :: forall k v. Map k v -> Boolean\nisEmpty Leaf = true\nisEmpty _ = false\n\n-- | Create a map with one key/value pair\nsingleton :: forall k v. k -> v -> Map k v\nsingleton k v = Node 1 1 k v Leaf Leaf\n\n-- | Check whether the underlying tree satisfies the height, size, and ordering invariants.\n-- |\n-- | This function is provided for internal use.\ncheckValid :: forall k v. Ord k => Map k v -> Boolean\ncheckValid = go\n where\n go = case _ of\n Leaf -> true\n Node h s k _ l r ->\n case l of\n Leaf ->\n case r of\n Leaf ->\n true\n Node rh rs rk _ _ _ ->\n h == 2 && rh == 1 && s > rs && rk > k && go r\n Node lh ls lk _ _ _ ->\n case r of\n Leaf ->\n h == 2 && lh == 1 && s > ls && lk < k && go l\n Node rh rs rk _ _ _ ->\n h > rh && rk > k && h > lh && lk < k && abs (rh - lh) < 2 && rs + ls + 1 == s && go l && go r\n\n-- | Look up a value for the specified key\nlookup :: forall k v. Ord k => k -> Map k v -> Maybe v\nlookup k = go\n where\n go = case _ of\n Leaf -> Nothing\n Node _ _ mk mv ml mr ->\n case compare k mk of\n LT -> go ml\n GT -> go mr\n EQ -> Just mv\n\n-- | Look up a value for the specified key, or the greatest one less than it\nlookupLE :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v }\nlookupLE k = go\n where\n go = case _ of\n Leaf -> Nothing\n Node _ _ mk mv ml mr ->\n case compare k mk of\n LT -> go ml\n GT ->\n case go mr of\n Nothing -> Just { key: mk, value: mv }\n other -> other\n EQ ->\n Just { key: mk, value: mv }\n\n-- | Look up a value for the greatest key less than the specified key\nlookupLT :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v }\nlookupLT k = go\n where\n go = case _ of\n Leaf -> Nothing\n Node _ _ mk mv ml mr ->\n case compare k mk of\n LT -> go ml\n GT ->\n case go mr of\n Nothing -> Just { key: mk, value: mv }\n other -> other\n EQ ->\n findMax ml\n\n-- | Look up a value for the specified key, or the least one greater than it\nlookupGE :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v }\nlookupGE k = go\n where\n go = case _ of\n Leaf -> Nothing\n Node _ _ mk mv ml mr ->\n case compare k mk of\n LT ->\n case go ml of\n Nothing -> Just { key: mk, value: mv }\n other -> other\n GT -> go mr\n EQ -> Just { key: mk, value: mv }\n\n-- | Look up a value for the least key greater than the specified key\nlookupGT :: forall k v. Ord k => k -> Map k v -> Maybe { key :: k, value :: v }\nlookupGT k = go\n where\n go = case _ of\n Leaf -> Nothing\n Node _ _ mk mv ml mr ->\n case compare k mk of\n LT ->\n case go ml of\n Nothing -> Just { key: mk, value: mv }\n other -> other\n GT -> go mr\n EQ -> findMin mr\n\n-- | Returns the pair with the greatest key\nfindMax :: forall k v. Map k v -> Maybe { key :: k, value :: v }\nfindMax = case _ of\n Leaf -> Nothing\n Node _ _ k v _ r ->\n case r of\n Leaf -> Just { key: k, value: v }\n _ -> findMax r\n\n-- | Returns the pair with the least key\nfindMin :: forall k v. Map k v -> Maybe { key :: k, value :: v }\nfindMin = case _ of\n Leaf -> Nothing\n Node _ _ k v l _ ->\n case l of\n Leaf -> Just { key: k, value: v }\n _ -> findMin l\n\n-- | Fold over the entries of a given map where the key is between a lower and\n-- | an upper bound. Passing `Nothing` as either the lower or upper bound\n-- | argument means that the fold has no lower or upper bound, i.e. the fold\n-- | starts from (or ends with) the smallest (or largest) key in the map.\n-- |\n-- | ```purescript\n-- | foldSubmap (Just 1) (Just 2) (\\_ v -> [v])\n-- | (fromFoldable [Tuple 0 \"zero\", Tuple 1 \"one\", Tuple 2 \"two\", Tuple 3 \"three\"])\n-- | == [\"one\", \"two\"]\n-- |\n-- | foldSubmap Nothing (Just 2) (\\_ v -> [v])\n-- | (fromFoldable [Tuple 0 \"zero\", Tuple 1 \"one\", Tuple 2 \"two\", Tuple 3 \"three\"])\n-- | == [\"zero\", \"one\", \"two\"]\n-- | ```\nfoldSubmap :: forall k v m. Ord k => Monoid m => Maybe k -> Maybe k -> (k -> v -> m) -> Map k v -> m\nfoldSubmap = foldSubmapBy (<>) mempty\n\nfoldSubmapBy :: forall k v m. Ord k => (m -> m -> m) -> m -> Maybe k -> Maybe k -> (k -> v -> m) -> Map k v -> m\nfoldSubmapBy appendFn memptyValue kmin kmax f =\n let\n tooSmall =\n case kmin of\n Just kmin' ->\n \\k -> k < kmin'\n Nothing ->\n const false\n\n tooLarge =\n case kmax of\n Just kmax' ->\n \\k -> k > kmax'\n Nothing ->\n const false\n\n inBounds =\n case kmin, kmax of\n Just kmin', Just kmax' ->\n \\k -> kmin' <= k && k <= kmax'\n Just kmin', Nothing ->\n \\k -> kmin' <= k\n Nothing, Just kmax' ->\n \\k -> k <= kmax'\n Nothing, Nothing ->\n const true\n\n go = case _ of\n Leaf ->\n memptyValue\n Node _ _ k v left right ->\n (if tooSmall k then memptyValue else go left)\n `appendFn` (if inBounds k then f k v else memptyValue)\n `appendFn` (if tooLarge k then memptyValue else go right)\n in\n go\n\n-- | Returns a new map containing all entries of the given map which lie\n-- | between a given lower and upper bound, treating `Nothing` as no bound i.e.\n-- | including the smallest (or largest) key in the map, no matter how small\n-- | (or large) it is. For example:\n-- |\n-- | ```purescript\n-- | submap (Just 1) (Just 2)\n-- | (fromFoldable [Tuple 0 \"zero\", Tuple 1 \"one\", Tuple 2 \"two\", Tuple 3 \"three\"])\n-- | == fromFoldable [Tuple 1 \"one\", Tuple 2 \"two\"]\n-- |\n-- | submap Nothing (Just 2)\n-- | (fromFoldable [Tuple 0 \"zero\", Tuple 1 \"one\", Tuple 2 \"two\", Tuple 3 \"three\"])\n-- | == fromFoldable [Tuple 0 \"zero\", Tuple 1 \"one\", Tuple 2 \"two\"]\n-- | ```\n-- |\n-- | The function is entirely specified by the following\n-- | property:\n-- |\n-- | ```purescript\n-- | Given any m :: Map k v, mmin :: Maybe k, mmax :: Maybe k, key :: k,\n-- | let m' = submap mmin mmax m in\n-- | if (maybe true (\\min -> min <= key) mmin &&\n-- | maybe true (\\max -> max >= key) mmax)\n-- | then lookup key m == lookup key m'\n-- | else not (member key m')\n-- | ```\nsubmap :: forall k v. Ord k => Maybe k -> Maybe k -> Map k v -> Map k v\nsubmap kmin kmax = foldSubmapBy union empty kmin kmax singleton\n\n-- | Test if a key is a member of a map\nmember :: forall k v. Ord k => k -> Map k v -> Boolean\nmember k = go\n where\n go = case _ of\n Leaf -> false\n Node _ _ mk _ ml mr ->\n case compare k mk of\n LT -> go ml\n GT -> go mr\n EQ -> true\n\n-- | Insert or replace a key/value pair in a map\ninsert :: forall k v. Ord k => k -> v -> Map k v -> Map k v\ninsert k v = go\n where\n go = case _ of\n Leaf -> singleton k v\n Node mh ms mk mv ml mr ->\n case compare k mk of\n LT -> runFn4 unsafeBalancedNode mk mv (go ml) mr\n GT -> runFn4 unsafeBalancedNode mk mv ml (go mr)\n EQ -> Node mh ms k v ml mr\n\n-- | Inserts or updates a value with the given function.\n-- |\n-- | The combining function is called with the existing value as the first\n-- | argument and the new value as the second argument.\ninsertWith :: forall k v. Ord k => (v -> v -> v) -> k -> v -> Map k v -> Map k v\ninsertWith app k v = go\n where\n go = case _ of\n Leaf -> singleton k v\n Node mh ms mk mv ml mr ->\n case compare k mk of\n LT -> runFn4 unsafeBalancedNode mk mv (go ml) mr\n GT -> runFn4 unsafeBalancedNode mk mv ml (go mr)\n EQ -> Node mh ms k (app mv v) ml mr\n\n-- | Delete a key and its corresponding value from a map.\ndelete :: forall k v. Ord k => k -> Map k v -> Map k v\ndelete k = go\n where\n go = case _ of\n Leaf -> Leaf\n Node _ _ mk mv ml mr ->\n case compare k mk of\n LT -> runFn4 unsafeBalancedNode mk mv (go ml) mr\n GT -> runFn4 unsafeBalancedNode mk mv ml (go mr)\n EQ -> runFn2 unsafeJoinNodes ml mr\n\n-- | Delete a key and its corresponding value from a map, returning the value\n-- | as well as the subsequent map.\npop :: forall k v. Ord k => k -> Map k v -> Maybe (Tuple v (Map k v))\npop k m = do\n let (Split x l r) = runFn3 unsafeSplit compare k m\n map (\\a -> Tuple a (runFn2 unsafeJoinNodes l r)) x\n\n-- | Insert the value, delete a value, or update a value for a key in a map\nalter :: forall k v. Ord k => (Maybe v -> Maybe v) -> k -> Map k v -> Map k v\nalter f k m = do\n let Split v l r = runFn3 unsafeSplit compare k m\n case f v of\n Nothing ->\n runFn2 unsafeJoinNodes l r\n Just v' ->\n runFn4 unsafeBalancedNode k v' l r\n\n-- | Update or delete the value for a key in a map\nupdate :: forall k v. Ord k => (v -> Maybe v) -> k -> Map k v -> Map k v\nupdate f k = go\n where\n go = case _ of\n Leaf -> Leaf\n Node mh ms mk mv ml mr ->\n case compare k mk of\n LT -> runFn4 unsafeBalancedNode mk mv (go ml) mr\n GT -> runFn4 unsafeBalancedNode mk mv ml (go mr)\n EQ ->\n case f mv of\n Nothing ->\n runFn2 unsafeJoinNodes ml mr\n Just mv' ->\n Node mh ms mk mv' ml mr\n\n-- | Convert any foldable collection of key/value pairs to a map.\n-- | On key collision, later values take precedence over earlier ones.\nfromFoldable :: forall f k v. Ord k => Foldable f => f (Tuple k v) -> Map k v\nfromFoldable = foldl (\\m (Tuple k v) -> insert k v m) empty\n\n-- | Convert any foldable collection of key/value pairs to a map.\n-- | On key collision, the values are configurably combined.\nfromFoldableWith :: forall f k v. Ord k => Foldable f => (v -> v -> v) -> f (Tuple k v) -> Map k v\nfromFoldableWith f = foldl (\\m (Tuple k v) -> f' k v m) empty\n where\n f' = insertWith (flip f)\n\n-- | Convert any indexed foldable collection into a map.\nfromFoldableWithIndex :: forall f k v. Ord k => FoldableWithIndex k f => f v -> Map k v\nfromFoldableWithIndex = foldlWithIndex (\\k m v -> insert k v m) empty\n\n-- | Convert a map to an unfoldable structure of key/value pairs where the keys are in ascending order\ntoUnfoldable :: forall f k v. Unfoldable f => Map k v -> f (Tuple k v)\ntoUnfoldable = unfoldr stepUnfoldr <<< toMapIter\n\n-- | Convert a map to an unfoldable structure of key/value pairs\n-- |\n-- | While this traversal is up to 10% faster in benchmarks than `toUnfoldable`,\n-- | it leaks the underlying map stucture, making it only suitable for applications\n-- | where order is irrelevant.\n-- |\n-- | If you are unsure, use `toUnfoldable`\ntoUnfoldableUnordered :: forall f k v. Unfoldable f => Map k v -> f (Tuple k v)\ntoUnfoldableUnordered = unfoldr stepUnfoldrUnordered <<< toMapIter\n\n-- | Get a list of the keys contained in a map\nkeys :: forall k v. Map k v -> List k\nkeys = foldrWithIndex (\\k _ acc -> k : acc) Nil\n\n-- | Get a list of the values contained in a map\nvalues :: forall k v. Map k v -> List v\nvalues = foldr Cons Nil\n\n-- | Compute the union of two maps, using the specified function\n-- | to combine values for duplicate keys.\nunionWith :: forall k v. Ord k => (v -> v -> v) -> Map k v -> Map k v -> Map k v\nunionWith app m1 m2 = runFn4 unsafeUnionWith compare app m1 m2\n\n-- | Compute the union of two maps, preferring values from the first map in the case\n-- | of duplicate keys\nunion :: forall k v. Ord k => Map k v -> Map k v -> Map k v\nunion = unionWith const\n\n-- | Compute the union of a collection of maps\nunions :: forall k v f. Ord k => Foldable f => f (Map k v) -> Map k v\nunions = foldl union empty\n\n-- | Compute the intersection of two maps, using the specified function\n-- | to combine values for duplicate keys.\nintersectionWith :: forall k a b c. Ord k => (a -> b -> c) -> Map k a -> Map k b -> Map k c\nintersectionWith app m1 m2 = runFn4 unsafeIntersectionWith compare app m1 m2\n\n-- | Compute the intersection of two maps, preferring values from the first map in the case\n-- | of duplicate keys.\nintersection :: forall k a b. Ord k => Map k a -> Map k b -> Map k a\nintersection = intersectionWith const\n\n-- | Difference of two maps. Return elements of the first map where\n-- | the keys do not exist in the second map.\ndifference :: forall k v w. Ord k => Map k v -> Map k w -> Map k v\ndifference m1 m2 = runFn3 unsafeDifference compare m1 m2\n\n-- | Test whether one map contains all of the keys and values contained in another map\nisSubmap :: forall k v. Ord k => Eq v => Map k v -> Map k v -> Boolean\nisSubmap = go\n where\n go m1 m2 = case m1 of\n Leaf -> true\n Node _ _ k v l r ->\n case lookup k m2 of\n Nothing -> false\n Just v' ->\n v == v' && go l m2 && go r m2\n\n-- | Calculate the number of key/value pairs in a map\nsize :: forall k v. Map k v -> Int\nsize = case _ of\n Leaf -> 0\n Node _ s _ _ _ _ -> s\n\n-- | Filter out those key/value pairs of a map for which a predicate\n-- | fails to hold.\nfilterWithKey :: forall k v. Ord k => (k -> v -> Boolean) -> Map k v -> Map k v\nfilterWithKey f = go\n where\n go = case _ of\n Leaf -> Leaf\n Node _ _ k v l r\n | f k v ->\n runFn4 unsafeBalancedNode k v (go l) (go r)\n | otherwise ->\n runFn2 unsafeJoinNodes (go l) (go r)\n\n-- | Filter out those key/value pairs of a map for which a predicate\n-- | on the key fails to hold.\nfilterKeys :: forall k. Ord k => (k -> Boolean) -> Map k ~> Map k\nfilterKeys f = go\n where\n go = case _ of\n Leaf -> Leaf\n Node _ _ k v l r\n | f k ->\n runFn4 unsafeBalancedNode k v (go l) (go r)\n | otherwise ->\n runFn2 unsafeJoinNodes (go l) (go r)\n\n-- | Filter out those key/value pairs of a map for which a predicate\n-- | on the value fails to hold.\nfilter :: forall k v. Ord k => (v -> Boolean) -> Map k v -> Map k v\nfilter = filterWithKey <<< const\n\n-- | Applies a function to each key/value pair in a map, discarding entries\n-- | where the function returns `Nothing`.\nmapMaybeWithKey :: forall k a b. Ord k => (k -> a -> Maybe b) -> Map k a -> Map k b\nmapMaybeWithKey f = go\n where\n go = case _ of\n Leaf -> Leaf\n Node _ _ k v l r ->\n case f k v of\n Just v' ->\n runFn4 unsafeBalancedNode k v' (go l) (go r)\n Nothing ->\n runFn2 unsafeJoinNodes (go l) (go r)\n\n-- | Applies a function to each value in a map, discarding entries where the\n-- | function returns `Nothing`.\nmapMaybe :: forall k a b. Ord k => (a -> Maybe b) -> Map k a -> Map k b\nmapMaybe = mapMaybeWithKey <<< const\n\n-- | Filter a map of optional values, keeping only the key/value pairs which\n-- | contain a value, creating a new map.\ncatMaybes :: forall k v. Ord k => Map k (Maybe v) -> Map k v\ncatMaybes = mapMaybe identity\n\n-- | Returns true if at least one map element satisfies the given predicateon the value,\n-- | iterating the map only as necessary and stopping as soon as the predicate\n-- | yields true.\nany :: forall k v. (v -> Boolean) -> Map k v -> Boolean\nany predicate = go\n where\n go = case _ of\n Leaf -> false\n Node _ _ _ mv ml mr -> predicate mv || go ml || go mr\n\n-- | Returns true if at least one map element satisfies the given predicate,\n-- | iterating the map only as necessary and stopping as soon as the predicate\n-- | yields true.\nanyWithKey :: forall k v. (k -> v -> Boolean) -> Map k v -> Boolean\nanyWithKey predicate = go\n where\n go = case _ of\n Leaf -> false\n Node _ _ mk mv ml mr -> predicate mk mv || go ml || go mr\n\n-- | Low-level Node constructor which maintains the height and size invariants\n-- | This is unsafe because it assumes the child Maps are ordered and balanced.\nunsafeNode :: forall k v. Fn4 k v (Map k v) (Map k v) (Map k v)\nunsafeNode = mkFn4 \\k v l r -> case l of\n Leaf ->\n case r of\n Leaf ->\n Node 1 1 k v l r\n Node h2 s2 _ _ _ _ ->\n Node (1 + h2) (1 + s2) k v l r\n Node h1 s1 _ _ _ _ ->\n case r of\n Leaf ->\n Node (1 + h1) (1 + s1) k v l r\n Node h2 s2 _ _ _ _ ->\n Node (1 + if h1 > h2 then h1 else h2) (1 + s1 + s2) k v l r\n\n-- | Low-level Node constructor which maintains the balance invariants.\n-- | This is unsafe because it assumes the child Maps are ordered.\nunsafeBalancedNode :: forall k v. Fn4 k v (Map k v) (Map k v) (Map k v)\nunsafeBalancedNode = mkFn4 \\k v l r -> case l of\n Leaf ->\n case r of\n Leaf ->\n singleton k v\n Node rh _ rk rv rl rr\n | rh > 1 ->\n runFn7 rotateLeft k v l rk rv rl rr\n _ ->\n runFn4 unsafeNode k v l r\n Node lh _ lk lv ll lr ->\n case r of\n Node rh _ rk rv rl rr\n | rh > lh + 1 ->\n runFn7 rotateLeft k v l rk rv rl rr\n | lh > rh + 1 ->\n runFn7 rotateRight k v lk lv ll lr r\n Leaf\n | lh > 1 ->\n runFn7 rotateRight k v lk lv ll lr r\n _ ->\n runFn4 unsafeNode k v l r\n where\n rotateLeft :: Fn7 k v (Map k v) k v (Map k v) (Map k v) (Map k v)\n rotateLeft = mkFn7 \\k v l rk rv rl rr -> case rl of\n Node lh _ lk lv ll lr\n | lh > height rr ->\n runFn4 unsafeNode lk lv (runFn4 unsafeNode k v l ll) (runFn4 unsafeNode rk rv lr rr)\n _ ->\n runFn4 unsafeNode rk rv (runFn4 unsafeNode k v l rl) rr\n\n rotateRight :: Fn7 k v k v (Map k v) (Map k v) (Map k v) (Map k v)\n rotateRight = mkFn7 \\k v lk lv ll lr r -> case lr of\n Node rh _ rk rv rl rr\n | height ll <= rh ->\n runFn4 unsafeNode rk rv (runFn4 unsafeNode lk lv ll rl) (runFn4 unsafeNode k v rr r)\n _ ->\n runFn4 unsafeNode lk lv ll (runFn4 unsafeNode k v lr r)\n\n height :: Map k v -> Int\n height = case _ of\n Leaf -> 0\n Node h _ _ _ _ _ -> h\n\n-- | Low-level Node constructor from two Maps.\n-- | This is unsafe because it assumes the child Maps are ordered.\nunsafeJoinNodes :: forall k v. Fn2 (Map k v) (Map k v) (Map k v)\nunsafeJoinNodes = mkFn2 case _, _ of\n Leaf, b -> b\n Node _ _ lk lv ll lr, r -> do\n let (SplitLast k v l) = runFn4 unsafeSplitLast lk lv ll lr\n runFn4 unsafeBalancedNode k v l r\n\ndata SplitLast k v = SplitLast k v (Map k v)\n\n-- | Reassociates a node by moving the last node to the top.\n-- | This is unsafe because it assumes the key and child Maps are from\n-- | a balanced node.\nunsafeSplitLast :: forall k v. Fn4 k v (Map k v) (Map k v) (SplitLast k v)\nunsafeSplitLast = mkFn4 \\k v l r -> case r of\n Leaf -> SplitLast k v l\n Node _ _ rk rv rl rr -> do\n let (SplitLast k' v' t') = runFn4 unsafeSplitLast rk rv rl rr\n SplitLast k' v' (runFn4 unsafeBalancedNode k v l t')\n\ndata Split k v = Split (Maybe v) (Map k v) (Map k v)\n\n-- | Reassocates a Map so the given key is at the top.\n-- | This is unsafe because it assumes the ordering function is appropriate.\nunsafeSplit :: forall k v. Fn3 (k -> k -> Ordering) k (Map k v) (Split k v)\nunsafeSplit = mkFn3 \\comp k m -> case m of\n Leaf ->\n Split Nothing Leaf Leaf\n Node _ _ mk mv ml mr ->\n case comp k mk of\n LT -> do\n let (Split b ll lr) = runFn3 unsafeSplit comp k ml\n Split b ll (runFn4 unsafeBalancedNode mk mv lr mr)\n GT -> do\n let (Split b rl rr) = runFn3 unsafeSplit comp k mr\n Split b (runFn4 unsafeBalancedNode mk mv ml rl) rr\n EQ ->\n Split (Just mv) ml mr\n\n-- | Low-level unionWith implementation.\n-- | This is unsafe because it assumes the ordering function is appropriate.\nunsafeUnionWith :: forall k v. Fn4 (k -> k -> Ordering) (v -> v -> v) (Map k v) (Map k v) (Map k v)\nunsafeUnionWith = mkFn4 \\comp app l r -> case l, r of\n Leaf, _ -> r\n _, Leaf -> l\n _, Node _ _ rk rv rl rr -> do\n let (Split lv ll lr) = runFn3 unsafeSplit comp rk l\n let l' = runFn4 unsafeUnionWith comp app ll rl\n let r' = runFn4 unsafeUnionWith comp app lr rr\n case lv of\n Just lv' ->\n runFn4 unsafeBalancedNode rk (app lv' rv) l' r'\n Nothing ->\n runFn4 unsafeBalancedNode rk rv l' r'\n\n-- | Low-level intersectionWith implementation.\n-- | This is unsafe because it assumes the ordering function is appropriate.\nunsafeIntersectionWith :: forall k a b c. Fn4 (k -> k -> Ordering) (a -> b -> c) (Map k a) (Map k b) (Map k c)\nunsafeIntersectionWith = mkFn4 \\comp app l r -> case l, r of\n Leaf, _ -> Leaf\n _, Leaf -> Leaf\n _, Node _ _ rk rv rl rr -> do\n let (Split lv ll lr) = runFn3 unsafeSplit comp rk l\n let l' = runFn4 unsafeIntersectionWith comp app ll rl\n let r' = runFn4 unsafeIntersectionWith comp app lr rr\n case lv of\n Just lv' ->\n runFn4 unsafeBalancedNode rk (app lv' rv) l' r'\n Nothing ->\n runFn2 unsafeJoinNodes l' r'\n\n-- | Low-level difference implementation.\n-- | This is unsafe because it assumes the ordering function is appropriate.\nunsafeDifference :: forall k v w. Fn3 (k -> k -> Ordering) (Map k v) (Map k w) (Map k v)\nunsafeDifference = mkFn3 \\comp l r -> case l, r of\n Leaf, _ -> Leaf\n _, Leaf -> l\n _, Node _ _ rk _ rl rr -> do\n let (Split _ ll lr) = runFn3 unsafeSplit comp rk l\n let l' = runFn3 unsafeDifference comp ll rl\n let r' = runFn3 unsafeDifference comp lr rr\n runFn2 unsafeJoinNodes l' r'\n\ndata MapIterStep k v\n = IterDone\n | IterNext k v (MapIter k v)\n\n-- | Low-level iteration state for a `Map`. Must be consumed using\n-- | an appropriate stepper.\ndata MapIter k v\n = IterLeaf\n | IterEmit k v (MapIter k v)\n | IterNode (Map k v) (MapIter k v)\n\ninstance (Eq k, Eq v) => Eq (MapIter k v) where\n eq = go\n where\n go a b = case stepAsc a of\n IterNext k1 v1 a' ->\n case stepAsc b of\n IterNext k2 v2 b'\n | k1 == k2 && v1 == v2 ->\n go a' b'\n _ ->\n false\n IterDone ->\n true\n\ninstance (Ord k, Ord v) => Ord (MapIter k v) where\n compare = go\n where\n go a b = case stepAsc a, stepAsc b of\n IterNext k1 v1 a', IterNext k2 v2 b' ->\n case compare k1 k2 of\n EQ ->\n case compare v1 v2 of\n EQ ->\n go a' b'\n other ->\n other\n other ->\n other\n IterDone, b'->\n case b' of\n IterDone ->\n EQ\n _ ->\n LT\n _, IterDone ->\n GT\n\n-- | Converts a Map to a MapIter for iteration using a MapStepper.\ntoMapIter :: forall k v. Map k v -> MapIter k v\ntoMapIter = flip IterNode IterLeaf\n\ntype MapStepper k v = MapIter k v -> MapIterStep k v\n\ntype MapStepperCps k v = forall r. (Fn3 k v (MapIter k v) r) -> (Unit -> r) -> MapIter k v -> r\n\n-- | Steps a `MapIter` in ascending order.\nstepAsc :: forall k v. MapStepper k v\nstepAsc = stepAscCps (mkFn3 \\k v next -> IterNext k v next) (const IterDone)\n\n-- | Steps a `MapIter` in descending order.\nstepDesc :: forall k v. MapStepper k v\nstepDesc = stepDescCps (mkFn3 \\k v next -> IterNext k v next) (const IterDone)\n\n-- | Steps a `MapIter` in arbitrary order.\nstepUnordered :: forall k v. MapStepper k v\nstepUnordered = stepUnorderedCps (mkFn3 \\k v next -> IterNext k v next) (const IterDone)\n\n-- | Steps a `MapIter` in ascending order with a CPS encoding.\nstepAscCps :: forall k v. MapStepperCps k v\nstepAscCps = stepWith iterMapL\n\n-- | Steps a `MapIter` in descending order with a CPS encoding.\nstepDescCps :: forall k v. MapStepperCps k v\nstepDescCps = stepWith iterMapR\n\n-- | Steps a `MapIter` in arbitrary order with a CPS encoding.\nstepUnorderedCps :: forall k v. MapStepperCps k v\nstepUnorderedCps = stepWith iterMapU\n\nstepUnfoldr :: forall k v. MapIter k v -> Maybe (Tuple (Tuple k v) (MapIter k v))\nstepUnfoldr = stepAscCps step (\\_ -> Nothing)\n where\n step = mkFn3 \\k v next ->\n Just (Tuple (Tuple k v) next)\n\nstepUnfoldrUnordered :: forall k v. MapIter k v -> Maybe (Tuple (Tuple k v) (MapIter k v))\nstepUnfoldrUnordered = stepUnorderedCps step (\\_ -> Nothing)\n where\n step = mkFn3 \\k v next ->\n Just (Tuple (Tuple k v) next)\n\nstepWith :: forall k v r. (MapIter k v -> Map k v -> MapIter k v) -> (Fn3 k v (MapIter k v) r) -> (Unit -> r) -> MapIter k v -> r\nstepWith f next done = go\n where\n go = case _ of\n IterLeaf ->\n done unit\n IterEmit k v iter ->\n runFn3 next k v iter\n IterNode m iter ->\n go (f iter m)\n\niterMapL :: forall k v. MapIter k v -> Map k v -> MapIter k v\niterMapL = go\n where\n go iter = case _ of\n Leaf -> iter\n Node _ _ k v l r ->\n case r of\n Leaf ->\n go (IterEmit k v iter) l\n _ ->\n go (IterEmit k v (IterNode r iter)) l\n\niterMapR :: forall k v. MapIter k v -> Map k v -> MapIter k v\niterMapR = go\n where\n go iter = case _ of\n Leaf -> iter\n Node _ _ k v l r ->\n case r of\n Leaf ->\n go (IterEmit k v iter) l\n _ ->\n go (IterEmit k v (IterNode l iter)) r\n\niterMapU :: forall k v. MapIter k v -> Map k v -> MapIter k v\niterMapU iter = case _ of\n Leaf -> iter\n Node _ _ k v l r ->\n case l of\n Leaf ->\n case r of\n Leaf ->\n IterEmit k v iter\n _ ->\n IterEmit k v (IterNode r iter)\n _ ->\n case r of\n Leaf ->\n IterEmit k v (IterNode l iter)\n _ ->\n IterEmit k v (IterNode l (IterNode r iter))\n", "export function typeOf(value) {\n return typeof value;\n}\n\nexport function tagOf(value) {\n return Object.prototype.toString.call(value).slice(8, -1);\n}\n\nexport function isNull(value) {\n return value === null;\n}\n\nexport function isUndefined(value) {\n return value === undefined;\n}\n\nexport const isArray = Array.isArray || function (value) {\n return Object.prototype.toString.call(value) === \"[object Array]\";\n};\n", "export const pureE = function (a) {\n return function () {\n return a;\n };\n};\n\nexport const bindE = function (a) {\n return function (f) {\n return function () {\n return f(a())();\n };\n };\n};\n\nexport const untilE = function (f) {\n return function () {\n while (!f());\n };\n};\n\nexport const whileE = function (f) {\n return function (a) {\n return function () {\n while (f()) {\n a();\n }\n };\n };\n};\n\nexport const forE = function (lo) {\n return function (hi) {\n return function (f) {\n return function () {\n for (var i = lo; i < hi; i++) {\n f(i)();\n }\n };\n };\n };\n};\n\nexport const foreachE = function (as) {\n return function (f) {\n return function () {\n for (var i = 0, l = as.length; i < l; i++) {\n f(as[i])();\n }\n };\n };\n};\n", "module Control.Monad\n ( class Monad\n , liftM1\n , whenM\n , unlessM\n , ap\n , module Data.Functor\n , module Control.Apply\n , module Control.Applicative\n , module Control.Bind\n ) where\n\nimport Control.Applicative (class Applicative, liftA1, pure, unless, when)\nimport Control.Apply (class Apply, apply, (*>), (<*), (<*>))\nimport Control.Bind (class Bind, bind, ifM, join, (<=<), (=<<), (>=>), (>>=))\n\nimport Data.Functor (class Functor, map, void, ($>), (<#>), (<$), (<$>))\nimport Data.Unit (Unit)\nimport Type.Proxy (Proxy)\n\n-- | The `Monad` type class combines the operations of the `Bind` and\n-- | `Applicative` type classes. Therefore, `Monad` instances represent type\n-- | constructors which support sequential composition, and also lifting of\n-- | functions of arbitrary arity.\n-- |\n-- | Instances must satisfy the following laws in addition to the\n-- | `Applicative` and `Bind` laws:\n-- |\n-- | - Left Identity: `pure x >>= f = f x`\n-- | - Right Identity: `x >>= pure = x`\nclass (Applicative m, Bind m) <= Monad m\n\ninstance monadFn :: Monad ((->) r)\n\ninstance monadArray :: Monad Array\n\ninstance monadProxy :: Monad Proxy\n\n-- | `liftM1` provides a default implementation of `(<$>)` for any\n-- | [`Monad`](#monad), without using `(<$>)` as provided by the\n-- | [`Functor`](#functor)-[`Monad`](#monad) superclass relationship.\n-- |\n-- | `liftM1` can therefore be used to write [`Functor`](#functor) instances\n-- | as follows:\n-- |\n-- | ```purescript\n-- | instance functorF :: Functor F where\n-- | map = liftM1\n-- | ```\nliftM1 :: forall m a b. Monad m => (a -> b) -> m a -> m b\nliftM1 f a = do\n a' <- a\n pure (f a')\n\n-- | Perform a monadic action when a condition is true, where the conditional\n-- | value is also in a monadic context.\nwhenM :: forall m. Monad m => m Boolean -> m Unit -> m Unit\nwhenM mb m = do\n b <- mb\n when b m\n\n-- | Perform a monadic action unless a condition is true, where the conditional\n-- | value is also in a monadic context.\nunlessM :: forall m. Monad m => m Boolean -> m Unit -> m Unit\nunlessM mb m = do\n b <- mb\n unless b m\n\n-- | `ap` provides a default implementation of `(<*>)` for any `Monad`, without\n-- | using `(<*>)` as provided by the `Apply`-`Monad` superclass relationship.\n-- |\n-- | `ap` can therefore be used to write `Apply` instances as follows:\n-- |\n-- | ```purescript\n-- | instance applyF :: Apply F where\n-- | apply = ap\n-- | ```\n-- Note: Only a `Bind` constraint is needed, but this can\n-- produce loops when used with other default implementations\n-- (i.e. `liftA1`).\n-- See https://github.com/purescript/purescript-prelude/issues/232\nap :: forall m a b. Monad m => m (a -> b) -> m a -> m b\nap f a = do\n f' <- f\n a' <- a\n pure (f' a')\n", "-- | This module provides the `Effect` type, which is used to represent\n-- | _native_ effects. The `Effect` type provides a typed API for effectful\n-- | computations, while at the same time generating efficient JavaScript.\nmodule Effect\n ( Effect\n , untilE, whileE, forE, foreachE\n ) where\n\nimport Prelude\n\nimport Control.Apply (lift2)\n\n-- | A native effect. The type parameter denotes the return type of running the\n-- | effect, that is, an `Effect Int` is a possibly-effectful computation which\n-- | eventually produces a value of the type `Int` when it finishes.\nforeign import data Effect :: Type -> Type\n\ntype role Effect representational\n\ninstance functorEffect :: Functor Effect where\n map = liftA1\n\ninstance applyEffect :: Apply Effect where\n apply = ap\n\ninstance applicativeEffect :: Applicative Effect where\n pure = pureE\n\nforeign import pureE :: forall a. a -> Effect a\n\ninstance bindEffect :: Bind Effect where\n bind = bindE\n\nforeign import bindE :: forall a b. Effect a -> (a -> Effect b) -> Effect b\n\ninstance monadEffect :: Monad Effect\n\n-- | The `Semigroup` instance for effects allows you to run two effects, one\n-- | after the other, and then combine their results using the result type's\n-- | `Semigroup` instance.\ninstance semigroupEffect :: Semigroup a => Semigroup (Effect a) where\n append = lift2 append\n\n-- | If you have a `Monoid a` instance, then `mempty :: Effect a` is defined as\n-- | `pure mempty`.\ninstance monoidEffect :: Monoid a => Monoid (Effect a) where\n mempty = pureE mempty\n\n-- | Loop until a condition becomes `true`.\n-- |\n-- | `untilE b` is an effectful computation which repeatedly runs the effectful\n-- | computation `b`, until its return value is `true`.\nforeign import untilE :: Effect Boolean -> Effect Unit\n\n-- | Loop while a condition is `true`.\n-- |\n-- | `whileE b m` is effectful computation which runs the effectful computation\n-- | `b`. If its result is `true`, it runs the effectful computation `m` and\n-- | loops. If not, the computation ends.\nforeign import whileE :: forall a. Effect Boolean -> Effect a -> Effect Unit\n\n-- | Loop over a consecutive collection of numbers.\n-- |\n-- | `forE lo hi f` runs the computation returned by the function `f` for each\n-- | of the inputs between `lo` (inclusive) and `hi` (exclusive).\nforeign import forE :: Int -> Int -> (Int -> Effect Unit) -> Effect Unit\n\n-- | Loop over an array of values.\n-- |\n-- | `foreachE xs f` runs the computation returned by the function `f` for each\n-- | of the inputs `xs`.\nforeign import foreachE :: forall a. Array a -> (a -> Effect Unit) -> Effect Unit\n", "export function showErrorImpl(err) {\n return err.stack || err.toString();\n}\n\nexport function error(msg) {\n return new Error(msg);\n}\n\nexport function errorWithCause(msg) {\n return function(cause) {\n return new Error(msg, { cause });\n };\n}\n\nexport function errorWithName(msg) {\n return function(name) {\n const e = new Error(msg);\n e.name = name;\n return e;\n };\n}\n\nexport function message(e) {\n return e.message;\n}\n\nexport function name(e) {\n return e.name || \"Error\";\n}\n\nexport function stackImpl(just) {\n return function (nothing) {\n return function (e) {\n return e.stack ? just(e.stack) : nothing;\n };\n };\n}\n\nexport function throwException(e) {\n return function () {\n throw e;\n };\n}\n\nexport function catchException(c) {\n return function (t) {\n return function () {\n try {\n return t();\n } catch (e) {\n if (e instanceof Error || Object.prototype.toString.call(e) === \"[object Error]\") {\n return c(e)();\n } else {\n return c(new Error(e.toString()))();\n }\n }\n };\n };\n}\n", "-- | This module defines an effect, actions and handlers for working\n-- | with JavaScript exceptions.\n\nmodule Effect.Exception\n ( Error\n , catchException\n , error\n , errorWithCause\n , errorWithName\n , message\n , name\n , stack\n , throw\n , throwException\n , try\n )\n where\n\nimport Prelude\n\nimport Effect (Effect)\n\nimport Data.Either (Either(..))\nimport Data.Maybe (Maybe(..))\n\n-- | The type of JavaScript errors\nforeign import data Error :: Type\n\ninstance showError :: Show Error where\n show = showErrorImpl\n\nforeign import showErrorImpl :: Error -> String\n\n-- | Create a JavaScript error, specifying a message\nforeign import error :: String -> Error\n\n-- | Create a JavaScript error, specifying a message and a cause\nforeign import errorWithCause :: String -> Error -> Error\n\n-- | Create a JavaScript error, specifying a message and a name\nforeign import errorWithName :: String -> String -> Error\n\n-- | Get the error message from a JavaScript error\nforeign import message :: Error -> String\n\n-- | Get the error name when defined, or fallback to 'Error'\nforeign import name :: Error -> String\n\n-- | Get the stack trace from a JavaScript error\nstack :: Error -> Maybe String\nstack = stackImpl Just Nothing\n\nforeign import stackImpl\n :: (forall a. a -> Maybe a)\n -> (forall a. Maybe a)\n -> Error\n -> Maybe String\n\n-- | Throw an exception\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | main = do\n-- | x <- readNumber\n-- | when (x < 0) $ throwException $\n-- | error \"Expected a non-negative number\"\n-- | ```\nforeign import throwException\n :: forall a\n . Error\n -> Effect a\n\n-- | Catch an exception by providing an exception handler.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | main = catchException Console.logShow do\n-- | Console.log \"Exceptions thrown in this block will be logged to the console\"\n-- | ```\nforeign import catchException\n :: forall a\n . (Error -> Effect a)\n -> Effect a\n -> Effect a\n\n-- | A shortcut allowing you to throw an error in one step. Defined as\n-- | `throwException <<< error`.\nthrow :: forall a. String -> Effect a\nthrow = throwException <<< error\n\n-- | Runs an Eff and returns eventual Exceptions as a `Left` value. If the\n-- | computation succeeds the result gets wrapped in a `Right`.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | main :: Effect Unit\n-- | main = do\n-- | result <- try (readTextFile UTF8 \"README.md\")\n-- | case result of\n-- | Right lines ->\n-- | Console.log (\"README: \\n\" <> lines )\n-- | Left error ->\n-- | Console.error (\"Couldn't open README.md. Error was: \" <> show error)\n-- | ```\n\ntry :: forall a. Effect a -> Effect (Either Error a)\ntry action = catchException (pure <<< Left) (Right <$> action)\n", "-- | This module defines the `MonadError` type class and its instances.\n\nmodule Control.Monad.Error.Class where\n\nimport Prelude\n\nimport Data.Either (Either(..), either)\nimport Data.Maybe (Maybe(..), maybe)\nimport Effect (Effect)\nimport Effect.Exception as Ex\n\n\n-- | The `MonadThrow` type class represents those monads which support errors via\n-- | `throwError`, where `throwError e` halts, yielding the error `e`.\n-- |\n-- | An implementation is provided for `ExceptT`, and for other monad transformers\n-- | defined in this library.\n-- |\n-- | Laws:\n-- |\n-- | - Left zero: `throwError e >>= f = throwError e`\n-- |\nclass Monad m <= MonadThrow e m | m -> e where\n throwError :: forall a. e -> m a\n\n-- | The `MonadError` type class represents those monads which support catching\n-- | errors.\n-- |\n-- | - `catchError x f` calls the error handler `f` if an error is thrown during the\n-- | evaluation of `x`.\n-- |\n-- | An implementation is provided for `ExceptT`, and for other monad transformers\n-- | defined in this library.\n-- |\n-- | Laws:\n-- |\n-- | - Catch: `catchError (throwError e) f = f e`\n-- | - Pure: `catchError (pure a) f = pure a`\n-- |\nclass MonadThrow e m <= MonadError e m | m -> e where\n catchError :: forall a. m a -> (e -> m a) -> m a\n\n-- | This function allows you to provide a predicate for selecting the\n-- | exceptions that you're interested in, and handle only those exceptons.\n-- | If the inner computation throws an exception, and the predicate returns\n-- | Nothing, then the whole computation will still fail with that exception.\ncatchJust\n :: forall e m a b\n . MonadError e m\n => (e -> Maybe b) -- ^ Predicate to select exceptions\n -> m a -- ^ Computation to run\n -> (b -> m a) -- ^ Handler\n -> m a\ncatchJust p act handler = catchError act handle\n where\n handle e =\n case p e of\n Nothing -> throwError e\n Just b -> handler b\n\n-- | Return `Right` if the given action succeeds, `Left` if it throws.\ntry\n :: forall e m a\n . MonadError e m\n => m a\n -> m (Either e a)\ntry a = (Right <$> a) `catchError` (pure <<< Left)\n\ninstance monadThrowEither :: MonadThrow e (Either e) where\n throwError = Left\n\ninstance monadErrorEither :: MonadError e (Either e) where\n catchError (Left e) h = h e\n catchError (Right x) _ = Right x\n\ninstance monadThrowMaybe :: MonadThrow Unit Maybe where\n throwError = const Nothing\n\ninstance monadErrorMaybe :: MonadError Unit Maybe where\n catchError Nothing f = f unit\n catchError (Just a) _ = Just a\n \ninstance monadThrowEffect :: MonadThrow Ex.Error Effect where\n throwError = Ex.throwException\n\ninstance monadErrorEffect :: MonadError Ex.Error Effect where\n catchError = flip Ex.catchException\n\n\n-- | Make sure that a resource is cleaned up in the event of an exception. The\n-- | release action is called regardless of whether the body action throws or\n-- | returns.\nwithResource\n :: forall e m r a\n . MonadError e m\n => m r\n -> (r -> m Unit)\n -> (r -> m a)\n -> m a\nwithResource acquire release kleisli = do\n resource <- acquire\n result <- try $ kleisli resource\n release resource\n either throwError pure result\n\n-- | Lift a `Maybe` value to a MonadThrow monad.\nliftMaybe :: forall m e a. MonadThrow e m => e -> Maybe a -> m a\nliftMaybe error = maybe (throwError error) pure\n\n-- | Lift an `Either` value to a MonadThrow monad.\nliftEither :: forall m e a. MonadThrow e m => Either e a -> m a\nliftEither = either throwError pure\n", "export const _new = function (val) {\n return function () {\n return { value: val };\n };\n};\n\nexport const newWithSelf = function (f) {\n return function () {\n var ref = { value: null };\n ref.value = f(ref);\n return ref;\n };\n};\n\nexport const read = function (ref) {\n return function () {\n return ref.value;\n };\n};\n\nexport const modifyImpl = function (f) {\n return function (ref) {\n return function () {\n var t = f(ref.value);\n ref.value = t.state;\n return t.value;\n };\n };\n};\n\nexport const write = function (val) {\n return function (ref) {\n return function () {\n ref.value = val;\n };\n };\n};\n", "-- | This module defines the `Ref` type for mutable value references, as well\n-- | as actions for working with them.\n-- |\n-- | You'll notice that all of the functions that operate on a `Ref` (e.g.\n-- | `new`, `read`, `write`) return their result wrapped in an `Effect`.\n-- | Working with mutable references is considered effectful in PureScript\n-- | because of the principle of purity: functions should not have side\n-- | effects, and should return the same result when called with the same\n-- | arguments. If a `Ref` could be written to without using `Effect`, that\n-- | would cause a side effect (the effect of changing the result of subsequent\n-- | reads for that `Ref`). If there were a function for reading the current\n-- | value of a `Ref` without the result being wrapped in `Effect`, the result\n-- | of calling that function would change each time a new value was written to\n-- | the `Ref`. Even creating a new `Ref` is effectful: if there were a\n-- | function for creating a new `Ref` with the type `forall s. s -> Ref s`,\n-- | then calling that function twice with the same argument would not give the\n-- | same result in each case, since you'd end up with two distinct references\n-- | which could be updated independently of each other.\n-- |\n-- | _Note_: `Control.Monad.ST` provides a pure alternative to `Ref` when\n-- | mutation is restricted to a local scope.\nmodule Effect.Ref\n ( Ref\n , new\n , newWithSelf\n , read\n , modify'\n , modify\n , modify_\n , write\n ) where\n\nimport Prelude\n\nimport Effect (Effect)\n\n-- | A value of type `Ref a` represents a mutable reference\n-- | which holds a value of type `a`.\nforeign import data Ref :: Type -> Type\n\ntype role Ref representational\n\n-- | Create a new mutable reference containing the specified value.\nforeign import _new :: forall s. s -> Effect (Ref s)\n\nnew :: forall s. s -> Effect (Ref s)\nnew = _new\n\n-- | Create a new mutable reference containing a value that can refer to the\n-- | `Ref` being created.\nforeign import newWithSelf :: forall s. (Ref s -> s) -> Effect (Ref s)\n\n-- | Read the current value of a mutable reference.\nforeign import read :: forall s. Ref s -> Effect s\n\n-- | Update the value of a mutable reference by applying a function\n-- | to the current value.\nmodify' :: forall s b. (s -> { state :: s, value :: b }) -> Ref s -> Effect b\nmodify' = modifyImpl\n\nforeign import modifyImpl :: forall s b. (s -> { state :: s, value :: b }) -> Ref s -> Effect b\n\n-- | Update the value of a mutable reference by applying a function\n-- | to the current value. The updated value is returned.\nmodify :: forall s. (s -> s) -> Ref s -> Effect s\nmodify f = modify' \\s -> let s' = f s in { state: s', value: s' }\n\n-- | A version of `modify` which does not return the updated value.\nmodify_ :: forall s. (s -> s) -> Ref s -> Effect Unit\nmodify_ f s = void $ modify f s\n\n-- | Update the value of a mutable reference to the specified value.\nforeign import write :: forall s. s -> Ref s -> Effect Unit\n", "module Control.Monad.Rec.Class\n ( Step(..)\n , class MonadRec\n , tailRec\n , tailRec2\n , tailRec3\n , tailRecM\n , tailRecM2\n , tailRecM3\n , forever\n , whileJust\n , untilJust\n , loop2\n , loop3\n ) where\n\nimport Prelude\n\nimport Data.Bifunctor (class Bifunctor)\nimport Data.Either (Either(..))\nimport Data.Identity (Identity(..))\nimport Data.Maybe (Maybe(..))\nimport Effect (Effect, untilE)\nimport Effect.Ref as Ref\nimport Partial.Unsafe (unsafePartial)\n\n-- | The result of a computation: either `Loop` containing the updated\n-- | accumulator, or `Done` containing the final result of the computation.\ndata Step a b = Loop a | Done b\n\nderive instance functorStep :: Functor (Step a)\n\ninstance bifunctorStep :: Bifunctor Step where\n bimap f _ (Loop a) = Loop (f a)\n bimap _ g (Done b) = Done (g b)\n\n-- | This type class captures those monads which support tail recursion in\n-- | constant stack space.\n-- |\n-- | The `tailRecM` function takes a step function, and applies that step\n-- | function recursively until a pure value of type `b` is found.\n-- |\n-- | Instances are provided for standard monad transformers.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | loopWriter :: Int -> WriterT (Additive Int) Effect Unit\n-- | loopWriter n = tailRecM go n\n-- | where\n-- | go 0 = do\n-- | traceM \"Done!\"\n-- | pure (Done unit)\n-- | go i = do\n-- | tell $ Additive i\n-- | pure (Loop (i - 1))\n-- | ```\nclass Monad m <= MonadRec m where\n tailRecM :: forall a b. (a -> m (Step a b)) -> a -> m b\n\n-- | Create a tail-recursive function of two arguments which uses constant stack space.\n-- |\n-- | The `loop2` helper function provides a curried alternative to the `Loop`\n-- | constructor for this function.\ntailRecM2\n :: forall m a b c\n . MonadRec m\n => (a -> b -> m (Step { a :: a, b :: b } c))\n -> a\n -> b\n -> m c\ntailRecM2 f a b = tailRecM (\\o -> f o.a o.b) { a, b }\n\n-- | Create a tail-recursive function of three arguments which uses constant stack space.\n-- |\n-- | The `loop3` helper function provides a curried alternative to the `Loop`\n-- | constructor for this function.\ntailRecM3\n :: forall m a b c d\n . MonadRec m\n => (a -> b -> c -> m (Step { a :: a, b :: b, c :: c } d))\n -> a\n -> b\n -> c\n -> m d\ntailRecM3 f a b c = tailRecM (\\o -> f o.a o.b o.c) { a, b, c }\n\n-- | Create a pure tail-recursive function of one argument\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | pow :: Int -> Int -> Int\n-- | pow n p = tailRec go { accum: 1, power: p }\n-- | where\n-- | go :: _ -> Step _ Int\n-- | go { accum: acc, power: 0 } = Done acc\n-- | go { accum: acc, power: p } = Loop { accum: acc * n, power: p - 1 }\n-- | ```\ntailRec :: forall a b. (a -> Step a b) -> a -> b\ntailRec f = go <<< f\n where\n go (Loop a) = go (f a)\n go (Done b) = b\n\n-- | Create a pure tail-recursive function of two arguments\n-- |\n-- | The `loop2` helper function provides a curried alternative to the `Loop`\n-- | constructor for this function.\ntailRec2 :: forall a b c. (a -> b -> Step { a :: a, b :: b } c) -> a -> b -> c\ntailRec2 f a b = tailRec (\\o -> f o.a o.b) { a, b }\n\n-- | Create a pure tail-recursive function of three arguments\n-- |\n-- | The `loop3` helper function provides a curried alternative to the `Loop`\n-- | constructor for this function.\ntailRec3 :: forall a b c d. (a -> b -> c -> Step { a :: a, b :: b, c :: c } d) -> a -> b -> c -> d\ntailRec3 f a b c = tailRec (\\o -> f o.a o.b o.c) { a, b, c }\n\ninstance monadRecIdentity :: MonadRec Identity where\n tailRecM f = Identity <<< tailRec (runIdentity <<< f)\n where runIdentity (Identity x) = x\n\ninstance monadRecEffect :: MonadRec Effect where\n tailRecM f a = do\n r <- Ref.new =<< f a\n untilE do\n Ref.read r >>= case _ of\n Loop a' -> do\n e <- f a'\n _ <- Ref.write e r\n pure false\n Done _ -> pure true\n fromDone <$> Ref.read r\n where\n fromDone :: forall a b. Step a b -> b\n fromDone = unsafePartial \\(Done b) -> b\n\ninstance monadRecFunction :: MonadRec ((->) e) where\n tailRecM f a0 e = tailRec (\\a -> f a e) a0\n\ninstance monadRecEither :: MonadRec (Either e) where\n tailRecM f a0 =\n let\n g (Left e) = Done (Left e)\n g (Right (Loop a)) = Loop (f a)\n g (Right (Done b)) = Done (Right b)\n in tailRec g (f a0)\n\ninstance monadRecMaybe :: MonadRec Maybe where\n tailRecM f a0 =\n let\n g Nothing = Done Nothing\n g (Just (Loop a)) = Loop (f a)\n g (Just (Done b)) = Done (Just b)\n in tailRec g (f a0)\n\n-- | `forever` runs an action indefinitely, using the `MonadRec` instance to\n-- | ensure constant stack usage.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | main = forever $ trace \"Hello, World!\"\n-- | ```\nforever :: forall m a b. MonadRec m => m a -> m b\nforever ma = tailRecM (\\u -> Loop u <$ ma) unit\n\n-- | While supplied computation evaluates to `Just _`, it will be\n-- | executed repeatedly and results will be combined using monoid instance.\nwhileJust :: forall a m. Monoid a => MonadRec m => m (Maybe a) -> m a\nwhileJust m = mempty # tailRecM \\v -> m <#> case _ of\n Nothing -> Done v\n Just x -> Loop $ v <> x\n\n-- | Supplied computation will be executed repeatedly until it evaluates\n-- | to `Just value` and then that `value` will be returned.\nuntilJust :: forall a m. MonadRec m => m (Maybe a) -> m a\nuntilJust m = unit # tailRecM \\_ -> m <#> case _ of\n Nothing -> Loop unit\n Just x -> Done x\n\n-- | A curried version of the `Loop` constructor, provided as a convenience for\n-- | use with `tailRec2` and `tailRecM2`.\nloop2 :: forall a b c. a -> b -> Step { a :: a, b :: b } c\nloop2 a b = Loop { a, b }\n\n-- | A curried version of the `Loop` constructor, provided as a convenience for\n-- | use with `tailRec3` and `tailRecM3`.\nloop3 :: forall a b c d. a -> b -> c -> Step { a :: a, b :: b, c :: c } d\nloop3 a b c = Loop { a, b, c }\n", "export const map_ = function (f) {\n return function (a) {\n return function () {\n return f(a());\n };\n };\n};\n\nexport const pure_ = function (a) {\n return function () {\n return a;\n };\n};\n\nexport const bind_ = function (a) {\n return function (f) {\n return function () {\n return f(a())();\n };\n };\n};\n\nexport const run = function (f) {\n return f();\n};\n\nfunction whileST(f) {\n return function (a) {\n return function () {\n while (f()) {\n a();\n }\n };\n };\n}\nexport { whileST as while };\n\nfunction forST(lo) {\n return function (hi) {\n return function (f) {\n return function () {\n for (var i = lo; i < hi; i++) {\n f(i)();\n }\n };\n };\n };\n}\nexport { forST as for };\n\nexport const foreach = function (as) {\n return function (f) {\n return function () {\n for (var i = 0, l = as.length; i < l; i++) {\n f(as[i])();\n }\n };\n };\n};\n\nfunction newSTRef(val) {\n return function () {\n return { value: val };\n };\n}\nexport { newSTRef as new };\n\nexport const read = function (ref) {\n return function () {\n return ref.value;\n };\n};\n\nexport const modifyImpl = function (f) {\n return function (ref) {\n return function () {\n var t = f(ref.value);\n ref.value = t.state;\n return t.value;\n };\n };\n};\n\nexport const write = function (a) {\n return function (ref) {\n return function () {\n return ref.value = a; // eslint-disable-line no-return-assign\n };\n };\n};\n", "module Control.Monad.ST.Internal\n ( Region\n , ST\n , run\n , while\n , for\n , foreach\n , STRef\n , new\n , read\n , modify'\n , modify\n , write\n ) where\n\nimport Prelude\n\nimport Control.Apply (lift2)\nimport Control.Monad.Rec.Class (class MonadRec, Step(..))\nimport Partial.Unsafe (unsafePartial)\n\n-- | `ST` is concerned with _restricted_ mutation. Mutation is restricted to a\n-- | _region_ of mutable references. This kind is inhabited by phantom types\n-- | which represent regions in the type system.\nforeign import data Region :: Type\n\n-- | The `ST` type constructor allows _local mutation_, i.e. mutation which\n-- | does not \"escape\" into the surrounding computation.\n-- |\n-- | An `ST` computation is parameterized by a phantom type which is used to\n-- | restrict the set of reference cells it is allowed to access.\n-- |\n-- | The `run` function can be used to run a computation in the `ST` monad.\nforeign import data ST :: Region -> Type -> Type\n\ntype role ST nominal representational\n\nforeign import map_ :: forall r a b. (a -> b) -> ST r a -> ST r b\n\nforeign import pure_ :: forall r a. a -> ST r a\n\nforeign import bind_ :: forall r a b. ST r a -> (a -> ST r b) -> ST r b\n\ninstance functorST :: Functor (ST r) where\n map = map_\n\ninstance applyST :: Apply (ST r) where\n apply = ap\n\ninstance applicativeST :: Applicative (ST r) where\n pure = pure_\n\ninstance bindST :: Bind (ST r) where\n bind = bind_\n\ninstance monadST :: Monad (ST r)\n\ninstance monadRecST :: MonadRec (ST r) where\n tailRecM f a = do\n r <- new =<< f a\n while (isLooping <$> read r) do\n read r >>= case _ of\n Loop a' -> do\n e <- f a'\n void (write e r)\n Done _ -> pure unit\n fromDone <$> read r\n where\n fromDone :: forall a b. Step a b -> b\n fromDone = unsafePartial \\(Done b) -> b\n\n isLooping = case _ of\n Loop _ -> true\n _ -> false\n\ninstance semigroupST :: Semigroup a => Semigroup (ST r a) where\n append = lift2 append\n\ninstance monoidST :: Monoid a => Monoid (ST r a) where\n mempty = pure mempty\n\n-- | Run an `ST` computation.\n-- |\n-- | Note: the type of `run` uses a rank-2 type to constrain the phantom\n-- | type `r`, such that the computation must not leak any mutable references\n-- | to the surrounding computation. It may cause problems to apply this\n-- | function using the `$` operator. The recommended approach is to use\n-- | parentheses instead.\nforeign import run :: forall a. (forall r. ST r a) -> a\n\n-- | Loop while a condition is `true`.\n-- |\n-- | `while b m` is ST computation which runs the ST computation `b`. If its\n-- | result is `true`, it runs the ST computation `m` and loops. If not, the\n-- | computation ends.\nforeign import while :: forall r a. ST r Boolean -> ST r a -> ST r Unit\n\n-- | Loop over a consecutive collection of numbers\n-- |\n-- | `ST.for lo hi f` runs the computation returned by the function `f` for each\n-- | of the inputs between `lo` (inclusive) and `hi` (exclusive).\nforeign import for :: forall r a. Int -> Int -> (Int -> ST r a) -> ST r Unit\n\n-- | Loop over an array of values.\n-- |\n-- | `ST.foreach xs f` runs the computation returned by the function `f` for each\n-- | of the inputs `xs`.\nforeign import foreach :: forall r a. Array a -> (a -> ST r Unit) -> ST r Unit\n\n-- | The type `STRef r a` represents a mutable reference holding a value of\n-- | type `a`, which can be used with the `ST r` effect.\nforeign import data STRef :: Region -> Type -> Type\n\ntype role STRef nominal representational\n\n-- | Create a new mutable reference.\nforeign import new :: forall a r. a -> ST r (STRef r a)\n\n-- | Read the current value of a mutable reference.\nforeign import read :: forall a r. STRef r a -> ST r a\n\n-- | Update the value of a mutable reference by applying a function\n-- | to the current value, computing a new state value for the reference and\n-- | a return value.\nmodify' :: forall r a b. (a -> { state :: a, value :: b }) -> STRef r a -> ST r b\nmodify' = modifyImpl\n\nforeign import modifyImpl :: forall r a b. (a -> { state :: a, value :: b }) -> STRef r a -> ST r b\n\n-- | Modify the value of a mutable reference by applying a function to the\n-- | current value. The modified value is returned.\nmodify :: forall r a. (a -> a) -> STRef r a -> ST r a\nmodify f = modify' \\s -> let s' = f s in { state: s', value: s' }\n\n-- | Set the value of a mutable reference.\nforeign import write :: forall a r. a -> STRef r a -> ST r a\n", "-- | This module defines the `MonadState` type class and its instances.\n\nmodule Control.Monad.State.Class where\n\nimport Prelude (class Monad, Unit, unit)\n\nimport Data.Tuple (Tuple(..))\n\n-- | The `MonadState s` type class represents those monads which support a single piece of mutable\n-- | state of type `s`.\n-- |\n-- | - `state f` updates the state using the function `f`.\n-- |\n-- | An implementation is provided for `StateT`, and for other monad transformers\n-- | defined in this library.\n-- |\n-- | Laws:\n-- |\n-- | - `do { get ; get } = get`\n-- | - `do { put x ; put y } = put y`\n-- | - `do { put x ; get } = put x $> x`\n-- | - `do { s <- get ; put s } = pure unit`\n-- |\nclass Monad m <= MonadState s m | m -> s where\n state :: forall a. (s -> (Tuple a s)) -> m a\n\n-- | Get the current state.\nget :: forall m s. MonadState s m => m s\nget = state \\s -> Tuple s s\n\n-- | Get a value which depends on the current state.\ngets :: forall s m a. MonadState s m => (s -> a) -> m a\ngets f = state \\s -> Tuple (f s) s\n\n-- | Set the state.\nput :: forall m s. MonadState s m => s -> m Unit\nput s = state \\_ -> Tuple unit s\n\n-- | Modify the state by applying a function to the current state. The returned\n-- | value is the new state value.\nmodify :: forall s m. MonadState s m => (s -> s) -> m s\nmodify f = state \\s -> let s' = f s in Tuple s' s'\n\nmodify_ :: forall s m. MonadState s m => (s -> s) -> m Unit\nmodify_ f = state \\s -> Tuple unit (f s)\n", "-- | This module defines the `MonadWriter` type class and its instances.\n\nmodule Control.Monad.Writer.Class where\n\nimport Prelude\n\nimport Data.Tuple (Tuple(..))\n\n-- | The `MonadTell w` type class represents those monads which support a\n-- | monoidal accumulator of type `w`, where `tell` appends a value to the\n-- | accumulator.\n-- |\n-- | An implementation is provided for `WriterT`, and for other monad\n-- | transformers defined in this library.\n-- |\n-- | Law:\n-- |\n-- | - `do { tell x ; tell y } = tell (x <> y)`\nclass (Semigroup w, Monad m) <= MonadTell w m | m -> w where\n tell :: w -> m Unit\n\n-- | An extension of the `MonadTell` class that introduces some operations on\n-- | the accumulator:\n-- |\n-- | - `listen` modifies the result to include the changes to the accumulator.\n-- | - `pass` applies the returned function to the accumulator.\n-- |\n-- | An implementation is provided for `WriterT`, and for other monad\n-- | transformers defined in this library.\n-- |\n-- | Laws in addition to the `MonadTell` law:\n-- |\n-- | - `do { tell x ; tell y } = tell (x <> y)`\n-- | - `listen (pure a) = pure (Tuple a mempty)`\n-- | - `listen (writer a x) = tell x $> Tuple a x`\nclass (Monoid w, MonadTell w m) <= MonadWriter w m | m -> w where\n listen :: forall a. m a -> m (Tuple a w)\n pass :: forall a. m (Tuple a (w -> w)) -> m a\n\n-- | Projects a value from modifications made to the accumulator during an\n-- | action.\nlistens :: forall w m a b. MonadWriter w m => (w -> b) -> m a -> m (Tuple a b)\nlistens f m = do\n Tuple a w <- listen m\n pure $ Tuple a (f w)\n\n-- | Modify the final accumulator value by applying a function.\ncensor :: forall w m a. MonadWriter w m => (w -> w) -> m a -> m a\ncensor f m = pass do\n a <- m\n pure $ Tuple a f\n", "module Effect.Class where\n\nimport Control.Category (identity)\nimport Control.Monad (class Monad)\nimport Effect (Effect)\n\n-- | The `MonadEffect` class captures those monads which support native effects.\n-- |\n-- | Instances are provided for `Effect` itself, and the standard monad\n-- | transformers.\n-- |\n-- | `liftEffect` can be used in any appropriate monad transformer stack to lift an\n-- | action of type `Effect a` into the monad.\n-- |\nclass Monad m <= MonadEffect m where\n liftEffect :: forall a. Effect a -> m a\n\ninstance monadEffectEffect :: MonadEffect Effect where\n liftEffect = identity\n", "-- | This module defines the _exception monad transformer_ `ExceptT`.\n\nmodule Control.Monad.Except.Trans\n ( ExceptT(..), runExceptT, withExceptT, mapExceptT, except\n , module Control.Monad.Trans.Class\n , module Control.Monad.Error.Class\n ) where\n\nimport Prelude\n\nimport Control.Alt (class Alt)\nimport Control.Alternative (class Alternative)\nimport Control.Apply (lift2)\nimport Control.Monad.Cont.Class (class MonadCont, callCC)\nimport Control.Monad.Error.Class (class MonadThrow, class MonadError, throwError, catchError)\nimport Control.Monad.Reader.Class (class MonadAsk, class MonadReader, ask, local)\nimport Control.Monad.Rec.Class (class MonadRec, tailRecM, Step(..))\nimport Control.Monad.ST.Class (class MonadST, liftST)\nimport Control.Monad.State.Class (class MonadState, state)\nimport Control.Monad.Trans.Class (class MonadTrans, lift)\nimport Control.Monad.Writer.Class (class MonadWriter, class MonadTell, pass, listen, tell)\nimport Control.MonadPlus (class MonadPlus)\nimport Control.Plus (class Plus)\nimport Data.Either (Either(..), either)\nimport Data.Newtype (class Newtype)\nimport Data.Tuple (Tuple(..))\nimport Effect.Class (class MonadEffect, liftEffect)\n\n-- | A monad transformer which adds exceptions to other monads, in the same way\n-- | as `Except`. As before, `e` is the type of exceptions, and `a` is the type\n-- | of successful results. The new type parameter `m` is the inner monad that\n-- | computations run in.\nnewtype ExceptT e m a = ExceptT (m (Either e a))\n\n-- | The inverse of `ExceptT`. Run a computation in the `ExceptT` monad.\nrunExceptT :: forall e m a. ExceptT e m a -> m (Either e a)\nrunExceptT (ExceptT x) = x\n\n-- | Transform any exceptions thrown by an `ExceptT` computation using the given function.\nwithExceptT :: forall e e' m a. Functor m => (e -> e') -> ExceptT e m a -> ExceptT e' m a\nwithExceptT f (ExceptT t) = ExceptT $ map (mapLeft f) t\n where\n mapLeft _ (Right x) = Right x\n mapLeft f' (Left x) = Left (f' x)\n\n-- | Transform the unwrapped computation using the given function.\nmapExceptT :: forall e e' m n a b. (m (Either e a) -> n (Either e' b)) -> ExceptT e m a -> ExceptT e' n b\nmapExceptT f (ExceptT m) = ExceptT (f m)\n\n-- | Construct a computation in the `ExceptT` transformer from an `Either` value.\nexcept :: forall e m a. Applicative m => Either e a -> ExceptT e m a\nexcept = ExceptT <<< pure\n\nderive instance newtypeExceptT :: Newtype (ExceptT e m a) _\n\ninstance functorExceptT :: Functor m => Functor (ExceptT e m) where\n map f = mapExceptT (map (map f))\n\ninstance applyExceptT :: Monad m => Apply (ExceptT e m) where\n apply = ap\n\ninstance applicativeExceptT :: Monad m => Applicative (ExceptT e m) where\n pure = ExceptT <<< pure <<< Right\n\ninstance bindExceptT :: Monad m => Bind (ExceptT e m) where\n bind (ExceptT m) k =\n ExceptT (m >>= either (pure <<< Left) (\\a -> case k a of ExceptT b -> b))\n\ninstance monadExceptT :: Monad m => Monad (ExceptT e m)\n\ninstance monadRecExceptT :: MonadRec m => MonadRec (ExceptT e m) where\n tailRecM f = ExceptT <<< tailRecM \\a ->\n case f a of\n ExceptT m -> m >>= \\m' ->\n pure case m' of\n Left e -> Done (Left e)\n Right (Loop a1) -> Loop a1\n Right (Done b) -> Done (Right b)\n\ninstance altExceptT :: (Semigroup e, Monad m) => Alt (ExceptT e m) where\n alt (ExceptT m) (ExceptT n) = ExceptT do\n rm <- m\n case rm of\n Right x -> pure (Right x)\n Left err -> do\n rn <- n\n case rn of\n Right x -> pure (Right x)\n Left err' -> pure (Left (err <> err'))\n\ninstance plusExceptT :: (Monoid e, Monad m) => Plus (ExceptT e m) where\n empty = throwError (mempty :: e)\n\ninstance alternativeExceptT :: (Monoid e, Monad m) => Alternative (ExceptT e m)\n\ninstance monadPlusExceptT :: (Monoid e, Monad m) => MonadPlus (ExceptT e m)\n\ninstance monadTransExceptT :: MonadTrans (ExceptT e) where\n lift m = ExceptT do\n a <- m\n pure $ Right a\n\ninstance monadEffectExceptT :: MonadEffect m => MonadEffect (ExceptT e m) where\n liftEffect = lift <<< liftEffect\n\ninstance monadContExceptT :: MonadCont m => MonadCont (ExceptT e m) where\n callCC f = ExceptT $ callCC \\c ->\n case f (\\a -> ExceptT $ c (Right a)) of ExceptT b -> b\n\ninstance monadThrowExceptT :: Monad m => MonadThrow e (ExceptT e m) where\n throwError = ExceptT <<< pure <<< Left\n\ninstance monadErrorExceptT :: Monad m => MonadError e (ExceptT e m) where\n catchError (ExceptT m) k =\n ExceptT (m >>= either (\\a -> case k a of ExceptT b -> b) (pure <<< Right))\n\ninstance monadAskExceptT :: MonadAsk r m => MonadAsk r (ExceptT e m) where\n ask = lift ask\n\ninstance monadReaderExceptT :: MonadReader r m => MonadReader r (ExceptT e m) where\n local f = mapExceptT (local f)\n\ninstance monadStateExceptT :: MonadState s m => MonadState s (ExceptT e m) where\n state f = lift (state f)\n\ninstance monadTellExceptT :: MonadTell w m => MonadTell w (ExceptT e m) where\n tell = lift <<< tell\n\ninstance monadWriterExceptT :: MonadWriter w m => MonadWriter w (ExceptT e m) where\n listen = mapExceptT \\m -> do\n Tuple a w <- listen m\n pure $ (\\r -> Tuple r w) <$> a\n pass = mapExceptT \\m -> pass do\n a <- m\n pure case a of\n Left e -> Tuple (Left e) identity\n Right (Tuple r f) -> Tuple (Right r) f\n\ninstance semigroupExceptT :: (Monad m, Semigroup a) => Semigroup (ExceptT e m a) where\n append = lift2 (<>)\n\ninstance monoidExceptT :: (Monad m, Monoid a) => Monoid (ExceptT e m a) where\n mempty = pure mempty\n\ninstance MonadST s m => MonadST s (ExceptT e m) where\n liftST = lift <<< liftST\n", "export const fromNumberImpl = function (just) {\n return function (nothing) {\n return function (n) {\n /* jshint bitwise: false */\n return (n | 0) === n ? just(n) : nothing;\n };\n };\n};\n\nexport const toNumber = function (n) {\n return n;\n};\n\nexport const fromStringAsImpl = function (just) {\n return function (nothing) {\n return function (radix) {\n var digits;\n if (radix < 11) {\n digits = \"[0-\" + (radix - 1).toString() + \"]\";\n } else if (radix === 11) {\n digits = \"[0-9a]\";\n } else {\n digits = \"[0-9a-\" + String.fromCharCode(86 + radix) + \"]\";\n }\n var pattern = new RegExp(\"^[\\\\+\\\\-]?\" + digits + \"+$\", \"i\");\n\n return function (s) {\n /* jshint bitwise: false */\n if (pattern.test(s)) {\n var i = parseInt(s, radix);\n return (i | 0) === i ? just(i) : nothing;\n } else {\n return nothing;\n }\n };\n };\n };\n};\n\nexport const toStringAs = function (radix) {\n return function (i) {\n return i.toString(radix);\n };\n};\n\n\nexport const quot = function (x) {\n return function (y) {\n /* jshint bitwise: false */\n return x / y | 0;\n };\n};\n\nexport const rem = function (x) {\n return function (y) {\n return x % y;\n };\n};\n\nexport const pow = function (x) {\n return function (y) {\n /* jshint bitwise: false */\n return Math.pow(x,y) | 0;\n };\n};\n", "/* globals exports */\nexport const nan = NaN;\nconst isNaNImpl = isNaN;\nexport { isNaNImpl as isNaN };\nexport const infinity = Infinity;\nconst isFiniteImpl = isFinite;\nexport { isFiniteImpl as isFinite };\n\nexport function fromStringImpl(str, isFinite, just, nothing) {\n var num = parseFloat(str);\n if (isFinite(num)) {\n return just(num);\n } else {\n return nothing;\n }\n}\n\nexport const abs = Math.abs;\n\nexport const acos = Math.acos;\n\nexport const asin = Math.asin;\n\nexport const atan = Math.atan;\n\nexport const atan2 = function (y) {\n return function (x) {\n return Math.atan2(y, x);\n };\n};\n\nexport const ceil = Math.ceil;\n\nexport const cos = Math.cos;\n\nexport const exp = Math.exp;\n\nexport const floor = Math.floor;\n\nexport const log = Math.log;\n\nexport const max = function (n1) {\n return function (n2) {\n return Math.max(n1, n2);\n };\n};\n\nexport const min = function (n1) {\n return function (n2) {\n return Math.min(n1, n2);\n };\n};\n\nexport const pow = function (n) {\n return function (p) {\n return Math.pow(n, p);\n };\n};\n\nexport const remainder = function (n) {\n return function (m) {\n return n % m;\n };\n};\n\nexport const round = Math.round;\n\nexport const sign = Math.sign ? Math.sign : function(x) {\n return x === 0 || x !== x ? x : (x < 0 ? -1 : 1);\n};\n\nexport const sin = Math.sin;\n\nexport const sqrt = Math.sqrt;\n\nexport const tan = Math.tan;\n\nexport const trunc = Math.trunc ? Math.trunc : function(x) {\n return x < 0 ? Math.ceil(x) : Math.floor(x);\n}\n", "module Data.Int\n ( fromNumber\n , ceil\n , floor\n , trunc\n , round\n , toNumber\n , fromString\n , Radix\n , radix\n , binary\n , octal\n , decimal\n , hexadecimal\n , base36\n , fromStringAs\n , toStringAs\n , Parity(..)\n , parity\n , even\n , odd\n , quot\n , rem\n , pow\n ) where\n\nimport Prelude\n\nimport Data.Int.Bits ((.&.))\nimport Data.Maybe (Maybe(..), fromMaybe)\nimport Data.Number (isFinite)\nimport Data.Number as Number\n\n-- | Creates an `Int` from a `Number` value. The number must already be an\n-- | integer and fall within the valid range of values for the `Int` type\n-- | otherwise `Nothing` is returned.\nfromNumber :: Number -> Maybe Int\nfromNumber = fromNumberImpl Just Nothing\n\nforeign import fromNumberImpl\n :: (forall a. a -> Maybe a)\n -> (forall a. Maybe a)\n -> Number\n -> Maybe Int\n\n-- | Convert a `Number` to an `Int`, by taking the closest integer equal to or\n-- | less than the argument. Values outside the `Int` range are clamped, `NaN`\n-- | and `Infinity` values return 0.\nfloor :: Number -> Int\nfloor = unsafeClamp <<< Number.floor\n\n-- | Convert a `Number` to an `Int`, by taking the closest integer equal to or\n-- | greater than the argument. Values outside the `Int` range are clamped,\n-- | `NaN` and `Infinity` values return 0.\nceil :: Number -> Int\nceil = unsafeClamp <<< Number.ceil\n\n-- | Convert a `Number` to an `Int`, by dropping the decimal.\n-- | Values outside the `Int` range are clamped, `NaN` and `Infinity`\n-- | values return 0.\ntrunc :: Number -> Int\ntrunc = unsafeClamp <<< Number.trunc\n\n-- | Convert a `Number` to an `Int`, by taking the nearest integer to the\n-- | argument. Values outside the `Int` range are clamped, `NaN` and `Infinity`\n-- | values return 0.\nround :: Number -> Int\nround = unsafeClamp <<< Number.round\n\n-- | Convert an integral `Number` to an `Int`, by clamping to the `Int` range.\n-- | This function will return 0 if the input is `NaN` or an `Infinity`.\nunsafeClamp :: Number -> Int\nunsafeClamp x\n | not (isFinite x) = 0\n | x >= toNumber top = top\n | x <= toNumber bottom = bottom\n | otherwise = fromMaybe 0 (fromNumber x)\n\n-- | Converts an `Int` value back into a `Number`. Any `Int` is a valid `Number`\n-- | so there is no loss of precision with this function.\nforeign import toNumber :: Int -> Number\n\n-- | Reads an `Int` from a `String` value. The number must parse as an integer\n-- | and fall within the valid range of values for the `Int` type, otherwise\n-- | `Nothing` is returned.\nfromString :: String -> Maybe Int\nfromString = fromStringAs (Radix 10)\n\n-- | A type for describing whether an integer is even or odd.\n-- |\n-- | The `Ord` instance considers `Even` to be less than `Odd`.\n-- |\n-- | The `Semiring` instance allows you to ask about the parity of the results\n-- | of arithmetical operations, given only the parities of the inputs. For\n-- | example, the sum of an odd number and an even number is odd, so\n-- | `Odd + Even == Odd`. This also works for multiplication, eg. the product\n-- | of two odd numbers is odd, and therefore `Odd * Odd == Odd`.\n-- |\n-- | More generally, we have that\n-- |\n-- | ```purescript\n-- | parity x + parity y == parity (x + y)\n-- | parity x * parity y == parity (x * y)\n-- | ```\n-- |\n-- | for any integers `x`, `y`. (A mathematician would say that `parity` is a\n-- | *ring homomorphism*.)\n-- |\n-- | After defining addition and multiplication on `Parity` in this way, the\n-- | `Semiring` laws now force us to choose `zero = Even` and `one = Odd`.\n-- | This `Semiring` instance actually turns out to be a `Field`.\ndata Parity = Even | Odd\n\nderive instance eqParity :: Eq Parity\nderive instance ordParity :: Ord Parity\n\ninstance showParity :: Show Parity where\n show Even = \"Even\"\n show Odd = \"Odd\"\n\ninstance boundedParity :: Bounded Parity where\n bottom = Even\n top = Odd\n\ninstance semiringParity :: Semiring Parity where\n zero = Even\n add x y = if x == y then Even else Odd\n one = Odd\n mul Odd Odd = Odd\n mul _ _ = Even\n\ninstance ringParity :: Ring Parity where\n sub = add\n\ninstance commutativeRingParity :: CommutativeRing Parity\n\ninstance euclideanRingParity :: EuclideanRing Parity where\n degree Even = 0\n degree Odd = 1\n div x _ = x\n mod _ _ = Even\n\ninstance divisionRingParity :: DivisionRing Parity where\n recip = identity\n\n-- | Returns whether an `Int` is `Even` or `Odd`.\n-- |\n-- | ``` purescript\n-- | parity 0 == Even\n-- | parity 1 == Odd\n-- | ```\nparity :: Int -> Parity\nparity n = if even n then Even else Odd\n\n-- | Returns whether an `Int` is an even number.\n-- |\n-- | ``` purescript\n-- | even 0 == true\n-- | even 1 == false\n-- | ```\neven :: Int -> Boolean\neven x = x .&. 1 == 0\n\n-- | The negation of `even`.\n-- |\n-- | ``` purescript\n-- | odd 0 == false\n-- | odd 1 == true\n-- | ```\nodd :: Int -> Boolean\nodd x = x .&. 1 /= 0\n\n-- | The number of unique digits (including zero) used to represent integers in\n-- | a specific base.\nnewtype Radix = Radix Int\n\n-- | The base-2 system.\nbinary :: Radix\nbinary = Radix 2\n\n-- | The base-8 system.\noctal :: Radix\noctal = Radix 8\n\n-- | The base-10 system.\ndecimal :: Radix\ndecimal = Radix 10\n\n-- | The base-16 system.\nhexadecimal :: Radix\nhexadecimal = Radix 16\n\n-- | The base-36 system.\nbase36 :: Radix\nbase36 = Radix 36\n\n-- | Create a `Radix` from a number between 2 and 36.\nradix :: Int -> Maybe Radix\nradix n | n >= 2 && n <= 36 = Just (Radix n)\n | otherwise = Nothing\n\n-- | Like `fromString`, but the integer can be specified in a different base.\n-- |\n-- | Example:\n-- | ``` purs\n-- | fromStringAs binary \"100\" == Just 4\n-- | fromStringAs hexadecimal \"ff\" == Just 255\n-- | ```\nfromStringAs :: Radix -> String -> Maybe Int\nfromStringAs = fromStringAsImpl Just Nothing\n\n-- | The `quot` function provides _truncating_ integer division (see the\n-- | documentation for the `EuclideanRing` class). It is identical to `div` in\n-- | the `EuclideanRing Int` instance if the dividend is positive, but will be\n-- | slightly different if the dividend is negative. For example:\n-- |\n-- | ```purescript\n-- | div 2 3 == 0\n-- | quot 2 3 == 0\n-- |\n-- | div (-2) 3 == (-1)\n-- | quot (-2) 3 == 0\n-- |\n-- | div 2 (-3) == 0\n-- | quot 2 (-3) == 0\n-- | ```\nforeign import quot :: Int -> Int -> Int\n\n-- | The `rem` function provides the remainder after _truncating_ integer\n-- | division (see the documentation for the `EuclideanRing` class). It is\n-- | identical to `mod` in the `EuclideanRing Int` instance if the dividend is\n-- | positive, but will be slightly different if the dividend is negative. For\n-- | example:\n-- |\n-- | ```purescript\n-- | mod 2 3 == 2\n-- | rem 2 3 == 2\n-- |\n-- | mod (-2) 3 == 1\n-- | rem (-2) 3 == (-2)\n-- |\n-- | mod 2 (-3) == 2\n-- | rem 2 (-3) == 2\n-- | ```\nforeign import rem :: Int -> Int -> Int\n\n-- | Raise an Int to the power of another Int.\nforeign import pow :: Int -> Int -> Int\n\nforeign import fromStringAsImpl\n :: (forall a. a -> Maybe a)\n -> (forall a. Maybe a)\n -> Radix\n -> String\n -> Maybe Int\n\nforeign import toStringAs :: Radix -> Int -> String\n", "-- | This module defines a type of _strict_ linked lists, and associated helper\n-- | functions and type class instances.\n-- |\n-- | _Note_: Depending on your use-case, you may prefer to use\n-- | `Data.Sequence` instead, which might give better performance for certain\n-- | use cases. This module is an improvement over `Data.Array` when working with\n-- | immutable lists of data in a purely-functional setting, but does not have\n-- | good random-access performance.\n\nmodule Data.List\n ( module Data.List.Types\n , toUnfoldable\n , fromFoldable\n\n , singleton\n , (..), range\n , some\n , someRec\n , many\n , manyRec\n\n , null\n , length\n\n , snoc\n , insert\n , insertBy\n\n , head\n , last\n , tail\n , init\n , uncons\n , unsnoc\n\n , (!!), index\n , elemIndex\n , elemLastIndex\n , findIndex\n , findLastIndex\n , insertAt\n , deleteAt\n , updateAt\n , modifyAt\n , alterAt\n\n , reverse\n , concat\n , concatMap\n , filter\n , filterM\n , mapMaybe\n , catMaybes\n\n , sort\n , sortBy\n\n , Pattern(..)\n , stripPrefix\n , slice\n , take\n , takeEnd\n , takeWhile\n , drop\n , dropEnd\n , dropWhile\n , span\n , group\n , groupAll\n , groupBy\n , groupAllBy\n , partition\n\n , nub\n , nubBy\n , nubEq\n , nubByEq\n , union\n , unionBy\n , delete\n , deleteBy\n , (\\\\), difference\n , intersect\n , intersectBy\n\n , zipWith\n , zipWithA\n , zip\n , unzip\n\n , transpose\n\n , foldM\n\n , module Exports\n ) where\n\nimport Prelude\n\nimport Control.Alt ((<|>))\nimport Control.Alternative (class Alternative)\nimport Control.Lazy (class Lazy, defer)\nimport Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM, tailRecM2)\nimport Data.Bifunctor (bimap)\nimport Data.Foldable (class Foldable, foldr, any, foldl)\nimport Data.Foldable (foldl, foldr, foldMap, fold, intercalate, elem, notElem, find, findMap, any, all) as Exports\nimport Data.List.Internal (emptySet, insertAndLookupBy)\nimport Data.List.Types (List(..), (:))\nimport Data.List.Types (NonEmptyList(..)) as NEL\nimport Data.Maybe (Maybe(..))\nimport Data.Newtype (class Newtype)\nimport Data.NonEmpty ((:|))\nimport Data.Traversable (scanl, scanr) as Exports\nimport Data.Traversable (sequence)\nimport Data.Tuple (Tuple(..))\nimport Data.Unfoldable (class Unfoldable, unfoldr)\n\n-- | Convert a list into any unfoldable structure.\n-- |\n-- | Running time: `O(n)`\ntoUnfoldable :: forall f. Unfoldable f => List ~> f\ntoUnfoldable = unfoldr (\\xs -> (\\rec -> Tuple rec.head rec.tail) <$> uncons xs)\n\n-- | Construct a list from a foldable structure.\n-- |\n-- | Running time: `O(n)`\nfromFoldable :: forall f. Foldable f => f ~> List\nfromFoldable = foldr Cons Nil\n\n--------------------------------------------------------------------------------\n-- List creation ---------------------------------------------------------------\n--------------------------------------------------------------------------------\n\n-- | Create a list with a single element.\n-- |\n-- | Running time: `O(1)`\nsingleton :: forall a. a -> List a\nsingleton a = a : Nil\n\n-- | An infix synonym for `range`.\ninfix 8 range as ..\n\n-- | Create a list containing a range of integers, including both endpoints.\nrange :: Int -> Int -> List Int\nrange start end | start == end = singleton start\n | otherwise = go end start (if start > end then 1 else -1) Nil\n where\n go s e step rest | s == e = s : rest\n | otherwise = go (s + step) e step (s : rest)\n\n-- | Attempt a computation multiple times, requiring at least one success.\n-- |\n-- | The `Lazy` constraint is used to generate the result lazily, to ensure\n-- | termination.\nsome :: forall f a. Alternative f => Lazy (f (List a)) => f a -> f (List a)\nsome v = Cons <$> v <*> defer (\\_ -> many v)\n\n-- | A stack-safe version of `some`, at the cost of a `MonadRec` constraint.\nsomeRec :: forall f a. MonadRec f => Alternative f => f a -> f (List a)\nsomeRec v = Cons <$> v <*> manyRec v\n\n-- | Attempt a computation multiple times, returning as many successful results\n-- | as possible (possibly zero).\n-- |\n-- | The `Lazy` constraint is used to generate the result lazily, to ensure\n-- | termination.\nmany :: forall f a. Alternative f => Lazy (f (List a)) => f a -> f (List a)\nmany v = some v <|> pure Nil\n\n-- | A stack-safe version of `many`, at the cost of a `MonadRec` constraint.\nmanyRec :: forall f a. MonadRec f => Alternative f => f a -> f (List a)\nmanyRec p = tailRecM go Nil\n where\n go :: List a -> f (Step (List a) (List a))\n go acc = do\n aa <- (Loop <$> p) <|> pure (Done unit)\n pure $ bimap (_ : acc) (\\_ -> reverse acc) aa\n\n--------------------------------------------------------------------------------\n-- List size -------------------------------------------------------------------\n--------------------------------------------------------------------------------\n\n-- | Test whether a list is empty.\n-- |\n-- | Running time: `O(1)`\nnull :: forall a. List a -> Boolean\nnull Nil = true\nnull _ = false\n\n-- | Get the length of a list\n-- |\n-- | Running time: `O(n)`\nlength :: forall a. List a -> Int\nlength = foldl (\\acc _ -> acc + 1) 0\n\n--------------------------------------------------------------------------------\n-- Extending lists -------------------------------------------------------------\n--------------------------------------------------------------------------------\n\n-- | Append an element to the end of a list, creating a new list.\n-- |\n-- | Running time: `O(n)`\nsnoc :: forall a. List a -> a -> List a\nsnoc xs x = foldr (:) (x : Nil) xs\n\n-- | Insert an element into a sorted list.\n-- |\n-- | Running time: `O(n)`\ninsert :: forall a. Ord a => a -> List a -> List a\ninsert = insertBy compare\n\n-- | Insert an element into a sorted list, using the specified function to\n-- | determine the ordering of elements.\n-- |\n-- | Running time: `O(n)`\ninsertBy :: forall a. (a -> a -> Ordering) -> a -> List a -> List a\ninsertBy _ x Nil = singleton x\ninsertBy cmp x ys@(y : ys') =\n case cmp x y of\n GT -> y : (insertBy cmp x ys')\n _ -> x : ys\n\n--------------------------------------------------------------------------------\n-- Non-indexed reads -----------------------------------------------------------\n--------------------------------------------------------------------------------\n\n-- | Get the first element in a list, or `Nothing` if the list is empty.\n-- |\n-- | Running time: `O(1)`.\nhead :: List ~> Maybe\nhead Nil = Nothing\nhead (x : _) = Just x\n\n-- | Get the last element in a list, or `Nothing` if the list is empty.\n-- |\n-- | Running time: `O(n)`.\nlast :: List ~> Maybe\nlast (x : Nil) = Just x\nlast (_ : xs) = last xs\nlast _ = Nothing\n\n-- | Get all but the first element of a list, or `Nothing` if the list is empty.\n-- |\n-- | Running time: `O(1)`\ntail :: forall a. List a -> Maybe (List a)\ntail Nil = Nothing\ntail (_ : xs) = Just xs\n\n-- | Get all but the last element of a list, or `Nothing` if the list is empty.\n-- |\n-- | Running time: `O(n)`\ninit :: forall a. List a -> Maybe (List a)\ninit lst = _.init <$> unsnoc lst\n\n-- | Break a list into its first element, and the remaining elements,\n-- | or `Nothing` if the list is empty.\n-- |\n-- | Running time: `O(1)`\nuncons :: forall a. List a -> Maybe { head :: a, tail :: List a }\nuncons Nil = Nothing\nuncons (x : xs) = Just { head: x, tail: xs }\n\n-- | Break a list into its last element, and the preceding elements,\n-- | or `Nothing` if the list is empty.\n-- |\n-- | Running time: `O(n)`\nunsnoc :: forall a. List a -> Maybe { init :: List a, last :: a }\nunsnoc lst = (\\h -> { init: reverse h.revInit, last: h.last }) <$> go lst Nil\n where\n go Nil _ = Nothing\n go (x : Nil) acc = Just { revInit: acc, last: x }\n go (x : xs) acc = go xs (x : acc)\n\n--------------------------------------------------------------------------------\n-- Indexed operations ----------------------------------------------------------\n--------------------------------------------------------------------------------\n\n-- | Get the element at the specified index, or `Nothing` if the index is out-of-bounds.\n-- |\n-- | Running time: `O(n)` where `n` is the required index.\nindex :: forall a. List a -> Int -> Maybe a\nindex Nil _ = Nothing\nindex (a : _) 0 = Just a\nindex (_ : as) i = index as (i - 1)\n\n-- | An infix synonym for `index`.\ninfixl 8 index as !!\n\n-- | Find the index of the first element equal to the specified element.\nelemIndex :: forall a. Eq a => a -> List a -> Maybe Int\nelemIndex x = findIndex (_ == x)\n\n-- | Find the index of the last element equal to the specified element.\nelemLastIndex :: forall a. Eq a => a -> List a -> Maybe Int\nelemLastIndex x = findLastIndex (_ == x)\n\n-- | Find the first index for which a predicate holds.\nfindIndex :: forall a. (a -> Boolean) -> List a -> Maybe Int\nfindIndex fn = go 0\n where\n go :: Int -> List a -> Maybe Int\n go n (x : xs) | fn x = Just n\n | otherwise = go (n + 1) xs\n go _ Nil = Nothing\n\n-- | Find the last index for which a predicate holds.\nfindLastIndex :: forall a. (a -> Boolean) -> List a -> Maybe Int\nfindLastIndex fn xs = ((length xs - 1) - _) <$> findIndex fn (reverse xs)\n\n-- | Insert an element into a list at the specified index, returning a new\n-- | list or `Nothing` if the index is out-of-bounds.\n-- |\n-- | Running time: `O(n)`\ninsertAt :: forall a. Int -> a -> List a -> Maybe (List a)\ninsertAt 0 x xs = Just (x : xs)\ninsertAt n x (y : ys) = (y : _) <$> insertAt (n - 1) x ys\ninsertAt _ _ _ = Nothing\n\n-- | Delete an element from a list at the specified index, returning a new\n-- | list or `Nothing` if the index is out-of-bounds.\n-- |\n-- | Running time: `O(n)`\ndeleteAt :: forall a. Int -> List a -> Maybe (List a)\ndeleteAt 0 (_ : ys) = Just ys\ndeleteAt n (y : ys) = (y : _) <$> deleteAt (n - 1) ys\ndeleteAt _ _ = Nothing\n\n-- | Update the element at the specified index, returning a new\n-- | list or `Nothing` if the index is out-of-bounds.\n-- |\n-- | Running time: `O(n)`\nupdateAt :: forall a. Int -> a -> List a -> Maybe (List a)\nupdateAt 0 x ( _ : xs) = Just (x : xs)\nupdateAt n x (x1 : xs) = (x1 : _) <$> updateAt (n - 1) x xs\nupdateAt _ _ _ = Nothing\n\n-- | Update the element at the specified index by applying a function to\n-- | the current value, returning a new list or `Nothing` if the index is\n-- | out-of-bounds.\n-- |\n-- | Running time: `O(n)`\nmodifyAt :: forall a. Int -> (a -> a) -> List a -> Maybe (List a)\nmodifyAt n f = alterAt n (Just <<< f)\n\n-- | Update or delete the element at the specified index by applying a\n-- | function to the current value, returning a new list or `Nothing` if the\n-- | index is out-of-bounds.\n-- |\n-- | Running time: `O(n)`\nalterAt :: forall a. Int -> (a -> Maybe a) -> List a -> Maybe (List a)\nalterAt 0 f (y : ys) = Just $\n case f y of\n Nothing -> ys\n Just y' -> y' : ys\nalterAt n f (y : ys) = (y : _) <$> alterAt (n - 1) f ys\nalterAt _ _ _ = Nothing\n\n--------------------------------------------------------------------------------\n-- Transformations -------------------------------------------------------------\n--------------------------------------------------------------------------------\n\n-- | Reverse a list.\n-- |\n-- | Running time: `O(n)`\nreverse :: List ~> List\nreverse = go Nil\n where\n go acc Nil = acc\n go acc (x : xs) = go (x : acc) xs\n\n-- | Flatten a list of lists.\n-- |\n-- | Running time: `O(n)`, where `n` is the total number of elements.\nconcat :: forall a. List (List a) -> List a\nconcat = (_ >>= identity)\n\n-- | Apply a function to each element in a list, and flatten the results\n-- | into a single, new list.\n-- |\n-- | Running time: `O(n)`, where `n` is the total number of elements.\nconcatMap :: forall a b. (a -> List b) -> List a -> List b\nconcatMap = flip bind\n\n-- | Filter a list, keeping the elements which satisfy a predicate function.\n-- |\n-- | Running time: `O(n)`\nfilter :: forall a. (a -> Boolean) -> List a -> List a\nfilter p = go Nil\n where\n go acc Nil = reverse acc\n go acc (x : xs)\n | p x = go (x : acc) xs\n | otherwise = go acc xs\n\n-- | Filter where the predicate returns a monadic `Boolean`.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | powerSet :: forall a. [a] -> [[a]]\n-- | powerSet = filterM (const [true, false])\n-- | ```\nfilterM :: forall a m. Monad m => (a -> m Boolean) -> List a -> m (List a)\nfilterM _ Nil = pure Nil\nfilterM p (x : xs) = do\n b <- p x\n xs' <- filterM p xs\n pure if b then x : xs' else xs'\n\n-- | Apply a function to each element in a list, keeping only the results which\n-- | contain a value.\n-- |\n-- | Running time: `O(n)`\nmapMaybe :: forall a b. (a -> Maybe b) -> List a -> List b\nmapMaybe f = go Nil\n where\n go acc Nil = reverse acc\n go acc (x : xs) =\n case f x of\n Nothing -> go acc xs\n Just y -> go (y : acc) xs\n\n-- | Filter a list of optional values, keeping only the elements which contain\n-- | a value.\ncatMaybes :: forall a. List (Maybe a) -> List a\ncatMaybes = mapMaybe identity\n\n--------------------------------------------------------------------------------\n-- Sorting ---------------------------------------------------------------------\n--------------------------------------------------------------------------------\n\n-- | Sort the elements of an list in increasing order.\nsort :: forall a. Ord a => List a -> List a\nsort xs = sortBy compare xs\n\n-- | Sort the elements of a list in increasing order, where elements are\n-- | compared using the specified ordering.\nsortBy :: forall a. (a -> a -> Ordering) -> List a -> List a\nsortBy cmp = mergeAll <<< sequences\n -- implementation lifted from http://hackage.haskell.org/package/base-4.8.0.0/docs/src/Data-OldList.html#sort\n where\n sequences :: List a -> List (List a)\n sequences (a : b : xs)\n | a `cmp` b == GT = descending b (singleton a) xs\n | otherwise = ascending b (a : _) xs\n sequences xs = singleton xs\n\n descending :: a -> List a -> List a -> List (List a)\n descending a as (b : bs)\n | a `cmp` b == GT = descending b (a : as) bs\n descending a as bs = (a : as) : sequences bs\n\n ascending :: a -> (List a -> List a) -> List a -> List (List a)\n ascending a as (b : bs)\n | a `cmp` b /= GT = ascending b (\\ys -> as (a : ys)) bs\n ascending a as bs = ((as $ singleton a) : sequences bs)\n\n mergeAll :: List (List a) -> List a\n mergeAll (x : Nil) = x\n mergeAll xs = mergeAll (mergePairs xs)\n\n mergePairs :: List (List a) -> List (List a)\n mergePairs (a : b : xs) = merge a b : mergePairs xs\n mergePairs xs = xs\n\n merge :: List a -> List a -> List a\n merge as@(a : as') bs@(b : bs')\n | a `cmp` b == GT = b : merge as bs'\n | otherwise = a : merge as' bs\n merge Nil bs = bs\n merge as Nil = as\n\n--------------------------------------------------------------------------------\n-- Sublists --------------------------------------------------------------------\n--------------------------------------------------------------------------------\n\n-- | A newtype used in cases where there is a list to be matched.\nnewtype Pattern a = Pattern (List a)\n\nderive instance eqPattern :: Eq a => Eq (Pattern a)\nderive instance ordPattern :: Ord a => Ord (Pattern a)\nderive instance newtypePattern :: Newtype (Pattern a) _\n\ninstance showPattern :: Show a => Show (Pattern a) where\n show (Pattern s) = \"(Pattern \" <> show s <> \")\"\n\n\n-- | If the list starts with the given prefix, return the portion of the\n-- | list left after removing it, as a Just value. Otherwise, return Nothing.\n-- | * `stripPrefix (Pattern (1:Nil)) (1:2:Nil) == Just (2:Nil)`\n-- | * `stripPrefix (Pattern Nil) (1:Nil) == Just (1:Nil)`\n-- | * `stripPrefix (Pattern (2:Nil)) (1:Nil) == Nothing`\n-- |\n-- | Running time: `O(n)` where `n` is the number of elements to strip.\nstripPrefix :: forall a. Eq a => Pattern a -> List a -> Maybe (List a)\nstripPrefix (Pattern p') s = tailRecM2 go p' s\n where\n go prefix input = case prefix, input of\n Cons p ps, Cons i is | p == i -> Just $ Loop { a: ps, b: is }\n Nil, is -> Just $ Done is\n _, _ -> Nothing\n\n-- | Extract a sublist by a start and end index.\nslice :: Int -> Int -> List ~> List\nslice start end xs = take (end - start) (drop start xs)\n\n-- | Take the specified number of elements from the front of a list.\n-- |\n-- | Running time: `O(n)` where `n` is the number of elements to take.\ntake :: forall a. Int -> List a -> List a\ntake = go Nil\n where\n go acc n _ | n < 1 = reverse acc\n go acc _ Nil = reverse acc\n go acc n (x : xs) = go (x : acc) (n - 1) xs\n\n-- | Take the specified number of elements from the end of a list.\n-- |\n-- | Running time: `O(2n - m)` where `n` is the number of elements in list\n-- | and `m` is number of elements to take.\ntakeEnd :: forall a. Int -> List a -> List a\ntakeEnd n xs = drop (length xs - n) xs\n\n-- | Take those elements from the front of a list which match a predicate.\n-- |\n-- | Running time (worst case): `O(n)`\ntakeWhile :: forall a. (a -> Boolean) -> List a -> List a\ntakeWhile p = go Nil\n where\n go acc (x : xs) | p x = go (x : acc) xs\n go acc _ = reverse acc\n\n-- | Drop the specified number of elements from the front of a list.\n-- |\n-- | Running time: `O(n)` where `n` is the number of elements to drop.\ndrop :: forall a. Int -> List a -> List a\ndrop n xs | n < 1 = xs\ndrop _ Nil = Nil\ndrop n (_ : xs) = drop (n - 1) xs\n\n-- | Drop the specified number of elements from the end of a list.\n-- |\n-- | Running time: `O(2n - m)` where `n` is the number of elements in list\n-- | and `m` is number of elements to drop.\ndropEnd :: forall a. Int -> List a -> List a\ndropEnd n xs = take (length xs - n) xs\n\n-- | Drop those elements from the front of a list which match a predicate.\n-- |\n-- | Running time (worst case): `O(n)`\ndropWhile :: forall a. (a -> Boolean) -> List a -> List a\ndropWhile p = go\n where\n go (x : xs) | p x = go xs\n go xs = xs\n\n-- | Split a list into two parts:\n-- |\n-- | 1. the longest initial segment for which all elements satisfy the specified predicate\n-- | 2. the remaining elements\n-- |\n-- | For example,\n-- |\n-- | ```purescript\n-- | span (\\n -> n % 2 == 1) (1 : 3 : 2 : 4 : 5 : Nil) == { init: (1 : 3 : Nil), rest: (2 : 4 : 5 : Nil) }\n-- | ```\n-- |\n-- | Running time: `O(n)`\nspan :: forall a. (a -> Boolean) -> List a -> { init :: List a, rest :: List a }\nspan p (x : xs') | p x = case span p xs' of\n { init: ys, rest: zs } -> { init: x : ys, rest: zs }\nspan _ xs = { init: Nil, rest: xs }\n\n-- | Group equal, consecutive elements of a list into lists.\n-- |\n-- | For example,\n-- |\n-- | ```purescript\n-- | group (1 : 1 : 2 : 2 : 1 : Nil) ==\n-- | (NonEmptyList (NonEmpty 1 (1 : Nil))) : (NonEmptyList (NonEmpty 2 (2 : Nil))) : (NonEmptyList (NonEmpty 1 Nil)) : Nil\n-- | ```\n-- |\n-- | Running time: `O(n)`\ngroup :: forall a. Eq a => List a -> List (NEL.NonEmptyList a)\ngroup = groupBy (==)\n\n-- | Group equal elements of a list into lists.\n-- |\n-- | For example,\n-- |\n-- | ```purescript\n-- | groupAll (1 : 1 : 2 : 2 : 1 : Nil) ==\n-- | (NonEmptyList (NonEmpty 1 (1 : 1 : Nil))) : (NonEmptyList (NonEmpty 2 (2 : Nil))) : Nil\n-- | ```\ngroupAll :: forall a. Ord a => List a -> List (NEL.NonEmptyList a)\ngroupAll = group <<< sort\n\n-- | Group equal, consecutive elements of a list into lists, using the specified\n-- | equivalence relation to determine equality.\n-- |\n-- | For example,\n-- |\n-- | ```purescript\n-- | groupBy (\\a b -> odd a && odd b) (1 : 3 : 2 : 4 : 3 : 3 : Nil) ==\n-- | (NonEmptyList (NonEmpty 1 (3 : Nil))) : (NonEmptyList (NonEmpty 2 Nil)) : (NonEmptyList (NonEmpty 4 Nil)) : (NonEmptyList (NonEmpty 3 (3 : Nil))) : Nil\n-- | ```\n-- |\n-- | Running time: `O(n)`\ngroupBy :: forall a. (a -> a -> Boolean) -> List a -> List (NEL.NonEmptyList a)\ngroupBy _ Nil = Nil\ngroupBy eq (x : xs) = case span (eq x) xs of\n { init: ys, rest: zs } -> NEL.NonEmptyList (x :| ys) : groupBy eq zs\n\n-- | Sort, then group equal elements of a list into lists, using the provided comparison function.\n-- |\n-- | ```purescript\n-- | groupAllBy (compare `on` (_ `div` 10)) (32 : 31 : 21 : 22 : 11 : 33 : Nil) ==\n-- | NonEmptyList (11 :| Nil) : NonEmptyList (21 :| 22 : Nil) : NonEmptyList (32 :| 31 : 33) : Nil\n-- | ```\n-- |\n-- | Running time: `O(n log n)`\ngroupAllBy :: forall a. (a -> a -> Ordering) -> List a -> List (NEL.NonEmptyList a)\ngroupAllBy p = groupBy (\\x y -> p x y == EQ) <<< sortBy p\n\n-- | Returns a lists of elements which do and do not satisfy a predicate.\n-- |\n-- | Running time: `O(n)`\npartition :: forall a. (a -> Boolean) -> List a -> { yes :: List a, no :: List a }\npartition p xs = foldr select { no: Nil, yes: Nil } xs\n where\n select x { no, yes } = if p x\n then { no, yes: x : yes }\n else { no: x : no, yes }\n\n-- | Returns all final segments of the argument, longest first. For example,\n-- |\n-- | ```purescript\n-- | tails (1 : 2 : 3 : Nil) == ((1 : 2 : 3 : Nil) : (2 : 3 : Nil) : (3 : Nil) : (Nil) : Nil)\n-- | ```\n-- | Running time: `O(n)`\ntails :: forall a. List a -> List (List a)\ntails Nil = singleton Nil\ntails list@(Cons _ tl)= list : tails tl\n\n--------------------------------------------------------------------------------\n-- Set-like operations ---------------------------------------------------------\n--------------------------------------------------------------------------------\n\n-- | Remove duplicate elements from a list.\n-- | Keeps the first occurrence of each element in the input list,\n-- | in the same order they appear in the input list.\n-- |\n-- | ```purescript\n-- | nub 1:2:1:3:3:Nil == 1:2:3:Nil\n-- | ```\n-- |\n-- | Running time: `O(n log n)`\nnub :: forall a. Ord a => List a -> List a\nnub = nubBy compare\n\n-- | Remove duplicate elements from a list based on the provided comparison function.\n-- | Keeps the first occurrence of each element in the input list,\n-- | in the same order they appear in the input list.\n-- |\n-- | ```purescript\n-- | nubBy (compare `on` Array.length) ([1]:[2]:[3,4]:Nil) == [1]:[3,4]:Nil\n-- | ```\n-- |\n-- | Running time: `O(n log n)`\nnubBy :: forall a. (a -> a -> Ordering) -> List a -> List a\nnubBy p = reverse <<< go emptySet Nil\n where\n go _ acc Nil = acc\n go s acc (a : as) =\n let { found, result: s' } = insertAndLookupBy p a s\n in if found\n then go s' acc as\n else go s' (a : acc) as\n\n-- | Remove duplicate elements from a list.\n-- | Keeps the first occurrence of each element in the input list,\n-- | in the same order they appear in the input list.\n-- | This less efficient version of `nub` only requires an `Eq` instance.\n-- |\n-- | ```purescript\n-- | nubEq 1:2:1:3:3:Nil == 1:2:3:Nil\n-- | ```\n-- |\n-- | Running time: `O(n^2)`\nnubEq :: forall a. Eq a => List a -> List a\nnubEq = nubByEq eq\n\n-- | Remove duplicate elements from a list, using the provided equivalence function.\n-- | Keeps the first occurrence of each element in the input list,\n-- | in the same order they appear in the input list.\n-- | This less efficient version of `nubBy` only requires an equivalence\n-- | function, rather than an ordering function.\n-- |\n-- | ```purescript\n-- | mod3eq = eq `on` \\n -> mod n 3\n-- | nubByEq mod3eq 1:3:4:5:6:Nil == 1:3:5:Nil\n-- | ```\n-- |\n-- | Running time: `O(n^2)`\nnubByEq :: forall a. (a -> a -> Boolean) -> List a -> List a\nnubByEq _ Nil = Nil\nnubByEq eq' (x : xs) = x : nubByEq eq' (filter (\\y -> not (eq' x y)) xs)\n\n-- | Calculate the union of two lists.\n-- |\n-- | Running time: `O(n^2)`\nunion :: forall a. Eq a => List a -> List a -> List a\nunion = unionBy (==)\n\n-- | Calculate the union of two lists, using the specified\n-- | function to determine equality of elements.\n-- |\n-- | Running time: `O(n^2)`\nunionBy :: forall a. (a -> a -> Boolean) -> List a -> List a -> List a\nunionBy eq xs ys = xs <> foldl (flip (deleteBy eq)) (nubByEq eq ys) xs\n\n-- | Delete the first occurrence of an element from a list.\n-- |\n-- | Running time: `O(n)`\ndelete :: forall a. Eq a => a -> List a -> List a\ndelete = deleteBy (==)\n\n-- | Delete the first occurrence of an element from a list, using the specified\n-- | function to determine equality of elements.\n-- |\n-- | Running time: `O(n)`\ndeleteBy :: forall a. (a -> a -> Boolean) -> a -> List a -> List a\ndeleteBy _ _ Nil = Nil\ndeleteBy eq' x (y : ys) | eq' x y = ys\ndeleteBy eq' x (y : ys) = y : deleteBy eq' x ys\n\ninfix 5 difference as \\\\\n\n-- | Delete the first occurrence of each element in the second list from the first list.\n-- |\n-- | Running time: `O(n^2)`\ndifference :: forall a. Eq a => List a -> List a -> List a\ndifference = foldl (flip delete)\n\n-- | Calculate the intersection of two lists.\n-- |\n-- | Running time: `O(n^2)`\nintersect :: forall a. Eq a => List a -> List a -> List a\nintersect = intersectBy (==)\n\n-- | Calculate the intersection of two lists, using the specified\n-- | function to determine equality of elements.\n-- |\n-- | Running time: `O(n^2)`\nintersectBy :: forall a. (a -> a -> Boolean) -> List a -> List a -> List a\nintersectBy _ Nil _ = Nil\nintersectBy _ _ Nil = Nil\nintersectBy eq xs ys = filter (\\x -> any (eq x) ys) xs\n\n--------------------------------------------------------------------------------\n-- Zipping ---------------------------------------------------------------------\n--------------------------------------------------------------------------------\n\n-- | Apply a function to pairs of elements at the same positions in two lists,\n-- | collecting the results in a new list.\n-- |\n-- | If one list is longer, elements will be discarded from the longer list.\n-- |\n-- | For example\n-- |\n-- | ```purescript\n-- | zipWith (*) (1 : 2 : 3 : Nil) (4 : 5 : 6 : 7 Nil) == 4 : 10 : 18 : Nil\n-- | ```\n-- |\n-- | Running time: `O(min(m, n))`\nzipWith :: forall a b c. (a -> b -> c) -> List a -> List b -> List c\nzipWith f xs ys = reverse $ go xs ys Nil\n where\n go Nil _ acc = acc\n go _ Nil acc = acc\n go (a : as) (b : bs) acc = go as bs $ f a b : acc\n\n-- | A generalization of `zipWith` which accumulates results in some `Applicative`\n-- | functor.\nzipWithA :: forall m a b c. Applicative m => (a -> b -> m c) -> List a -> List b -> m (List c)\nzipWithA f xs ys = sequence (zipWith f xs ys)\n\n-- | Collect pairs of elements at the same positions in two lists.\n-- |\n-- | Running time: `O(min(m, n))`\nzip :: forall a b. List a -> List b -> List (Tuple a b)\nzip = zipWith Tuple\n\n-- | Transforms a list of pairs into a list of first components and a list of\n-- | second components.\nunzip :: forall a b. List (Tuple a b) -> Tuple (List a) (List b)\nunzip = foldr (\\(Tuple a b) (Tuple as bs) -> Tuple (a : as) (b : bs)) (Tuple Nil Nil)\n\n--------------------------------------------------------------------------------\n-- Transpose -------------------------------------------------------------------\n--------------------------------------------------------------------------------\n\n-- | The 'transpose' function transposes the rows and columns of its argument.\n-- | For example,\n-- |\n-- | transpose ((1:2:3:Nil) : (4:5:6:Nil) : Nil) ==\n-- | ((1:4:Nil) : (2:5:Nil) : (3:6:Nil) : Nil)\n-- |\n-- | If some of the rows are shorter than the following rows, their elements are skipped:\n-- |\n-- | transpose ((10:11:Nil) : (20:Nil) : Nil : (30:31:32:Nil) : Nil) ==\n-- | ((10:20:30:Nil) : (11:31:Nil) : (32:Nil) : Nil)\ntranspose :: forall a. List (List a) -> List (List a)\ntranspose Nil = Nil\ntranspose (Nil : xss) = transpose xss\ntranspose ((x : xs) : xss) =\n (x : mapMaybe head xss) : transpose (xs : mapMaybe tail xss)\n\n--------------------------------------------------------------------------------\n-- Folding ---------------------------------------------------------------------\n--------------------------------------------------------------------------------\n\n-- | Perform a fold using a monadic step function.\nfoldM :: forall m a b. Monad m => (b -> a -> m b) -> b -> List a -> m b\nfoldM _ b Nil = pure b\nfoldM f b (a : as) = f b a >>= \\b' -> foldM f b' as\n", "// module Partial.Unsafe\n\nexport const _unsafePartial = function (f) {\n return f();\n};\n", "// module Partial\n\nexport const _crashWith = function (msg) {\n throw new Error(msg);\n};\n", "-- | Some partial helper functions. See the README for more documentation.\nmodule Partial\n ( crash\n , crashWith\n ) where\n\n-- | A partial function which crashes on any input with a default message.\ncrash :: forall a. Partial => a\ncrash = crashWith \"Partial.crash: partial function\"\n\n-- | A partial function which crashes on any input with the specified message.\ncrashWith :: forall a. Partial => String -> a\ncrashWith = _crashWith\n\nforeign import _crashWith :: forall a. String -> a\n", "-- | Utilities for working with partial functions.\n-- | See the README for more documentation.\nmodule Partial.Unsafe\n ( unsafePartial\n , unsafeCrashWith\n ) where\n\nimport Partial (crashWith)\n\n-- Note: this function's type signature is more like\n-- `(Unit -> a) -> a`. However, we would need to use\n-- `unsafeCoerce` to make this compile, incurring\n-- either a dependency or reimplementing it here.\n-- Rather than doing that, we'll use a type signature\n-- of `a -> b` instead.\nforeign import _unsafePartial :: forall a b. a -> b\n\n-- | Discharge a partiality constraint, unsafely.\nunsafePartial :: forall a. (Partial => a) -> a\nunsafePartial = _unsafePartial\n\n-- | A function which crashes with the specified error message.\nunsafeCrashWith :: forall a. String -> a\nunsafeCrashWith msg = unsafePartial (crashWith msg)\n", "module Data.List.NonEmpty\n ( module Data.List.Types\n , toUnfoldable\n , fromFoldable\n , fromList\n , toList\n , singleton\n , length\n , cons\n , cons'\n , snoc\n , snoc'\n , head\n , last\n , tail\n , init\n , uncons\n , unsnoc\n , (!!), index\n , elemIndex\n , elemLastIndex\n , findIndex\n , findLastIndex\n , insertAt\n , updateAt\n , modifyAt\n , reverse\n , concat\n , concatMap\n , filter\n , filterM\n , mapMaybe\n , catMaybes\n , appendFoldable\n , sort\n , sortBy\n , take\n , takeWhile\n , drop\n , dropWhile\n , span\n , group\n , groupAll\n , groupBy\n , groupAllBy\n , partition\n , nub\n , nubBy\n , nubEq\n , nubByEq\n , union\n , unionBy\n , intersect\n , intersectBy\n , zipWith\n , zipWithA\n , zip\n , unzip\n , foldM\n , module Exports\n ) where\n\nimport Prelude\n\nimport Data.Foldable (class Foldable)\nimport Data.List ((:))\nimport Data.List as L\nimport Data.List.Types (NonEmptyList(..))\nimport Data.Maybe (Maybe(..), fromMaybe, maybe)\nimport Data.NonEmpty ((:|))\nimport Data.NonEmpty as NE\nimport Data.Semigroup.Traversable (sequence1)\nimport Data.Tuple (Tuple(..), fst, snd)\nimport Data.Unfoldable (class Unfoldable, unfoldr)\nimport Partial.Unsafe (unsafeCrashWith)\n\nimport Data.Foldable (foldl, foldr, foldMap, fold, intercalate, elem, notElem, find, findMap, any, all) as Exports\nimport Data.Semigroup.Foldable (fold1, foldMap1, for1_, sequence1_, traverse1_) as Exports\nimport Data.Semigroup.Traversable (sequence1, traverse1, traverse1Default) as Exports\nimport Data.Traversable (scanl, scanr) as Exports\n\n-- | Internal function: any operation on a list that is guaranteed not to delete\n-- | all elements also applies to a NEL, this function is a helper for defining\n-- | those cases.\nwrappedOperation\n :: forall a b\n . String\n -> (L.List a -> L.List b)\n -> NonEmptyList a\n -> NonEmptyList b\nwrappedOperation name f (NonEmptyList (x :| xs)) =\n case f (x : xs) of\n x' : xs' -> NonEmptyList (x' :| xs')\n L.Nil -> unsafeCrashWith (\"Impossible: empty list in NonEmptyList \" <> name)\n\n-- | Like `wrappedOperation`, but for functions that operate on 2 lists.\nwrappedOperation2\n :: forall a b c\n . String\n -> (L.List a -> L.List b -> L.List c)\n -> NonEmptyList a\n -> NonEmptyList b\n -> NonEmptyList c\nwrappedOperation2 name f (NonEmptyList (x :| xs)) (NonEmptyList (y :| ys)) =\n case f (x : xs) (y : ys) of\n x' : xs' -> NonEmptyList (x' :| xs')\n L.Nil -> unsafeCrashWith (\"Impossible: empty list in NonEmptyList \" <> name)\n\n-- | Lifts a function that operates on a list to work on a NEL. This does not\n-- | preserve the non-empty status of the result.\nlift :: forall a b. (L.List a -> b) -> NonEmptyList a -> b\nlift f (NonEmptyList (x :| xs)) = f (x : xs)\n\ntoUnfoldable :: forall f. Unfoldable f => NonEmptyList ~> f\ntoUnfoldable =\n unfoldr (\\xs -> (\\rec -> Tuple rec.head rec.tail) <$> L.uncons xs) <<< toList\n\nfromFoldable :: forall f a. Foldable f => f a -> Maybe (NonEmptyList a)\nfromFoldable = fromList <<< L.fromFoldable\n\nfromList :: forall a. L.List a -> Maybe (NonEmptyList a)\nfromList L.Nil = Nothing\nfromList (x : xs) = Just (NonEmptyList (x :| xs))\n\ntoList :: NonEmptyList ~> L.List\ntoList (NonEmptyList (x :| xs)) = x : xs\n\nsingleton :: forall a. a -> NonEmptyList a\nsingleton = NonEmptyList <<< NE.singleton\n\ncons :: forall a. a -> NonEmptyList a -> NonEmptyList a\ncons y (NonEmptyList (x :| xs)) = NonEmptyList (y :| x : xs)\n\ncons' :: forall a. a -> L.List a -> NonEmptyList a\ncons' x xs = NonEmptyList (x :| xs)\n\nsnoc :: forall a. NonEmptyList a -> a -> NonEmptyList a\nsnoc (NonEmptyList (x :| xs)) y = NonEmptyList (x :| L.snoc xs y)\n\nsnoc' :: forall a. L.List a -> a -> NonEmptyList a\nsnoc' (x : xs) y = NonEmptyList (x :| L.snoc xs y)\nsnoc' L.Nil y = singleton y\n\nhead :: forall a. NonEmptyList a -> a\nhead (NonEmptyList (x :| _)) = x\n\nlast :: forall a. NonEmptyList a -> a\nlast (NonEmptyList (x :| xs)) = fromMaybe x (L.last xs)\n\ntail :: NonEmptyList ~> L.List\ntail (NonEmptyList (_ :| xs)) = xs\n\ninit :: NonEmptyList ~> L.List\ninit (NonEmptyList (x :| xs)) = maybe L.Nil (x : _) (L.init xs)\n\nuncons :: forall a. NonEmptyList a -> { head :: a, tail :: L.List a }\nuncons (NonEmptyList (x :| xs)) = { head: x, tail: xs }\n\nunsnoc :: forall a. NonEmptyList a -> { init :: L.List a, last :: a }\nunsnoc (NonEmptyList (x :| xs)) = case L.unsnoc xs of\n Nothing -> { init: L.Nil, last: x }\n Just un -> { init: x : un.init, last: un.last }\n\nlength :: forall a. NonEmptyList a -> Int\nlength (NonEmptyList (_ :| xs)) = 1 + L.length xs\n\nindex :: forall a. NonEmptyList a -> Int -> Maybe a\nindex (NonEmptyList (x :| xs)) i\n | i == 0 = Just x\n | otherwise = L.index xs (i - 1)\n\ninfixl 8 index as !!\n\nelemIndex :: forall a. Eq a => a -> NonEmptyList a -> Maybe Int\nelemIndex x = findIndex (_ == x)\n\nelemLastIndex :: forall a. Eq a => a -> NonEmptyList a -> Maybe Int\nelemLastIndex x = findLastIndex (_ == x)\n\nfindIndex :: forall a. (a -> Boolean) -> NonEmptyList a -> Maybe Int\nfindIndex f (NonEmptyList (x :| xs))\n | f x = Just 0\n | otherwise = (_ + 1) <$> L.findIndex f xs\n\nfindLastIndex :: forall a. (a -> Boolean) -> NonEmptyList a -> Maybe Int\nfindLastIndex f (NonEmptyList (x :| xs)) =\n case L.findLastIndex f xs of\n Just i -> Just (i + 1)\n Nothing\n | f x -> Just 0\n | otherwise -> Nothing\n\ninsertAt :: forall a. Int -> a -> NonEmptyList a -> Maybe (NonEmptyList a)\ninsertAt i a (NonEmptyList (x :| xs))\n | i == 0 = Just (NonEmptyList (a :| x : xs))\n | otherwise = NonEmptyList <<< (x :| _) <$> L.insertAt (i - 1) a xs\n\nupdateAt :: forall a. Int -> a -> NonEmptyList a -> Maybe (NonEmptyList a)\nupdateAt i a (NonEmptyList (x :| xs))\n | i == 0 = Just (NonEmptyList (a :| xs))\n | otherwise = NonEmptyList <<< (x :| _) <$> L.updateAt (i - 1) a xs\n\nmodifyAt :: forall a. Int -> (a -> a) -> NonEmptyList a -> Maybe (NonEmptyList a)\nmodifyAt i f (NonEmptyList (x :| xs))\n | i == 0 = Just (NonEmptyList (f x :| xs))\n | otherwise = NonEmptyList <<< (x :| _) <$> L.modifyAt (i - 1) f xs\n\nreverse :: forall a. NonEmptyList a -> NonEmptyList a\nreverse = wrappedOperation \"reverse\" L.reverse\n\nfilter :: forall a. (a -> Boolean) -> NonEmptyList a -> L.List a\nfilter = lift <<< L.filter\n\nfilterM :: forall m a. Monad m => (a -> m Boolean) -> NonEmptyList a -> m (L.List a)\nfilterM = lift <<< L.filterM\n\nmapMaybe :: forall a b. (a -> Maybe b) -> NonEmptyList a -> L.List b\nmapMaybe = lift <<< L.mapMaybe\n\ncatMaybes :: forall a. NonEmptyList (Maybe a) -> L.List a\ncatMaybes = lift L.catMaybes\n\nconcat :: forall a. NonEmptyList (NonEmptyList a) -> NonEmptyList a\nconcat = (_ >>= identity)\n\nconcatMap :: forall a b. (a -> NonEmptyList b) -> NonEmptyList a -> NonEmptyList b\nconcatMap = flip bind\n\nappendFoldable :: forall t a. Foldable t => NonEmptyList a -> t a -> NonEmptyList a\nappendFoldable (NonEmptyList (x :| xs)) ys =\n NonEmptyList (x :| (xs <> L.fromFoldable ys))\n\nsort :: forall a. Ord a => NonEmptyList a -> NonEmptyList a\nsort xs = sortBy compare xs\n\nsortBy :: forall a. (a -> a -> Ordering) -> NonEmptyList a -> NonEmptyList a\nsortBy = wrappedOperation \"sortBy\" <<< L.sortBy\n\ntake :: forall a. Int -> NonEmptyList a -> L.List a\ntake = lift <<< L.take\n\ntakeWhile :: forall a. (a -> Boolean) -> NonEmptyList a -> L.List a\ntakeWhile = lift <<< L.takeWhile\n\ndrop :: forall a. Int -> NonEmptyList a -> L.List a\ndrop = lift <<< L.drop\n\ndropWhile :: forall a. (a -> Boolean) -> NonEmptyList a -> L.List a\ndropWhile = lift <<< L.dropWhile\n\nspan :: forall a. (a -> Boolean) -> NonEmptyList a -> { init :: L.List a, rest :: L.List a }\nspan = lift <<< L.span\n\ngroup :: forall a. Eq a => NonEmptyList a -> NonEmptyList (NonEmptyList a)\ngroup = wrappedOperation \"group\" L.group\n\ngroupAll :: forall a. Ord a => NonEmptyList a -> NonEmptyList (NonEmptyList a)\ngroupAll = wrappedOperation \"groupAll\" L.groupAll\n\ngroupBy :: forall a. (a -> a -> Boolean) -> NonEmptyList a -> NonEmptyList (NonEmptyList a)\ngroupBy = wrappedOperation \"groupBy\" <<< L.groupBy\n\ngroupAllBy :: forall a. (a -> a -> Ordering) -> NonEmptyList a -> NonEmptyList (NonEmptyList a)\ngroupAllBy = wrappedOperation \"groupAllBy\" <<< L.groupAllBy\n\npartition :: forall a. (a -> Boolean) -> NonEmptyList a -> { yes :: L.List a, no :: L.List a }\npartition = lift <<< L.partition\n\nnub :: forall a. Ord a => NonEmptyList a -> NonEmptyList a\nnub = wrappedOperation \"nub\" L.nub\n\nnubBy :: forall a. (a -> a -> Ordering) -> NonEmptyList a -> NonEmptyList a\nnubBy = wrappedOperation \"nubBy\" <<< L.nubBy\n\nnubEq :: forall a. Eq a => NonEmptyList a -> NonEmptyList a\nnubEq = wrappedOperation \"nubEq\" L.nubEq\n\nnubByEq :: forall a. (a -> a -> Boolean) -> NonEmptyList a -> NonEmptyList a\nnubByEq = wrappedOperation \"nubByEq\" <<< L.nubByEq\n\nunion :: forall a. Eq a => NonEmptyList a -> NonEmptyList a -> NonEmptyList a\nunion = wrappedOperation2 \"union\" L.union\n\nunionBy :: forall a. (a -> a -> Boolean) -> NonEmptyList a -> NonEmptyList a -> NonEmptyList a\nunionBy = wrappedOperation2 \"unionBy\" <<< L.unionBy\n\nintersect :: forall a. Eq a => NonEmptyList a -> NonEmptyList a -> NonEmptyList a\nintersect = wrappedOperation2 \"intersect\" L.intersect\n\nintersectBy :: forall a. (a -> a -> Boolean) -> NonEmptyList a -> NonEmptyList a -> NonEmptyList a\nintersectBy = wrappedOperation2 \"intersectBy\" <<< L.intersectBy\n\nzipWith :: forall a b c. (a -> b -> c) -> NonEmptyList a -> NonEmptyList b -> NonEmptyList c\nzipWith f (NonEmptyList (x :| xs)) (NonEmptyList (y :| ys)) =\n NonEmptyList (f x y :| L.zipWith f xs ys)\n\nzipWithA :: forall m a b c. Applicative m => (a -> b -> m c) -> NonEmptyList a -> NonEmptyList b -> m (NonEmptyList c)\nzipWithA f xs ys = sequence1 (zipWith f xs ys)\n\nzip :: forall a b. NonEmptyList a -> NonEmptyList b -> NonEmptyList (Tuple a b)\nzip = zipWith Tuple\n\nunzip :: forall a b. NonEmptyList (Tuple a b) -> Tuple (NonEmptyList a) (NonEmptyList b)\nunzip ts = Tuple (map fst ts) (map snd ts)\n\nfoldM :: forall m a b. Monad m => (b -> a -> m b) -> b -> NonEmptyList a -> m b\nfoldM f b (NonEmptyList (a :| as)) = f b a >>= \\b' -> L.foldM f b' as\n", "export const fromCharArray = function (a) {\n return a.join(\"\");\n};\n\nexport const toCharArray = function (s) {\n return s.split(\"\");\n};\n\nexport const singleton = function (c) {\n return c;\n};\n\nexport const _charAt = function (just) {\n return function (nothing) {\n return function (i) {\n return function (s) {\n return i >= 0 && i < s.length ? just(s.charAt(i)) : nothing;\n };\n };\n };\n};\n\nexport const _toChar = function (just) {\n return function (nothing) {\n return function (s) {\n return s.length === 1 ? just(s) : nothing;\n };\n };\n};\n\nexport const length = function (s) {\n return s.length;\n};\n\nexport const countPrefix = function (p) {\n return function (s) {\n var i = 0;\n while (i < s.length && p(s.charAt(i))) i++;\n return i;\n };\n};\n\nexport const _indexOf = function (just) {\n return function (nothing) {\n return function (x) {\n return function (s) {\n var i = s.indexOf(x);\n return i === -1 ? nothing : just(i);\n };\n };\n };\n};\n\nexport const _indexOfStartingAt = function (just) {\n return function (nothing) {\n return function (x) {\n return function (startAt) {\n return function (s) {\n if (startAt < 0 || startAt > s.length) return nothing;\n var i = s.indexOf(x, startAt);\n return i === -1 ? nothing : just(i);\n };\n };\n };\n };\n};\n\nexport const _lastIndexOf = function (just) {\n return function (nothing) {\n return function (x) {\n return function (s) {\n var i = s.lastIndexOf(x);\n return i === -1 ? nothing : just(i);\n };\n };\n };\n};\n\nexport const _lastIndexOfStartingAt = function (just) {\n return function (nothing) {\n return function (x) {\n return function (startAt) {\n return function (s) {\n var i = s.lastIndexOf(x, startAt);\n return i === -1 ? nothing : just(i);\n };\n };\n };\n };\n};\n\nexport const take = function (n) {\n return function (s) {\n return s.substr(0, n);\n };\n};\n\nexport const drop = function (n) {\n return function (s) {\n return s.substring(n);\n };\n};\n\nexport const slice = function (b) {\n return function (e) {\n return function (s) {\n return s.slice(b,e);\n };\n };\n};\n\nexport const splitAt = function (i) {\n return function (s) {\n return { before: s.substring(0, i), after: s.substring(i) };\n };\n};\n", "export const charAt = function (i) {\n return function (s) {\n if (i >= 0 && i < s.length) return s.charAt(i);\n throw new Error(\"Data.String.Unsafe.charAt: Invalid index.\");\n };\n};\n\nexport const char = function (s) {\n if (s.length === 1) return s.charAt(0);\n throw new Error(\"Data.String.Unsafe.char: Expected string of length 1.\");\n};\n", "module Data.String.CodeUnits\n ( stripPrefix\n , stripSuffix\n , contains\n , singleton\n , fromCharArray\n , toCharArray\n , charAt\n , toChar\n , uncons\n , length\n , countPrefix\n , indexOf\n , indexOf'\n , lastIndexOf\n , lastIndexOf'\n , take\n , takeRight\n , takeWhile\n , drop\n , dropRight\n , dropWhile\n , slice\n , splitAt\n ) where\n\nimport Prelude\n\nimport Data.Maybe (Maybe(..), isJust)\nimport Data.String.Pattern (Pattern(..))\nimport Data.String.Unsafe as U\n\n-------------------------------------------------------------------------------\n-- `stripPrefix`, `stripSuffix`, and `contains` are CodeUnit/CodePoint agnostic\n-- as they are based on patterns rather than lengths/indices, but they need to\n-- be defined in here to avoid a circular module dependency\n-------------------------------------------------------------------------------\n\n-- | If the string starts with the given prefix, return the portion of the\n-- | string left after removing it, as a `Just` value. Otherwise, return `Nothing`.\n-- |\n-- | ```purescript\n-- | stripPrefix (Pattern \"http:\") \"http://purescript.org\" == Just \"//purescript.org\"\n-- | stripPrefix (Pattern \"http:\") \"https://purescript.org\" == Nothing\n-- | ```\nstripPrefix :: Pattern -> String -> Maybe String\nstripPrefix (Pattern prefix) str =\n let { before, after } = splitAt (length prefix) str in\n if before == prefix then Just after else Nothing\n\n-- | If the string ends with the given suffix, return the portion of the\n-- | string left after removing it, as a `Just` value. Otherwise, return\n-- | `Nothing`.\n-- |\n-- | ```purescript\n-- | stripSuffix (Pattern \".exe\") \"psc.exe\" == Just \"psc\"\n-- | stripSuffix (Pattern \".exe\") \"psc\" == Nothing\n-- | ```\nstripSuffix :: Pattern -> String -> Maybe String\nstripSuffix (Pattern suffix) str =\n let { before, after } = splitAt (length str - length suffix) str in\n if after == suffix then Just before else Nothing\n\n-- | Checks whether the pattern appears in the given string.\n-- |\n-- | ```purescript\n-- | contains (Pattern \"needle\") \"haystack with needle\" == true\n-- | contains (Pattern \"needle\") \"haystack\" == false\n-- | ```\ncontains :: Pattern -> String -> Boolean\ncontains pat = isJust <<< indexOf pat\n\n-------------------------------------------------------------------------------\n-- all functions past this point are CodeUnit specific\n-------------------------------------------------------------------------------\n\n-- | Returns a string of length `1` containing the given character.\n-- |\n-- | ```purescript\n-- | singleton 'l' == \"l\"\n-- | ```\n-- |\nforeign import singleton :: Char -> String\n\n-- | Converts an array of characters into a string.\n-- |\n-- | ```purescript\n-- | fromCharArray ['H', 'e', 'l', 'l', 'o'] == \"Hello\"\n-- | ```\nforeign import fromCharArray :: Array Char -> String\n\n-- | Converts the string into an array of characters.\n-- |\n-- | ```purescript\n-- | toCharArray \"Hello\u263A\\n\" == ['H','e','l','l','o','\u263A','\\n']\n-- | ```\nforeign import toCharArray :: String -> Array Char\n\n-- | Returns the character at the given index, if the index is within bounds.\n-- |\n-- | ```purescript\n-- | charAt 2 \"Hello\" == Just 'l'\n-- | charAt 10 \"Hello\" == Nothing\n-- | ```\n-- |\ncharAt :: Int -> String -> Maybe Char\ncharAt = _charAt Just Nothing\n\nforeign import _charAt\n :: (forall a. a -> Maybe a)\n -> (forall a. Maybe a)\n -> Int\n -> String\n -> Maybe Char\n\n-- | Converts the string to a character, if the length of the string is\n-- | exactly `1`.\n-- |\n-- | ```purescript\n-- | toChar \"l\" == Just 'l'\n-- | toChar \"Hi\" == Nothing -- since length is not 1\n-- | ```\ntoChar :: String -> Maybe Char\ntoChar = _toChar Just Nothing\n\nforeign import _toChar\n :: (forall a. a -> Maybe a)\n -> (forall a. Maybe a)\n -> String\n -> Maybe Char\n\n-- | Returns the first character and the rest of the string,\n-- | if the string is not empty.\n-- |\n-- | ```purescript\n-- | uncons \"\" == Nothing\n-- | uncons \"Hello World\" == Just { head: 'H', tail: \"ello World\" }\n-- | ```\n-- |\nuncons :: String -> Maybe { head :: Char, tail :: String }\nuncons \"\" = Nothing\nuncons s = Just { head: U.charAt zero s, tail: drop one s }\n\n-- | Returns the number of characters the string is composed of.\n-- |\n-- | ```purescript\n-- | length \"Hello World\" == 11\n-- | ```\n-- |\nforeign import length :: String -> Int\n\n-- | Returns the number of contiguous characters at the beginning\n-- | of the string for which the predicate holds.\n-- |\n-- | ```purescript\n-- | countPrefix (_ /= ' ') \"Hello World\" == 5 -- since length \"Hello\" == 5\n-- | ```\n-- |\nforeign import countPrefix :: (Char -> Boolean) -> String -> Int\n\n-- | Returns the index of the first occurrence of the pattern in the\n-- | given string. Returns `Nothing` if there is no match.\n-- |\n-- | ```purescript\n-- | indexOf (Pattern \"c\") \"abcdc\" == Just 2\n-- | indexOf (Pattern \"c\") \"aaa\" == Nothing\n-- | ```\n-- |\nindexOf :: Pattern -> String -> Maybe Int\nindexOf = _indexOf Just Nothing\n\nforeign import _indexOf\n :: (forall a. a -> Maybe a)\n -> (forall a. Maybe a)\n -> Pattern\n -> String\n -> Maybe Int\n\n-- | Returns the index of the first occurrence of the pattern in the\n-- | given string, starting at the specified index. Returns `Nothing` if there is\n-- | no match.\n-- |\n-- | ```purescript\n-- | indexOf' (Pattern \"a\") 2 \"ababa\" == Just 2\n-- | indexOf' (Pattern \"a\") 3 \"ababa\" == Just 4\n-- | ```\n-- |\nindexOf' :: Pattern -> Int -> String -> Maybe Int\nindexOf' = _indexOfStartingAt Just Nothing\n\nforeign import _indexOfStartingAt\n :: (forall a. a -> Maybe a)\n -> (forall a. Maybe a)\n -> Pattern\n -> Int\n -> String\n -> Maybe Int\n\n-- | Returns the index of the last occurrence of the pattern in the\n-- | given string. Returns `Nothing` if there is no match.\n-- |\n-- | ```purescript\n-- | lastIndexOf (Pattern \"c\") \"abcdc\" == Just 4\n-- | lastIndexOf (Pattern \"c\") \"aaa\" == Nothing\n-- | ```\n-- |\nlastIndexOf :: Pattern -> String -> Maybe Int\nlastIndexOf = _lastIndexOf Just Nothing\n\nforeign import _lastIndexOf\n :: (forall a. a -> Maybe a)\n -> (forall a. Maybe a)\n -> Pattern\n -> String\n -> Maybe Int\n\n-- | Returns the index of the last occurrence of the pattern in the\n-- | given string, starting at the specified index and searching\n-- | backwards towards the beginning of the string.\n-- |\n-- | Starting at a negative index is equivalent to starting at 0 and\n-- | starting at an index greater than the string length is equivalent\n-- | to searching in the whole string.\n-- |\n-- | Returns `Nothing` if there is no match.\n-- |\n-- | ```purescript\n-- | lastIndexOf' (Pattern \"a\") (-1) \"ababa\" == Just 0\n-- | lastIndexOf' (Pattern \"a\") 1 \"ababa\" == Just 0\n-- | lastIndexOf' (Pattern \"a\") 3 \"ababa\" == Just 2\n-- | lastIndexOf' (Pattern \"a\") 4 \"ababa\" == Just 4\n-- | lastIndexOf' (Pattern \"a\") 5 \"ababa\" == Just 4\n-- | ```\n-- |\nlastIndexOf' :: Pattern -> Int -> String -> Maybe Int\nlastIndexOf' = _lastIndexOfStartingAt Just Nothing\n\nforeign import _lastIndexOfStartingAt\n :: (forall a. a -> Maybe a)\n -> (forall a. Maybe a)\n -> Pattern\n -> Int\n -> String\n -> Maybe Int\n\n-- | Returns the first `n` characters of the string.\n-- |\n-- | ```purescript\n-- | take 5 \"Hello World\" == \"Hello\"\n-- | ```\n-- |\nforeign import take :: Int -> String -> String\n\n-- | Returns the last `n` characters of the string.\n-- |\n-- | ```purescript\n-- | takeRight 5 \"Hello World\" == \"World\"\n-- | ```\n-- |\ntakeRight :: Int -> String -> String\ntakeRight i s = drop (length s - i) s\n\n-- | Returns the longest prefix (possibly empty) of characters that satisfy\n-- | the predicate.\n-- |\n-- | ```purescript\n-- | takeWhile (_ /= ':') \"http://purescript.org\" == \"http\"\n-- | ```\n-- |\ntakeWhile :: (Char -> Boolean) -> String -> String\ntakeWhile p s = take (countPrefix p s) s\n\n-- | Returns the string without the first `n` characters.\n-- |\n-- | ```purescript\n-- | drop 6 \"Hello World\" == \"World\"\n-- | ```\n-- |\nforeign import drop :: Int -> String -> String\n\n-- | Returns the string without the last `n` characters.\n-- |\n-- | ```purescript\n-- | dropRight 6 \"Hello World\" == \"Hello\"\n-- | ```\n-- |\ndropRight :: Int -> String -> String\ndropRight i s = take (length s - i) s\n\n-- | Returns the suffix remaining after `takeWhile`.\n-- |\n-- | ```purescript\n-- | dropWhile (_ /= '.') \"Test.purs\" == \".purs\"\n-- | ```\n-- |\ndropWhile :: (Char -> Boolean) -> String -> String\ndropWhile p s = drop (countPrefix p s) s\n\n-- | Returns the substring at indices `[begin, end)`.\n-- | If either index is negative, it is normalised to `length s - index`,\n-- | where `s` is the input string. `\"\"` is returned if either\n-- | index is out of bounds or if `begin > end` after normalisation.\n-- |\n-- | ```purescript\n-- | slice 0 0 \"purescript\" == \"\"\n-- | slice 0 1 \"purescript\" == \"p\"\n-- | slice 3 6 \"purescript\" == \"esc\"\n-- | slice (-4) (-1) \"purescript\" == \"rip\"\n-- | slice (-4) 3 \"purescript\" == \"\"\n-- | ```\nforeign import slice :: Int -> Int -> String -> String\n\n-- | Splits a string into two substrings, where `before` contains the\n-- | characters up to (but not including) the given index, and `after` contains\n-- | the rest of the string, from that index on.\n-- |\n-- | ```purescript\n-- | splitAt 2 \"Hello World\" == { before: \"He\", after: \"llo World\"}\n-- | splitAt 10 \"Hi\" == { before: \"Hi\", after: \"\"}\n-- | ```\n-- |\n-- | Thus the length of `(splitAt i s).before` will equal either `i` or\n-- | `length s`, if that is shorter. (Or if `i` is negative the length will be\n-- | 0.)\n-- |\n-- | In code:\n-- | ```purescript\n-- | length (splitAt i s).before == min (max i 0) (length s)\n-- | (splitAt i s).before <> (splitAt i s).after == s\n-- | splitAt i s == {before: take i s, after: drop i s}\n-- | ```\nforeign import splitAt :: Int -> String -> { before :: String, after :: String }\n", "-- | This module defines types and functions for working with _foreign_\n-- | data.\n-- |\n-- | `ExceptT (NonEmptyList ForeignError) m` is used in this library\n-- | to encode possible failures when dealing with foreign data.\n-- |\n-- | The `Alt` instance for `ExceptT` allows us to accumulate errors,\n-- | unlike `Either`, which preserves only the last error.\nmodule Foreign\n ( Foreign\n , ForeignError(..)\n , MultipleErrors(..)\n , F\n , FT\n , renderForeignError\n , unsafeToForeign\n , unsafeFromForeign\n , unsafeReadTagged\n , typeOf\n , tagOf\n , isNull\n , isUndefined\n , isArray\n , readString\n , readChar\n , readBoolean\n , readNumber\n , readInt\n , readArray\n , readNull\n , readUndefined\n , readNullOrUndefined\n , fail\n ) where\n\nimport Prelude\n\nimport Control.Monad.Except (Except, ExceptT, mapExceptT, throwError)\nimport Data.Either (Either(..), either)\nimport Data.Int as Int\nimport Data.List.NonEmpty (NonEmptyList)\nimport Data.List.NonEmpty as NEL\nimport Data.Maybe (Maybe(..), maybe)\nimport Data.String.CodeUnits (toChar)\nimport Unsafe.Coerce (unsafeCoerce)\n\n-- | A type for _foreign data_.\n-- |\n-- | Foreign data is data from any external _unknown_ or _unreliable_\n-- | source, for which it cannot be guaranteed that the runtime representation\n-- | conforms to that of any particular type.\n-- |\n-- | Suitable applications of `Foreign` are\n-- |\n-- | - To represent responses from web services\n-- | - To integrate with external JavaScript libraries.\nforeign import data Foreign :: Type\n\n-- | A type for foreign type errors\ndata ForeignError\n = ForeignError String\n | TypeMismatch String String\n | ErrorAtIndex Int ForeignError\n | ErrorAtProperty String ForeignError\n\nderive instance eqForeignError :: Eq ForeignError\nderive instance ordForeignError :: Ord ForeignError\n\ninstance showForeignError :: Show ForeignError where\n show (ForeignError msg) = \"(ForeignError \" <> show msg <> \")\"\n show (ErrorAtIndex i e) = \"(ErrorAtIndex \" <> show i <> \" \" <> show e <> \")\"\n show (ErrorAtProperty prop e) = \"(ErrorAtProperty \" <> show prop <> \" \" <> show e <> \")\"\n show (TypeMismatch exps act) = \"(TypeMismatch \" <> show exps <> \" \" <> show act <> \")\"\n\n-- | A type for accumulating multiple `ForeignError`s.\ntype MultipleErrors = NonEmptyList ForeignError\n\nrenderForeignError :: ForeignError -> String\nrenderForeignError (ForeignError msg) = msg\nrenderForeignError (ErrorAtIndex i e) = \"Error at array index \" <> show i <> \": \" <> renderForeignError e\nrenderForeignError (ErrorAtProperty prop e) = \"Error at property \" <> show prop <> \": \" <> renderForeignError e\nrenderForeignError (TypeMismatch exp act) = \"Type mismatch: expected \" <> exp <> \", found \" <> act\n\n-- | While this alias is not deprecated, it is recommended\n-- | that one use `Except (NonEmptyList ForeignError)` directly\n-- | for all future usages rather than this type alias.\n-- |\n-- | An error monad, used in this library to encode possible failures when\n-- | dealing with foreign data.\n-- |\n-- | The `Alt` instance for `Except` allows us to accumulate errors,\n-- | unlike `Either`, which preserves only the last error.\ntype F = Except MultipleErrors\n\n-- | While this alias is not deprecated, it is recommended\n-- | that one use `ExceptT (NonEmptyList ForeignError)` directly\n-- | for all future usages rather than this type alias.\ntype FT = ExceptT MultipleErrors\n\n-- | Coerce any value to the a `Foreign` value.\n-- |\n-- | This is considered unsafe as it's only intended to be used on primitive\n-- | JavaScript types, rather than PureScript types. Exporting PureScript values\n-- | via the FFI can be dangerous as they can be mutated by code outside the\n-- | PureScript program, resulting in difficult to diagnose problems elsewhere.\nunsafeToForeign :: forall a. a -> Foreign\nunsafeToForeign = unsafeCoerce\n\n-- | Unsafely coerce a `Foreign` value.\nunsafeFromForeign :: forall a. Foreign -> a\nunsafeFromForeign = unsafeCoerce\n\n-- | Read the Javascript _type_ of a value\nforeign import typeOf :: Foreign -> String\n\n-- | Read the Javascript _tag_ of a value.\n-- |\n-- | This function wraps the `Object.toString` method.\nforeign import tagOf :: Foreign -> String\n\n-- | Unsafely coerce a `Foreign` value when the value has a particular `tagOf`\n-- | value.\nunsafeReadTagged :: forall m a. Monad m => String -> Foreign -> ExceptT (NonEmptyList ForeignError) m a\nunsafeReadTagged tag value\n | tagOf value == tag = pure (unsafeFromForeign value)\n | otherwise = fail $ TypeMismatch tag (tagOf value)\n\n-- | Test whether a foreign value is null\nforeign import isNull :: Foreign -> Boolean\n\n-- | Test whether a foreign value is undefined\nforeign import isUndefined :: Foreign -> Boolean\n\n-- | Test whether a foreign value is an array\nforeign import isArray :: Foreign -> Boolean\n\n-- | Attempt to coerce a foreign value to a `String`.\nreadString :: forall m. Monad m => Foreign -> ExceptT (NonEmptyList ForeignError) m String\nreadString = unsafeReadTagged \"String\"\n\n-- | Attempt to coerce a foreign value to a `Char`.\nreadChar :: forall m. Monad m => Foreign -> ExceptT (NonEmptyList ForeignError) m Char\nreadChar value = mapExceptT (map $ either (const error) fromString) (readString value)\n where\n fromString = maybe error pure <<< toChar\n error = Left $ NEL.singleton $ TypeMismatch \"Char\" (tagOf value)\n\n-- | Attempt to coerce a foreign value to a `Boolean`.\nreadBoolean :: forall m. Monad m => Foreign -> ExceptT (NonEmptyList ForeignError) m Boolean\nreadBoolean = unsafeReadTagged \"Boolean\"\n\n-- | Attempt to coerce a foreign value to a `Number`.\nreadNumber :: forall m. Monad m => Foreign -> ExceptT (NonEmptyList ForeignError) m Number\nreadNumber = unsafeReadTagged \"Number\"\n\n-- | Attempt to coerce a foreign value to an `Int`.\nreadInt :: forall m. Monad m => Foreign -> ExceptT (NonEmptyList ForeignError) m Int\nreadInt value = mapExceptT (map $ either (const error) fromNumber) (readNumber value)\n where\n fromNumber = maybe error pure <<< Int.fromNumber\n error = Left $ NEL.singleton $ TypeMismatch \"Int\" (tagOf value)\n\n-- | Attempt to coerce a foreign value to an array.\nreadArray :: forall m. Monad m => Foreign -> ExceptT (NonEmptyList ForeignError) m (Array Foreign)\nreadArray value\n | isArray value = pure $ unsafeFromForeign value\n | otherwise = fail $ TypeMismatch \"array\" (tagOf value)\n\nreadNull :: forall m. Monad m => Foreign -> ExceptT (NonEmptyList ForeignError) m (Maybe Foreign)\nreadNull value\n | isNull value = pure Nothing\n | otherwise = pure (Just value)\n\nreadUndefined :: forall m. Monad m => Foreign -> ExceptT (NonEmptyList ForeignError) m (Maybe Foreign)\nreadUndefined value\n | isUndefined value = pure Nothing\n | otherwise = pure (Just value)\n\nreadNullOrUndefined :: forall m. Monad m => Foreign -> ExceptT (NonEmptyList ForeignError) m (Maybe Foreign)\nreadNullOrUndefined value\n | isNull value || isUndefined value = pure Nothing\n | otherwise = pure (Just value)\n\n-- | Throws a failure error in `ExceptT (NonEmptyList ForeignError) m`.\nfail :: forall m a. Monad m => ForeignError -> ExceptT (NonEmptyList ForeignError) m a\nfail = throwError <<< NEL.singleton\n", "export function _copyST(m) {\n return function () {\n var r = {};\n for (var k in m) {\n if (hasOwnProperty.call(m, k)) {\n r[k] = m[k];\n }\n }\n return r;\n };\n}\n\nexport const empty = {};\n\nexport function runST(f) {\n return f();\n}\n\nexport function _fmapObject(m0, f) {\n var m = {};\n for (var k in m0) {\n if (hasOwnProperty.call(m0, k)) {\n m[k] = f(m0[k]);\n }\n }\n return m;\n}\n\nexport function _mapWithKey(m0, f) {\n var m = {};\n for (var k in m0) {\n if (hasOwnProperty.call(m0, k)) {\n m[k] = f(k)(m0[k]);\n }\n }\n return m;\n}\n\nexport function _foldM(bind) {\n return function (f) {\n return function (mz) {\n return function (m) {\n var acc = mz;\n function g(k) {\n return function (z) {\n return f(z)(k)(m[k]);\n };\n }\n for (var k in m) {\n if (hasOwnProperty.call(m, k)) {\n acc = bind(acc)(g(k));\n }\n }\n return acc;\n };\n };\n };\n}\n\nexport function _foldSCObject(m, z, f, fromMaybe) {\n var acc = z;\n for (var k in m) {\n if (hasOwnProperty.call(m, k)) {\n var maybeR = f(acc)(k)(m[k]);\n var r = fromMaybe(null)(maybeR);\n if (r === null) return acc;\n else acc = r;\n }\n }\n return acc;\n}\n\nexport function all(f) {\n return function (m) {\n for (var k in m) {\n if (hasOwnProperty.call(m, k) && !f(k)(m[k])) return false;\n }\n return true;\n };\n}\n\nexport function size(m) {\n var s = 0;\n for (var k in m) {\n if (hasOwnProperty.call(m, k)) {\n ++s;\n }\n }\n return s;\n}\n\nexport function _lookup(no, yes, k, m) {\n return k in m ? yes(m[k]) : no;\n}\n\nexport function _lookupST(no, yes, k, m) {\n return function () {\n return k in m ? yes(m[k]) : no;\n };\n}\n\nexport function toArrayWithKey(f) {\n return function (m) {\n var r = [];\n for (var k in m) {\n if (hasOwnProperty.call(m, k)) {\n r.push(f(k)(m[k]));\n }\n }\n return r;\n };\n}\n\nexport const keys = Object.keys || toArrayWithKey(function (k) {\n return function () { return k; };\n});\n", "//------------------------------------------------------------------------------\n// Array creation --------------------------------------------------------------\n//------------------------------------------------------------------------------\n\nexport const rangeImpl = function (start, end) {\n var step = start > end ? -1 : 1;\n var result = new Array(step * (end - start) + 1);\n var i = start, n = 0;\n while (i !== end) {\n result[n++] = i;\n i += step;\n }\n result[n] = i;\n return result;\n};\n\nvar replicateFill = function (count, value) {\n if (count < 1) {\n return [];\n }\n var result = new Array(count);\n return result.fill(value);\n};\n\nvar replicatePolyfill = function (count, value) {\n var result = [];\n var n = 0;\n for (var i = 0; i < count; i++) {\n result[n++] = value;\n }\n return result;\n};\n\n// In browsers that have Array.prototype.fill we use it, as it's faster.\nexport const replicateImpl = typeof Array.prototype.fill === \"function\" ? replicateFill : replicatePolyfill;\n\nexport const fromFoldableImpl = (function () {\n function Cons(head, tail) {\n this.head = head;\n this.tail = tail;\n }\n var emptyList = {};\n\n function curryCons(head) {\n return function (tail) {\n return new Cons(head, tail);\n };\n }\n\n function listToArray(list) {\n var result = [];\n var count = 0;\n var xs = list;\n while (xs !== emptyList) {\n result[count++] = xs.head;\n xs = xs.tail;\n }\n return result;\n }\n\n return function (foldr, xs) {\n return listToArray(foldr(curryCons)(emptyList)(xs));\n };\n})();\n\n//------------------------------------------------------------------------------\n// Array size ------------------------------------------------------------------\n//------------------------------------------------------------------------------\n\nexport const length = function (xs) {\n return xs.length;\n};\n\n//------------------------------------------------------------------------------\n// Non-indexed reads -----------------------------------------------------------\n//------------------------------------------------------------------------------\n\nexport const unconsImpl = function (empty, next, xs) {\n return xs.length === 0 ? empty({}) : next(xs[0])(xs.slice(1));\n};\n\n//------------------------------------------------------------------------------\n// Indexed operations ----------------------------------------------------------\n//------------------------------------------------------------------------------\n\nexport const indexImpl = function (just, nothing, xs, i) {\n return i < 0 || i >= xs.length ? nothing : just(xs[i]);\n};\n\nexport const findMapImpl = function (nothing, isJust, f, xs) {\n for (var i = 0; i < xs.length; i++) {\n var result = f(xs[i]);\n if (isJust(result)) return result;\n }\n return nothing;\n};\n\nexport const findIndexImpl = function (just, nothing, f, xs) {\n for (var i = 0, l = xs.length; i < l; i++) {\n if (f(xs[i])) return just(i);\n }\n return nothing;\n};\n\nexport const findLastIndexImpl = function (just, nothing, f, xs) {\n for (var i = xs.length - 1; i >= 0; i--) {\n if (f(xs[i])) return just(i);\n }\n return nothing;\n};\n\nexport const _insertAt = function (just, nothing, i, a, l) {\n if (i < 0 || i > l.length) return nothing;\n var l1 = l.slice();\n l1.splice(i, 0, a);\n return just(l1);\n};\n\nexport const _deleteAt = function (just, nothing, i, l) {\n if (i < 0 || i >= l.length) return nothing;\n var l1 = l.slice();\n l1.splice(i, 1);\n return just(l1);\n};\n\nexport const _updateAt = function (just, nothing, i, a, l) {\n if (i < 0 || i >= l.length) return nothing;\n var l1 = l.slice();\n l1[i] = a;\n return just(l1);\n};\n\n//------------------------------------------------------------------------------\n// Transformations -------------------------------------------------------------\n//------------------------------------------------------------------------------\n\nexport const reverse = function (l) {\n return l.slice().reverse();\n};\n\nexport const concat = function (xss) {\n if (xss.length <= 10000) {\n // This method is faster, but it crashes on big arrays.\n // So we use it when can and fallback to simple variant otherwise.\n return Array.prototype.concat.apply([], xss);\n }\n\n var result = [];\n for (var i = 0, l = xss.length; i < l; i++) {\n var xs = xss[i];\n for (var j = 0, m = xs.length; j < m; j++) {\n result.push(xs[j]);\n }\n }\n return result;\n};\n\nexport const filterImpl = function (f, xs) {\n return xs.filter(f);\n};\n\nexport const partitionImpl = function (f, xs) {\n var yes = [];\n var no = [];\n for (var i = 0; i < xs.length; i++) {\n var x = xs[i];\n if (f(x))\n yes.push(x);\n else\n no.push(x);\n }\n return { yes: yes, no: no };\n};\n\nexport const scanlImpl = function (f, b, xs) {\n var len = xs.length;\n var acc = b;\n var out = new Array(len);\n for (var i = 0; i < len; i++) {\n acc = f(acc)(xs[i]);\n out[i] = acc;\n }\n return out;\n};\n\nexport const scanrImpl = function (f, b, xs) {\n var len = xs.length;\n var acc = b;\n var out = new Array(len);\n for (var i = len - 1; i >= 0; i--) {\n acc = f(xs[i])(acc);\n out[i] = acc;\n }\n return out;\n};\n\n//------------------------------------------------------------------------------\n// Sorting ---------------------------------------------------------------------\n//------------------------------------------------------------------------------\n\nexport const sortByImpl = (function () {\n function mergeFromTo(compare, fromOrdering, xs1, xs2, from, to) {\n var mid;\n var i;\n var j;\n var k;\n var x;\n var y;\n var c;\n\n mid = from + ((to - from) >> 1);\n if (mid - from > 1) mergeFromTo(compare, fromOrdering, xs2, xs1, from, mid);\n if (to - mid > 1) mergeFromTo(compare, fromOrdering, xs2, xs1, mid, to);\n\n i = from;\n j = mid;\n k = from;\n while (i < mid && j < to) {\n x = xs2[i];\n y = xs2[j];\n c = fromOrdering(compare(x)(y));\n if (c > 0) {\n xs1[k++] = y;\n ++j;\n }\n else {\n xs1[k++] = x;\n ++i;\n }\n }\n while (i < mid) {\n xs1[k++] = xs2[i++];\n }\n while (j < to) {\n xs1[k++] = xs2[j++];\n }\n }\n\n return function (compare, fromOrdering, xs) {\n var out;\n\n if (xs.length < 2) return xs;\n\n out = xs.slice(0);\n mergeFromTo(compare, fromOrdering, out, xs.slice(0), 0, xs.length);\n\n return out;\n };\n})();\n\n//------------------------------------------------------------------------------\n// Subarrays -------------------------------------------------------------------\n//------------------------------------------------------------------------------\n\nexport const sliceImpl = function (s, e, l) {\n return l.slice(s, e);\n};\n\n//------------------------------------------------------------------------------\n// Zipping ---------------------------------------------------------------------\n//------------------------------------------------------------------------------\n\nexport const zipWithImpl = function (f, xs, ys) {\n var l = xs.length < ys.length ? xs.length : ys.length;\n var result = new Array(l);\n for (var i = 0; i < l; i++) {\n result[i] = f(xs[i])(ys[i]);\n }\n return result;\n};\n\n//------------------------------------------------------------------------------\n// Folding ---------------------------------------------------------------------\n//------------------------------------------------------------------------------\n\nexport const anyImpl = function (p, xs) {\n var len = xs.length;\n for (var i = 0; i < len; i++) {\n if (p(xs[i])) return true;\n }\n return false;\n};\n\nexport const allImpl = function (p, xs) {\n var len = xs.length;\n for (var i = 0; i < len; i++) {\n if (!p(xs[i])) return false;\n }\n return true;\n};\n\n//------------------------------------------------------------------------------\n// Partial ---------------------------------------------------------------------\n//------------------------------------------------------------------------------\n\nexport const unsafeIndexImpl = function (xs, n) {\n return xs[n];\n};\n", "function newSTArray() {\n return [];\n}\nexport { newSTArray as new };\n\nexport const peekImpl = function (just, nothing, i, xs) {\n return i >= 0 && i < xs.length ? just(xs[i]) : nothing;\n};\n\nexport const pokeImpl = function (i, a, xs) {\n var ret = i >= 0 && i < xs.length;\n if (ret) xs[i] = a;\n return ret;\n};\n\nexport const lengthImpl = function (xs) {\n return xs.length;\n};\n\nexport const popImpl = function (just, nothing, xs) {\n return xs.length > 0 ? just(xs.pop()) : nothing;\n};\n\nexport const pushAllImpl = function (as, xs) {\n return xs.push.apply(xs, as);\n};\n\nexport const shiftImpl = function (just, nothing, xs) {\n return xs.length > 0 ? just(xs.shift()) : nothing;\n};\n\nexport const unshiftAllImpl = function (as, xs) {\n return xs.unshift.apply(xs, as);\n};\n\nexport const spliceImpl = function (i, howMany, bs, xs) {\n return xs.splice.apply(xs, [i, howMany].concat(bs));\n};\n\nfunction unsafeFreezeThawImpl(xs) {\n return xs;\n}\n\nexport const unsafeFreezeImpl = unsafeFreezeThawImpl;\n\nexport const unsafeThawImpl = unsafeFreezeThawImpl;\n\nfunction copyImpl(xs) {\n return xs.slice();\n}\n\nexport const freezeImpl = copyImpl;\n\nexport const thawImpl = copyImpl;\n\nexport const cloneImpl = copyImpl;\n\nexport const sortByImpl = (function () {\n function mergeFromTo(compare, fromOrdering, xs1, xs2, from, to) {\n var mid;\n var i;\n var j;\n var k;\n var x;\n var y;\n var c;\n\n mid = from + ((to - from) >> 1);\n if (mid - from > 1) mergeFromTo(compare, fromOrdering, xs2, xs1, from, mid);\n if (to - mid > 1) mergeFromTo(compare, fromOrdering, xs2, xs1, mid, to);\n\n i = from;\n j = mid;\n k = from;\n while (i < mid && j < to) {\n x = xs2[i];\n y = xs2[j];\n c = fromOrdering(compare(x)(y));\n if (c > 0) {\n xs1[k++] = y;\n ++j;\n } else {\n xs1[k++] = x;\n ++i;\n }\n }\n while (i < mid) {\n xs1[k++] = xs2[i++];\n }\n while (j < to) {\n xs1[k++] = xs2[j++];\n }\n }\n\n return function (compare, fromOrdering, xs) {\n if (xs.length < 2) return xs;\n\n mergeFromTo(compare, fromOrdering, xs, xs.slice(0), 0, xs.length);\n\n return xs;\n };\n})();\n\nexport const toAssocArrayImpl = function (xs) {\n var n = xs.length;\n var as = new Array(n);\n for (var i = 0; i < n; i++) as[i] = { value: xs[i], index: i };\n return as;\n};\n\nexport const pushImpl = function (a, xs) {\n return xs.push(a);\n};\n", "export const mkSTFn1 = function mkSTFn1(fn) {\n return function(x) {\n return fn(x)();\n };\n};\n \nexport const mkSTFn2 = function mkSTFn2(fn) {\n return function(a, b) {\n return fn(a)(b)();\n };\n};\n \nexport const mkSTFn3 = function mkSTFn3(fn) {\n return function(a, b, c) {\n return fn(a)(b)(c)();\n };\n};\n \nexport const mkSTFn4 = function mkSTFn4(fn) {\n return function(a, b, c, d) {\n return fn(a)(b)(c)(d)();\n };\n};\n \nexport const mkSTFn5 = function mkSTFn5(fn) {\n return function(a, b, c, d, e) {\n return fn(a)(b)(c)(d)(e)();\n };\n};\n \nexport const mkSTFn6 = function mkSTFn6(fn) {\n return function(a, b, c, d, e, f) {\n return fn(a)(b)(c)(d)(e)(f)();\n };\n};\n \nexport const mkSTFn7 = function mkSTFn7(fn) {\n return function(a, b, c, d, e, f, g) {\n return fn(a)(b)(c)(d)(e)(f)(g)();\n };\n};\n \nexport const mkSTFn8 = function mkSTFn8(fn) {\n return function(a, b, c, d, e, f, g, h) {\n return fn(a)(b)(c)(d)(e)(f)(g)(h)();\n };\n};\n \nexport const mkSTFn9 = function mkSTFn9(fn) {\n return function(a, b, c, d, e, f, g, h, i) {\n return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)();\n };\n};\n \nexport const mkSTFn10 = function mkSTFn10(fn) {\n return function(a, b, c, d, e, f, g, h, i, j) {\n return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(j)();\n };\n};\n \nexport const runSTFn1 = function runSTFn1(fn) {\n return function(a) {\n return function() {\n return fn(a);\n };\n };\n};\n \nexport const runSTFn2 = function runSTFn2(fn) {\n return function(a) {\n return function(b) {\n return function() {\n return fn(a, b);\n };\n };\n };\n};\n \nexport const runSTFn3 = function runSTFn3(fn) {\n return function(a) {\n return function(b) {\n return function(c) {\n return function() {\n return fn(a, b, c);\n };\n };\n };\n };\n};\n \nexport const runSTFn4 = function runSTFn4(fn) {\n return function(a) {\n return function(b) {\n return function(c) {\n return function(d) {\n return function() {\n return fn(a, b, c, d);\n };\n };\n };\n };\n };\n};\n \nexport const runSTFn5 = function runSTFn5(fn) {\n return function(a) {\n return function(b) {\n return function(c) {\n return function(d) {\n return function(e) {\n return function() {\n return fn(a, b, c, d, e);\n };\n };\n };\n };\n };\n };\n};\n \nexport const runSTFn6 = function runSTFn6(fn) {\n return function(a) {\n return function(b) {\n return function(c) {\n return function(d) {\n return function(e) {\n return function(f) {\n return function() {\n return fn(a, b, c, d, e, f);\n };\n };\n };\n };\n };\n };\n };\n};\n \nexport const runSTFn7 = function runSTFn7(fn) {\n return function(a) {\n return function(b) {\n return function(c) {\n return function(d) {\n return function(e) {\n return function(f) {\n return function(g) {\n return function() {\n return fn(a, b, c, d, e, f, g);\n };\n };\n };\n };\n };\n };\n };\n };\n};\n \nexport const runSTFn8 = function runSTFn8(fn) {\n return function(a) {\n return function(b) {\n return function(c) {\n return function(d) {\n return function(e) {\n return function(f) {\n return function(g) {\n return function(h) {\n return function() {\n return fn(a, b, c, d, e, f, g, h);\n };\n };\n };\n };\n };\n };\n };\n };\n };\n};\n \nexport const runSTFn9 = function runSTFn9(fn) {\n return function(a) {\n return function(b) {\n return function(c) {\n return function(d) {\n return function(e) {\n return function(f) {\n return function(g) {\n return function(h) {\n return function(i) {\n return function() {\n return fn(a, b, c, d, e, f, g, h, i);\n };\n };\n };\n };\n };\n };\n };\n };\n };\n };\n};\n \nexport const runSTFn10 = function runSTFn10(fn) {\n return function(a) {\n return function(b) {\n return function(c) {\n return function(d) {\n return function(e) {\n return function(f) {\n return function(g) {\n return function(h) {\n return function(i) {\n return function(j) {\n return function() {\n return fn(a, b, c, d, e, f, g, h, i, j);\n };\n };\n };\n };\n };\n };\n };\n };\n };\n };\n };\n};", "-- | Helper functions for working with mutable arrays using the `ST` effect.\n-- |\n-- | This module can be used when performance is important and mutation is a local effect.\n\nmodule Data.Array.ST\n ( STArray(..)\n , Assoc\n , run\n , withArray\n , new\n , peek\n , poke\n , modify\n , length\n , pop\n , push\n , pushAll\n , shift\n , unshift\n , unshiftAll\n , splice\n , sort\n , sortBy\n , sortWith\n , freeze\n , thaw\n , clone\n , unsafeFreeze\n , unsafeThaw\n , toAssocArray\n ) where\n\nimport Prelude\n\nimport Control.Monad.ST (ST, Region)\nimport Control.Monad.ST as ST\nimport Control.Monad.ST.Uncurried (STFn1, STFn2, STFn3, STFn4, runSTFn1, runSTFn2, runSTFn3, runSTFn4)\nimport Data.Maybe (Maybe(..))\n\n-- | A reference to a mutable array.\n-- |\n-- | The first type parameter represents the memory region which the array belongs to.\n-- | The second type parameter defines the type of elements of the mutable array.\n-- |\n-- | The runtime representation of a value of type `STArray h a` is the same as that of `Array a`,\n-- | except that mutation is allowed.\nforeign import data STArray :: Region -> Type -> Type\n\ntype role STArray nominal representational\n\n-- | An element and its index.\ntype Assoc a = { value :: a, index :: Int }\n\n-- | A safe way to create and work with a mutable array before returning an\n-- | immutable array for later perusal. This function avoids copying the array\n-- | before returning it - it uses unsafeFreeze internally, but this wrapper is\n-- | a safe interface to that function.\nrun :: forall a. (forall h. ST h (STArray h a)) -> Array a\nrun st = ST.run (st >>= unsafeFreeze)\n\n-- | Perform an effect requiring a mutable array on a copy of an immutable array,\n-- | safely returning the result as an immutable array.\nwithArray\n :: forall h a b\n . (STArray h a -> ST h b)\n -> Array a\n -> ST h (Array a)\nwithArray f xs = do\n result <- thaw xs\n _ <- f result\n unsafeFreeze result\n\n-- | O(1). Convert a mutable array to an immutable array, without copying. The mutable\n-- | array must not be mutated afterwards.\nunsafeFreeze :: forall h a. STArray h a -> ST h (Array a)\nunsafeFreeze = runSTFn1 unsafeFreezeImpl\n\nforeign import unsafeFreezeImpl :: forall h a. STFn1 (STArray h a) h (Array a)\n\n-- | O(1) Convert an immutable array to a mutable array, without copying. The input\n-- | array must not be used afterward.\nunsafeThaw :: forall h a. Array a -> ST h (STArray h a)\nunsafeThaw = runSTFn1 unsafeThawImpl\n\nforeign import unsafeThawImpl :: forall h a. STFn1 (Array a) h (STArray h a)\n\n-- | Create a new, empty mutable array.\nforeign import new :: forall h a. ST h (STArray h a)\n\nthaw\n :: forall h a\n . Array a\n -> ST h (STArray h a)\nthaw = runSTFn1 thawImpl\n\n-- | Create a mutable copy of an immutable array.\nforeign import thawImpl :: forall h a. STFn1 (Array a) h (STArray h a)\n\n-- | Make a mutable copy of a mutable array.\nclone\n :: forall h a\n . STArray h a\n -> ST h (STArray h a)\nclone = runSTFn1 cloneImpl\n\nforeign import cloneImpl :: forall h a. STFn1 (STArray h a) h (STArray h a)\n\n-- | Sort a mutable array in place. Sorting is stable: the order of equal\n-- | elements is preserved.\nsort :: forall a h. Ord a => STArray h a -> ST h (STArray h a)\nsort = sortBy compare\n\n-- | Remove the first element from an array and return that element.\nshift :: forall h a. STArray h a -> ST h (Maybe a)\nshift = runSTFn3 shiftImpl Just Nothing\n\nforeign import shiftImpl\n :: forall h a\n . STFn3 (forall b. b -> Maybe b) (forall b. Maybe b) (STArray h a) h (Maybe a)\n\n-- | Sort a mutable array in place using a comparison function. Sorting is\n-- | stable: the order of elements is preserved if they are equal according to\n-- | the comparison function.\nsortBy\n :: forall a h\n . (a -> a -> Ordering)\n -> STArray h a\n -> ST h (STArray h a)\nsortBy comp = runSTFn3 sortByImpl comp case _ of\n GT -> 1\n EQ -> 0\n LT -> -1\n\nforeign import sortByImpl\n :: forall a h\n . STFn3 (a -> a -> Ordering) (Ordering -> Int) (STArray h a) h (STArray h a)\n\n-- | Sort a mutable array in place based on a projection. Sorting is stable: the\n-- | order of elements is preserved if they are equal according to the projection.\nsortWith\n :: forall a b h\n . Ord b\n => (a -> b)\n -> STArray h a\n -> ST h (STArray h a)\nsortWith f = sortBy (comparing f)\n\n-- | Create an immutable copy of a mutable array.\nfreeze\n :: forall h a\n . STArray h a\n -> ST h (Array a)\nfreeze = runSTFn1 freezeImpl\n\nforeign import freezeImpl :: forall h a. STFn1 (STArray h a) h (Array a)\n\n-- | Read the value at the specified index in a mutable array.\npeek\n :: forall h a\n . Int\n -> STArray h a\n -> ST h (Maybe a)\npeek = runSTFn4 peekImpl Just Nothing\n\nforeign import peekImpl :: forall h a r. STFn4 (a -> r) r Int (STArray h a) h r\n\npoke\n :: forall h a\n . Int\n -> a\n -> STArray h a\n -> ST h Boolean\npoke = runSTFn3 pokeImpl\n\n-- | Change the value at the specified index in a mutable array.\nforeign import pokeImpl :: forall h a. STFn3 Int a (STArray h a) h Boolean\n\nforeign import lengthImpl :: forall h a. STFn1 (STArray h a) h Int\n\n-- | Get the number of elements in a mutable array.\nlength :: forall h a. STArray h a -> ST h Int\nlength = runSTFn1 lengthImpl\n\n-- | Remove the last element from an array and return that element.\npop :: forall h a. STArray h a -> ST h (Maybe a)\npop = runSTFn3 popImpl Just Nothing\n\nforeign import popImpl\n :: forall h a\n . STFn3 (forall b. b -> Maybe b) (forall b. Maybe b) (STArray h a) h (Maybe a)\n\n-- | Append an element to the end of a mutable array. Returns the new length of\n-- | the array.\npush :: forall h a. a -> (STArray h a) -> ST h Int\npush = runSTFn2 pushImpl\n\nforeign import pushImpl :: forall h a. STFn2 a (STArray h a) h Int\n\n-- | Append the values in an immutable array to the end of a mutable array.\n-- | Returns the new length of the mutable array.\npushAll\n :: forall h a\n . Array a\n -> STArray h a\n -> ST h Int\npushAll = runSTFn2 pushAllImpl\n\nforeign import pushAllImpl\n :: forall h a\n . STFn2 (Array a) (STArray h a) h Int\n\n-- | Append an element to the front of a mutable array. Returns the new length of\n-- | the array.\nunshift :: forall h a. a -> STArray h a -> ST h Int\nunshift a = runSTFn2 unshiftAllImpl [ a ]\n\n-- | Append the values in an immutable array to the front of a mutable array.\n-- | Returns the new length of the mutable array.\nunshiftAll\n :: forall h a\n . Array a\n -> STArray h a\n -> ST h Int\nunshiftAll = runSTFn2 unshiftAllImpl\n\nforeign import unshiftAllImpl\n :: forall h a\n . STFn2 (Array a) (STArray h a) h Int\n\n-- | Mutate the element at the specified index using the supplied function.\nmodify :: forall h a. Int -> (a -> a) -> STArray h a -> ST h Boolean\nmodify i f xs = do\n entry <- peek i xs\n case entry of\n Just x -> poke i (f x) xs\n Nothing -> pure false\n\n-- | Remove and/or insert elements from/into a mutable array at the specified index.\nsplice\n :: forall h a\n . Int\n -> Int\n -> Array a\n -> STArray h a\n -> ST h (Array a)\nsplice = runSTFn4 spliceImpl\n\nforeign import spliceImpl\n :: forall h a\n . STFn4 Int Int (Array a) (STArray h a) h (Array a)\n\n-- | Create an immutable copy of a mutable array, where each element\n-- | is labelled with its index in the original array.\ntoAssocArray\n :: forall h a\n . STArray h a\n -> ST h (Array (Assoc a))\ntoAssocArray = runSTFn1 toAssocArrayImpl\n\nforeign import toAssocArrayImpl\n :: forall h a\n . STFn1 (STArray h a) h (Array (Assoc a))\n", "// module Data.Function.Uncurried\n\nexport const mkFn0 = function (fn) {\n return function () {\n return fn();\n };\n};\n\nexport const mkFn2 = function (fn) {\n /* jshint maxparams: 2 */\n return function (a, b) {\n return fn(a)(b);\n };\n};\n\nexport const mkFn3 = function (fn) {\n /* jshint maxparams: 3 */\n return function (a, b, c) {\n return fn(a)(b)(c);\n };\n};\n\nexport const mkFn4 = function (fn) {\n /* jshint maxparams: 4 */\n return function (a, b, c, d) {\n return fn(a)(b)(c)(d);\n };\n};\n\nexport const mkFn5 = function (fn) {\n /* jshint maxparams: 5 */\n return function (a, b, c, d, e) {\n return fn(a)(b)(c)(d)(e);\n };\n};\n\nexport const mkFn6 = function (fn) {\n /* jshint maxparams: 6 */\n return function (a, b, c, d, e, f) {\n return fn(a)(b)(c)(d)(e)(f);\n };\n};\n\nexport const mkFn7 = function (fn) {\n /* jshint maxparams: 7 */\n return function (a, b, c, d, e, f, g) {\n return fn(a)(b)(c)(d)(e)(f)(g);\n };\n};\n\nexport const mkFn8 = function (fn) {\n /* jshint maxparams: 8 */\n return function (a, b, c, d, e, f, g, h) {\n return fn(a)(b)(c)(d)(e)(f)(g)(h);\n };\n};\n\nexport const mkFn9 = function (fn) {\n /* jshint maxparams: 9 */\n return function (a, b, c, d, e, f, g, h, i) {\n return fn(a)(b)(c)(d)(e)(f)(g)(h)(i);\n };\n};\n\nexport const mkFn10 = function (fn) {\n /* jshint maxparams: 10 */\n return function (a, b, c, d, e, f, g, h, i, j) {\n return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(j);\n };\n};\n\nexport const runFn0 = function (fn) {\n return fn();\n};\n\nexport const runFn2 = function (fn) {\n return function (a) {\n return function (b) {\n return fn(a, b);\n };\n };\n};\n\nexport const runFn3 = function (fn) {\n return function (a) {\n return function (b) {\n return function (c) {\n return fn(a, b, c);\n };\n };\n };\n};\n\nexport const runFn4 = function (fn) {\n return function (a) {\n return function (b) {\n return function (c) {\n return function (d) {\n return fn(a, b, c, d);\n };\n };\n };\n };\n};\n\nexport const runFn5 = function (fn) {\n return function (a) {\n return function (b) {\n return function (c) {\n return function (d) {\n return function (e) {\n return fn(a, b, c, d, e);\n };\n };\n };\n };\n };\n};\n\nexport const runFn6 = function (fn) {\n return function (a) {\n return function (b) {\n return function (c) {\n return function (d) {\n return function (e) {\n return function (f) {\n return fn(a, b, c, d, e, f);\n };\n };\n };\n };\n };\n };\n};\n\nexport const runFn7 = function (fn) {\n return function (a) {\n return function (b) {\n return function (c) {\n return function (d) {\n return function (e) {\n return function (f) {\n return function (g) {\n return fn(a, b, c, d, e, f, g);\n };\n };\n };\n };\n };\n };\n };\n};\n\nexport const runFn8 = function (fn) {\n return function (a) {\n return function (b) {\n return function (c) {\n return function (d) {\n return function (e) {\n return function (f) {\n return function (g) {\n return function (h) {\n return fn(a, b, c, d, e, f, g, h);\n };\n };\n };\n };\n };\n };\n };\n };\n};\n\nexport const runFn9 = function (fn) {\n return function (a) {\n return function (b) {\n return function (c) {\n return function (d) {\n return function (e) {\n return function (f) {\n return function (g) {\n return function (h) {\n return function (i) {\n return fn(a, b, c, d, e, f, g, h, i);\n };\n };\n };\n };\n };\n };\n };\n };\n };\n};\n\nexport const runFn10 = function (fn) {\n return function (a) {\n return function (b) {\n return function (c) {\n return function (d) {\n return function (e) {\n return function (f) {\n return function (g) {\n return function (h) {\n return function (i) {\n return function (j) {\n return fn(a, b, c, d, e, f, g, h, i, j);\n };\n };\n };\n };\n };\n };\n };\n };\n };\n };\n};\n", "-- | Helper functions for working with immutable Javascript arrays.\n-- |\n-- | _Note_: Depending on your use-case, you may prefer to use `Data.List` or\n-- | `Data.Sequence` instead, which might give better performance for certain\n-- | use cases. This module is useful when integrating with JavaScript libraries\n-- | which use arrays, but immutable arrays are not a practical data structure\n-- | for many use cases due to their poor asymptotics.\n-- |\n-- | In addition to the functions in this module, Arrays have a number of\n-- | useful instances:\n-- |\n-- | * `Functor`, which provides `map :: forall a b. (a -> b) -> Array a ->\n-- | Array b`\n-- | * `Apply`, which provides `(<*>) :: forall a b. Array (a -> b) -> Array a\n-- | -> Array b`. This function works a bit like a Cartesian product; the\n-- | result array is constructed by applying each function in the first\n-- | array to each value in the second, so that the result array ends up with\n-- | a length equal to the product of the two arguments' lengths.\n-- | * `Bind`, which provides `(>>=) :: forall a b. (a -> Array b) -> Array a\n-- | -> Array b` (this is the same as `concatMap`).\n-- | * `Semigroup`, which provides `(<>) :: forall a. Array a -> Array a ->\n-- | Array a`, for concatenating arrays.\n-- | * `Foldable`, which provides a slew of functions for *folding* (also known\n-- | as *reducing*) arrays down to one value. For example,\n-- | `Data.Foldable.or` tests whether an array of `Boolean` values contains\n-- | at least one `true` value.\n-- | * `Traversable`, which provides the PureScript version of a for-loop,\n-- | allowing you to STAI.iterate over an array and accumulate effects.\n-- |\nmodule Data.Array\n ( fromFoldable\n , toUnfoldable\n , singleton\n , (..)\n , range\n , replicate\n , some\n , many\n\n , null\n , length\n\n , (:)\n , cons\n , snoc\n , insert\n , insertBy\n\n , head\n , last\n , tail\n , init\n , uncons\n , unsnoc\n\n , (!!)\n , index\n , elem\n , notElem\n , elemIndex\n , elemLastIndex\n , find\n , findMap\n , findIndex\n , findLastIndex\n , insertAt\n , deleteAt\n , updateAt\n , updateAtIndices\n , modifyAt\n , modifyAtIndices\n , alterAt\n\n , intersperse\n , reverse\n , concat\n , concatMap\n , filter\n , partition\n , splitAt\n , filterA\n , mapMaybe\n , catMaybes\n , mapWithIndex\n , foldl\n , foldr\n , foldMap\n , fold\n , intercalate\n , transpose\n , scanl\n , scanr\n\n , sort\n , sortBy\n , sortWith\n , slice\n , take\n , takeEnd\n , takeWhile\n , drop\n , dropEnd\n , dropWhile\n , span\n , group\n , groupAll\n , groupBy\n , groupAllBy\n\n , nub\n , nubEq\n , nubBy\n , nubByEq\n , union\n , unionBy\n , delete\n , deleteBy\n\n , (\\\\)\n , difference\n , intersect\n , intersectBy\n\n , zipWith\n , zipWithA\n , zip\n , unzip\n\n , any\n , all\n\n , foldM\n , foldRecM\n\n , unsafeIndex\n ) where\n\nimport Prelude\n\nimport Control.Alt ((<|>))\nimport Control.Alternative (class Alternative)\nimport Control.Lazy (class Lazy, defer)\nimport Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM2)\nimport Control.Monad.ST as ST\nimport Data.Array.NonEmpty.Internal (NonEmptyArray(..))\nimport Data.Array.ST as STA\nimport Data.Array.ST.Iterator as STAI\nimport Data.Foldable (class Foldable, traverse_)\nimport Data.Foldable as F\nimport Data.Function.Uncurried (Fn2, Fn3, Fn4, Fn5, runFn2, runFn3, runFn4, runFn5)\nimport Data.FunctorWithIndex as FWI\nimport Data.Maybe (Maybe(..), maybe, isJust, fromJust, isNothing)\nimport Data.Traversable (sequence, traverse)\nimport Data.Tuple (Tuple(..), fst, snd)\nimport Data.Unfoldable (class Unfoldable, unfoldr)\nimport Partial.Unsafe (unsafePartial)\n\n-- | Convert an `Array` into an `Unfoldable` structure.\ntoUnfoldable :: forall f. Unfoldable f => Array ~> f\ntoUnfoldable xs = unfoldr f 0\n where\n len = length xs\n f i\n | i < len = Just (Tuple (unsafePartial (unsafeIndex xs i)) (i + 1))\n | otherwise = Nothing\n\n-- | Convert a `Foldable` structure into an `Array`.\n-- |\n-- | ```purescript\n-- | fromFoldable (Just 1) = [1]\n-- | fromFoldable (Nothing) = []\n-- | ```\n-- |\nfromFoldable :: forall f. Foldable f => f ~> Array\nfromFoldable = runFn2 fromFoldableImpl F.foldr\n\nforeign import fromFoldableImpl\n :: forall f a\n . Fn2 (forall b. (a -> b -> b) -> b -> f a -> b) (f a) (Array a)\n\n-- | Create an array of one element\n-- | ```purescript\n-- | singleton 2 = [2]\n-- | ```\nsingleton :: forall a. a -> Array a\nsingleton a = [ a ]\n\n-- | Create an array containing a range of integers, including both endpoints.\n-- | ```purescript\n-- | range 2 5 = [2, 3, 4, 5]\n-- | ```\nrange :: Int -> Int -> Array Int\nrange = runFn2 rangeImpl\n\nforeign import rangeImpl :: Fn2 Int Int (Array Int)\n\n-- | Create an array containing a value repeated the specified number of times.\n-- | ```purescript\n-- | replicate 2 \"Hi\" = [\"Hi\", \"Hi\"]\n-- | ```\nreplicate :: forall a. Int -> a -> Array a\nreplicate = runFn2 replicateImpl\n\nforeign import replicateImpl :: forall a. Fn2 Int a (Array a)\n\n-- | An infix synonym for `range`.\n-- | ```purescript\n-- | 2 .. 5 = [2, 3, 4, 5]\n-- | ```\ninfix 8 range as ..\n\n-- | Attempt a computation multiple times, requiring at least one success.\n-- |\n-- | The `Lazy` constraint is used to generate the result lazily, to ensure\n-- | termination.\nsome :: forall f a. Alternative f => Lazy (f (Array a)) => f a -> f (Array a)\nsome v = (:) <$> v <*> defer (\\_ -> many v)\n\n-- | Attempt a computation multiple times, returning as many successful results\n-- | as possible (possibly zero).\n-- |\n-- | The `Lazy` constraint is used to generate the result lazily, to ensure\n-- | termination.\nmany :: forall f a. Alternative f => Lazy (f (Array a)) => f a -> f (Array a)\nmany v = some v <|> pure []\n\n--------------------------------------------------------------------------------\n-- Array size ------------------------------------------------------------------\n--------------------------------------------------------------------------------\n\n-- | Test whether an array is empty.\n-- | ```purescript\n-- | null [] = true\n-- | null [1, 2] = false\n-- | ```\nnull :: forall a. Array a -> Boolean\nnull xs = length xs == 0\n\n-- | Get the number of elements in an array.\n-- | ```purescript\n-- | length [\"Hello\", \"World\"] = 2\n-- | ```\nforeign import length :: forall a. Array a -> Int\n\n--------------------------------------------------------------------------------\n-- Extending arrays ------------------------------------------------------------\n--------------------------------------------------------------------------------\n\n-- | Attaches an element to the front of an array, creating a new array.\n-- |\n-- | ```purescript\n-- | cons 1 [2, 3, 4] = [1, 2, 3, 4]\n-- | ```\n-- |\n-- | Note, the running time of this function is `O(n)`.\ncons :: forall a. a -> Array a -> Array a\ncons x xs = [ x ] <> xs\n\n-- | An infix alias for `cons`.\n-- |\n-- | ```purescript\n-- | 1 : [2, 3, 4] = [1, 2, 3, 4]\n-- | ```\n-- |\n-- | Note, the running time of this function is `O(n)`.\ninfixr 6 cons as :\n\n-- | Append an element to the end of an array, creating a new array.\n-- |\n-- | ```purescript\n-- | snoc [1, 2, 3] 4 = [1, 2, 3, 4]\n-- | ```\n-- |\nsnoc :: forall a. Array a -> a -> Array a\nsnoc xs x = ST.run (STA.withArray (STA.push x) xs)\n\n-- | Insert an element into a sorted array.\n-- |\n-- | ```purescript\n-- | insert 10 [1, 2, 20, 21] = [1, 2, 10, 20, 21]\n-- | ```\n-- |\ninsert :: forall a. Ord a => a -> Array a -> Array a\ninsert = insertBy compare\n\n-- | Insert an element into a sorted array, using the specified function to\n-- | determine the ordering of elements.\n-- |\n-- | ```purescript\n-- | invertCompare a b = invert $ compare a b\n-- |\n-- | insertBy invertCompare 10 [21, 20, 2, 1] = [21, 20, 10, 2, 1]\n-- | ```\n-- |\ninsertBy :: forall a. (a -> a -> Ordering) -> a -> Array a -> Array a\ninsertBy cmp x ys =\n let\n i = maybe 0 (_ + 1) (findLastIndex (\\y -> cmp x y == GT) ys)\n in\n unsafePartial (fromJust (insertAt i x ys))\n\n--------------------------------------------------------------------------------\n-- Non-indexed reads -----------------------------------------------------------\n--------------------------------------------------------------------------------\n\n-- | Get the first element in an array, or `Nothing` if the array is empty\n-- |\n-- | Running time: `O(1)`.\n-- |\n-- | ```purescript\n-- | head [1, 2] = Just 1\n-- | head [] = Nothing\n-- | ```\n-- |\nhead :: forall a. Array a -> Maybe a\nhead xs = xs !! 0\n\n-- | Get the last element in an array, or `Nothing` if the array is empty\n-- |\n-- | Running time: `O(1)`.\n-- |\n-- | ```purescript\n-- | last [1, 2] = Just 2\n-- | last [] = Nothing\n-- | ```\n-- |\nlast :: forall a. Array a -> Maybe a\nlast xs = xs !! (length xs - 1)\n\n-- | Get all but the first element of an array, creating a new array, or\n-- | `Nothing` if the array is empty\n-- |\n-- | ```purescript\n-- | tail [1, 2, 3, 4] = Just [2, 3, 4]\n-- | tail [] = Nothing\n-- | ```\n-- |\n-- | Running time: `O(n)` where `n` is the length of the array\ntail :: forall a. Array a -> Maybe (Array a)\ntail = runFn3 unconsImpl (const Nothing) (\\_ xs -> Just xs)\n\n-- | Get all but the last element of an array, creating a new array, or\n-- | `Nothing` if the array is empty.\n-- |\n-- | ```purescript\n-- | init [1, 2, 3, 4] = Just [1, 2, 3]\n-- | init [] = Nothing\n-- | ```\n-- |\n-- | Running time: `O(n)` where `n` is the length of the array\ninit :: forall a. Array a -> Maybe (Array a)\ninit xs\n | null xs = Nothing\n | otherwise = Just (slice zero (length xs - one) xs)\n\n-- | Break an array into its first element and remaining elements.\n-- |\n-- | Using `uncons` provides a way of writing code that would use cons patterns\n-- | in Haskell or pre-PureScript 0.7:\n-- | ``` purescript\n-- | f (x : xs) = something\n-- | f [] = somethingElse\n-- | ```\n-- | Becomes:\n-- | ``` purescript\n-- | f arr = case uncons arr of\n-- | Just { head: x, tail: xs } -> something\n-- | Nothing -> somethingElse\n-- | ```\nuncons :: forall a. Array a -> Maybe { head :: a, tail :: Array a }\nuncons = runFn3 unconsImpl (const Nothing) \\x xs -> Just { head: x, tail: xs }\n\nforeign import unconsImpl\n :: forall a b\n . Fn3 (Unit -> b) (a -> Array a -> b) (Array a) b\n\n-- | Break an array into its last element and all preceding elements.\n-- |\n-- | ```purescript\n-- | unsnoc [1, 2, 3] = Just {init: [1, 2], last: 3}\n-- | unsnoc [] = Nothing\n-- | ```\n-- |\n-- | Running time: `O(n)` where `n` is the length of the array\nunsnoc :: forall a. Array a -> Maybe { init :: Array a, last :: a }\nunsnoc xs = { init: _, last: _ } <$> init xs <*> last xs\n\n--------------------------------------------------------------------------------\n-- Indexed operations ----------------------------------------------------------\n--------------------------------------------------------------------------------\n\n-- | This function provides a safe way to read a value at a particular index\n-- | from an array.\n-- |\n-- | ```purescript\n-- | sentence = [\"Hello\", \"World\", \"!\"]\n-- |\n-- | index sentence 0 = Just \"Hello\"\n-- | index sentence 7 = Nothing\n-- | ```\n-- |\nindex :: forall a. Array a -> Int -> Maybe a\nindex = runFn4 indexImpl Just Nothing\n\nforeign import indexImpl\n :: forall a\n . Fn4 (forall r. r -> Maybe r) (forall r. Maybe r) (Array a) Int (Maybe a)\n\n-- | An infix version of `index`.\n-- |\n-- | ```purescript\n-- | sentence = [\"Hello\", \"World\", \"!\"]\n-- |\n-- | sentence !! 0 = Just \"Hello\"\n-- | sentence !! 7 = Nothing\n-- | ```\n-- |\ninfixl 8 index as !!\n\n-- | Returns true if the array has the given element.\nelem :: forall a. Eq a => a -> Array a -> Boolean\nelem a arr = isJust $ elemIndex a arr\n\n-- | Returns true if the array does not have the given element.\nnotElem :: forall a. Eq a => a -> Array a -> Boolean\nnotElem a arr = isNothing $ elemIndex a arr\n\n-- | Find the index of the first element equal to the specified element.\n-- |\n-- | ```purescript\n-- | elemIndex \"a\" [\"a\", \"b\", \"a\", \"c\"] = Just 0\n-- | elemIndex \"Earth\" [\"Hello\", \"World\", \"!\"] = Nothing\n-- | ```\n-- |\nelemIndex :: forall a. Eq a => a -> Array a -> Maybe Int\nelemIndex x = findIndex (_ == x)\n\n-- | Find the index of the last element equal to the specified element.\n-- |\n-- | ```purescript\n-- | elemLastIndex \"a\" [\"a\", \"b\", \"a\", \"c\"] = Just 2\n-- | elemLastIndex \"Earth\" [\"Hello\", \"World\", \"!\"] = Nothing\n-- | ```\n-- |\nelemLastIndex :: forall a. Eq a => a -> Array a -> Maybe Int\nelemLastIndex x = findLastIndex (_ == x)\n\n-- | Find the first element for which a predicate holds.\n-- |\n-- | ```purescript\n-- | find (contains $ Pattern \"b\") [\"a\", \"bb\", \"b\", \"d\"] = Just \"bb\"\n-- | find (contains $ Pattern \"x\") [\"a\", \"bb\", \"b\", \"d\"] = Nothing\n-- | ```\nfind :: forall a. (a -> Boolean) -> Array a -> Maybe a\nfind f xs = unsafePartial (unsafeIndex xs) <$> findIndex f xs\n\n-- | Find the first element in a data structure which satisfies\n-- | a predicate mapping.\nfindMap :: forall a b. (a -> Maybe b) -> Array a -> Maybe b\nfindMap = runFn4 findMapImpl Nothing isJust\n\nforeign import findMapImpl\n :: forall a b\n . Fn4\n (forall c. Maybe c)\n (forall c. Maybe c -> Boolean)\n (a -> Maybe b)\n (Array a)\n (Maybe b)\n\n-- | Find the first index for which a predicate holds.\n-- |\n-- | ```purescript\n-- | findIndex (contains $ Pattern \"b\") [\"a\", \"bb\", \"b\", \"d\"] = Just 1\n-- | findIndex (contains $ Pattern \"x\") [\"a\", \"bb\", \"b\", \"d\"] = Nothing\n-- | ```\n-- |\nfindIndex :: forall a. (a -> Boolean) -> Array a -> Maybe Int\nfindIndex = runFn4 findIndexImpl Just Nothing\n\nforeign import findIndexImpl\n :: forall a\n . Fn4\n (forall b. b -> Maybe b)\n (forall b. Maybe b)\n (a -> Boolean)\n (Array a)\n (Maybe Int)\n\n-- | Find the last index for which a predicate holds.\n-- |\n-- | ```purescript\n-- | findLastIndex (contains $ Pattern \"b\") [\"a\", \"bb\", \"b\", \"d\"] = Just 2\n-- | findLastIndex (contains $ Pattern \"x\") [\"a\", \"bb\", \"b\", \"d\"] = Nothing\n-- | ```\n-- |\nfindLastIndex :: forall a. (a -> Boolean) -> Array a -> Maybe Int\nfindLastIndex = runFn4 findLastIndexImpl Just Nothing\n\nforeign import findLastIndexImpl\n :: forall a\n . Fn4\n (forall b. b -> Maybe b)\n (forall b. Maybe b)\n (a -> Boolean)\n (Array a)\n (Maybe Int)\n\n-- | Insert an element at the specified index, creating a new array, or\n-- | returning `Nothing` if the index is out of bounds.\n-- |\n-- | ```purescript\n-- | insertAt 2 \"!\" [\"Hello\", \"World\"] = Just [\"Hello\", \"World\", \"!\"]\n-- | insertAt 10 \"!\" [\"Hello\"] = Nothing\n-- | ```\n-- |\ninsertAt :: forall a. Int -> a -> Array a -> Maybe (Array a)\ninsertAt = runFn5 _insertAt Just Nothing\n\nforeign import _insertAt\n :: forall a\n . Fn5\n (forall b. b -> Maybe b)\n (forall b. Maybe b)\n Int\n a\n (Array a)\n (Maybe (Array a))\n\n-- | Delete the element at the specified index, creating a new array, or\n-- | returning `Nothing` if the index is out of bounds.\n-- |\n-- | ```purescript\n-- | deleteAt 0 [\"Hello\", \"World\"] = Just [\"World\"]\n-- | deleteAt 10 [\"Hello\", \"World\"] = Nothing\n-- | ```\n-- |\ndeleteAt :: forall a. Int -> Array a -> Maybe (Array a)\ndeleteAt = runFn4 _deleteAt Just Nothing\n\nforeign import _deleteAt\n :: forall a\n . Fn4\n (forall b. b -> Maybe b)\n (forall b. Maybe b)\n Int\n (Array a)\n (Maybe (Array a))\n\n-- | Change the element at the specified index, creating a new array, or\n-- | returning `Nothing` if the index is out of bounds.\n-- |\n-- | ```purescript\n-- | updateAt 1 \"World\" [\"Hello\", \"Earth\"] = Just [\"Hello\", \"World\"]\n-- | updateAt 10 \"World\" [\"Hello\", \"Earth\"] = Nothing\n-- | ```\n-- |\nupdateAt :: forall a. Int -> a -> Array a -> Maybe (Array a)\nupdateAt = runFn5 _updateAt Just Nothing\n\nforeign import _updateAt\n :: forall a\n . Fn5\n (forall b. b -> Maybe b)\n (forall b. Maybe b)\n Int\n a\n (Array a)\n (Maybe (Array a))\n\n-- | Apply a function to the element at the specified index, creating a new\n-- | array, or returning `Nothing` if the index is out of bounds.\n-- |\n-- | ```purescript\n-- | modifyAt 1 toUpper [\"Hello\", \"World\"] = Just [\"Hello\", \"WORLD\"]\n-- | modifyAt 10 toUpper [\"Hello\", \"World\"] = Nothing\n-- | ```\n-- |\nmodifyAt :: forall a. Int -> (a -> a) -> Array a -> Maybe (Array a)\nmodifyAt i f xs = maybe Nothing go (xs !! i)\n where\n go x = updateAt i (f x) xs\n\n-- | Update or delete the element at the specified index by applying a\n-- | function to the current value, returning a new array or `Nothing` if the\n-- | index is out-of-bounds.\n-- |\n-- | ```purescript\n-- | alterAt 1 (stripSuffix $ Pattern \"!\") [\"Hello\", \"World!\"]\n-- | = Just [\"Hello\", \"World\"]\n-- |\n-- | alterAt 1 (stripSuffix $ Pattern \"!!!!!\") [\"Hello\", \"World!\"]\n-- | = Just [\"Hello\"]\n-- |\n-- | alterAt 10 (stripSuffix $ Pattern \"!\") [\"Hello\", \"World!\"] = Nothing\n-- | ```\n-- |\nalterAt :: forall a. Int -> (a -> Maybe a) -> Array a -> Maybe (Array a)\nalterAt i f xs = maybe Nothing go (xs !! i)\n where\n go x = case f x of\n Nothing -> deleteAt i xs\n Just x' -> updateAt i x' xs\n\n--------------------------------------------------------------------------------\n-- Transformations -------------------------------------------------------------\n--------------------------------------------------------------------------------\n\n-- | Inserts the given element in between each element in the array. The array\n-- | must have two or more elements for this operation to take effect.\n-- |\n-- | ```purescript\n-- | intersperse \" \" [ \"a\", \"b\" ] == [ \"a\", \" \", \"b\" ]\n-- | intersperse 0 [ 1, 2, 3, 4, 5 ] == [ 1, 0, 2, 0, 3, 0, 4, 0, 5 ]\n-- | ```\n-- |\n-- | If the array has less than two elements, the input array is returned.\n-- | ```purescript\n-- | intersperse \" \" [] == []\n-- | intersperse \" \" [\"a\"] == [\"a\"]\n-- | ```\nintersperse :: forall a. a -> Array a -> Array a\nintersperse a arr = case length arr of\n len\n | len < 2 -> arr\n | otherwise -> STA.run do\n let unsafeGetElem idx = unsafePartial (unsafeIndex arr idx)\n out <- STA.new\n _ <- STA.push (unsafeGetElem 0) out\n ST.for 1 len \\idx -> do\n _ <- STA.push a out\n void (STA.push (unsafeGetElem idx) out)\n pure out\n\n-- | Reverse an array, creating a new array.\n-- |\n-- | ```purescript\n-- | reverse [] = []\n-- | reverse [1, 2, 3] = [3, 2, 1]\n-- | ```\n-- |\nforeign import reverse :: forall a. Array a -> Array a\n\n-- | Flatten an array of arrays, creating a new array.\n-- |\n-- | ```purescript\n-- | concat [[1, 2, 3], [], [4, 5, 6]] = [1, 2, 3, 4, 5, 6]\n-- | ```\n-- |\nforeign import concat :: forall a. Array (Array a) -> Array a\n\n-- | Apply a function to each element in an array, and flatten the results\n-- | into a single, new array.\n-- |\n-- | ```purescript\n-- | concatMap (split $ Pattern \" \") [\"Hello World\", \"other thing\"]\n-- | = [\"Hello\", \"World\", \"other\", \"thing\"]\n-- | ```\n-- |\nconcatMap :: forall a b. (a -> Array b) -> Array a -> Array b\nconcatMap = flip bind\n\n-- | Filter an array, keeping the elements which satisfy a predicate function,\n-- | creating a new array.\n-- |\n-- | ```purescript\n-- | filter (_ > 0) [-1, 4, -5, 7] = [4, 7]\n-- | ```\n-- |\nfilter :: forall a. (a -> Boolean) -> Array a -> Array a\nfilter = runFn2 filterImpl\n\nforeign import filterImpl\n :: forall a\n . Fn2 (a -> Boolean) (Array a) (Array a)\n\n-- | Partition an array using a predicate function, creating a set of\n-- | new arrays. One for the values satisfying the predicate function\n-- | and one for values that don't.\n-- |\n-- | ```purescript\n-- | partition (_ > 0) [-1, 4, -5, 7] = { yes: [4, 7], no: [-1, -5] }\n-- | ```\n-- |\npartition\n :: forall a\n . (a -> Boolean)\n -> Array a\n -> { yes :: Array a, no :: Array a }\npartition = runFn2 partitionImpl\n\nforeign import partitionImpl\n :: forall a\n . Fn2 (a -> Boolean) (Array a) { yes :: Array a, no :: Array a }\n\n-- | Splits an array into two subarrays, where `before` contains the elements\n-- | up to (but not including) the given index, and `after` contains the rest\n-- | of the elements, from that index on.\n-- |\n-- | ```purescript\n-- | >>> splitAt 3 [1, 2, 3, 4, 5]\n-- | { before: [1, 2, 3], after: [4, 5] }\n-- | ```\n-- |\n-- | Thus, the length of `(splitAt i arr).before` will equal either `i` or\n-- | `length arr`, if that is shorter. (Or if `i` is negative the length will\n-- | be 0.)\n-- |\n-- | ```purescript\n-- | splitAt 2 ([] :: Array Int) == { before: [], after: [] }\n-- | splitAt 3 [1, 2, 3, 4, 5] == { before: [1, 2, 3], after: [4, 5] }\n-- | ```\nsplitAt :: forall a. Int -> Array a -> { before :: Array a, after :: Array a }\nsplitAt i xs | i <= 0 = { before: [], after: xs }\nsplitAt i xs = { before: slice 0 i xs, after: slice i (length xs) xs }\n\n-- | Filter where the predicate returns a `Boolean` in some `Applicative`.\n-- |\n-- | ```purescript\n-- | powerSet :: forall a. Array a -> Array (Array a)\n-- | powerSet = filterA (const [true, false])\n-- | ```\nfilterA :: forall a f. Applicative f => (a -> f Boolean) -> Array a -> f (Array a)\nfilterA p =\n traverse (\\x -> Tuple x <$> p x)\n >>> map (mapMaybe (\\(Tuple x b) -> if b then Just x else Nothing))\n\n-- | Apply a function to each element in an array, keeping only the results\n-- | which contain a value, creating a new array.\n-- |\n-- | ```purescript\n-- | parseEmail :: String -> Maybe Email\n-- | parseEmail = ...\n-- |\n-- | mapMaybe parseEmail [\"a.com\", \"hello@example.com\", \"--\"]\n-- | = [Email {user: \"hello\", domain: \"example.com\"}]\n-- | ```\n-- |\nmapMaybe :: forall a b. (a -> Maybe b) -> Array a -> Array b\nmapMaybe f = concatMap (maybe [] singleton <<< f)\n\n-- | Filter an array of optional values, keeping only the elements which contain\n-- | a value, creating a new array.\n-- |\n-- | ```purescript\n-- | catMaybes [Nothing, Just 2, Nothing, Just 4] = [2, 4]\n-- | ```\n-- |\ncatMaybes :: forall a. Array (Maybe a) -> Array a\ncatMaybes = mapMaybe identity\n\n-- | Apply a function to each element in an array, supplying a generated\n-- | zero-based index integer along with the element, creating an array\n-- | with the new elements.\n-- |\n-- | ```purescript\n-- | prefixIndex index element = show index <> element\n-- |\n-- | mapWithIndex prefixIndex [\"Hello\", \"World\"] = [\"0Hello\", \"1World\"]\n-- | ```\n-- |\nmapWithIndex :: forall a b. (Int -> a -> b) -> Array a -> Array b\nmapWithIndex = FWI.mapWithIndex\n\n-- | Change the elements at the specified indices in index/value pairs.\n-- | Out-of-bounds indices will have no effect.\n-- |\n-- | ```purescript\n-- | updates = [Tuple 0 \"Hi\", Tuple 2 \".\" , Tuple 10 \"foobar\"]\n-- |\n-- | updateAtIndices updates [\"Hello\", \"World\", \"!\"] = [\"Hi\", \"World\", \".\"]\n-- | ```\n-- |\nupdateAtIndices :: forall t a. Foldable t => t (Tuple Int a) -> Array a -> Array a\nupdateAtIndices us xs =\n ST.run (STA.withArray (\\res -> traverse_ (\\(Tuple i a) -> STA.poke i a res) us) xs)\n\n-- | Apply a function to the element at the specified indices,\n-- | creating a new array. Out-of-bounds indices will have no effect.\n-- |\n-- | ```purescript\n-- | indices = [1, 3]\n-- | modifyAtIndices indices toUpper [\"Hello\", \"World\", \"and\", \"others\"]\n-- | = [\"Hello\", \"WORLD\", \"and\", \"OTHERS\"]\n-- | ```\n-- |\nmodifyAtIndices :: forall t a. Foldable t => t Int -> (a -> a) -> Array a -> Array a\nmodifyAtIndices is f xs =\n ST.run (STA.withArray (\\res -> traverse_ (\\i -> STA.modify i f res) is) xs)\n\nfoldl :: forall a b. (b -> a -> b) -> b -> Array a -> b\nfoldl = F.foldl\n\nfoldr :: forall a b. (a -> b -> b) -> b -> Array a -> b\nfoldr = F.foldr\n\nfoldMap :: forall a m. Monoid m => (a -> m) -> Array a -> m\nfoldMap = F.foldMap\n\nfold :: forall m. Monoid m => Array m -> m\nfold = F.fold\n\nintercalate :: forall a. Monoid a => a -> Array a -> a\nintercalate = F.intercalate\n\n-- | The 'transpose' function transposes the rows and columns of its argument.\n-- | For example,\n-- |\n-- | ```purescript\n-- | transpose \n-- | [ [1, 2, 3]\n-- | , [4, 5, 6]\n-- | ] == \n-- | [ [1, 4]\n-- | , [2, 5]\n-- | , [3, 6]\n-- | ]\n-- | ```\n-- |\n-- | If some of the rows are shorter than the following rows, their elements are skipped:\n-- |\n-- | ```purescript\n-- | transpose \n-- | [ [10, 11]\n-- | , [20]\n-- | , [30, 31, 32]\n-- | ] == \n-- | [ [10, 20, 30]\n-- | , [11, 31]\n-- | , [32]\n-- | ]\n-- | ```\ntranspose :: forall a. Array (Array a) -> Array (Array a)\ntranspose xs = go 0 []\n where\n go :: Int -> Array (Array a) -> Array (Array a)\n go idx allArrays = case buildNext idx of\n Nothing -> allArrays\n Just next -> go (idx + 1) (snoc allArrays next)\n\n buildNext :: Int -> Maybe (Array a)\n buildNext idx = do\n xs # flip foldl Nothing \\acc nextArr -> do\n maybe acc (\\el -> Just $ maybe [ el ] (flip snoc el) acc) $ index nextArr idx\n\n-- | Fold a data structure from the left, keeping all intermediate results\n-- | instead of only the final result. Note that the initial value does not\n-- | appear in the result (unlike Haskell's `Prelude.scanl`).\n-- |\n-- | ```\n-- | scanl (+) 0 [1,2,3] = [1,3,6]\n-- | scanl (-) 10 [1,2,3] = [9,7,4]\n-- | ```\nscanl :: forall a b. (b -> a -> b) -> b -> Array a -> Array b\nscanl = runFn3 scanlImpl\n\nforeign import scanlImpl :: forall a b. Fn3 (b -> a -> b) b (Array a) (Array b)\n\n-- | Fold a data structure from the right, keeping all intermediate results\n-- | instead of only the final result. Note that the initial value does not\n-- | appear in the result (unlike Haskell's `Prelude.scanr`).\n-- |\n-- | ```\n-- | scanr (+) 0 [1,2,3] = [6,5,3]\n-- | scanr (flip (-)) 10 [1,2,3] = [4,5,7]\n-- | ```\nscanr :: forall a b. (a -> b -> b) -> b -> Array a -> Array b\nscanr = runFn3 scanrImpl\n\nforeign import scanrImpl :: forall a b. Fn3 (a -> b -> b) b (Array a) (Array b)\n\n--------------------------------------------------------------------------------\n-- Sorting ---------------------------------------------------------------------\n--------------------------------------------------------------------------------\n\n-- | Sort the elements of an array in increasing order, creating a new array.\n-- | Sorting is stable: the order of equal elements is preserved.\n-- |\n-- | ```purescript\n-- | sort [2, -3, 1] = [-3, 1, 2]\n-- | ```\n-- |\nsort :: forall a. Ord a => Array a -> Array a\nsort xs = sortBy compare xs\n\n-- | Sort the elements of an array in increasing order, where elements are\n-- | compared using the specified partial ordering, creating a new array.\n-- | Sorting is stable: the order of elements is preserved if they are equal\n-- | according to the specified partial ordering.\n-- |\n-- | ```purescript\n-- | compareLength a b = compare (length a) (length b)\n-- | sortBy compareLength [[1, 2, 3], [7, 9], [-2]] = [[-2],[7,9],[1,2,3]]\n-- | ```\n-- |\nsortBy :: forall a. (a -> a -> Ordering) -> Array a -> Array a\nsortBy comp = runFn3 sortByImpl comp case _ of\n GT -> 1\n EQ -> 0\n LT -> -1\n\n-- | Sort the elements of an array in increasing order, where elements are\n-- | sorted based on a projection. Sorting is stable: the order of elements is\n-- | preserved if they are equal according to the projection.\n-- |\n-- | ```purescript\n-- | sortWith (_.age) [{name: \"Alice\", age: 42}, {name: \"Bob\", age: 21}]\n-- | = [{name: \"Bob\", age: 21}, {name: \"Alice\", age: 42}]\n-- | ```\n-- |\nsortWith :: forall a b. Ord b => (a -> b) -> Array a -> Array a\nsortWith f = sortBy (comparing f)\n\nforeign import sortByImpl :: forall a. Fn3 (a -> a -> Ordering) (Ordering -> Int) (Array a) (Array a)\n\n--------------------------------------------------------------------------------\n-- Subarrays -------------------------------------------------------------------\n--------------------------------------------------------------------------------\n\n-- | Extract a subarray by a start and end index.\n-- |\n-- | ```purescript\n-- | letters = [\"a\", \"b\", \"c\"]\n-- | slice 1 3 letters = [\"b\", \"c\"]\n-- | slice 5 7 letters = []\n-- | slice 4 1 letters = []\n-- | ```\n-- |\nslice :: forall a. Int -> Int -> Array a -> Array a\nslice = runFn3 sliceImpl\n\nforeign import sliceImpl :: forall a. Fn3 Int Int (Array a) (Array a)\n\n-- | Keep only a number of elements from the start of an array, creating a new\n-- | array.\n-- |\n-- | ```purescript\n-- | letters = [\"a\", \"b\", \"c\"]\n-- |\n-- | take 2 letters = [\"a\", \"b\"]\n-- | take 100 letters = [\"a\", \"b\", \"c\"]\n-- | ```\n-- |\ntake :: forall a. Int -> Array a -> Array a\ntake n xs = if n < 1 then [] else slice 0 n xs\n\n-- | Keep only a number of elements from the end of an array, creating a new\n-- | array.\n-- |\n-- | ```purescript\n-- | letters = [\"a\", \"b\", \"c\"]\n-- |\n-- | takeEnd 2 letters = [\"b\", \"c\"]\n-- | takeEnd 100 letters = [\"a\", \"b\", \"c\"]\n-- | ```\n-- |\ntakeEnd :: forall a. Int -> Array a -> Array a\ntakeEnd n xs = drop (length xs - n) xs\n\n-- | Calculate the longest initial subarray for which all element satisfy the\n-- | specified predicate, creating a new array.\n-- |\n-- | ```purescript\n-- | takeWhile (_ > 0) [4, 1, 0, -4, 5] = [4, 1]\n-- | takeWhile (_ > 0) [-1, 4] = []\n-- | ```\n-- |\ntakeWhile :: forall a. (a -> Boolean) -> Array a -> Array a\ntakeWhile p xs = (span p xs).init\n\n-- | Drop a number of elements from the start of an array, creating a new array.\n-- |\n-- | ```purescript\n-- | letters = [\"a\", \"b\", \"c\", \"d\"]\n-- |\n-- | drop 2 letters = [\"c\", \"d\"]\n-- | drop 10 letters = []\n-- | ```\n-- |\ndrop :: forall a. Int -> Array a -> Array a\ndrop n xs = if n < 1 then xs else slice n (length xs) xs\n\n-- | Drop a number of elements from the end of an array, creating a new array.\n-- |\n-- | ```purescript\n-- | letters = [\"a\", \"b\", \"c\", \"d\"]\n-- |\n-- | dropEnd 2 letters = [\"a\", \"b\"]\n-- | dropEnd 10 letters = []\n-- | ```\n-- |\ndropEnd :: forall a. Int -> Array a -> Array a\ndropEnd n xs = take (length xs - n) xs\n\n-- | Remove the longest initial subarray for which all element satisfy the\n-- | specified predicate, creating a new array.\n-- |\n-- | ```purescript\n-- | dropWhile (_ < 0) [-3, -1, 0, 4, -6] = [0, 4, -6]\n-- | ```\n-- |\ndropWhile :: forall a. (a -> Boolean) -> Array a -> Array a\ndropWhile p xs = (span p xs).rest\n\n-- | Split an array into two parts:\n-- |\n-- | 1. the longest initial subarray for which all elements satisfy the\n-- | specified predicate\n-- | 2. the remaining elements\n-- |\n-- | ```purescript\n-- | span (\\n -> n % 2 == 1) [1,3,2,4,5] == { init: [1,3], rest: [2,4,5] }\n-- | ```\n-- |\n-- | Running time: `O(n)`.\nspan\n :: forall a\n . (a -> Boolean)\n -> Array a\n -> { init :: Array a, rest :: Array a }\nspan p arr =\n case breakIndex of\n Just 0 ->\n { init: [], rest: arr }\n Just i ->\n { init: slice 0 i arr, rest: slice i (length arr) arr }\n Nothing ->\n { init: arr, rest: [] }\n where\n breakIndex = go 0\n go i =\n -- This looks like a good opportunity to use the Monad Maybe instance,\n -- but it's important to write out an explicit case expression here in\n -- order to ensure that TCO is triggered.\n case index arr i of\n Just x -> if p x then go (i + 1) else Just i\n Nothing -> Nothing\n\n-- | Group equal, consecutive elements of an array into arrays.\n-- |\n-- | ```purescript\n-- | group [1, 1, 2, 2, 1] == [NonEmptyArray [1, 1], NonEmptyArray [2, 2], NonEmptyArray [1]]\n-- | ```\ngroup :: forall a. Eq a => Array a -> Array (NonEmptyArray a)\ngroup xs = groupBy eq xs\n\n-- | Group equal elements of an array into arrays.\n-- |\n-- | ```purescript\n-- | groupAll [1, 1, 2, 2, 1] == [NonEmptyArray [1, 1, 1], NonEmptyArray [2, 2]]\n-- | ```\ngroupAll :: forall a. Ord a => Array a -> Array (NonEmptyArray a)\ngroupAll = groupAllBy compare\n\n-- | Group equal, consecutive elements of an array into arrays, using the\n-- | specified equivalence relation to determine equality.\n-- |\n-- | ```purescript\n-- | groupBy (\\a b -> odd a && odd b) [1, 3, 2, 4, 3, 3]\n-- | = [NonEmptyArray [1, 3], NonEmptyArray [2], NonEmptyArray [4], NonEmptyArray [3, 3]]\n-- | ```\n-- |\ngroupBy :: forall a. (a -> a -> Boolean) -> Array a -> Array (NonEmptyArray a)\ngroupBy op xs =\n ST.run do\n result <- STA.new\n iter <- STAI.iterator (xs !! _)\n STAI.iterate iter \\x -> void do\n sub <- STA.new\n _ <- STA.push x sub\n STAI.pushWhile (op x) iter sub\n grp <- STA.unsafeFreeze sub\n STA.push (NonEmptyArray grp) result\n STA.unsafeFreeze result\n\n-- | Group equal elements of an array into arrays, using the specified\n-- | comparison function to determine equality.\n-- |\n-- | ```purescript\n-- | groupAllBy (comparing Down) [1, 3, 2, 4, 3, 3]\n-- | = [NonEmptyArray [4], NonEmptyArray [3, 3, 3], NonEmptyArray [2], NonEmptyArray [1]]\n-- | ```\n-- |\ngroupAllBy :: forall a. (a -> a -> Ordering) -> Array a -> Array (NonEmptyArray a)\ngroupAllBy cmp = groupBy (\\x y -> cmp x y == EQ) <<< sortBy cmp\n\n-- | Remove the duplicates from an array, creating a new array.\n-- |\n-- | ```purescript\n-- | nub [1, 2, 1, 3, 3] = [1, 2, 3]\n-- | ```\n-- |\nnub :: forall a. Ord a => Array a -> Array a\nnub = nubBy compare\n\n-- | Remove the duplicates from an array, creating a new array.\n-- |\n-- | This less efficient version of `nub` only requires an `Eq` instance.\n-- |\n-- | ```purescript\n-- | nubEq [1, 2, 1, 3, 3] = [1, 2, 3]\n-- | ```\n-- |\nnubEq :: forall a. Eq a => Array a -> Array a\nnubEq = nubByEq eq\n\n-- | Remove the duplicates from an array, where element equality is determined\n-- | by the specified ordering, creating a new array.\n-- |\n-- | ```purescript\n-- | nubBy compare [1, 3, 4, 2, 2, 1] == [1, 3, 4, 2]\n-- | ```\n-- |\nnubBy :: forall a. (a -> a -> Ordering) -> Array a -> Array a\nnubBy comp xs = case head indexedAndSorted of\n Nothing -> []\n Just x -> map snd $ sortWith fst $ ST.run do\n -- TODO: use NonEmptyArrays here to avoid partial functions\n result <- STA.unsafeThaw $ singleton x\n ST.foreach indexedAndSorted \\pair@(Tuple _ x') -> do\n lst <- snd <<< unsafePartial (fromJust <<< last) <$> STA.unsafeFreeze result\n when (comp lst x' /= EQ) $ void $ STA.push pair result\n STA.unsafeFreeze result\n where\n indexedAndSorted :: Array (Tuple Int a)\n indexedAndSorted = sortBy (\\x y -> comp (snd x) (snd y))\n (mapWithIndex Tuple xs)\n\n-- | Remove the duplicates from an array, where element equality is determined\n-- | by the specified equivalence relation, creating a new array.\n-- |\n-- | This less efficient version of `nubBy` only requires an equivalence\n-- | relation.\n-- |\n-- | ```purescript\n-- | mod3eq a b = a `mod` 3 == b `mod` 3\n-- | nubByEq mod3eq [1, 3, 4, 5, 6] = [1, 3, 5]\n-- | ```\n-- |\nnubByEq :: forall a. (a -> a -> Boolean) -> Array a -> Array a\nnubByEq eq xs = ST.run do\n arr <- STA.new\n ST.foreach xs \\x -> do\n e <- not <<< any (_ `eq` x) <$> (STA.unsafeFreeze arr)\n when e $ void $ STA.push x arr\n STA.unsafeFreeze arr\n\n-- | Calculate the union of two arrays. Note that duplicates in the first array\n-- | are preserved while duplicates in the second array are removed.\n-- |\n-- | Running time: `O(n^2)`\n-- |\n-- | ```purescript\n-- | union [1, 2, 1, 1] [3, 3, 3, 4] = [1, 2, 1, 1, 3, 4]\n-- | ```\n-- |\nunion :: forall a. Eq a => Array a -> Array a -> Array a\nunion = unionBy (==)\n\n-- | Calculate the union of two arrays, using the specified function to\n-- | determine equality of elements. Note that duplicates in the first array\n-- | are preserved while duplicates in the second array are removed.\n-- |\n-- | ```purescript\n-- | mod3eq a b = a `mod` 3 == b `mod` 3\n-- | unionBy mod3eq [1, 5, 1, 2] [3, 4, 3, 3] = [1, 5, 1, 2, 3]\n-- | ```\n-- |\nunionBy :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Array a\nunionBy eq xs ys = xs <> foldl (flip (deleteBy eq)) (nubByEq eq ys) xs\n\n-- | Delete the first element of an array which is equal to the specified value,\n-- | creating a new array.\n-- |\n-- | ```purescript\n-- | delete 7 [1, 7, 3, 7] = [1, 3, 7]\n-- | delete 7 [1, 2, 3] = [1, 2, 3]\n-- | ```\n-- |\n-- | Running time: `O(n)`\ndelete :: forall a. Eq a => a -> Array a -> Array a\ndelete = deleteBy eq\n\n-- | Delete the first element of an array which matches the specified value,\n-- | under the equivalence relation provided in the first argument, creating a\n-- | new array.\n-- |\n-- | ```purescript\n-- | mod3eq a b = a `mod` 3 == b `mod` 3\n-- | deleteBy mod3eq 6 [1, 3, 4, 3] = [1, 4, 3]\n-- | ```\n-- |\ndeleteBy :: forall a. (a -> a -> Boolean) -> a -> Array a -> Array a\ndeleteBy _ _ [] = []\ndeleteBy eq x ys = maybe ys (\\i -> unsafePartial $ fromJust (deleteAt i ys)) (findIndex (eq x) ys)\n\n-- | Delete the first occurrence of each element in the second array from the\n-- | first array, creating a new array.\n-- |\n-- | ```purescript\n-- | difference [2, 1] [2, 3] = [1]\n-- | ```\n-- |\n-- | Running time: `O(n*m)`, where n is the length of the first array, and m is\n-- | the length of the second.\ndifference :: forall a. Eq a => Array a -> Array a -> Array a\ndifference = foldr delete\n\ninfix 5 difference as \\\\\n\n-- | Calculate the intersection of two arrays, creating a new array. Note that\n-- | duplicates in the first array are preserved while duplicates in the second\n-- | array are removed.\n-- |\n-- | ```purescript\n-- | intersect [1, 1, 2] [2, 2, 1] = [1, 1, 2]\n-- | ```\n-- |\nintersect :: forall a. Eq a => Array a -> Array a -> Array a\nintersect = intersectBy eq\n\n-- | Calculate the intersection of two arrays, using the specified equivalence\n-- | relation to compare elements, creating a new array. Note that duplicates\n-- | in the first array are preserved while duplicates in the second array are\n-- | removed.\n-- |\n-- | ```purescript\n-- | mod3eq a b = a `mod` 3 == b `mod` 3\n-- | intersectBy mod3eq [1, 2, 3] [4, 6, 7] = [1, 3]\n-- | ```\n-- |\nintersectBy :: forall a. (a -> a -> Boolean) -> Array a -> Array a -> Array a\nintersectBy eq xs ys = filter (\\x -> isJust (findIndex (eq x) ys)) xs\n\n-- | Apply a function to pairs of elements at the same index in two arrays,\n-- | collecting the results in a new array.\n-- |\n-- | If one array is longer, elements will be discarded from the longer array.\n-- |\n-- | For example\n-- |\n-- | ```purescript\n-- | zipWith (*) [1, 2, 3] [4, 5, 6, 7] == [4, 10, 18]\n-- | ```\nzipWith\n :: forall a b c\n . (a -> b -> c)\n -> Array a\n -> Array b\n -> Array c\nzipWith = runFn3 zipWithImpl\n\nforeign import zipWithImpl\n :: forall a b c\n . Fn3\n (a -> b -> c)\n (Array a)\n (Array b)\n (Array c)\n\n-- | A generalization of `zipWith` which accumulates results in some\n-- | `Applicative` functor.\n-- |\n-- | ```purescript\n-- | sndChars = zipWithA (\\a b -> charAt 2 (a <> b))\n-- | sndChars [\"a\", \"b\"] [\"A\", \"B\"] = Nothing -- since \"aA\" has no 3rd char\n-- | sndChars [\"aa\", \"b\"] [\"AA\", \"BBB\"] = Just ['A', 'B']\n-- | ```\n-- |\nzipWithA\n :: forall m a b c\n . Applicative m\n => (a -> b -> m c)\n -> Array a\n -> Array b\n -> m (Array c)\nzipWithA f xs ys = sequence (zipWith f xs ys)\n\n-- | Takes two arrays and returns an array of corresponding pairs.\n-- | If one input array is short, excess elements of the longer array are\n-- | discarded.\n-- |\n-- | ```purescript\n-- | zip [1, 2, 3] [\"a\", \"b\"] = [Tuple 1 \"a\", Tuple 2 \"b\"]\n-- | ```\n-- |\nzip :: forall a b. Array a -> Array b -> Array (Tuple a b)\nzip = zipWith Tuple\n\n-- | Transforms an array of pairs into an array of first components and an\n-- | array of second components.\n-- |\n-- | ```purescript\n-- | unzip [Tuple 1 \"a\", Tuple 2 \"b\"] = Tuple [1, 2] [\"a\", \"b\"]\n-- | ```\n-- |\nunzip :: forall a b. Array (Tuple a b) -> Tuple (Array a) (Array b)\nunzip xs =\n ST.run do\n fsts <- STA.new\n snds <- STA.new\n iter <- STAI.iterator (xs !! _)\n STAI.iterate iter \\(Tuple fst snd) -> do\n void $ STA.push fst fsts\n void $ STA.push snd snds\n fsts' <- STA.unsafeFreeze fsts\n snds' <- STA.unsafeFreeze snds\n pure $ Tuple fsts' snds'\n\n-- | Returns true if at least one array element satisfies the given predicate,\n-- | iterating the array only as necessary and stopping as soon as the predicate\n-- | yields true.\n-- |\n-- | ```purescript\n-- | any (_ > 0) [] = False\n-- | any (_ > 0) [-1, 0, 1] = True\n-- | any (_ > 0) [-1, -2, -3] = False\n-- | ```\nany :: forall a. (a -> Boolean) -> Array a -> Boolean\nany = runFn2 anyImpl\n\nforeign import anyImpl :: forall a. Fn2 (a -> Boolean) (Array a) Boolean\n\n-- | Returns true if all the array elements satisfy the given predicate.\n-- | iterating the array only as necessary and stopping as soon as the predicate\n-- | yields false.\n-- |\n-- | ```purescript\n-- | all (_ > 0) [] = True\n-- | all (_ > 0) [1, 2, 3] = True\n-- | all (_ > 0) [-1, -2, -3] = False\n-- | ```\nall :: forall a. (a -> Boolean) -> Array a -> Boolean\nall = runFn2 allImpl\n\nforeign import allImpl :: forall a. Fn2 (a -> Boolean) (Array a) Boolean\n\n-- | Perform a fold using a monadic step function.\n-- |\n-- | ```purescript\n-- | foldM (\\x y -> Just (x + y)) 0 [1, 4] = Just 5\n-- | ```\nfoldM :: forall m a b. Monad m => (b -> a -> m b) -> b -> Array a -> m b\nfoldM f b = runFn3 unconsImpl (\\_ -> pure b) (\\a as -> f b a >>= \\b' -> foldM f b' as)\n\nfoldRecM :: forall m a b. MonadRec m => (b -> a -> m b) -> b -> Array a -> m b\nfoldRecM f b array = tailRecM2 go b 0\n where\n go res i\n | i >= length array = pure (Done res)\n | otherwise = do\n res' <- f res (unsafePartial (unsafeIndex array i))\n pure (Loop { a: res', b: i + 1 })\n\n-- | Find the element of an array at the specified index.\n-- |\n-- | ```purescript\n-- | unsafePartial $ unsafeIndex [\"a\", \"b\", \"c\"] 1 = \"b\"\n-- | ```\n-- |\n-- | Using `unsafeIndex` with an out-of-range index will not immediately raise a runtime error.\n-- | Instead, the result will be undefined. Most attempts to subsequently use the result will\n-- | cause a runtime error, of course, but this is not guaranteed, and is dependent on the backend;\n-- | some programs will continue to run as if nothing is wrong. For example, in the JavaScript backend,\n-- | the expression `unsafePartial (unsafeIndex [true] 1)` has type `Boolean`;\n-- | since this expression evaluates to `undefined`, attempting to use it in an `if` statement will cause\n-- | the else branch to be taken.\nunsafeIndex :: forall a. Partial => Array a -> Int -> a\nunsafeIndex = runFn2 unsafeIndexImpl\n\nforeign import unsafeIndexImpl :: forall a. Fn2 (Array a) Int a\n", "const newImpl = function () {\n return {};\n};\nexport { newImpl as new };\n\nexport function peekImpl(just) {\n return function (nothing) {\n return function (k) {\n return function (m) {\n return function () {\n return {}.hasOwnProperty.call(m, k) ? just(m[k]) : nothing;\n };\n };\n };\n };\n}\n\nexport function poke(k) {\n return function (v) {\n return function (m) {\n return function () {\n m[k] = v;\n return m;\n };\n };\n };\n}\n\nconst deleteImpl = function (k) {\n return function (m) {\n return function () {\n delete m[k];\n return m;\n };\n };\n};\nexport { deleteImpl as delete };\n", "-- | This module defines a type of native homogeneous Javascript Objects.\n-- |\n-- | To maximize performance, Javascript objects are not wrapped,\n-- | and some native code is used even when it's not necessary.\n\nmodule Foreign.Object\n ( Object\n , empty\n , isEmpty\n , size\n , singleton\n , insert\n , lookup\n , toUnfoldable\n , toAscUnfoldable\n , fromFoldable\n , fromFoldableWith\n , fromFoldableWithIndex\n , fromHomogeneous\n , delete\n , pop\n , member\n , alter\n , update\n , mapWithKey\n , filterWithKey\n , filterKeys\n , filter\n , keys\n , values\n , union\n , unionWith\n , unions\n , isSubmap\n , fold\n , foldMap\n , foldM\n , foldMaybe\n , all\n , thawST\n , freezeST\n , runST\n , toArrayWithKey\n ) where\n\nimport Prelude\n\nimport Control.Monad.ST (ST)\nimport Control.Monad.ST as ST\nimport Data.Array as A\nimport Data.Eq (class Eq1)\nimport Data.Foldable (class Foldable, foldl, foldr, for_)\nimport Data.FoldableWithIndex (class FoldableWithIndex, forWithIndex_)\nimport Data.Function.Uncurried (Fn2, runFn2, Fn4, runFn4)\nimport Data.FunctorWithIndex (class FunctorWithIndex)\nimport Data.Maybe (Maybe(..), maybe, fromMaybe)\nimport Data.Traversable (class Traversable, traverse)\nimport Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)\nimport Data.Tuple (Tuple(..), fst, uncurry)\nimport Data.Unfoldable (class Unfoldable)\nimport Foreign.Object.ST (STObject)\nimport Foreign.Object.ST as OST\nimport Type.Row.Homogeneous (class Homogeneous)\nimport Unsafe.Coerce (unsafeCoerce)\n\n-- | `Object a` represents a homogeneous JS Object with values of type `a`.\nforeign import data Object :: Type -> Type\n\ntype role Object representational\n\nforeign import _copyST :: forall a b r. a -> ST r b\n\n-- | Convert an immutable Object into a mutable Object\nthawST :: forall a r. Object a -> ST r (STObject r a)\nthawST = _copyST\n\n-- | Convert a mutable Object into an immutable Object\nfreezeST :: forall a r. STObject r a -> ST r (Object a)\nfreezeST = _copyST\n\n-- | Freeze a mutable Object, creating an immutable Object. Use this function as you would use\n-- | `Control.Monad.ST.run` (from the `purescript-st` package) to freeze a mutable reference.\n-- |\n-- | The rank-2 type prevents the Object from escaping the scope of `runST`.\nforeign import runST :: forall a. (forall r. ST r (STObject r a)) -> Object a\n\nmutate :: forall a b. (forall r. STObject r a -> ST r b) -> Object a -> Object a\nmutate f m = runST do\n s <- thawST m\n _ <- f s\n pure s\n\nforeign import _fmapObject :: forall a b. Fn2 (Object a) (a -> b) (Object b)\n\ninstance functorObject :: Functor Object where\n map f m = runFn2 _fmapObject m f\n\ninstance functorWithIndexObject :: FunctorWithIndex String Object where\n mapWithIndex = mapWithKey\n\nforeign import _foldM :: forall a m z. (m -> (z -> m) -> m) -> (z -> String -> a -> m) -> m -> Object a -> m\n\n-- | Fold the keys and values of an object\nfold :: forall a z. (z -> String -> a -> z) -> z -> Object a -> z\nfold = _foldM ((#))\n\n-- | Fold the keys and values of an object, accumulating values using some\n-- | `Monoid`.\nfoldMap :: forall a m. Monoid m => (String -> a -> m) -> Object a -> m\nfoldMap f = fold (\\acc k v -> acc <> f k v) mempty\n\n-- | Fold the keys and values of an object, accumulating values and effects in\n-- | some `Monad`.\nfoldM :: forall a m z. Monad m => (z -> String -> a -> m z) -> z -> Object a -> m z\nfoldM f z = _foldM bind f (pure z)\n\ninstance foldableObject :: Foldable Object where\n foldl f = fold (\\z _ -> f z)\n foldr f z m = foldr f z (values m)\n foldMap f = foldMap (const f)\n\ninstance foldableWithIndexObject :: FoldableWithIndex String Object where\n foldlWithIndex f = fold (flip f)\n foldrWithIndex f z m = foldr (uncurry f) z (toArrayWithKey Tuple m)\n foldMapWithIndex = foldMap\n\ninstance traversableObject :: Traversable Object where\n traverse = traverseWithIndex <<< const\n sequence = traverse identity\n\ninstance traversableWithIndexObject :: TraversableWithIndex String Object where\n traverseWithIndex f ms =\n fold (\\acc k v -> flip (insert k) <$> acc <*> f k v) (pure empty) ms\n\n-- Unfortunately the above are not short-circuitable (consider using purescript-machines)\n-- so we need special cases:\n\nforeign import _foldSCObject :: forall a z. Fn4 (Object a) z (z -> String -> a -> Maybe z) (forall b. b -> Maybe b -> b) z\n\n-- | Fold the keys and values of a map.\n-- |\n-- | This function allows the folding function to terminate the fold early,\n-- | using `Maybe`.\nfoldMaybe :: forall a z. (z -> String -> a -> Maybe z) -> z -> Object a -> z\nfoldMaybe f z m = runFn4 _foldSCObject m z f fromMaybe\n\n-- | Test whether all key/value pairs in a `Object` satisfy a predicate.\nforeign import all :: forall a. (String -> a -> Boolean) -> Object a -> Boolean\n\ninstance eqObject :: Eq a => Eq (Object a) where\n eq m1 m2 = (isSubmap m1 m2) && (isSubmap m2 m1)\n\ninstance eq1Object :: Eq1 Object where\n eq1 = eq\n\n-- Internal use\ntoAscArray :: forall v. Object v -> Array (Tuple String v)\ntoAscArray = toAscUnfoldable\n\ninstance ordObject :: Ord a => Ord (Object a) where\n compare m1 m2 = compare (toAscArray m1) (toAscArray m2)\n\ninstance showObject :: Show a => Show (Object a) where\n show m = \"(fromFoldable \" <> show (toArray m) <> \")\"\n\n-- | An empty map\nforeign import empty :: forall a. Object a\n\n-- | Test whether one map contains all of the keys and values contained in another map\nisSubmap :: forall a. Eq a => Object a -> Object a -> Boolean\nisSubmap m1 m2 = all f m1 where\n f k v = runFn4 _lookup false ((==) v) k m2\n\n-- | Test whether a map is empty\nisEmpty :: forall a. Object a -> Boolean\nisEmpty = all (\\_ _ -> false)\n\n-- | Calculate the number of key/value pairs in a map\nforeign import size :: forall a. Object a -> Int\n\n-- | Create an `Object a` with one key/value pair\nsingleton :: forall a. String -> a -> Object a\nsingleton k v = runST (OST.poke k v =<< OST.new)\n\nforeign import _lookup :: forall a z. Fn4 z (a -> z) String (Object a) z\n\n-- | Lookup the value for a key in a map\nlookup :: forall a. String -> Object a -> Maybe a\nlookup = runFn4 _lookup Nothing Just\n\n-- | Test whether a `String` appears as a key in a map\nmember :: forall a. String -> Object a -> Boolean\nmember = runFn4 _lookup false (const true)\n\n-- | Insert or replace a key/value pair in a map\ninsert :: forall a. String -> a -> Object a -> Object a\ninsert k v = mutate (OST.poke k v)\n\n-- | Delete a key and value from a map\ndelete :: forall a. String -> Object a -> Object a\ndelete k = mutate (OST.delete k)\n\n-- | Delete a key and value from a map, returning the value\n-- | as well as the subsequent map\npop :: forall a. String -> Object a -> Maybe (Tuple a (Object a))\npop k m = lookup k m <#> \\a -> Tuple a (delete k m)\n\n-- | Insert, remove or update a value for a key in a map\nalter :: forall a. (Maybe a -> Maybe a) -> String -> Object a -> Object a\nalter f k m = case f (k `lookup` m) of\n Nothing -> delete k m\n Just v -> insert k v m\n\n-- | Remove or update a value for a key in a map\nupdate :: forall a. (a -> Maybe a) -> String -> Object a -> Object a\nupdate f k m = alter (maybe Nothing f) k m\n\n-- | Create an `Object a` from a foldable collection of key/value pairs\nfromFoldable :: forall f a. Foldable f => f (Tuple String a) -> Object a\nfromFoldable l = runST do\n s <- OST.new\n ST.foreach (A.fromFoldable l) \\(Tuple k v) -> void $ OST.poke k v s\n pure s\n\n-- | Create an `Object a` from a `String`-indexed foldable collection\nfromFoldableWithIndex :: forall f a. FoldableWithIndex String f => f a -> Object a\nfromFoldableWithIndex l = runST do\n s <- OST.new\n forWithIndex_ l \\k v -> OST.poke k v s\n pure s\n\nforeign import _lookupST :: forall a r z. Fn4 z (a -> z) String (STObject r a) (ST r z)\n\n-- | Create an `Object a` from a foldable collection of key/value pairs, using the\n-- | specified function to combine values for duplicate keys.\nfromFoldableWith :: forall f a. Foldable f => (a -> a -> a) -> f (Tuple String a) -> Object a\nfromFoldableWith f l = runST (do\n s <- OST.new\n for_ l (\\(Tuple k v) -> runFn4 _lookupST v (f v) k s >>= \\v' -> OST.poke k v' s)\n pure s)\n\n-- | Create an `Object a` from a homogeneous record, i.e. all of the record\n-- | fields are of the same type.\nfromHomogeneous :: forall r a. Homogeneous r a => { | r } -> Object a\nfromHomogeneous = unsafeCoerce\n\nforeign import toArrayWithKey :: forall a b . (String -> a -> b) -> Object a -> Array b\n\n-- | Unfolds a map into a list of key/value pairs\ntoUnfoldable :: forall f a. Unfoldable f => Object a -> f (Tuple String a)\ntoUnfoldable = A.toUnfoldable <<< toArrayWithKey Tuple\n\n-- | Unfolds a map into a list of key/value pairs which is guaranteed to be\n-- | sorted by key\ntoAscUnfoldable :: forall f a. Unfoldable f => Object a -> f (Tuple String a)\ntoAscUnfoldable = A.toUnfoldable <<< A.sortWith fst <<< toArrayWithKey Tuple\n\n-- Internal\ntoArray :: forall a. Object a -> Array (Tuple String a)\ntoArray = toArrayWithKey Tuple\n\n-- | Get an array of the keys in a map\nforeign import keys :: forall a. Object a -> Array String\n\n-- | Get a list of the values in a map\nvalues :: forall a. Object a -> Array a\nvalues = toArrayWithKey (\\_ v -> v)\n\n-- | Compute the union of two maps, preferring the first map in the case of\n-- | duplicate keys.\nunion :: forall a. Object a -> Object a -> Object a\nunion m = mutate (\\s -> foldM (\\s' k v -> OST.poke k v s') s m)\n\n-- | Compute the union of two maps, using the specified function\n-- | to combine values for duplicate keys.\nunionWith :: forall a. (a -> a -> a) -> Object a -> Object a -> Object a\nunionWith f m1 m2 =\n mutate (\\s1 -> foldM (\\s2 k v1 -> OST.poke k (runFn4 _lookup v1 (\\v2 -> f v1 v2) k m2) s2) s1 m1) m2\n\n-- | Compute the union of a collection of maps\nunions :: forall f a. Foldable f => f (Object a) -> Object a\nunions = foldl union empty\n\nforeign import _mapWithKey :: forall a b. Fn2 (Object a) (String -> a -> b) (Object b)\n\n-- | Apply a function of two arguments to each key/value pair, producing a new map\nmapWithKey :: forall a b. (String -> a -> b) -> Object a -> Object b\nmapWithKey f m = runFn2 _mapWithKey m f\n\ninstance semigroupObject :: (Semigroup a) => Semigroup (Object a) where\n append = unionWith (<>)\n\ninstance monoidObject :: (Semigroup a) => Monoid (Object a) where\n mempty = empty\n\n-- | Filter out those key/value pairs of a map for which a predicate\n-- | fails to hold.\nfilterWithKey :: forall a. (String -> a -> Boolean) -> Object a -> Object a\nfilterWithKey predicate m = runST go\n where\n go :: forall r. ST r (STObject r a)\n go = do\n m' <- OST.new\n foldM step m' m\n where\n step acc k v = if predicate k v then OST.poke k v acc else pure acc\n\n-- | Filter out those key/value pairs of a map for which a predicate\n-- | on the key fails to hold.\nfilterKeys :: (String -> Boolean) -> Object ~> Object\nfilterKeys predicate = filterWithKey $ const <<< predicate\n\n-- | Filter out those key/value pairs of a map for which a predicate\n-- | on the value fails to hold.\nfilter :: forall a. (a -> Boolean) -> Object a -> Object a\nfilter predicate = filterWithKey $ const predicate\n", "-- | ## Overview of the Problem\n-- |\n-- | This module provides a way of dealing with the JS idiom of options\n-- | objects in PureScript, by giving you the tools to provide a reasonably\n-- | comfortable typed layer on top of JavaScript APIs which make use of this\n-- | idiom.\n-- |\n-- | Many JavaScript APIs include functions which take an object argument,\n-- | where the object's properties come from a fixed set of optional\n-- | configuration values. For example, the `createWriteStream` function from\n-- | the Node.js `fs` module may contain properties such as:\n-- |\n-- | - `flags`, which should be a `String`, such as `\"w\"`, `\"rw\"`, or `\"r+\"`,\n-- | - `defaultEncoding`, which should be a `String` representing an\n-- | encoding, such as `\"utf8\"`,\n-- |\n-- | and so on.\n-- |\n-- | ## Why PureScript Records Don't Work\n-- |\n-- | PureScript's record types can be a little awkward for this, since it is\n-- | usually the case that any subset of these properties can be specified;\n-- | however, a value of type `{ flags :: String, defaultEncoding :: String, [...] }`\n-- | must include every property listed, even if you only want to specify\n-- | one or two properties.\n-- |\n-- | ## Using this Library\n-- |\n-- | This library provides a better solution for this problem. Using this\n-- | module, you could wrap `fs.createWriteStream` as follows:\n-- |\n-- | First, create a phantom type used for the options object:\n-- |\n-- | ```purescript\n-- | data CreateWriteStreamOptions\n-- | ```\n-- |\n-- | Then, create `Option` values for each of the options:\n-- |\n-- | ```purescript\n-- | flags :: Option CreateWriteStreamOptions String\n-- | flags = opt \"flags\"\n-- |\n-- | defaultEncoding :: Option CreateWriteStreamOptions String\n-- | defaultEncoding = opt \"defaultEncoding\"\n-- |\n-- | -- and so on\n-- | ```\n-- |\n-- | Import the function you're wrapping using the FFI, using the `Foreign`\n-- | type for the options object:\n-- |\n-- | ```purescript\n-- | -- don't export this!\n-- | foreign import createWriteStreamImpl :: FilePath -> Foreign -> Effect Unit\n-- | ```\n-- |\n-- | Finally, in the function you are going to export, take an `Options` value\n-- | for the options argument, and use the `options` function provided by this\n-- | library to convert it into a `Foreign` value, which will then have a\n-- | suitable representation for passing to the JavaScript API.\n-- |\n-- | ```\n-- | createWriteStream :: FilePath -> Options CreateWriteStreamOptions -> Effect Unit\n-- | createWriteStream path opts = createWriteStreamImpl path (options opts)\n-- | ```\n-- |\n-- | Then, users of your API can create `Options` values using the `:=`\n-- | operator to assign values for the options they want to configure, and the\n-- | `Monoid Options` instance to combine them. For example, as a user of this\n-- | API, you might write:\n-- |\n-- | ```purescript\n-- | FS.createWriteStream \"file.txt\" $\n-- | defaultEncoding := \"utf8\" <>\n-- | flags := \"rw\"\n-- | ```\n-- |\n-- | ## Increasing Type Safety\n-- |\n-- | You can also use more specific types for more type safety. For example,\n-- | it would be safer to use the existing `FileFlags` and `Encoding` types\n-- | already provided by the `node-fs` library. However, we cannot use them\n-- | directly because they will have the wrong runtime representation. This is\n-- | where the `Contravariant` instance for `Option` comes in; it can be used\n-- | to transform an option's value to give it a suitable runtime\n-- | representation based on what the JS API is expecting. For example:\n-- |\n-- | ```purescript\n-- | flags :: Option CreateWriteStreamOptions FileFlags\n-- | flags = cmap fileFlagsToNode (opt \"flags\")\n-- | ```\n-- |\n-- | Note that `fileFlagsToNode` takes a `FileFlags` and returns a `String`\n-- | suitable for passing to a Node.js API.\nmodule Data.Options\n ( Options(..)\n , options\n , Option\n , assoc\n , (:=)\n , optional\n , opt\n , tag\n , defaultToOptions\n ) where\n\nimport Prelude\n\nimport Data.Maybe (Maybe, maybe)\nimport Data.Newtype (class Newtype, unwrap)\nimport Data.Op (Op(..))\nimport Data.Tuple (Tuple(..))\nimport Foreign (Foreign, unsafeToForeign)\nimport Foreign.Object as Object\n\n-- | The `Options` type represents a set of options. The type argument is a\n-- | phantom type, which is useful for ensuring that options for one particular\n-- | API are not accidentally passed to some other API.\nnewtype Options :: forall k. k -> Type\nnewtype Options opt = Options (Array (Tuple String Foreign))\n\ntype role Options nominal\n\nderive instance newtypeOptions :: Newtype (Options opt) _\nderive newtype instance semigroupOptions :: Semigroup (Options opt)\nderive newtype instance monoidOptions :: Monoid (Options opt)\n\n-- | Convert an `Options` value into a JavaScript object, suitable for passing\n-- | to JavaScript APIs.\noptions :: forall opt. Options opt -> Foreign\noptions (Options os) = unsafeToForeign (Object.fromFoldable os)\n\n-- | An `Option` represents an opportunity to configure a specific attribute\n-- | of a call to some API. This normally corresponds to one specific property\n-- | of an \"options\" object in JavaScript APIs, but can in general correspond\n-- | to zero or more actual properties.\ntype Option :: forall k. k -> (Type -> Type)\ntype Option opt = Op (Options opt)\n\n-- | Associates a value with a specific option.\nassoc :: forall opt value. Option opt value -> value -> Options opt\nassoc = unwrap\n\n-- | An infix version of `assoc`.\ninfixr 6 assoc as :=\n\n-- | A version of `assoc` which takes possibly absent values. `Nothing` values\n-- | are ignored; passing `Nothing` for the second argument will result in an\n-- | empty `Options`.\noptional :: forall opt value. Option opt value -> Option opt (Maybe value)\noptional option = Op $ maybe mempty (option := _)\n\n-- | The default way of creating `Option` values. Constructs an `Option` with\n-- | the given key, which passes the given value through unchanged.\nopt :: forall opt value. String -> Option opt value\nopt = Op <<< defaultToOptions\n\n-- | Create a `tag`, by fixing an `Option` to a single value.\ntag :: forall opt value. Option opt value -> value -> Option opt Unit\ntag o value = Op \\_ -> o := value\n\n-- | The default method for turning a string property key into an\n-- | `Option`. This function simply calls `unsafeToForeign` on the value. If\n-- | you need some other behaviour, you can write your own function to replace\n-- | this one, and construct an `Option` yourself.\ndefaultToOptions :: forall opt value. String -> value -> Options opt\ndefaultToOptions k v = Options [ Tuple k (unsafeToForeign v) ]\n", "module CSS.String where\n\nimport Prelude\n\nclass IsString s where\n fromString :: String -> s\n\ninstance isStringString :: IsString String where\n fromString = identity\n", "/* global Symbol */\n\nvar hasArrayFrom = typeof Array.from === \"function\";\nvar hasStringIterator =\n typeof Symbol !== \"undefined\" &&\n Symbol != null &&\n typeof Symbol.iterator !== \"undefined\" &&\n typeof String.prototype[Symbol.iterator] === \"function\";\nvar hasFromCodePoint = typeof String.prototype.fromCodePoint === \"function\";\nvar hasCodePointAt = typeof String.prototype.codePointAt === \"function\";\n\nexport const _unsafeCodePointAt0 = function (fallback) {\n return hasCodePointAt\n ? function (str) { return str.codePointAt(0); }\n : fallback;\n};\n\nexport const _codePointAt = function (fallback) {\n return function (Just) {\n return function (Nothing) {\n return function (unsafeCodePointAt0) {\n return function (index) {\n return function (str) {\n var length = str.length;\n if (index < 0 || index >= length) return Nothing;\n if (hasStringIterator) {\n var iter = str[Symbol.iterator]();\n for (var i = index;; --i) {\n var o = iter.next();\n if (o.done) return Nothing;\n if (i === 0) return Just(unsafeCodePointAt0(o.value));\n }\n }\n return fallback(index)(str);\n };\n };\n };\n };\n };\n};\n\nexport const _countPrefix = function (fallback) {\n return function (unsafeCodePointAt0) {\n if (hasStringIterator) {\n return function (pred) {\n return function (str) {\n var iter = str[Symbol.iterator]();\n for (var cpCount = 0; ; ++cpCount) {\n var o = iter.next();\n if (o.done) return cpCount;\n var cp = unsafeCodePointAt0(o.value);\n if (!pred(cp)) return cpCount;\n }\n };\n };\n }\n return fallback;\n };\n};\n\nexport const _fromCodePointArray = function (singleton) {\n return hasFromCodePoint\n ? function (cps) {\n // Function.prototype.apply will fail for very large second parameters,\n // so we don't use it for arrays with 10,000 or more entries.\n if (cps.length < 10e3) {\n return String.fromCodePoint.apply(String, cps);\n }\n return cps.map(singleton).join(\"\");\n }\n : function (cps) {\n return cps.map(singleton).join(\"\");\n };\n};\n\nexport const _singleton = function (fallback) {\n return hasFromCodePoint ? String.fromCodePoint : fallback;\n};\n\nexport const _take = function (fallback) {\n return function (n) {\n if (hasStringIterator) {\n return function (str) {\n var accum = \"\";\n var iter = str[Symbol.iterator]();\n for (var i = 0; i < n; ++i) {\n var o = iter.next();\n if (o.done) return accum;\n accum += o.value;\n }\n return accum;\n };\n }\n return fallback(n);\n };\n};\n\nexport const _toCodePointArray = function (fallback) {\n return function (unsafeCodePointAt0) {\n if (hasArrayFrom) {\n return function (str) {\n return Array.from(str, unsafeCodePointAt0);\n };\n }\n return fallback;\n };\n};\n", "export function toCharCode(c) {\n return c.charCodeAt(0);\n}\n\nexport function fromCharCode(c) {\n return String.fromCharCode(c);\n}\n", "module Data.Enum\n ( class Enum, succ, pred\n , class BoundedEnum, cardinality, toEnum, fromEnum\n , toEnumWithDefaults\n , Cardinality(..)\n , enumFromTo\n , enumFromThenTo\n , upFrom\n , upFromIncluding\n , downFrom\n , downFromIncluding\n , defaultSucc\n , defaultPred\n , defaultCardinality\n , defaultToEnum\n , defaultFromEnum\n ) where\n\nimport Prelude\n\nimport Control.MonadPlus (guard)\nimport Data.Either (Either(..))\nimport Data.Maybe (Maybe(..), maybe, fromJust)\nimport Data.Newtype (class Newtype)\nimport Data.Tuple (Tuple(..))\nimport Data.Unfoldable (class Unfoldable, singleton, unfoldr)\nimport Data.Unfoldable1 (class Unfoldable1, unfoldr1)\nimport Partial.Unsafe (unsafePartial)\n\n-- | Type class for enumerations.\n-- |\n-- | Laws:\n-- | - Successor: `all (a < _) (succ a)`\n-- | - Predecessor: `all (_ < a) (pred a)`\n-- | - Succ retracts pred: `pred >=> succ >=> pred = pred`\n-- | - Pred retracts succ: `succ >=> pred >=> succ = succ`\n-- | - Non-skipping succ: `b <= a || any (_ <= b) (succ a)`\n-- | - Non-skipping pred: `a <= b || any (b <= _) (pred a)`\n-- |\n-- | The retraction laws can intuitively be understood as saying that `succ` is\n-- | the opposite of `pred`; if you apply `succ` and then `pred` to something,\n-- | you should end up with what you started with (although of course this\n-- | doesn't apply if you tried to `succ` the last value in an enumeration and\n-- | therefore got `Nothing` out).\n-- |\n-- | The non-skipping laws can intuitively be understood as saying that `succ`\n-- | shouldn't skip over any elements of your type. For example, _without_ the\n-- | non-skipping laws, it would be permissible to write an `Enum Int` instance\n-- | where `succ x = Just (x+2)`, and similarly `pred x = Just (x-2)`.\nclass Ord a <= Enum a where\n succ :: a -> Maybe a\n pred :: a -> Maybe a\n\ninstance enumBoolean :: Enum Boolean where\n succ false = Just true\n succ _ = Nothing\n pred true = Just false\n pred _= Nothing\n\ninstance enumInt :: Enum Int where\n succ n = if n < top then Just (n + 1) else Nothing\n pred n = if n > bottom then Just (n - 1) else Nothing\n\ninstance enumChar :: Enum Char where\n succ = defaultSucc charToEnum toCharCode\n pred = defaultPred charToEnum toCharCode\n\ninstance enumUnit :: Enum Unit where\n succ = const Nothing\n pred = const Nothing\n\ninstance enumOrdering :: Enum Ordering where\n succ LT = Just EQ\n succ EQ = Just GT\n succ GT = Nothing\n pred LT = Nothing\n pred EQ = Just LT\n pred GT = Just EQ\n\ninstance enumMaybe :: BoundedEnum a => Enum (Maybe a) where\n succ Nothing = Just (Just bottom)\n succ (Just a) = Just <$> succ a\n pred Nothing = Nothing\n pred (Just a) = Just (pred a)\n\ninstance enumEither :: (BoundedEnum a, BoundedEnum b) => Enum (Either a b) where\n succ (Left a) = maybe (Just (Right bottom)) (Just <<< Left) (succ a)\n succ (Right b) = maybe Nothing (Just <<< Right) (succ b)\n pred (Left a) = maybe Nothing (Just <<< Left) (pred a)\n pred (Right b) = maybe (Just (Left top)) (Just <<< Right) (pred b)\n\ninstance enumTuple :: (Enum a, BoundedEnum b) => Enum (Tuple a b) where\n succ (Tuple a b) = maybe (flip Tuple bottom <$> succ a) (Just <<< Tuple a) (succ b)\n pred (Tuple a b) = maybe (flip Tuple top <$> pred a) (Just <<< Tuple a) (pred b)\n\n-- | Type class for finite enumerations.\n-- |\n-- | This should not be considered a part of a numeric hierarchy, as in Haskell.\n-- | Rather, this is a type class for small, ordered sum types with\n-- | statically-determined cardinality and the ability to easily compute\n-- | successor and predecessor elements like `DayOfWeek`.\n-- |\n-- | Laws:\n-- |\n-- | - ```succ bottom >>= succ >>= succ ... succ [cardinality - 1 times] == top```\n-- | - ```pred top >>= pred >>= pred ... pred [cardinality - 1 times] == bottom```\n-- | - ```forall a > bottom: pred a >>= succ == Just a```\n-- | - ```forall a < top: succ a >>= pred == Just a```\n-- | - ```forall a > bottom: fromEnum <$> pred a = pred (fromEnum a)```\n-- | - ```forall a < top: fromEnum <$> succ a = succ (fromEnum a)```\n-- | - ```e1 `compare` e2 == fromEnum e1 `compare` fromEnum e2```\n-- | - ```toEnum (fromEnum a) = Just a```\nclass (Bounded a, Enum a) <= BoundedEnum a where\n cardinality :: Cardinality a\n toEnum :: Int -> Maybe a\n fromEnum :: a -> Int\n\ninstance boundedEnumBoolean :: BoundedEnum Boolean where\n cardinality = Cardinality 2\n toEnum 0 = Just false\n toEnum 1 = Just true\n toEnum _ = Nothing\n fromEnum false = 0\n fromEnum true = 1\n\ninstance boundedEnumChar :: BoundedEnum Char where\n cardinality = Cardinality (toCharCode top - toCharCode bottom)\n toEnum = charToEnum\n fromEnum = toCharCode\n\ninstance boundedEnumUnit :: BoundedEnum Unit where\n cardinality = Cardinality 1\n toEnum 0 = Just unit\n toEnum _ = Nothing\n fromEnum = const 0\n\ninstance boundedEnumOrdering :: BoundedEnum Ordering where\n cardinality = Cardinality 3\n toEnum 0 = Just LT\n toEnum 1 = Just EQ\n toEnum 2 = Just GT\n toEnum _ = Nothing\n fromEnum LT = 0\n fromEnum EQ = 1\n fromEnum GT = 2\n\n-- | Like `toEnum` but returns the first argument if `x` is less than\n-- | `fromEnum bottom` and the second argument if `x` is greater than\n-- | `fromEnum top`.\n-- |\n-- | ``` purescript\n-- | toEnumWithDefaults False True (-1) -- False\n-- | toEnumWithDefaults False True 0 -- False\n-- | toEnumWithDefaults False True 1 -- True\n-- | toEnumWithDefaults False True 2 -- True\n-- | ```\ntoEnumWithDefaults :: forall a. BoundedEnum a => a -> a -> Int -> a\ntoEnumWithDefaults low high x = case toEnum x of\n Just enum -> enum\n Nothing -> if x < fromEnum (bottom :: a) then low else high\n\n-- | A type for the size of finite enumerations.\nnewtype Cardinality :: forall k. k -> Type\nnewtype Cardinality a = Cardinality Int\n\ntype role Cardinality representational\n\nderive instance newtypeCardinality :: Newtype (Cardinality a) _\nderive newtype instance eqCardinality :: Eq (Cardinality a)\nderive newtype instance ordCardinality :: Ord (Cardinality a)\n\ninstance showCardinality :: Show (Cardinality a) where\n show (Cardinality n) = \"(Cardinality \" <> show n <> \")\"\n\n-- | Returns a contiguous sequence of elements from the first value to the\n-- | second value (inclusive).\n-- |\n-- | ``` purescript\n-- | enumFromTo 0 3 = [0, 1, 2, 3]\n-- | enumFromTo 'c' 'a' = ['c', 'b', 'a']\n-- | ```\n-- |\n-- | The example shows `Array` return values, but the result can be any type\n-- | with an `Unfoldable1` instance.\nenumFromTo :: forall a u. Enum a => Unfoldable1 u => a -> a -> u a\nenumFromTo = case _, _ of\n from, to\n | from == to -> singleton from\n | from < to -> unfoldr1 (go succ (<=) to) from\n | otherwise -> unfoldr1 (go pred (>=) to) from\n where\n go step op to a = Tuple a (step a >>= \\a' -> guard (a' `op` to) $> a')\n\n-- | Returns a sequence of elements from the first value, taking steps\n-- | according to the difference between the first and second value, up to\n-- | (but not exceeding) the third value.\n-- |\n-- | ``` purescript\n-- | enumFromThenTo 0 2 6 = [0, 2, 4, 6]\n-- | enumFromThenTo 0 3 5 = [0, 3]\n-- | ```\n-- |\n-- | Note that there is no `BoundedEnum` instance for integers, they're just\n-- | being used here for illustrative purposes to help clarify the behaviour.\n-- |\n-- | The example shows `Array` return values, but the result can be any type\n-- | with an `Unfoldable1` instance.\nenumFromThenTo :: forall f a. Unfoldable f => Functor f => BoundedEnum a => a -> a -> a -> f a\nenumFromThenTo = unsafePartial \\a b c ->\n let\n a' = fromEnum a\n b' = fromEnum b\n c' = fromEnum c\n in\n (toEnum >>> fromJust) <$> unfoldr (go (b' - a') c') a'\n where\n go step to e\n | e <= to = Just (Tuple e (e + step))\n | otherwise = Nothing\n\n-- | Produces all successors of an `Enum` value, excluding the start value.\nupFrom :: forall a u. Enum a => Unfoldable u => a -> u a\nupFrom = unfoldr (map diag <<< succ)\n\n-- | Produces all successors of an `Enum` value, including the start value.\n-- |\n-- | `upFromIncluding bottom` will return all values in an `Enum`.\nupFromIncluding :: \u2200 a u. Enum a => Unfoldable1 u => a -> u a\nupFromIncluding = unfoldr1 (Tuple <*> succ)\n\n-- | Produces all predecessors of an `Enum` value, excluding the start value.\ndownFrom :: forall a u. Enum a => Unfoldable u => a -> u a\ndownFrom = unfoldr (map diag <<< pred)\n\n-- | Produces all predecessors of an `Enum` value, including the start value.\n-- |\n-- | `downFromIncluding top` will return all values in an `Enum`, in reverse\n-- | order.\ndownFromIncluding :: forall a u. Enum a => Unfoldable1 u => a -> u a\ndownFromIncluding = unfoldr1 (Tuple <*> pred)\n\n-- | Provides a default implementation for `succ`, given a function that maps\n-- | integers to values in the `Enum`, and a function that maps values in the\n-- | `Enum` back to integers. The integer mapping must agree in both directions\n-- | for this to implement a law-abiding `succ`.\n-- |\n-- | If a `BoundedEnum` instance exists for `a`, the `toEnum` and `fromEnum`\n-- | functions can be used here:\n-- |\n-- | ``` purescript\n-- | succ = defaultSucc toEnum fromEnum\n-- | ```\ndefaultSucc :: forall a. (Int -> Maybe a) -> (a -> Int) -> a -> Maybe a\ndefaultSucc toEnum' fromEnum' a = toEnum' (fromEnum' a + 1)\n\n-- | Provides a default implementation for `pred`, given a function that maps\n-- | integers to values in the `Enum`, and a function that maps values in the\n-- | `Enum` back to integers. The integer mapping must agree in both directions\n-- | for this to implement a law-abiding `pred`.\n-- |\n-- | If a `BoundedEnum` instance exists for `a`, the `toEnum` and `fromEnum`\n-- | functions can be used here:\n-- |\n-- | ``` purescript\n-- | pred = defaultPred toEnum fromEnum\n-- | ```\ndefaultPred :: forall a. (Int -> Maybe a) -> (a -> Int) -> a -> Maybe a\ndefaultPred toEnum' fromEnum' a = toEnum' (fromEnum' a - 1)\n\n-- | Provides a default implementation for `cardinality`.\n-- |\n-- | Runs in `O(n)` where `n` is `fromEnum top`\ndefaultCardinality :: forall a. Bounded a => Enum a => Cardinality a\ndefaultCardinality = Cardinality $ go 1 (bottom :: a) where\n go i x =\n case succ x of\n Just x' -> go (i + 1) x'\n Nothing -> i\n\n-- | Provides a default implementation for `toEnum`.\n-- |\n-- | - Assumes `fromEnum bottom = 0`.\n-- | - Cannot be used in conjuction with `defaultSucc`.\n-- |\n-- | Runs in `O(n)` where `n` is `fromEnum a`.\ndefaultToEnum :: forall a. Bounded a => Enum a => Int -> Maybe a\ndefaultToEnum i' =\n if i' < 0\n then Nothing\n else go i' bottom\n where\n go i x =\n if i == 0\n then Just x\n -- We avoid using >>= here because it foils tail-call optimization\n else case succ x of\n Just x' -> go (i - 1) x'\n Nothing -> Nothing\n\n-- | Provides a default implementation for `fromEnum`.\n-- |\n-- | - Assumes `toEnum 0 = Just bottom`.\n-- | - Cannot be used in conjuction with `defaultPred`.\n-- |\n-- | Runs in `O(n)` where `n` is `fromEnum a`.\ndefaultFromEnum :: forall a. Enum a => a -> Int\ndefaultFromEnum = go 0 where\n go i x =\n case pred x of\n Just x' -> go (i + 1) x'\n Nothing -> i\n\ndiag :: forall a. a -> Tuple a a\ndiag a = Tuple a a\n\ncharToEnum :: Int -> Maybe Char\ncharToEnum n | n >= toCharCode bottom && n <= toCharCode top = Just (fromCharCode n)\ncharToEnum _ = Nothing\n\nforeign import toCharCode :: Char -> Int\nforeign import fromCharCode :: Int -> Char\n", "export const _localeCompare = function (lt) {\n return function (eq) {\n return function (gt) {\n return function (s1) {\n return function (s2) {\n var result = s1.localeCompare(s2);\n return result < 0 ? lt : result > 0 ? gt : eq;\n };\n };\n };\n };\n};\n\nexport const replace = function (s1) {\n return function (s2) {\n return function (s3) {\n return s3.replace(s1, s2);\n };\n };\n};\n\nexport const replaceAll = function (s1) {\n return function (s2) {\n return function (s3) {\n return s3.replace(new RegExp(s1.replace(/[-\\/\\\\^$*+?.()|[\\]{}]/g, \"\\\\$&\"), \"g\"), s2); // eslint-disable-line no-useless-escape\n };\n };\n};\n\nexport const split = function (sep) {\n return function (s) {\n return s.split(sep);\n };\n};\n\nexport const toLower = function (s) {\n return s.toLowerCase();\n};\n\nexport const toUpper = function (s) {\n return s.toUpperCase();\n};\n\nexport const trim = function (s) {\n return s.trim();\n};\n\nexport const joinWith = function (s) {\n return function (xs) {\n return xs.join(s);\n };\n};\n", "module Data.String.Common\n ( null\n , localeCompare\n , replace\n , replaceAll\n , split\n , toLower\n , toUpper\n , trim\n , joinWith\n ) where\n\nimport Prelude\n\nimport Data.String.Pattern (Pattern, Replacement)\n\n-- | Returns `true` if the given string is empty.\n-- |\n-- | ```purescript\n-- | null \"\" == true\n-- | null \"Hi\" == false\n-- | ```\nnull :: String -> Boolean\nnull s = s == \"\"\n\n-- | Compare two strings in a locale-aware fashion. This is in contrast to\n-- | the `Ord` instance on `String` which treats strings as arrays of code\n-- | units:\n-- |\n-- | ```purescript\n-- | \"\u00E4\" `localeCompare` \"b\" == LT\n-- | \"\u00E4\" `compare` \"b\" == GT\n-- | ```\nlocaleCompare :: String -> String -> Ordering\nlocaleCompare = _localeCompare LT EQ GT\n\nforeign import _localeCompare\n :: Ordering\n -> Ordering\n -> Ordering\n -> String\n -> String\n -> Ordering\n\n-- | Replaces the first occurence of the pattern with the replacement string.\n-- |\n-- | ```purescript\n-- | replace (Pattern \"<=\") (Replacement \"\u2264\") \"a <= b <= c\" == \"a \u2264 b <= c\"\n-- | ```\nforeign import replace :: Pattern -> Replacement -> String -> String\n\n-- | Replaces all occurences of the pattern with the replacement string.\n-- |\n-- | ```purescript\n-- | replaceAll (Pattern \"<=\") (Replacement \"\u2264\") \"a <= b <= c\" == \"a \u2264 b \u2264 c\"\n-- | ```\nforeign import replaceAll :: Pattern -> Replacement -> String -> String\n\n-- | Returns the substrings of the second string separated along occurences\n-- | of the first string.\n-- |\n-- | ```purescript\n-- | split (Pattern \" \") \"hello world\" == [\"hello\", \"world\"]\n-- | ```\nforeign import split :: Pattern -> String -> Array String\n\n-- | Returns the argument converted to lowercase.\n-- |\n-- | ```purescript\n-- | toLower \"hElLo\" == \"hello\"\n-- | ```\nforeign import toLower :: String -> String\n\n-- | Returns the argument converted to uppercase.\n-- |\n-- | ```purescript\n-- | toUpper \"Hello\" == \"HELLO\"\n-- | ```\nforeign import toUpper :: String -> String\n\n-- | Removes whitespace from the beginning and end of a string, including\n-- | [whitespace characters](http://www.ecma-international.org/ecma-262/5.1/#sec-7.2)\n-- | and [line terminators](http://www.ecma-international.org/ecma-262/5.1/#sec-7.3).\n-- |\n-- | ```purescript\n-- | trim \" Hello \\n World\\n\\t \" == \"Hello \\n World\"\n-- | ```\nforeign import trim :: String -> String\n\n-- | Joins the strings in the array together, inserting the first argument\n-- | as separator between them.\n-- |\n-- | ```purescript\n-- | joinWith \", \" [\"apple\", \"banana\", \"orange\"] == \"apple, banana, orange\"\n-- | ```\nforeign import joinWith :: String -> Array String -> String\n", "-- | These functions allow PureScript strings to be treated as if they were\n-- | sequences of Unicode code points instead of their true underlying\n-- | implementation (sequences of UTF-16 code units). For nearly all uses of\n-- | strings, these functions should be preferred over the ones in\n-- | `Data.String.CodeUnits`.\nmodule Data.String.CodePoints\n ( module Exports\n , CodePoint\n , codePointFromChar\n , singleton\n , fromCodePointArray\n , toCodePointArray\n , codePointAt\n , uncons\n , length\n , countPrefix\n , indexOf\n , indexOf'\n , lastIndexOf\n , lastIndexOf'\n , take\n -- , takeRight\n , takeWhile\n , drop\n -- , dropRight\n , dropWhile\n -- , slice\n , splitAt\n ) where\n\nimport Prelude\n\nimport Data.Array as Array\nimport Data.Enum (class BoundedEnum, class Enum, Cardinality(..), defaultPred, defaultSucc, fromEnum, toEnum, toEnumWithDefaults)\nimport Data.Int (hexadecimal, toStringAs)\nimport Data.Maybe (Maybe(..))\nimport Data.String.CodeUnits (contains, stripPrefix, stripSuffix) as Exports\nimport Data.String.CodeUnits as CU\nimport Data.String.Common (toUpper)\nimport Data.String.Pattern (Pattern)\nimport Data.String.Unsafe as Unsafe\nimport Data.Tuple (Tuple(..))\nimport Data.Unfoldable (unfoldr)\n\n-- | CodePoint is an `Int` bounded between `0` and `0x10FFFF`, corresponding to\n-- | Unicode code points.\nnewtype CodePoint = CodePoint Int\n\nderive instance eqCodePoint :: Eq CodePoint\nderive instance ordCodePoint :: Ord CodePoint\n\ninstance showCodePoint :: Show CodePoint where\n show (CodePoint i) = \"(CodePoint 0x\" <> toUpper (toStringAs hexadecimal i) <> \")\"\n\ninstance boundedCodePoint :: Bounded CodePoint where\n bottom = CodePoint 0\n top = CodePoint 0x10FFFF\n\ninstance enumCodePoint :: Enum CodePoint where\n succ = defaultSucc toEnum fromEnum\n pred = defaultPred toEnum fromEnum\n\ninstance boundedEnumCodePoint :: BoundedEnum CodePoint where\n cardinality = Cardinality (0x10FFFF + 1)\n fromEnum (CodePoint n) = n\n toEnum n\n | n >= 0 && n <= 0x10FFFF = Just (CodePoint n)\n | otherwise = Nothing\n\n-- | Creates a `CodePoint` from a given `Char`.\n-- |\n-- | ```purescript\n-- | >>> codePointFromChar 'B'\n-- | CodePoint 0x42 -- represents 'B'\n-- | ```\n-- |\ncodePointFromChar :: Char -> CodePoint\ncodePointFromChar = fromEnum >>> CodePoint\n\n-- | Creates a string containing just the given code point. Operates in\n-- | constant space and time.\n-- |\n-- | ```purescript\n-- | >>> map singleton (toEnum 0x1D400)\n-- | Just \"\uD835\uDC00\"\n-- | ```\n-- |\nsingleton :: CodePoint -> String\nsingleton = _singleton singletonFallback\n\nforeign import _singleton\n :: (CodePoint -> String)\n -> CodePoint\n -> String\n\nsingletonFallback :: CodePoint -> String\nsingletonFallback (CodePoint cp) | cp <= 0xFFFF = fromCharCode cp\nsingletonFallback (CodePoint cp) =\n let lead = ((cp - 0x10000) / 0x400) + 0xD800 in\n let trail = (cp - 0x10000) `mod` 0x400 + 0xDC00 in\n fromCharCode lead <> fromCharCode trail\n\n-- | Creates a string from an array of code points. Operates in space and time\n-- | linear to the length of the array.\n-- |\n-- | ```purescript\n-- | >>> codePointArray = toCodePointArray \"c \uD835\uDC00\"\n-- | >>> codePointArray\n-- | [CodePoint 0x63, CodePoint 0x20, CodePoint 0x1D400]\n-- | >>> fromCodePointArray codePointArray\n-- | \"c \uD835\uDC00\"\n-- | ```\n-- |\nfromCodePointArray :: Array CodePoint -> String\nfromCodePointArray = _fromCodePointArray singletonFallback\n\nforeign import _fromCodePointArray\n :: (CodePoint -> String)\n -> Array CodePoint\n -> String\n\n-- | Creates an array of code points from a string. Operates in space and time\n-- | linear to the length of the string.\n-- |\n-- | ```purescript\n-- | >>> codePointArray = toCodePointArray \"b \uD835\uDC00\uD835\uDC00\"\n-- | >>> codePointArray\n-- | [CodePoint 0x62, CodePoint 0x20, CodePoint 0x1D400, CodePoint 0x1D400]\n-- | >>> map singleton codePointArray\n-- | [\"b\", \" \", \"\uD835\uDC00\", \"\uD835\uDC00\"]\n-- | ```\n-- |\ntoCodePointArray :: String -> Array CodePoint\ntoCodePointArray = _toCodePointArray toCodePointArrayFallback unsafeCodePointAt0\n\nforeign import _toCodePointArray\n :: (String -> Array CodePoint)\n -> (String -> CodePoint)\n -> String\n -> Array CodePoint\n\ntoCodePointArrayFallback :: String -> Array CodePoint\ntoCodePointArrayFallback s = unfoldr unconsButWithTuple s\n\nunconsButWithTuple :: String -> Maybe (Tuple CodePoint String)\nunconsButWithTuple s = (\\{ head, tail } -> Tuple head tail) <$> uncons s\n\n-- | Returns the first code point of the string after dropping the given number\n-- | of code points from the beginning, if there is such a code point. Operates\n-- | in constant space and in time linear to the given index.\n-- |\n-- | ```purescript\n-- | >>> codePointAt 1 \"\uD835\uDC00\uD835\uDC00\uD835\uDC00\uD835\uDC00\"\n-- | Just (CodePoint 0x1D400) -- represents \"\uD835\uDC00\"\n-- | -- compare to Data.String:\n-- | >>> charAt 1 \"\uD835\uDC00\uD835\uDC00\uD835\uDC00\uD835\uDC00\"\n-- | Just '\uFFFD'\n-- | ```\n-- |\ncodePointAt :: Int -> String -> Maybe CodePoint\ncodePointAt n _ | n < 0 = Nothing\ncodePointAt 0 \"\" = Nothing\ncodePointAt 0 s = Just (unsafeCodePointAt0 s)\ncodePointAt n s = _codePointAt codePointAtFallback Just Nothing unsafeCodePointAt0 n s\n\nforeign import _codePointAt\n :: (Int -> String -> Maybe CodePoint)\n -> (forall a. a -> Maybe a)\n -> (forall a. Maybe a)\n -> (String -> CodePoint)\n -> Int\n -> String\n -> Maybe CodePoint\n\ncodePointAtFallback :: Int -> String -> Maybe CodePoint\ncodePointAtFallback n s = case uncons s of\n Just { head, tail } -> if n == 0 then Just head else codePointAtFallback (n - 1) tail\n _ -> Nothing\n\n-- | Returns a record with the first code point and the remaining code points\n-- | of the string. Returns `Nothing` if the string is empty. Operates in\n-- | constant space and time.\n-- |\n-- | ```purescript\n-- | >>> uncons \"\uD835\uDC00\uD835\uDC00 c \uD835\uDC00\"\n-- | Just { head: CodePoint 0x1D400, tail: \"\uD835\uDC00 c \uD835\uDC00\" }\n-- | >>> uncons \"\"\n-- | Nothing\n-- | ```\n-- |\nuncons :: String -> Maybe { head :: CodePoint, tail :: String }\nuncons s = case CU.length s of\n 0 -> Nothing\n 1 -> Just { head: CodePoint (fromEnum (Unsafe.charAt 0 s)), tail: \"\" }\n _ ->\n let\n cu0 = fromEnum (Unsafe.charAt 0 s)\n cu1 = fromEnum (Unsafe.charAt 1 s)\n in\n if isLead cu0 && isTrail cu1\n then Just { head: unsurrogate cu0 cu1, tail: CU.drop 2 s }\n else Just { head: CodePoint cu0, tail: CU.drop 1 s }\n\n-- | Returns the number of code points in the string. Operates in constant\n-- | space and in time linear to the length of the string.\n-- |\n-- | ```purescript\n-- | >>> length \"b \uD835\uDC00\uD835\uDC00 c \uD835\uDC00\"\n-- | 8\n-- | -- compare to Data.String:\n-- | >>> length \"b \uD835\uDC00\uD835\uDC00 c \uD835\uDC00\"\n-- | 11\n-- | ```\n-- |\nlength :: String -> Int\nlength = Array.length <<< toCodePointArray\n\n-- | Returns the number of code points in the leading sequence of code points\n-- | which all match the given predicate. Operates in constant space and in\n-- | time linear to the length of the string.\n-- |\n-- | ```purescript\n-- | >>> countPrefix (\\c -> fromEnum c == 0x1D400) \"\uD835\uDC00\uD835\uDC00 b c \uD835\uDC00\"\n-- | 2\n-- | ```\n-- |\ncountPrefix :: (CodePoint -> Boolean) -> String -> Int\ncountPrefix = _countPrefix countFallback unsafeCodePointAt0\n\nforeign import _countPrefix\n :: ((CodePoint -> Boolean) -> String -> Int)\n -> (String -> CodePoint)\n -> (CodePoint -> Boolean)\n -> String\n -> Int\n\ncountFallback :: (CodePoint -> Boolean) -> String -> Int\ncountFallback p s = countTail p s 0\n\ncountTail :: (CodePoint -> Boolean) -> String -> Int -> Int\ncountTail p s accum = case uncons s of\n Just { head, tail } -> if p head then countTail p tail (accum + 1) else accum\n _ -> accum\n\n-- | Returns the number of code points preceding the first match of the given\n-- | pattern in the string. Returns `Nothing` when no matches are found.\n-- |\n-- | ```purescript\n-- | >>> indexOf (Pattern \"\uD835\uDC00\") \"b \uD835\uDC00\uD835\uDC00 c \uD835\uDC00\"\n-- | Just 2\n-- | >>> indexOf (Pattern \"o\") \"b \uD835\uDC00\uD835\uDC00 c \uD835\uDC00\"\n-- | Nothing\n-- | ```\n-- |\nindexOf :: Pattern -> String -> Maybe Int\nindexOf p s = (\\i -> length (CU.take i s)) <$> CU.indexOf p s\n\n-- | Returns the number of code points preceding the first match of the given\n-- | pattern in the string. Pattern matches preceding the given index will be\n-- | ignored. Returns `Nothing` when no matches are found.\n-- |\n-- | ```purescript\n-- | >>> indexOf' (Pattern \"\uD835\uDC00\") 4 \"b \uD835\uDC00\uD835\uDC00 c \uD835\uDC00\"\n-- | Just 7\n-- | >>> indexOf' (Pattern \"o\") 4 \"b \uD835\uDC00\uD835\uDC00 c \uD835\uDC00\"\n-- | Nothing\n-- | ```\n-- |\nindexOf' :: Pattern -> Int -> String -> Maybe Int\nindexOf' p i s =\n let s' = drop i s in\n (\\k -> i + length (CU.take k s')) <$> CU.indexOf p s'\n\n-- | Returns the number of code points preceding the last match of the given\n-- | pattern in the string. Returns `Nothing` when no matches are found.\n-- |\n-- | ```purescript\n-- | >>> lastIndexOf (Pattern \"\uD835\uDC00\") \"b \uD835\uDC00\uD835\uDC00 c \uD835\uDC00\"\n-- | Just 7\n-- | >>> lastIndexOf (Pattern \"o\") \"b \uD835\uDC00\uD835\uDC00 c \uD835\uDC00\"\n-- | Nothing\n-- | ```\n-- |\nlastIndexOf :: Pattern -> String -> Maybe Int\nlastIndexOf p s = (\\i -> length (CU.take i s)) <$> CU.lastIndexOf p s\n\n-- | Returns the number of code points preceding the first match of the given\n-- | pattern in the string. Pattern matches following the given index will be\n-- | ignored.\n-- |\n-- | Giving a negative index is equivalent to giving 0 and giving an index\n-- | greater than the number of code points in the string is equivalent to\n-- | searching in the whole string.\n-- |\n-- | Returns `Nothing` when no matches are found.\n-- |\n-- | ```purescript\n-- | >>> lastIndexOf' (Pattern \"\uD835\uDC00\") (-1) \"b \uD835\uDC00\uD835\uDC00 c \uD835\uDC00\"\n-- | Nothing\n-- | >>> lastIndexOf' (Pattern \"\uD835\uDC00\") 0 \"b \uD835\uDC00\uD835\uDC00 c \uD835\uDC00\"\n-- | Nothing\n-- | >>> lastIndexOf' (Pattern \"\uD835\uDC00\") 5 \"b \uD835\uDC00\uD835\uDC00 c \uD835\uDC00\"\n-- | Just 3\n-- | >>> lastIndexOf' (Pattern \"\uD835\uDC00\") 8 \"b \uD835\uDC00\uD835\uDC00 c \uD835\uDC00\"\n-- | Just 7\n-- | >>> lastIndexOf' (Pattern \"o\") 5 \"b \uD835\uDC00\uD835\uDC00 c \uD835\uDC00\"\n-- | Nothing\n-- | ```\n-- |\nlastIndexOf' :: Pattern -> Int -> String -> Maybe Int\nlastIndexOf' p i s =\n let i' = CU.length (take i s) in\n (\\k -> length (CU.take k s)) <$> CU.lastIndexOf' p i' s\n\n-- | Returns a string containing the given number of code points from the\n-- | beginning of the given string. If the string does not have that many code\n-- | points, returns the empty string. Operates in constant space and in time\n-- | linear to the given number.\n-- |\n-- | ```purescript\n-- | >>> take 3 \"b \uD835\uDC00\uD835\uDC00 c \uD835\uDC00\"\n-- | \"b \uD835\uDC00\"\n-- | -- compare to Data.String:\n-- | >>> take 3 \"b \uD835\uDC00\uD835\uDC00 c \uD835\uDC00\"\n-- | \"b \uFFFD\"\n-- | ```\n-- |\ntake :: Int -> String -> String\ntake = _take takeFallback\n\nforeign import _take :: (Int -> String -> String) -> Int -> String -> String\n\ntakeFallback :: Int -> String -> String\ntakeFallback n _ | n < 1 = \"\"\ntakeFallback n s = case uncons s of\n Just { head, tail } -> singleton head <> takeFallback (n - 1) tail\n _ -> s\n\n-- | Returns a string containing the leading sequence of code points which all\n-- | match the given predicate from the string. Operates in constant space and\n-- | in time linear to the length of the string.\n-- |\n-- | ```purescript\n-- | >>> takeWhile (\\c -> fromEnum c == 0x1D400) \"\uD835\uDC00\uD835\uDC00 b c \uD835\uDC00\"\n-- | \"\uD835\uDC00\uD835\uDC00\"\n-- | ```\n-- |\ntakeWhile :: (CodePoint -> Boolean) -> String -> String\ntakeWhile p s = take (countPrefix p s) s\n\n-- | Drops the given number of code points from the beginning of the string. If\n-- | the string does not have that many code points, returns the empty string.\n-- | Operates in constant space and in time linear to the given number.\n-- |\n-- | ```purescript\n-- | >>> drop 5 \"\uD835\uDC00\uD835\uDC00 b c\"\n-- | \"c\"\n-- | -- compared to Data.String:\n-- | >>> drop 5 \"\uD835\uDC00\uD835\uDC00 b c\"\n-- | \"b c\" -- because \"\uD835\uDC00\" occupies 2 code units\n-- | ```\n-- |\ndrop :: Int -> String -> String\ndrop n s = CU.drop (CU.length (take n s)) s\n\n-- | Drops the leading sequence of code points which all match the given\n-- | predicate from the string. Operates in constant space and in time linear\n-- | to the length of the string.\n-- |\n-- | ```purescript\n-- | >>> dropWhile (\\c -> fromEnum c == 0x1D400) \"\uD835\uDC00\uD835\uDC00 b c \uD835\uDC00\"\n-- | \" b c \uD835\uDC00\"\n-- | ```\n-- |\ndropWhile :: (CodePoint -> Boolean) -> String -> String\ndropWhile p s = drop (countPrefix p s) s\n\n-- | Splits a string into two substrings, where `before` contains the code\n-- | points up to (but not including) the given index, and `after` contains the\n-- | rest of the string, from that index on.\n-- |\n-- | ```purescript\n-- | >>> splitAt 3 \"b \uD835\uDC00\uD835\uDC00 c \uD835\uDC00\"\n-- | { before: \"b \uD835\uDC00\", after: \"\uD835\uDC00 c \uD835\uDC00\" }\n-- | ```\n-- |\n-- | Thus the length of `(splitAt i s).before` will equal either `i` or\n-- | `length s`, if that is shorter. (Or if `i` is negative the length will be\n-- | 0.)\n-- |\n-- | In code:\n-- | ```purescript\n-- | length (splitAt i s).before == min (max i 0) (length s)\n-- | (splitAt i s).before <> (splitAt i s).after == s\n-- | splitAt i s == {before: take i s, after: drop i s}\n-- | ```\nsplitAt :: Int -> String -> { before :: String, after :: String }\nsplitAt i s =\n let before = take i s in\n { before\n -- inline drop i s to reuse the result of take i s\n , after: CU.drop (CU.length before) s\n }\n\nunsurrogate :: Int -> Int -> CodePoint\nunsurrogate lead trail = CodePoint ((lead - 0xD800) * 0x400 + (trail - 0xDC00) + 0x10000)\n\nisLead :: Int -> Boolean\nisLead cu = 0xD800 <= cu && cu <= 0xDBFF\n\nisTrail :: Int -> Boolean\nisTrail cu = 0xDC00 <= cu && cu <= 0xDFFF\n\nfromCharCode :: Int -> String\nfromCharCode = CU.singleton <<< toEnumWithDefaults bottom top\n\n-- WARN: this function expects the String parameter to be non-empty\nunsafeCodePointAt0 :: String -> CodePoint\nunsafeCodePointAt0 = _unsafeCodePointAt0 unsafeCodePointAt0Fallback\n\nforeign import _unsafeCodePointAt0\n :: (String -> CodePoint)\n -> String\n -> CodePoint\n\nunsafeCodePointAt0Fallback :: String -> CodePoint\nunsafeCodePointAt0Fallback s =\n let\n cu0 = fromEnum (Unsafe.charAt 0 s)\n in\n if isLead cu0 && CU.length s > 1\n then\n let cu1 = fromEnum (Unsafe.charAt 1 s) in\n if isTrail cu1 then unsurrogate cu0 cu1 else CodePoint cu0\n else\n CodePoint cu0\n", "-- | This module provides basic types and functions for dealing with colors.\n-- |\n-- | Colors can be constructed from HSL values, RGB values or Hex strings /\n-- | integers. In addition, a lot of standardized named colors can be found in\n-- | `Color.Scheme.X11`.\n-- |\n-- | This module also provides functions to modify colors (e.g. lighten/darken,\n-- | saturate/desaturate, complementary), to combine colors (mix) and to\n-- | analyze colors (e.g. brightness, luminance, contrast).\n-- |\n-- | Implementation detail: Colors are represented by their HSL values (hue,\n-- | saturation, lightness) internally, as this provides more flexibility than\n-- | storing RGB values. In particular, note that only colors within the sRGB\n-- | gamut can be represented.\n\nmodule Color\n ( Color\n , ColorSpace(..)\n -- Construct\n , rgba\n , rgb\n , rgba'\n , rgb'\n , hsla\n , hsl\n , hsva\n , hsv\n , xyz\n , lab\n , lch\n , fromHexString\n , fromInt\n -- Convert\n , toHSLA\n , toHSVA\n , toRGBA\n , toRGBA'\n , toXYZ\n , toLab\n , toLCh\n , toHexString\n , cssStringHSLA\n , cssStringRGBA\n -- Basic\n , black\n , white\n , graytone\n -- Modify\n , rotateHue\n , complementary\n , lighten\n , darken\n , saturate\n , desaturate\n , toGray\n -- Combine\n , Interpolator\n , mix\n , mixCubehelix\n -- Analyze\n , brightness\n , luminance\n , contrast\n , isLight\n , isReadable\n , textColor\n , distance\n ) where\n\nimport Prelude\n\nimport Control.Alt ((<|>))\nimport Data.Array.NonEmpty (index)\nimport Data.Either (either)\nimport Data.Foldable (minimumBy)\nimport Data.Function (on)\nimport Data.Int (toNumber, round, fromStringAs, toStringAs, hexadecimal)\nimport Data.Int.Bits ((.&.), shr)\nimport Data.Maybe (Maybe(..), fromJust, fromMaybe)\nimport Data.Number (abs, atan2, cos, pi, pow, sin, sqrt, (%))\nimport Data.String (length, joinWith)\nimport Data.String.Regex (regex, parseFlags, match)\nimport Partial.Unsafe (unsafePartial)\n\n-- | The representation of a color.\n-- |\n-- | Note:\n-- | - The `Eq` instance compares two `Color`s by comparing their (integer) RGB\n-- | values. This is different from comparing the HSL values (for example,\n-- | HSL has many different representations of black (arbitrary hue and\n-- | saturation values).\n-- | - Colors outside the sRGB gamut which cannot be displayed on a typical\n-- | computer screen can not be represented by `Color`.\n-- |\ndata Color = HSLA Hue Number Number Number\n\nnewtype Hue = UnclippedHue Number\n\n-- | Assert that the hue angle is in the interval [0, 360].\nclipHue :: Hue -> Number\nclipHue (UnclippedHue x) = if 360.0 == x then x else x `modPos` 360.0\n\n-- | Definition of a color space.\n-- |\n-- | * `RGB`: red, green, blue\n-- | * `HSL`: hue, saturation, lightness\n-- | * `LCh`: Lightness, chroma, hue\n-- | * `Lab`: Lightness, a, b\ndata ColorSpace = RGB | HSL | LCh | Lab\n\ninstance showColor :: Show Color where\n show c = joinWith \" \"\n [ \"rgba\"\n , show col.r\n , show col.g\n , show col.b\n , show col.a\n ]\n where\n col = toRGBA c\n\ninstance eqColor :: Eq Color where\n eq = eq `on` toRGBA\n\n-- | Like `%`, but always positive.\nmodPos :: Number -> Number -> Number\nmodPos x y = (x % y + y) % y\n\n-- | Create a `Color` from integer RGB values between 0 and 255 and a floating\n-- | point alpha value between 0.0 and 1.0.\nrgba :: Int -> Int -> Int -> Number -> Color\nrgba red' green' blue' alpha = HSLA (UnclippedHue hue) saturation lightness alpha\n where\n -- RGB to HSL conversion algorithm adapted from\n -- https://en.wikipedia.org/wiki/HSL_and_HSV\n red = clamp 0 255 red'\n blue = clamp 0 255 blue'\n green = clamp 0 255 green'\n\n r = toNumber red / 255.0\n g = toNumber green / 255.0\n b = toNumber blue / 255.0\n\n maxChroma = max (max red green) blue\n minChroma = min (min red green) blue\n\n chroma = maxChroma - minChroma\n chroma' = toNumber chroma / 255.0\n\n hue' 0 = 0.0\n hue' _\n | maxChroma == red = ((g - b) / chroma') `modPos` 6.0\n | maxChroma == green = ((b - r) / chroma') + 2.0\n | otherwise = ((r - g) / chroma') + 4.0\n\n hue = 60.0 * hue' chroma\n\n lightness = toNumber (maxChroma + minChroma) / (255.0 * 2.0)\n\n saturation\n | chroma == 0 = 0.0\n | otherwise = chroma' / (1.0 - abs (2.0 * lightness - 1.0))\n\n-- | Create a `Color` from integer RGB values between 0 and 255.\nrgb :: Int -> Int -> Int -> Color\nrgb r g b = rgba r g b 1.0\n\n-- | Create a `Color` from RGB and alpha values between 0.0 and 1.0.\nrgba' :: Number -> Number -> Number -> Number -> Color\nrgba' r g b a = rgba (round $ r * 255.0)\n (round $ g * 255.0)\n (round $ b * 255.0)\n a\n\n-- | Create a `Color` from RGB values between 0.0 and 1.0.\nrgb' :: Number -> Number -> Number -> Color\nrgb' r g b = rgba' r g b 1.0\n\n-- | Create a `Color` from Hue, Saturation, Lightness and Alpha values. The\n-- | Hue is given in degrees, as a `Number` between 0.0 and 360.0. Saturation,\n-- | Lightness and Alpha are numbers between 0.0 and 1.0.\nhsla :: Number -> Number -> Number -> Number -> Color\nhsla h s l a = HSLA (UnclippedHue h) s' l' a'\n where\n s' = clamp 0.0 1.0 s\n l' = clamp 0.0 1.0 l\n a' = clamp 0.0 1.0 a\n\n-- | Create a `Color` from Hue, Saturation and Lightness values. The Hue is\n-- | given in degrees, as a `Number` between 0.0 and 360.0. Both Saturation and\n-- | Lightness are numbers between 0.0 and 1.0.\nhsl :: Number -> Number -> Number -> Color\nhsl h s l = hsla h s l 1.0\n\n-- | Create a `Color` from Hue, Saturation, Value and Alpha values. The\n-- | Hue is given in degrees, as a `Number` between 0.0 and 360.0. Saturation,\n-- | Value and Alpha are numbers between 0.0 and 1.0.\nhsva :: Number -> Number -> Number -> Number -> Color\nhsva h s 0.0 a = hsla h (s / (2.0 - s)) 0.0 a\nhsva h 0.0 1.0 a = hsla h 0.0 1.0 a\nhsva h s' v' a = hsla h s l a\n where\n tmp = (2.0 - s') * v'\n s = s' * v' / (if tmp < 1.0 then tmp else 2.0 - tmp)\n l = tmp / 2.0\n\n-- | Create a `Color` from Hue, Saturation and Value values. The Hue is\n-- | given in degrees, as a `Number` between 0.0 and 360.0. Both Saturation and\n-- | Value are numbers between 0.0 and 1.0.\nhsv :: Number -> Number -> Number -> Color\nhsv h s v = hsva h s v 1.0\n\n-- | Create a `Color` from XYZ coordinates in the CIE 1931 color space. Note\n-- | that a `Color` always represents a color in the sRGB gamut (colors that\n-- | can be represented on a typical computer screen) while the XYZ color space\n-- | is bigger. This function will tend to create fully saturated colors at the\n-- | edge of the sRGB gamut if the coordinates lie outside the sRGB range.\n-- |\n-- | See:\n-- | - https://en.wikipedia.org/wiki/CIE_1931_color_space\n-- | - https://en.wikipedia.org/wiki/SRGB\nxyz :: Number -> Number -> Number -> Color\nxyz x y z = rgb' r g b\n where\n r = f (3.2406 * x - 1.5372 * y - 0.4986 * z)\n g = f (-0.9689 * x + 1.8758 * y + 0.0415 * z)\n b = f (0.0557 * x - 0.2040 * y + 1.0570 * z)\n\n f c\n | c <= 0.0031308 = 12.92 * c\n | otherwise = 1.055 * (c `pow` (1.0 / 2.4)) - 0.055\n\n-- Illuminant D65 constants used for Lab color space conversions.\nd65 :: { xn :: Number, yn :: Number, zn :: Number }\nd65 =\n { xn: 0.950470\n , yn: 1.0\n , zn: 1.088830\n }\n\n-- | Create a `Color` from L, a and b coordinates coordinates in the Lab color\n-- | space.\n-- | Note: See documentation for `xyz`. The same restrictions apply here.\n-- |\n-- | See: https://en.wikipedia.org/wiki/Lab_color_space\nlab :: Number -> Number -> Number -> Color\nlab l a b = xyz x y z\n where\n l' = (l + 16.0) / 116.0\n x = d65.xn * finv (l' + a / 500.0)\n y = d65.yn * finv l'\n z = d65.zn * finv (l' - b / 200.0)\n\n delta = 6.0 / 29.0\n finv t\n | t > delta = t `pow` 3.0\n | otherwise = 3.0 * delta * delta * (t - 4.0 / 29.0)\n\n-- | Create a `Color` from lightness, chroma and hue coordinates in the CIE LCh\n-- | color space. This is a cylindrical transform of the Lab color space.\n-- | Note: See documentation for `xyz`. The same restrictions apply here.\n-- |\n-- | See: https://en.wikipedia.org/wiki/Lab_color_space\nlch :: Number -> Number -> Number -> Color\nlch l c h = lab l a b\n where\n deg2rad = pi / 180.0\n a = c * cos (h * deg2rad)\n b = c * sin (h * deg2rad)\n\n-- | Parse a hexadecimal RGB code of the form `#rgb` or `#rrggbb`. The `#`\n-- | character is required. Each hexadecimal digit is of the form `[0-9a-fA-F]`\n-- | (case insensitive). Returns `Nothing` if the string is in a wrong format.\nfromHexString :: String -> Maybe Color\nfromHexString str = do\n pattern <- hush mPattern\n groups <- match pattern str\n r <- parseHex <$> join (index groups 1)\n g <- parseHex <$> join (index groups 2)\n b <- parseHex <$> join (index groups 3)\n a <- parseHex <$> (join (index groups 4) <|> pure (if isShort then \"f\" else \"ff\"))\n if isShort then\n let\n alpha = toNumber (clamp 0 15 a) / 15.0\n in\n pure $ rgba (16 * r + r) (16 * g + g) (16 * b + b) alpha\n else\n let\n alpha = toNumber (clamp 0 255 a) / 255.0\n in\n pure (rgba r g b alpha)\n where\n isShort = length str < 6\n digit = \"[0-9a-f]\"\n single = \"(\" <> digit <> \")\"\n pair = \"(\" <> digit <> digit <> \")\"\n variant =\n if isShort then single <> single <> single <> single <> \"?\"\n else pair <> pair <> pair <> pair <> \"?\"\n mPattern = regex (\"^#(?:\" <> variant <> \")$\") (parseFlags \"i\")\n hush = either (const Nothing) Just\n parseHex = fromMaybe 0 <<< fromStringAs hexadecimal\n\n-- | Converts an integer to a color (RGB representation). `0` is black and\n-- | `0xffffff` is white. Values outside this range will be clamped.\n-- |\n-- | This function is useful if you want to hard-code Hex values. For example:\n-- |\n-- | ``` purs\n-- | red = fromInt 0xff0000\n-- | ```\nfromInt :: Int -> Color\nfromInt m = rgb r g b\n where\n b = n .&. 0xff\n g = (n `shr` 8) .&. 0xff\n r = (n `shr` 16) .&. 0xff\n n = clamp 0 0xffffff m\n\n-- | Convert a `Color` to its Hue, Saturation, Lightness and Alpha values. See\n-- | `hsla` for the ranges of each channel.\ntoHSLA :: Color -> { h :: Number, s :: Number, l :: Number, a :: Number }\ntoHSLA (HSLA h s l a) = { h: clipHue h, s, l, a }\n\n-- | Convert a `Color` to its Hue, Saturation, Value and Alpha values. See\n-- | `hsva` for the ranges of each channel.\ntoHSVA :: Color -> { h :: Number, s :: Number, v :: Number, a :: Number }\ntoHSVA (HSLA h s 0.0 a) = { h: clipHue h, s: 2.0 * s / (1.0 + s), v: 0.0, a }\ntoHSVA (HSLA h 0.0 1.0 a) = { h: clipHue h, s: 0.0, v: 1.0, a }\ntoHSVA (HSLA h s' l' a) = { h: clipHue h, s, v, a }\n where\n tmp = s' * (if l' < 0.5 then l' else 1.0 - l')\n s = 2.0 * tmp / (l' + tmp)\n v = l' + tmp\n\n-- | Convert a `Color` to its red, green, blue and alpha values. The RGB values\n-- | are integers in the range from 0 to 255. The alpha channel is a number\n-- | between 0.0 and 1.0.\ntoRGBA :: Color -> { r :: Int, g :: Int, b :: Int, a :: Number }\ntoRGBA col = { r, g, b, a: c.a }\n where\n c = toRGBA' col\n r = round (255.0 * c.r)\n g = round (255.0 * c.g)\n b = round (255.0 * c.b)\n\n-- | Convert a `Color` to its red, green, blue and alpha values. All values\n-- | are numbers in the range from 0.0 to 1.0.\ntoRGBA' :: Color -> { r :: Number, g :: Number, b :: Number, a :: Number }\ntoRGBA' (HSLA h s l a) = { r: col.r + m, g: col.g + m, b: col.b + m, a }\n where\n h' = clipHue h / 60.0\n chr = (1.0 - abs (2.0 * l - 1.0)) * s\n m = l - chr / 2.0\n x = chr * (1.0 - abs (h' % 2.0 - 1.0))\n col\n | h' < 1.0 = { r: chr, g: x, b: 0.0 }\n | 1.0 <= h' && h' < 2.0 = { r: x, g: chr, b: 0.0 }\n | 2.0 <= h' && h' < 3.0 = { r: 0.0, g: chr, b: x }\n | 3.0 <= h' && h' < 4.0 = { r: 0.0, g: x, b: chr }\n | 4.0 <= h' && h' < 5.0 = { r: x, g: 0.0, b: chr }\n | otherwise = { r: chr, g: 0.0, b: x }\n\n-- | Get XYZ coordinates according to the CIE 1931 color space.\n-- |\n-- | See:\n-- | - https://en.wikipedia.org/wiki/CIE_1931_color_space\n-- | - https://en.wikipedia.org/wiki/SRGB\ntoXYZ :: Color -> { x :: Number, y :: Number, z :: Number }\ntoXYZ c = { x, y, z }\n where\n x = 0.4124 * r + 0.3576 * g + 0.1805 * b\n y = 0.2126 * r + 0.7152 * g + 0.0722 * b\n z = 0.0193 * r + 0.1192 * g + 0.9505 * b\n\n rec = toRGBA' c\n r = finv rec.r\n g = finv rec.g\n b = finv rec.b\n\n finv c'\n | c' <= 0.04045 = c' / 12.92\n | otherwise = ((c' + 0.055) / 1.055) `pow` 2.4\n\n-- | Get L, a and b coordinates according to the Lab color space.\n-- |\n-- | See: https://en.wikipedia.org/wiki/Lab_color_space\ntoLab :: Color -> { l :: Number, a :: Number, b :: Number }\ntoLab col = { l, a, b }\n where\n rec = toXYZ col\n\n fy = f (rec.y / d65.yn)\n\n l = 116.0 * fy - 16.0\n a = 500.0 * (f (rec.x / d65.xn) - fy)\n b = 200.0 * (fy - f (rec.z / d65.zn))\n\n cut = (6.0 / 29.0) `pow` 3.0\n f t\n | t > cut = t `pow` (1.0 / 3.0)\n | otherwise = (1.0 / 3.0) * (29.0 / 6.0) `pow` 2.0 * t + 4.0 / 29.0\n\n-- | Get L, C and h coordinates according to the CIE LCh color space.\n-- |\n-- | See: https://en.wikipedia.org/wiki/Lab_color_space\ntoLCh :: Color -> { l :: Number, c :: Number, h :: Number }\ntoLCh col = { l, c, h }\n where\n rec = toLab col\n\n l = rec.l\n a = rec.a\n b = rec.b\n\n rad2deg = 180.0 / pi\n\n c = sqrt (a * a + b * b)\n h = (atan2 b a * rad2deg) `modPos` 360.0\n\n-- | Return a hexadecimal representation of the color in the forms `#rrggbb`\n-- | or `#rrggbbaa`, where `rr`, `gg`, `bb`, and `aa` refer to hexadecimal\n-- | digits corresponding to the RGBA channel values between `00` and `ff`. The\n-- | alpha channel is only represented when it has a value less than 100%.\ntoHexString :: Color -> String\ntoHexString color = \"#\" <> toHex c.r <> toHex c.g <> toHex c.b <> alpha\n where\n c = toRGBA color\n alpha\n | c.a == 1.0 = \"\"\n | otherwise = toHex $ round (255.0 * c.a)\n toHex num =\n let\n repr = toStringAs hexadecimal num\n in\n if length repr == 1 then \"0\" <> repr\n else repr\n\n-- | A CSS representation of the color in the form `hsl(..)` or `hsla(...)`.\ncssStringHSLA :: Color -> String\ncssStringHSLA (HSLA (UnclippedHue h) s l a) =\n if a == 1.0 then \"hsl(\" <> hue <> \", \" <> saturation <> \", \" <> lightness <> \")\"\n else \"hsla(\" <> hue <> \", \" <> saturation <> \", \" <> lightness <> \", \"\n <> alpha\n <> \")\"\n where\n hue = toString h\n saturation = toString (s * 100.0) <> \"%\"\n lightness = toString (l * 100.0) <> \"%\"\n alpha = show a\n toString n = show $ toNumber (round (100.0 * n)) / 100.0\n\n-- | A CSS representation of the color in the form `rgb(..)` or `rgba(...)`.\ncssStringRGBA :: Color -> String\ncssStringRGBA col =\n if c.a == 1.0 then \"rgb(\" <> red <> \", \" <> green <> \", \" <> blue <> \")\"\n else \"rgba(\" <> red <> \", \" <> green <> \", \" <> blue <> \", \"\n <> alpha\n <> \")\"\n where\n c = toRGBA col\n red = show c.r\n green = show c.g\n blue = show c.b\n alpha = show c.a\n\n-- | Pure black.\nblack :: Color\nblack = hsl 0.0 0.0 0.0\n\n-- | Pure white.\nwhite :: Color\nwhite = hsl 0.0 0.0 1.0\n\n-- | Create a gray tone from a lightness values (0.0 is black, 1.0 is white).\ngraytone :: Number -> Color\ngraytone l = hsl 0.0 0.0 l\n\n-- | Rotate the hue of a `Color` by a certain angle (in degrees).\nrotateHue :: Number -> Color -> Color\nrotateHue angle (HSLA (UnclippedHue h) s l a) = hsla (h + angle) s l a\n\n-- | Get the complementary color (hue rotated by 180\u00B0).\ncomplementary :: Color -> Color\ncomplementary = rotateHue 180.0\n\n-- | Lighten a color by adding a certain amount (number between -1.0 and 1.0)\n-- | to the lightness channel. If the number is negative, the color is\n-- | darkened.\nlighten :: Number -> Color -> Color\nlighten f (HSLA (UnclippedHue h) s l a) = hsla h s (l + f) a\n\n-- | Darken a color by subtracting a certain amount (number between -1.0 and\n-- | 1.0) from the lightness channel. If the number is negative, the color is\n-- | lightened.\ndarken :: Number -> Color -> Color\ndarken f = lighten (-f)\n\n-- | Increase the saturation of a color by adding a certain amount (number\n-- | between -1.0 and 1.0) to the saturation channel. If the number is\n-- | negative, the color is desaturated.\nsaturate :: Number -> Color -> Color\nsaturate f (HSLA (UnclippedHue h) s l a) = hsla h (s + f) l a\n\n-- | Decrease the saturation of a color by subtracting a certain amount (number\n-- | between -1.0 and 1.0) from the saturation channel. If the number is\n-- | negative, the color is saturated.\ndesaturate :: Number -> Color -> Color\ndesaturate f = saturate (-f)\n\n-- | Convert a color to a gray tone with the same perceived luminance (see\n-- | `luminance`).\ntoGray :: Color -> Color\ntoGray col = desaturate 1.0 (lch res.l 0.0 0.0)\n -- the desaturation step is only needed to correct minor rounding\n -- errors.\n where\n res = toLCh col\n\n-- | Linearly interpolate between two values.\ninterpolate :: Number -> Number -> Number -> Number\ninterpolate fraction a b = a + fraction * (b - a)\n\n-- | Linearly interpolate between two angles. Always take the shortest path\n-- | along the circle.\ninterpolateAngle :: Number -> Number -> Number -> Number\ninterpolateAngle fraction a b = interpolate fraction shortest.from shortest.to\n where\n paths =\n [ { from: a, to: b }\n , { from: a, to: b + 360.0 }\n , { from: a + 360.0, to: b }\n ]\n dist { from, to } = abs (to - from)\n shortest = unsafePartial (fromJust (minimumBy (comparing dist) paths))\n\n-- | A function that interpolates between two colors. It takes a start color,\n-- | an end color, and a ratio in the interval [0.0, 1.0]. It returns the\n-- | mixed color.\ntype Interpolator = Color -> Color -> Number -> Color\n\n-- | Mix two colors by linearly interpolating between them in the specified\n-- | color space. For the HSL colorspace, the shortest path is chosen along the\n-- | circle of hue values.\nmix :: ColorSpace -> Interpolator\nmix HSL c1 c2 frac = hsla\n (interpolateAngle frac f.h t.h)\n (interpolate frac f.s t.s)\n (interpolate frac f.l t.l)\n (interpolate frac f.a t.a)\n where\n f = toHSLA c1\n t = toHSLA c2\n\nmix RGB c1 c2 frac = rgba'\n (interpolate frac f.r t.r)\n (interpolate frac f.g t.g)\n (interpolate frac f.b t.b)\n (interpolate frac f.a t.a)\n where\n f = toRGBA' c1\n t = toRGBA' c2\n\nmix LCh c1 c2 frac = lch\n (interpolate frac f.l t.l)\n (interpolate frac f.c t.c)\n (interpolateAngle frac f.h t.h)\n where\n f = toLCh c1\n t = toLCh c2\n\nmix Lab c1 c2 frac = lab\n (interpolate frac f.l t.l)\n (interpolate frac f.a t.a)\n (interpolate frac f.b t.b)\n where\n f = toLab c1\n t = toLab c2\n\n-- | Mix two colors via Dave Green's [cubehelix](http://www.mrao.cam.ac.uk/~dag/CUBEHELIX/) by\n-- | interpolating between them. Takes a gamma correction value as an argument and\n-- | returns an `Interpolator` function.\n-- |\n-- | For more details see:\n-- | * [d3-plugins/cubehelix](https://github.com/d3/d3-plugins/tree/40f8b3b91e67719f58408732d7ddae94cafa559a/cubehelix#interpolateCubehelix)\n-- |\n-- | Ported from:\n-- | * [d3-plugins/cubehelix/cubehelix.js](https://github.com/d3/d3-plugins/blob/40f8b3b91e67719f58408732d7ddae94cafa559a/cubehelix/cubehelix.js#L13)\nmixCubehelix :: Number -> Interpolator\nmixCubehelix gamma (HSLA (UnclippedHue ah') as' al' aa') (HSLA (UnclippedHue bh') bs' bl' ba') =\n let\n radians :: Number\n radians = pi / 180.0\n ah = (ah' + 120.0) * radians\n bh = (bh' + 120.0) * radians - ah\n as = as'\n bs = bs' - as\n al = al'\n bl = bl' - al\n in\n \\t ->\n let\n angle = ah + bh * t\n fract = pow (al + bl * t) gamma\n amp = (as + bs * t) * fract * (1.0 - fract)\n r = fract + amp * (-0.14861 * cos (angle) + 1.78277 * sin (angle))\n g = fract + amp * (-0.29227 * cos (angle) - 0.90649 * sin (angle))\n b = fract + amp * (1.97294 * cos (angle))\n a = interpolate t aa' ba'\n in\n rgba' r g b a\n\n-- | The percieved brightness of the color (A number between 0.0 and 1.0).\n-- |\n-- | See: https://www.w3.org/TR/AERT#color-contrast\nbrightness :: Color -> Number\nbrightness col = (299.0 * c.r + 587.0 * c.g + 114.0 * c.b) / 1000.0\n where\n c = toRGBA' col\n\n-- | The relative brightness of a color (normalized to 0.0 for darkest black\n-- | and 1.0 for lightest white), according to the WCAG definition.\n-- |\n-- | See: https://www.w3.org/TR/2008/REC-WCAG20-20081211/#relativeluminancedef\nluminance :: Color -> Number\nluminance col = 0.2126 * r + 0.7152 * g + 0.0722 * b\n where\n r = f val.r\n g = f val.g\n b = f val.b\n\n f c\n | c <= 0.03928 = c / 12.92\n | otherwise = ((c + 0.055) / 1.055) `pow` 2.4\n\n val = toRGBA' col\n\n-- | The contrast ratio of two colors. A minimum contrast ratio of 4.5 is\n-- | recommended to ensure that text is readable on a colored background. The\n-- | contrast ratio is symmetric on both arguments:\n-- | `contrast c1 c2 == contrast c2 c1`.\n-- |\n-- | See http://www.w3.org/TR/2008/REC-WCAG20-20081211/#contrast-ratiodef\ncontrast :: Color -> Color -> Number\ncontrast c1 c2 =\n if l1 > l2 then (l1 + o) / (l2 + o)\n else (l2 + o) / (l1 + o)\n where\n l1 = luminance c1\n l2 = luminance c2\n o = 0.05\n\n-- | Determine whether a color is perceived as a light color.\n-- |\n-- | ``` purs\n-- | isLight c = brightness c > 0.5\n-- | ```\nisLight :: Color -> Boolean\nisLight c = brightness c > 0.5\n\n-- | Determine whether text of one color is readable on a background of a\n-- | different color (see `contrast`). This function is symmetric in both\n-- | arguments.\n-- |\n-- | ``` purs\n-- | isReadable c1 c2 = contrast c1 c2 > 4.5\n-- | ```\nisReadable :: Color -> Color -> Boolean\nisReadable c1 c2 = contrast c1 c2 > 4.5\n\n-- | Return a readable foreground text color (either `black` or `white`) for a\n-- | given background color.\ntextColor :: Color -> Color\ntextColor c\n | isLight c = black\n | otherwise = white\n\n-- | Compute the perceived 'distance' between two colors according to the CIE76\n-- | delta-E standard. A distance below ~2.3 is not noticable.\n-- |\n-- | See: https://en.wikipedia.org/wiki/Color_difference\ndistance :: Color -> Color -> Number\ndistance col1 col2 = sqrt (sq (c1.l - c2.l) + sq (c1.a - c2.a) + sq (c1.b - c2.b))\n where\n c1 = toLab col1\n c2 = toLab col2\n sq x = x `pow` 2.0\n", "module Data.Profunctor where\n\nimport Prelude\nimport Data.Newtype (class Newtype, wrap, unwrap)\n\n-- | A `Profunctor` is a `Functor` from the pair category `(Type^op, Type)`\n-- | to `Type`.\n-- |\n-- | In other words, a `Profunctor` is a type constructor of two type\n-- | arguments, which is contravariant in its first argument and covariant\n-- | in its second argument.\n-- |\n-- | The `dimap` function can be used to map functions over both arguments\n-- | simultaneously.\n-- |\n-- | A straightforward example of a profunctor is the function arrow `(->)`.\n-- |\n-- | Laws:\n-- |\n-- | - Identity: `dimap identity identity = identity`\n-- | - Composition: `dimap f1 g1 <<< dimap f2 g2 = dimap (f1 >>> f2) (g1 <<< g2)`\nclass Profunctor p where\n dimap :: forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d\n\n-- | Map a function over the (contravariant) first type argument only.\nlcmap :: forall a b c p. Profunctor p => (a -> b) -> p b c -> p a c\nlcmap a2b = dimap a2b identity\n\n-- | Map a function over the (covariant) second type argument only.\nrmap :: forall a b c p. Profunctor p => (b -> c) -> p a b -> p a c\nrmap b2c = dimap identity b2c\n\n-- | Lift a pure function into any `Profunctor` which is also a `Category`.\narr :: forall a b p. Category p => Profunctor p => (a -> b) -> p a b\narr f = rmap f identity\n\nunwrapIso :: forall p t a. Profunctor p => Newtype t a => p t t -> p a a\nunwrapIso = dimap wrap unwrap\n\nwrapIso :: forall p t a. Profunctor p => Newtype t a => (a -> t) -> p a a -> p t t\nwrapIso _ = dimap unwrap wrap\n\ninstance profunctorFn :: Profunctor (->) where\n dimap a2b c2d b2c = a2b >>> b2c >>> c2d\n", "module Data.Profunctor.Strong where\n\nimport Prelude\n\nimport Data.Profunctor (class Profunctor, lcmap)\nimport Data.Tuple (Tuple(..))\n\n-- | The `Strong` class extends `Profunctor` with combinators for working with\n-- | product types.\n-- |\n-- | `first` and `second` lift values in a `Profunctor` to act on the first and\n-- | second components of a `Tuple`, respectively.\n-- |\n-- | Another way to think about Strong is to piggyback on the intuition of\n-- | inputs and outputs. Rewriting the type signature in this light then yields:\n-- | ```\n-- | first :: forall input output a. p input output -> p (Tuple input a) (Tuple output a)\n-- | second :: forall input output a. p input output -> p (Tuple a input) (Tuple a output)\n-- | ```\n-- | If we specialize the profunctor p to the function arrow, we get the following type\n-- | signatures, which may look a bit more familiar:\n-- | ```\n-- | first :: forall input output a. (input -> output) -> (Tuple input a) -> (Tuple output a)\n-- | second :: forall input output a. (input -> output) -> (Tuple a input) -> (Tuple a output)\n-- | ```\n-- | So, when the `profunctor` is `Function` application, `first` essentially applies your function\n-- | to the first element of a `Tuple`, and `second` applies it to the second element (same as `map` would do).\nclass Profunctor p <= Strong p where\n first :: forall a b c. p a b -> p (Tuple a c) (Tuple b c)\n second :: forall a b c. p b c -> p (Tuple a b) (Tuple a c)\n\ninstance strongFn :: Strong (->) where\n first a2b (Tuple a c) = Tuple (a2b a) c\n second = (<$>)\n\n-- | Compose a value acting on a `Tuple` from two values, each acting on one of\n-- | the components of the `Tuple`.\n-- |\n-- | Specializing `(***)` to function application would look like this:\n-- | ```\n-- | (***) :: forall a b c d. (a -> b) -> (c -> d) -> (Tuple a c) -> (Tuple b d)\n-- | ```\n-- | We take two functions, `f` and `g`, and we transform them into a single function which\n-- | takes a `Tuple` and maps `f` over the first element and `g` over the second. Just like `bi-map`\n-- | would do for the `bi-functor` instance of `Tuple`.\nsplitStrong\n :: forall p a b c d\n . Semigroupoid p\n => Strong p\n => p a b\n -> p c d\n -> p (Tuple a c) (Tuple b d)\nsplitStrong l r = first l >>> second r\n\ninfixr 3 splitStrong as ***\n\n-- | Compose a value which introduces a `Tuple` from two values, each introducing\n-- | one side of the `Tuple`.\n-- |\n-- | This combinator is useful when assembling values from smaller components,\n-- | because it provides a way to support two different types of output.\n-- |\n-- | Specializing `(&&&)` to function application would look like this:\n-- | ```\n-- | (&&&) :: forall a b c. (a -> b) -> (a -> c) -> (a -> (Tuple b c))\n-- | ```\n-- | We take two functions, `f` and `g`, with the same parameter type and we transform them into a\n-- | single function which takes one parameter and returns a `Tuple` of the results of running\n-- | `f` and `g` on the parameter, respectively. This allows us to run two parallel computations\n-- | on the same input and return both results in a `Tuple`.\nfanout\n :: forall p a b c\n . Semigroupoid p\n => Strong p\n => p a b\n -> p a c\n -> p a (Tuple b c)\nfanout l r = lcmap (\\a -> Tuple a a) (l *** r)\n\ninfixr 3 fanout as &&&\n", "module CSS.Property where\n\nimport Prelude\n\nimport CSS.String (class IsString, fromString)\nimport Color (Color, cssStringHSLA)\nimport Data.Foldable (intercalate, lookup)\nimport Data.Maybe (fromMaybe)\nimport Data.NonEmpty (NonEmpty, oneOf)\nimport Data.Profunctor.Strong (second)\nimport Data.Tuple (Tuple(..))\n\ndata Prefixed\n = Prefixed (Array (Tuple String String))\n | Plain String\n\nderive instance eqPrefixed :: Eq Prefixed\nderive instance ordPrefixed :: Ord Prefixed\n\ninstance isStringPrefixed :: IsString Prefixed where\n fromString = Plain\n\ninstance semigroupPrefixed :: Semigroup Prefixed where\n append (Plain x) (Plain y) = Plain $ x <> y\n append (Plain x) (Prefixed ys) = Prefixed $ second (x <> _) <$> ys\n append (Prefixed xs) (Plain y) = Prefixed $ second (y <> _) <$> xs\n append (Prefixed xs) (Prefixed ys) = Prefixed $ xs <> ys\n\ninstance monoidPrefixed :: Monoid Prefixed where\n mempty = Plain mempty\n\nplain :: Prefixed -> String\nplain (Prefixed xs) = fromMaybe \"\" $ lookup \"\" xs\nplain (Plain p) = p\n\n-- TODO: Escape\nquote :: String -> String\nquote s = \"\\\"\" <> s <> \"\\\"\"\n\nnewtype Key :: Type -> Type\nnewtype Key a = Key Prefixed\n\ntype role Key representational\n\nderive instance eqKey :: (Eq a) => Eq (Key a)\nderive instance ordKey :: (Ord a) => Ord (Key a)\n\ninstance isStringKey :: IsString (Key a) where\n fromString = Key <<< fromString\n\ncast :: forall a. Key a -> Key Unit\ncast (Key k) = Key k\n\nnewtype Value = Value Prefixed\n\nderive instance eqValue :: Eq Value\nderive instance ordValue :: Ord Value\n\ninstance isStringValue :: IsString Value where\n fromString = Value <<< fromString\n\ninstance semigroupValue :: Semigroup Value where\n append (Value a) (Value b) = Value $ a <> b\n\ninstance monoidValue :: Monoid Value where\n mempty = Value mempty\n\nclass Val a where\n value :: a -> Value\n\nnewtype Literal = Literal String\n\nderive instance eqLiteral :: Eq Literal\nderive instance ordLiteral :: Ord Literal\n\ninstance valLiteral :: Val Literal where\n value (Literal a) = fromString $ quote a\n\ninstance valValue :: Val Value where\n value = identity\n\ninstance valString :: Val String where\n value = fromString\n\ninstance valUnit :: Val Unit where\n value _ = fromString \"\"\n\ninstance valTuple :: (Val a, Val b) => Val (Tuple a b) where\n value (Tuple a b) = value a <> fromString \" \" <> value b\n\ninstance valNumber :: Val Number where\n value = fromString <<< show\n\ninstance valList :: (Val a) => Val (Array a) where\n value = intercalate (fromString \", \") <<< (value <$> _)\n\ninstance valNonEmpty :: (Val a) => Val (NonEmpty Array a) where\n value = value <<< oneOf\n\ninstance valColor :: Val Color where\n value = fromString <<< cssStringHSLA\n\nnoCommas :: forall a. (Val a) => Array a -> Value\nnoCommas = intercalate (fromString \" \") <<< (value <$> _)\n\ninfixr 9 Tuple as !\n", "-- | A bunch of type classes representing common values shared between multiple\n-- | CSS properties, like `Auto`, `Inherit`, `None`, `Normal` and several more.\n-- |\n-- | All the common value type classes have an instance for the `Value` type,\n-- | making them easily derivable for custom value types.\n\nmodule CSS.Common where\n\nimport Prelude\nimport Data.Tuple (Tuple(..))\n\nimport CSS.Property (Prefixed(..), Value)\nimport CSS.String (class IsString, fromString)\n\nclass All a where\n all :: a\n\nclass Auto a where\n auto :: a\n\nclass Baseline a where\n baseline :: a\n\nclass Center a where\n center :: a\n\nclass Inherit a where\n inherit :: a\n\nclass None a where\n none :: a\n\nclass Normal a where\n normal :: a\n\nclass Visible a where\n visible :: a\n\nclass Hidden a where\n hidden :: a\n\nclass Initial a where\n initial :: a\n\nclass Unset a where\n unset :: a\n\nclass Top a where\n top :: a\n\nclass Middle a where\n middle :: a\n\nclass Bottom a where\n bottom :: a\n\nclass URL a where\n url :: String -> a\n\n-- | The other type class is used to escape from the type safety introduced by\n-- | embedding CSS properties into the typed world of purescript-css.\n-- | `Other` allows you to cast any `Value` to a specific value type.\nclass Other a where\n other :: Value -> a\n\ninstance allValue :: All Value where\n all = fromString \"all\"\n\ninstance autoValue :: Auto Value where\n auto = fromString \"auto\"\n\ninstance baselineValue :: Baseline Value where\n baseline = fromString \"baseline\"\n\ninstance centerValue :: Center Value where\n center = fromString \"center\"\n\ninstance inheritValue :: Inherit Value where\n inherit = fromString \"inherit\"\n\ninstance normalValue :: Normal Value where\n normal = fromString \"normal\"\n\ninstance noneValue :: None Value where\n none = fromString \"none\"\n\ninstance visibleValue :: Visible Value where\n visible = fromString \"visible\"\n\ninstance hiddenValue :: Hidden Value where\n hidden = fromString \"hidden\"\n\ninstance otherValue :: Other Value where\n other = identity\n\ninstance initialValue :: Initial Value where\n initial = fromString \"initial\"\n\ninstance unsetValue :: Unset Value where\n unset = fromString \"unset\"\n\ninstance topValue :: Top Value where\n top = fromString \"top\"\n\ninstance middleValue :: Middle Value where\n middle = fromString \"middle\"\n\ninstance bottomValue :: Bottom Value where\n bottom = fromString \"bottom\"\n\ninstance urlValue :: URL Value where\n url s = fromString (\"url(\\\"\" <> s <> \"\\\")\")\n\n-- | Common list browser prefixes to make\n-- | experimental properties work in different browsers.\nbrowsers :: Prefixed\nbrowsers = Prefixed\n [ Tuple \"-webkit-\" \"\"\n , Tuple \"-moz-\" \"\"\n , Tuple \"-ms-\" \"\"\n , Tuple \"-o-\" \"\"\n , Tuple \"\" \"\"\n ]\n\n-- | Syntax for CSS function call.\ncall :: forall s. IsString s => Monoid s => s -> s -> s\ncall fn arg = fn <> fromString \"(\" <> arg <> fromString \")\"\n", "module Data.Exists where\n\nimport Unsafe.Coerce (unsafeCoerce)\n\n-- | This type constructor can be used to existentially quantify over a type.\n-- |\n-- | Specifically, the type `Exists f` is isomorphic to the existential type `exists a. f a`.\n-- |\n-- | Existential types can be encoded using universal types (`forall`) for endofunctors in more general\n-- | categories. The benefit of this library is that, by using the FFI, we can create an efficient\n-- | representation of the existential by simply hiding type information.\n-- |\n-- | For example, consider the type `exists s. Tuple s (s -> Tuple s a)` which represents infinite streams\n-- | of elements of type `a`.\n-- |\n-- | This type can be constructed by creating a type constructor `StreamF` as follows:\n-- |\n-- | ```purescript\n-- | data StreamF a s = StreamF s (s -> Tuple s a)\n-- | ```\n-- |\n-- | We can then define the type of streams using `Exists`:\n-- |\n-- | ```purescript\n-- | type Stream a = Exists (StreamF a)\n-- | ```\nforeign import data Exists :: forall k. (k -> Type) -> Type\n\ntype role Exists representational\n\n-- | The `mkExists` function is used to introduce a value of type `Exists f`, by providing a value of\n-- | type `f a`, for some type `a` which will be hidden in the existentially-quantified type.\n-- |\n-- | For example, to create a value of type `Stream Number`, we might use `mkExists` as follows:\n-- |\n-- | ```purescript\n-- | nats :: Stream Number\n-- | nats = mkExists $ StreamF 0 (\\n -> Tuple (n + 1) n)\n-- | ```\nmkExists :: forall f a. f a -> Exists f\nmkExists = unsafeCoerce\n\n-- | The `runExists` function is used to eliminate a value of type `Exists f`. The rank 2 type ensures\n-- | that the existentially-quantified type does not escape its scope. Since the function is required\n-- | to work for _any_ type `a`, it will work for the existentially-quantified type.\n-- |\n-- | For example, we can write a function to obtain the head of a stream by using `runExists` as follows:\n-- |\n-- | ```purescript\n-- | head :: forall a. Stream a -> a\n-- | head = runExists head'\n-- | where\n-- | head' :: forall s. StreamF a s -> a\n-- | head' (StreamF s f) = snd (f s)\n-- | ```\nrunExists :: forall f r. (forall a. f a -> r) -> Exists f -> r\nrunExists = unsafeCoerce\n", "module CSS.Size where\n\nimport Prelude\n\nimport CSS.Common (class Auto, class Inherit, class Initial, class Unset, browsers)\nimport CSS.Property (class Val, Prefixed(Plain), Value(..), plain, value)\nimport CSS.String (class IsString, fromString)\nimport Data.Exists (Exists, mkExists, runExists)\n\ndata LengthUnit\n\ndata Percentage\n\ndata Combination\n\ndata Size :: Type -> Type\ndata Size a\n = BasicSize Value\n | SumSize (Exists Size) (Exists Size)\n | DiffSize (Exists Size) (Exists Size)\n | MultSize Number (Exists Size)\n | DivSize Number (Exists Size)\n\ntype role Size nominal\n\ninstance isStringSize :: IsString (Size a) where\n fromString = BasicSize <<< fromString\n\nsizeToString :: forall a. Size a -> String\nsizeToString (BasicSize (Value x)) = plain x\nsizeToString (SumSize a b) = runExists (\\a' -> runExists (\\b' -> \"(\" <> sizeToString a' <> \" + \" <> sizeToString b' <> \")\") b) a\nsizeToString (DiffSize a b) = runExists (\\a' -> runExists (\\b' -> \"(\" <> sizeToString a' <> \" - \" <> sizeToString b' <> \")\") b) a\nsizeToString (MultSize a b) = runExists (\\b' -> \"(\" <> show a <> \" * \" <> sizeToString b' <> \")\") b\nsizeToString (DivSize a b) = runExists (\\b' -> \"(\" <> sizeToString b' <> \" / \" <> show a <> \")\") b\n\ninstance valSize :: Val (Size a) where\n value (BasicSize x) = x\n value x = Value $ browsers <> Plain (\"calc\" <> sizeToString x)\n\ninstance autoSize :: Auto (Size a) where\n auto = fromString \"auto\"\n\ninstance inheritSize :: Inherit (Size a) where\n inherit = fromString \"inherit\"\n\ninstance initialSize :: Initial (Size a) where\n initial = fromString \"initial\"\n\ninstance unsetSize :: Unset (Size a) where\n unset = fromString \"unset\"\n\n-- | Zero size.\nnil :: forall a. Size a\nnil = BasicSize $ fromString \"0\"\n\n-- | Unitless size (as recommended for line-height).\nunitless :: forall a. Number -> Size a\nunitless = BasicSize <<< value\n\n-- | Size in pixels.\npx :: Number -> Size LengthUnit\npx i = BasicSize (value i <> fromString \"px\")\n\n-- | Size in points (1pt = 1/72 of 1in).\npt :: Number -> Size LengthUnit\npt i = BasicSize (value i <> fromString \"pt\")\n\n-- | Size in em's.\nem :: Number -> Size LengthUnit\nem i = BasicSize (value i <> fromString \"em\")\n\n-- | Size in ex'es (x-height of the first avaliable font).\nex :: Number -> Size LengthUnit\nex i = BasicSize (value i <> fromString \"ex\")\n\nch :: Number -> Size LengthUnit\nch i = BasicSize (value i <> fromString \"ch\")\n\n-- | SimpleSize in percents.\npct :: Number -> Size Percentage\npct i = BasicSize (value i <> fromString \"%\")\n\n-- | Size in rem's.\nrem :: Number -> Size LengthUnit\nrem i = BasicSize (value i <> fromString \"rem\")\n\n-- | Size in vw's (1vw = 1% of viewport width).\nvw :: Number -> Size LengthUnit\nvw i = BasicSize (value i <> fromString \"vw\")\n\n-- | Size in vh's (1vh = 1% of viewport height).\nvh :: Number -> Size LengthUnit\nvh i = BasicSize (value i <> fromString \"vh\")\n\n-- | Size in vmin's (the smaller of vw or vh).\nvmin :: Number -> Size LengthUnit\nvmin i = BasicSize (value i <> fromString \"vmin\")\n\n-- | Size in vmax's (the larger of vw or vh).\nvmax :: Number -> Size LengthUnit\nvmax i = BasicSize (value i <> fromString \"vmax\")\n\nclass SizeCombination :: forall a b c. a -> b -> c -> Constraint\nclass SizeCombination a b c | a -> c, b -> c\n\ninstance SizeCombination Percentage Percentage Percentage\ninstance SizeCombination LengthUnit LengthUnit LengthUnit\ninstance SizeCombination Percentage LengthUnit Combination\ninstance SizeCombination LengthUnit Percentage Combination\n\ninfixl 6 calcSum as @+@\n\ncalcSum :: forall a b c. SizeCombination a b c => Size a -> Size b -> Size c\ncalcSum a b = SumSize (mkExists a) (mkExists b)\n\ninfixl 6 calcDiff as @-@\n\ncalcDiff :: forall a b c. SizeCombination a b c => Size a -> Size b -> Size c\ncalcDiff a b = DiffSize (mkExists a) (mkExists b)\n\ninfixl 7 calcMult as *@\n\ncalcMult :: forall a. Number -> Size a -> Size a\ncalcMult a b = MultSize a $ mkExists b\n\ninfixl 7 calcMultFlipped as @*\n\ncalcMultFlipped :: forall a. Size a -> Number -> Size a\ncalcMultFlipped = flip calcMult\n\ninfixl 7 calcDiv as @/\n\ncalcDiv :: forall a. Size a -> Number -> Size a\ncalcDiv a b = DivSize b $ mkExists a\n\nsym :: forall a b. (a -> a -> a -> a -> b) -> a -> b\nsym f a = f a a a a\n\ndata Deg\ndata Rad\n\nnewtype Angle :: Type -> Type\nnewtype Angle a = Angle Value\n\ntype role Angle nominal\n\nderive instance eqAngle :: Eq a => Eq (Angle a)\nderive instance ordAngle :: Ord a => Ord (Angle a)\n\ninstance valAngle :: Val (Angle a) where\n value (Angle v) = v\n\n-- | Angle in degrees.\ndeg :: Number -> Angle Deg\ndeg i = Angle $ (value i <> fromString \"deg\")\n\n-- | Angle in radians.\nrad :: Number -> Angle Rad\nrad i = Angle $ (value i <> fromString \"rad\")\n", "-- | This module defines the writer monad transformer, `WriterT`.\n\nmodule Control.Monad.Writer.Trans\n ( WriterT(..), runWriterT, execWriterT, mapWriterT\n , module Control.Monad.Trans.Class\n , module Control.Monad.Writer.Class\n ) where\n\nimport Prelude\n\nimport Control.Alt (class Alt, (<|>))\nimport Control.Alternative (class Alternative)\nimport Control.Apply (lift2)\nimport Control.Monad.Cont.Class (class MonadCont, callCC)\nimport Control.Monad.Error.Class (class MonadThrow, class MonadError, catchError, throwError)\nimport Control.Monad.Reader.Class (class MonadAsk, class MonadReader, ask, local)\nimport Control.Monad.Rec.Class (class MonadRec, tailRecM, Step(..))\nimport Control.Monad.ST.Class (class MonadST, liftST)\nimport Control.Monad.State.Class (class MonadState, state)\nimport Control.Monad.Trans.Class (class MonadTrans, lift)\nimport Control.Monad.Writer.Class (class MonadTell, tell, class MonadWriter, censor, listen, listens, pass)\nimport Control.MonadPlus (class MonadPlus)\nimport Control.Plus (class Plus, empty)\nimport Data.Newtype (class Newtype)\nimport Data.Tuple (Tuple(..), snd)\nimport Effect.Class (class MonadEffect, liftEffect)\n\n-- | The writer monad transformer.\n-- |\n-- | This monad transformer extends the base monad with a monoidal accumulator of\n-- | type `w`.\n-- |\n-- | The `MonadWriter` type class describes the operations supported by this monad.\nnewtype WriterT w m a = WriterT (m (Tuple a w))\n\n-- | Run a computation in the `WriterT` monad.\nrunWriterT :: forall w m a. WriterT w m a -> m (Tuple a w)\nrunWriterT (WriterT x) = x\n\n-- | Run a computation in the `WriterT` monad, discarding the result.\nexecWriterT :: forall w m a. Functor m => WriterT w m a -> m w\nexecWriterT (WriterT m) = snd <$> m\n\n-- | Change the accumulator and base monad types in a `WriterT` monad action.\nmapWriterT :: forall w1 w2 m1 m2 a b. (m1 (Tuple a w1) -> m2 (Tuple b w2)) -> WriterT w1 m1 a -> WriterT w2 m2 b\nmapWriterT f (WriterT m) = WriterT (f m)\n\nderive instance newtypeWriterT :: Newtype (WriterT w m a) _\n\ninstance functorWriterT :: Functor m => Functor (WriterT w m) where\n map f = mapWriterT $ map \\(Tuple a w) -> Tuple (f a) w\n\ninstance applyWriterT :: (Semigroup w, Apply m) => Apply (WriterT w m) where\n apply (WriterT f) (WriterT v) = WriterT\n let k (Tuple a w) (Tuple b w') = Tuple (a b) (w <> w')\n in k <$> f <*> v\n\ninstance applicativeWriterT :: (Monoid w, Applicative m) => Applicative (WriterT w m) where\n pure a = WriterT $ pure $ Tuple a mempty\n\ninstance altWriterT :: Alt m => Alt (WriterT w m) where\n alt (WriterT m) (WriterT n) = WriterT (m <|> n)\n\ninstance plusWriterT :: Plus m => Plus (WriterT w m) where\n empty = WriterT empty\n\ninstance alternativeWriterT :: (Monoid w, Alternative m) => Alternative (WriterT w m)\n\ninstance bindWriterT :: (Semigroup w, Bind m) => Bind (WriterT w m) where\n bind (WriterT m) k = WriterT $\n m >>= \\(Tuple a w) ->\n case k a of\n WriterT wt ->\n map (\\(Tuple b w') -> Tuple b (w <> w')) wt\n\ninstance monadWriterT :: (Monoid w, Monad m) => Monad (WriterT w m)\n\ninstance monadRecWriterT :: (Monoid w, MonadRec m) => MonadRec (WriterT w m) where\n tailRecM f a = WriterT $ tailRecM f' (Tuple a mempty)\n where\n f' (Tuple a' w) =\n case f a' of\n WriterT wt -> wt >>= \\(Tuple m w1) ->\n pure case m of\n Loop x -> Loop (Tuple x (w <> w1))\n Done y -> Done (Tuple y (w <> w1))\n\ninstance monadPlusWriterT :: (Monoid w, MonadPlus m) => MonadPlus (WriterT w m)\n\ninstance monadTransWriterT :: Monoid w => MonadTrans (WriterT w) where\n lift m = WriterT do\n a <- m\n pure $ Tuple a mempty\n\ninstance monadEffectWriter :: (Monoid w, MonadEffect m) => MonadEffect (WriterT w m) where\n liftEffect = lift <<< liftEffect\n\ninstance monadContWriterT :: (Monoid w, MonadCont m) => MonadCont (WriterT w m) where\n callCC f = WriterT $ callCC \\c ->\n case f (\\a -> WriterT $ c (Tuple a mempty)) of WriterT b -> b\n\ninstance monadThrowWriterT :: (Monoid w, MonadThrow e m) => MonadThrow e (WriterT w m) where\n throwError e = lift (throwError e)\n\ninstance monadErrorWriterT :: (Monoid w, MonadError e m) => MonadError e (WriterT w m) where\n catchError (WriterT m) h = WriterT $ catchError m (\\e -> case h e of WriterT a -> a)\n\ninstance monadAskWriterT :: (Monoid w, MonadAsk r m) => MonadAsk r (WriterT w m) where\n ask = lift ask\n\ninstance monadReaderWriterT :: (Monoid w, MonadReader r m) => MonadReader r (WriterT w m) where\n local f = mapWriterT (local f)\n\ninstance monadStateWriterT :: (Monoid w, MonadState s m) => MonadState s (WriterT w m) where\n state f = lift (state f)\n\ninstance monadTellWriterT :: (Monoid w, Monad m) => MonadTell w (WriterT w m) where\n tell = WriterT <<< pure <<< Tuple unit\n\ninstance monadWriterWriterT :: (Monoid w, Monad m) => MonadWriter w (WriterT w m) where\n listen (WriterT m) = WriterT do\n Tuple a w <- m\n pure $ Tuple (Tuple a w) w\n pass (WriterT m) = WriterT do\n Tuple (Tuple a f) w <- m\n pure $ Tuple a (f w)\n\ninstance semigroupWriterT :: (Apply m, Semigroup w, Semigroup a) => Semigroup (WriterT w m a) where\n append = lift2 (<>)\n\ninstance monoidWriterT :: (Applicative m, Monoid w, Monoid a) => Monoid (WriterT w m a) where\n mempty = pure mempty\n\ninstance (Monoid w, MonadST s m) => MonadST s (WriterT w m) where\n liftST = lift <<< liftST\n", "-- | This module defines the `Writer` monad.\n\nmodule Control.Monad.Writer\n ( Writer\n , writer\n , runWriter\n , execWriter\n , mapWriter\n , module Control.Monad.Writer.Class\n , module Control.Monad.Writer.Trans\n ) where\n\nimport Prelude\n\nimport Control.Monad.Writer.Class (class MonadTell, tell, class MonadWriter, censor, listen, listens, pass)\nimport Control.Monad.Writer.Trans (class MonadTrans, WriterT(..), execWriterT, lift, mapWriterT, runWriterT)\n\nimport Data.Identity (Identity(..))\nimport Data.Newtype (unwrap)\nimport Data.Tuple (Tuple, snd)\n\n-- | The `Writer` monad is a synonym for the `WriterT` monad transformer, applied\n-- | to the `Identity` monad.\ntype Writer w = WriterT w Identity\n\n-- | Creates a `Writer` from a result and output pair.\nwriter :: forall w a. Tuple a w -> Writer w a\nwriter = WriterT <<< pure\n\n-- | Run a computation in the `Writer` monad\nrunWriter :: forall w a. Writer w a -> Tuple a w\nrunWriter = unwrap <<< runWriterT\n\n-- | Run a computation in the `Writer` monad, discarding the result\nexecWriter :: forall w a. Writer w a -> w\nexecWriter m = snd (runWriter m)\n\n-- | Change the result and accumulator types in a `Writer` monad action\nmapWriter :: forall w1 w2 a b. (Tuple a w1 -> Tuple b w2) -> Writer w1 a -> Writer w2 b\nmapWriter f = mapWriterT (Identity <<< f <<< unwrap)\n", "module CSS.Stylesheet where\n\nimport Prelude\n\nimport Control.Monad.Writer (Writer, execWriter)\nimport Control.Monad.Writer.Class (tell)\n\nimport Data.Array (singleton)\nimport Data.Maybe (Maybe(..))\nimport Data.NonEmpty (NonEmpty, (:|))\nimport Data.Profunctor.Strong (second)\nimport Data.Tuple (Tuple(..))\n\nimport CSS.Property (class Val, Key(..), Prefixed, Value, cast, value)\nimport CSS.Selector (Selector, Refinement)\n\nnewtype MediaType = MediaType Value\n\nderive instance eqMediaType :: Eq MediaType\nderive instance ordMediaType :: Ord MediaType\n\ndata NotOrOnly = Not | Only\n\nderive instance eqNotOrOnly :: Eq NotOrOnly\nderive instance ordNotOrOnly :: Ord NotOrOnly\n\ndata MediaQuery = MediaQuery (Maybe NotOrOnly) MediaType (NonEmpty Array Feature)\n\nderive instance eqMediaQuery :: Eq MediaQuery\nderive instance ordMediaQuery :: Ord MediaQuery\n\ndata Feature = Feature String (Maybe Value)\n\nderive instance eqFeature :: Eq Feature\nderive instance ordFeature :: Ord Feature\n\ndata App\n = Self Refinement\n | Root Selector\n | Pop Int\n | Child Selector\n | Sub Selector\n\nderive instance eqApp :: Eq App\nderive instance ordApp :: Ord App\n\ndata Keyframes = Keyframes String (NonEmpty Array (Tuple Number (Array Rule)))\n\nderive instance eqKeyframes :: Eq Keyframes\nderive instance ordKeyframes :: Ord Keyframes\n\ndata Rule\n = Property (Key Unit) Value\n | Nested App (Array Rule)\n | Query MediaQuery (Array Rule)\n | Face (Array Rule)\n | Keyframe Keyframes\n | Import String\n\nderive instance eqRule :: Eq Rule\nderive instance ordRule :: Ord Rule\n\nnewtype StyleM a = S (Writer (Array Rule) a)\n\ninstance functorStyleM :: Functor StyleM where\n map f (S w) = S $ f <$> w\n\ninstance applyStyleM :: Apply StyleM where\n apply (S f) (S w) = S $ f <*> w\n\ninstance bindStyleM :: Bind StyleM where\n bind (S w) f = S $ w >>= (\\(S w') -> w') <<< f\n\ninstance applicativeStyleM :: Applicative StyleM where\n pure = S <<< pure\n\ninstance monadStyleM :: Monad StyleM\n\nrunS :: forall a. StyleM a -> Array Rule\nrunS (S s) = execWriter s\n\nrule :: Rule -> CSS\nrule = S <<< tell <<< singleton\n\ntype CSS = StyleM Unit\n\ninstance semigroupCSS :: Semigroup (StyleM Unit) where\n append = (*>)\n\nkey :: forall a. (Val a) => Key a -> a -> CSS\nkey k v = rule $ Property (cast k) (value v)\n\nprefixed :: forall a. Val a => Prefixed -> a -> CSS\nprefixed xs = key (Key xs)\n\ninfixr 5 select as ?\n\nselect :: Selector -> CSS -> CSS\nselect sel rs = rule $ Nested (Sub sel) (runS rs)\n\nquery :: MediaType -> NonEmpty Array Feature -> CSS -> CSS\nquery ty fs = rule <<< Query (MediaQuery Nothing ty fs) <<< runS\n\nkeyframes :: String -> NonEmpty Array (Tuple Number CSS) -> CSS\nkeyframes n xs = rule $ Keyframe (Keyframes n (second runS <$> xs))\n\nkeyframesFromTo :: String -> CSS -> CSS -> CSS\nkeyframesFromTo n a b = keyframes n $ Tuple 0.0 a :| [ Tuple 100.0 b ]\n\nfontFace :: CSS -> CSS\nfontFace = rule <<< Face <<< runS\n\nimportUrl :: String -> CSS\nimportUrl = rule <<< Import\n", "module CSS.Border\n (\n -- * Stroke type, used for border-style and outline-style.\n Stroke(..)\n , solid\n , dotted\n , dashed\n , double\n , wavy\n , groove\n , ridge\n , inset\n , outset\n\n -- * Border properties.\n\n , border\n , borderTop\n , borderLeft\n , borderBottom\n , borderRight\n , borderColor\n\n -- * Outline properties.\n\n , outline\n , outlineColor\n , outlineStyle\n , outlineWidth\n , outlineOffset\n\n -- * Border radius.\n\n , borderRadius\n\n -- * Collapsing borders model for a table\n , borderSpacing\n ) where\n\nimport Prelude\n\nimport CSS.Color (Color)\nimport CSS.Common (class Inherit, class Initial, class Unset)\nimport CSS.Property (class Val, Value, (!))\nimport CSS.Size (Size, LengthUnit)\nimport CSS.String (class IsString, fromString)\nimport CSS.Stylesheet (CSS, key)\nimport Data.Tuple (Tuple(..))\n\nnewtype Stroke = Stroke Value\n\nderive instance eqStroke :: Eq Stroke\nderive instance ordStroke :: Ord Stroke\n\ninstance isStringStroke :: IsString Stroke where\n fromString = Stroke <<< fromString\n\ninstance valStroke :: Val Stroke where\n value (Stroke v) = v\n\ninstance inheritStroke :: Inherit Stroke where\n inherit = fromString \"inherit\"\n\ninstance initialStroke :: Initial Stroke where\n initial = fromString \"initial\"\n\ninstance unsetStroke :: Unset Stroke where\n unset = fromString \"unset\"\n\nsolid :: Stroke\nsolid = Stroke $ fromString \"solid\"\n\ndotted :: Stroke\ndotted = Stroke $ fromString \"dotted\"\n\ndashed :: Stroke\ndashed = Stroke $ fromString \"dashed\"\n\ndouble :: Stroke\ndouble = Stroke $ fromString \"double\"\n\nwavy :: Stroke\nwavy = Stroke $ fromString \"wavy\"\n\ngroove :: Stroke\ngroove = Stroke $ fromString \"groove\"\n\nridge :: Stroke\nridge = Stroke $ fromString \"ridge\"\n\ninset :: Stroke\ninset = Stroke $ fromString \"inset\"\n\noutset :: Stroke\noutset = Stroke $ fromString \"outset\"\n\nborder :: Stroke -> Size LengthUnit -> Color -> CSS\nborder a b c = key (fromString \"border\") (Tuple a (Tuple b c))\n\nborderTop :: Stroke -> Size LengthUnit -> Color -> CSS\nborderTop a b c = key (fromString \"border-top\") (Tuple a (Tuple b c))\n\nborderBottom :: Stroke -> Size LengthUnit -> Color -> CSS\nborderBottom a b c = key (fromString \"border-bottom\") (Tuple a (Tuple b c))\n\nborderLeft :: Stroke -> Size LengthUnit -> Color -> CSS\nborderLeft a b c = key (fromString \"border-left\") (Tuple a (Tuple b c))\n\nborderRight :: Stroke -> Size LengthUnit -> Color -> CSS\nborderRight a b c = key (fromString \"border-right\") (Tuple a (Tuple b c))\n\nborderColor :: Color -> CSS\nborderColor = key $ fromString \"border-color\"\n\n-------------------------------------------------------------------------------\n\noutline :: Stroke -> Size LengthUnit -> Color -> CSS\noutline a b c = key (fromString \"outline\") (a ! b ! c)\n\noutlineColor :: Color -> CSS\noutlineColor = key (fromString \"outline-color\")\n\noutlineStyle :: Stroke -> CSS\noutlineStyle = key (fromString \"outline-style\")\n\noutlineWidth :: Size LengthUnit -> CSS\noutlineWidth = key (fromString \"outline-width\")\n\noutlineOffset :: Size LengthUnit -> CSS\noutlineOffset = key (fromString \"outline-offset\")\n\n-------------------------------------------------------------------------------\n\nborderRadius :: forall a. Size a -> Size a -> Size a -> Size a -> CSS\nborderRadius a b c d = key (fromString \"border-radius\") (Tuple (Tuple a b) (Tuple c d))\n\nborderSpacing :: forall a. Size a -> CSS\nborderSpacing = key $ fromString \"border-spacing\"\n", "module CSS.Display where\n\nimport Prelude\n\nimport CSS.Common (class Hidden, class Inherit, class Initial, class None, class Other, class Unset, class Visible)\nimport CSS.Property (class Val, Value)\nimport CSS.String (fromString)\nimport CSS.Stylesheet (CSS, key)\n\nnewtype Position = Position Value\n\nderive instance eqPosition :: Eq Position\nderive instance ordPosition :: Ord Position\n\ninstance valPosition :: Val Position where\n value (Position v) = v\n\nposition :: Position -> CSS\nposition = key $ fromString \"position\"\n\nstatic :: Position\nstatic = Position $ fromString \"static\"\n\nabsolute :: Position\nabsolute = Position $ fromString \"absolute\"\n\nfixed :: Position\nfixed = Position $ fromString \"fixed\"\n\nrelative :: Position\nrelative = Position $ fromString \"relative\"\n\nnewtype Display = Display Value\n\nderive instance eqDisplay :: Eq Display\nderive instance ordDisplay :: Ord Display\n\ninstance valDisplay :: Val Display where\n value (Display v) = v\n\ninline :: Display\ninline = Display $ fromString \"inline\"\n\nblock :: Display\nblock = Display $ fromString \"block\"\n\nlistItem :: Display\nlistItem = Display $ fromString \"list-item\"\n\nrunIn :: Display\nrunIn = Display $ fromString \"runIn\"\n\ninlineBlock :: Display\ninlineBlock = Display $ fromString \"inline-block\"\n\ndisplayTable :: Display\ndisplayTable = Display $ fromString \"table\"\n\ninlineTable :: Display\ninlineTable = Display $ fromString \"inline-table\"\n\ntableRowGroup :: Display\ntableRowGroup = Display $ fromString \"table-row-Group\"\n\ntableHeaderGroup :: Display\ntableHeaderGroup = Display $ fromString \"table-header-group\"\n\ntableFooterGroup :: Display\ntableFooterGroup = Display $ fromString \"table-footer-group\"\n\ntableRow :: Display\ntableRow = Display $ fromString \"table-row\"\n\ntableColumnGroup :: Display\ntableColumnGroup = Display $ fromString \"table-column-group\"\n\ntableColumn :: Display\ntableColumn = Display $ fromString \"table-column\"\n\ntableCell :: Display\ntableCell = Display $ fromString \"table-cell\"\n\ntableCaption :: Display\ntableCaption = Display $ fromString \"table-caption\"\n\ndisplayNone :: Display\ndisplayNone = Display $ fromString \"none\"\n\ndisplayInherit :: Display\ndisplayInherit = Display $ fromString \"inherit\"\n\nflex :: Display\nflex = Display $ fromString \"flex\"\n\ninlineFlex :: Display\ninlineFlex = Display $ fromString \"inline-flex\"\n\ngrid :: Display\ngrid = Display $ fromString \"grid\"\n\ninlineGrid :: Display\ninlineGrid = Display $ fromString \"inline-grid\"\n\ndisplay :: Display -> CSS\ndisplay = key $ fromString \"display\"\n\ndata Float = FloatLeft | FloatRight | FloatNone\n\nderive instance eqFloat :: Eq Float\n\ninstance showFloat :: Show Float where\n show FloatLeft = \"FloatLeft\"\n show FloatRight = \"FloatRight\"\n show FloatNone = \"FloatNone\"\n\ninstance valFloat :: Val (Float) where\n value (FloatLeft) = fromString \"left\"\n value (FloatRight) = fromString \"right\"\n value (FloatNone) = fromString \"none\"\n\ninstance noneFloat :: None (Float) where\n none = FloatNone\n\nfloatLeft :: Float\nfloatLeft = FloatLeft\n\nfloatRight :: Float\nfloatRight = FloatRight\n\nfloat :: Float -> CSS\nfloat = key (fromString \"float\")\n\ndata ClearFloat\n = ClearFloatLeft\n | ClearFloatRight\n | ClearFloatBoth\n | ClearFloatNone\n | ClearFloatInherit\n | ClearFloatInlineStart\n | ClearFloatInlineEnd\n\nderive instance eqClearFloat :: Eq ClearFloat\n\ninstance showClearFloat :: Show ClearFloat where\n show ClearFloatLeft = \"ClearFloatLeft\"\n show ClearFloatRight = \"ClearFloatRight\"\n show ClearFloatBoth = \"ClearFloatBoth\"\n show ClearFloatNone = \"ClearFloatNone\"\n show ClearFloatInherit = \"ClearFloatInherit\"\n show ClearFloatInlineStart = \"ClearFloatInlineStart\"\n show ClearFloatInlineEnd = \"ClearFloatInlineEnd\"\n\ninstance valClearFloat :: Val (ClearFloat) where\n value (ClearFloatLeft) = fromString \"left\"\n value (ClearFloatRight) = fromString \"right\"\n value (ClearFloatBoth) = fromString \"both\"\n value (ClearFloatNone) = fromString \"none\"\n value (ClearFloatInherit) = fromString \"inherit\"\n value (ClearFloatInlineStart) = fromString \"inline-start\"\n value (ClearFloatInlineEnd) = fromString \"inline-end\"\n\ninstance noneClearFloat :: None (ClearFloat) where\n none = ClearFloatNone\n\ninstance inheritClearFloat :: Inherit (ClearFloat) where\n inherit = ClearFloatInherit\n\nclearLeft :: ClearFloat\nclearLeft = ClearFloatLeft\n\nclearRight :: ClearFloat\nclearRight = ClearFloatRight\n\nclearBoth :: ClearFloat\nclearBoth = ClearFloatBoth\n\nclearInlineStart :: ClearFloat\nclearInlineStart = ClearFloatInlineStart\n\nclearInlineEnd :: ClearFloat\nclearInlineEnd = ClearFloatInlineEnd\n\nclear :: ClearFloat -> CSS\nclear = key (fromString \"clear\")\n\nopacity :: Number -> CSS\nopacity = key $ fromString \"opacity\"\n\n-------------------------------------------------------------------------------\n\nnewtype Visibility = Visibility Value\n\nderive newtype instance Val Visibility\nderive newtype instance Other Visibility\nderive newtype instance Inherit Visibility\nderive newtype instance Initial Visibility\nderive newtype instance Unset Visibility\nderive newtype instance Hidden Visibility\nderive newtype instance Visible Visibility\n\ncollapse :: Visibility\ncollapse = Visibility $ fromString \"collapse\"\n\nvisibility :: Visibility -> CSS\nvisibility = key $ fromString \"visibility\"\n\n-------------------------------------------------------------------------------\n\nzIndex :: Int -> CSS\nzIndex = key (fromString \"z-index\") <<< show\n", "module CSS.Font where\n\nimport Prelude\nimport CSS.Color (Color)\nimport CSS.Common (class Inherit, class Initial, class Normal, class Unset)\nimport CSS.Property (class Val, Value, value, quote)\nimport CSS.Size (Size)\nimport CSS.String (fromString)\nimport CSS.Stylesheet (CSS, key)\nimport Data.NonEmpty (NonEmpty, oneOf)\n\ncolor :: Color -> CSS\ncolor = key $ fromString \"color\"\n\nnewtype GenericFontFamily = GenericFontFamily Value\n\nderive instance eqGenericFontFamily :: Eq GenericFontFamily\nderive instance ordGenericFontFamily :: Ord GenericFontFamily\n\ninstance valGenericFontFamily :: Val GenericFontFamily where\n value (GenericFontFamily v) = v\n\nserif :: GenericFontFamily\nserif = GenericFontFamily $ fromString \"serif\"\n\nsansSerif :: GenericFontFamily\nsansSerif = GenericFontFamily $ fromString \"sans-serif\"\n\ncursive :: GenericFontFamily\ncursive = GenericFontFamily $ fromString \"cursive\"\n\nmonospace :: GenericFontFamily\nmonospace = GenericFontFamily $ fromString \"monospace\"\n\nfantasy :: GenericFontFamily\nfantasy = GenericFontFamily $ fromString \"fantasy\"\n\nsystemUi :: GenericFontFamily\nsystemUi = GenericFontFamily $ fromString \"system-ui\"\n\nuiSerif :: GenericFontFamily\nuiSerif = GenericFontFamily $ fromString \"ui-serif\"\n\nuiSansSerif :: GenericFontFamily\nuiSansSerif = GenericFontFamily $ fromString \"ui-sans-serif\"\n\nuiMonospace :: GenericFontFamily\nuiMonospace = GenericFontFamily $ fromString \"ui-monospace\"\n\nuiRounded :: GenericFontFamily\nuiRounded = GenericFontFamily $ fromString \"ui-rounded\"\n\nemoji :: GenericFontFamily\nemoji = GenericFontFamily $ fromString \"emoji\"\n\nmath :: GenericFontFamily\nmath = GenericFontFamily $ fromString \"math\"\n\nfangsong :: GenericFontFamily\nfangsong = GenericFontFamily $ fromString \"fangsong\"\n\nfontFamily :: Array String -> NonEmpty Array GenericFontFamily -> CSS\nfontFamily a b = key (fromString \"font-family\") <<< value $ (value <<< quote <$> a) <> oneOf (value <$> b)\n\nfontSize :: forall a. Size a -> CSS\nfontSize = key $ fromString \"font-size\"\n\nnewtype FontWeight = FontWeight Value\n\nderive instance eqFontWeight :: Eq FontWeight\nderive instance ordFontWeight :: Ord FontWeight\n\ninstance valFontWeight :: Val FontWeight where\n value (FontWeight v) = v\n\ninstance normalFontWeight :: Normal FontWeight where\n normal = FontWeight (fromString \"normal\")\n\ninstance initialFontWeight :: Initial FontWeight where\n initial = FontWeight (fromString \"initial\")\n\ninstance inheritFontWeight :: Inherit FontWeight where\n inherit = FontWeight (fromString \"inherit\")\n\ninstance unsetFontWeight :: Unset FontWeight where\n unset = FontWeight (fromString \"unset\")\n\nbold :: FontWeight\nbold = FontWeight $ fromString \"bold\"\n\nbolder :: FontWeight\nbolder = FontWeight $ fromString \"bolder\"\n\nlighter :: FontWeight\nlighter = FontWeight $ fromString \"lighter\"\n\nweight :: Number -> FontWeight\nweight i = FontWeight $ value i\n\nfontWeight :: FontWeight -> CSS\nfontWeight = key $ fromString \"font-weight\"\n", "module CSS.Geometry where\n\nimport CSS.Size (Size)\nimport CSS.String (fromString)\nimport CSS.Stylesheet (CSS, key)\nimport Data.Function (($))\nimport Data.Tuple (Tuple(..))\n\nwidth :: forall a. Size a -> CSS\nwidth = key $ fromString \"width\"\n\nheight :: forall a. Size a -> CSS\nheight = key $ fromString \"height\"\n\nminWidth :: forall a. Size a -> CSS\nminWidth = key $ fromString \"min-width\"\n\nminHeight :: forall a. Size a -> CSS\nminHeight = key $ fromString \"min-height\"\n\nmaxWidth :: forall a. Size a -> CSS\nmaxWidth = key $ fromString \"max-width\"\n\nmaxHeight :: forall a. Size a -> CSS\nmaxHeight = key $ fromString \"max-height\"\n\ntop :: forall a. Size a -> CSS\ntop = key $ fromString \"top\"\n\nbottom :: forall a. Size a -> CSS\nbottom = key $ fromString \"bottom\"\n\nleft :: forall a. Size a -> CSS\nleft = key $ fromString \"left\"\n\nright :: forall a. Size a -> CSS\nright = key $ fromString \"right\"\n\npadding :: forall a. Size a -> Size a -> Size a -> Size a -> CSS\npadding a b c d = key (fromString \"padding\") (Tuple (Tuple a b) (Tuple c d))\n\npaddingTop :: forall a. Size a -> CSS\npaddingTop = key $ fromString \"padding-top\"\n\npaddingBottom :: forall a. Size a -> CSS\npaddingBottom = key $ fromString \"padding-bottom\"\n\npaddingLeft :: forall a. Size a -> CSS\npaddingLeft = key $ fromString \"padding-left\"\n\npaddingRight :: forall a. Size a -> CSS\npaddingRight = key $ fromString \"padding-right\"\n\nmargin :: forall a. Size a -> Size a -> Size a -> Size a -> CSS\nmargin a b c d = key (fromString \"margin\") (Tuple (Tuple a b) (Tuple c d))\n\nmarginTop :: forall a. Size a -> CSS\nmarginTop = key $ fromString \"margin-top\"\n\nmarginBottom :: forall a. Size a -> CSS\nmarginBottom = key $ fromString \"margin-bottom\"\n\nmarginLeft :: forall a. Size a -> CSS\nmarginLeft = key $ fromString \"margin-left\"\n\nmarginRight :: forall a. Size a -> CSS\nmarginRight = key $ fromString \"margin-right\"\n\nlineHeight :: forall a. Size a -> CSS\nlineHeight = key $ fromString \"line-height\"\n", "module DOM.HTML.Indexed.InputType where\n\nimport Prelude\n\ndata InputType\n = InputButton\n | InputCheckbox\n | InputColor\n | InputDate\n | InputDatetimeLocal\n | InputEmail\n | InputFile\n | InputHidden\n | InputImage\n | InputMonth\n | InputNumber\n | InputPassword\n | InputRadio\n | InputRange\n | InputReset\n | InputSearch\n | InputSubmit\n | InputTel\n | InputText\n | InputTime\n | InputUrl\n | InputWeek\n\nderive instance eqInputType :: Eq InputType\nderive instance ordInputType :: Ord InputType\n\nrenderInputType :: InputType -> String\nrenderInputType = case _ of\n InputButton -> \"button\"\n InputCheckbox -> \"checkbox\"\n InputColor -> \"color\"\n InputDate -> \"date\"\n InputDatetimeLocal -> \"datetime-local\"\n InputEmail -> \"email\"\n InputFile -> \"file\"\n InputHidden -> \"hidden\"\n InputImage -> \"image\"\n InputMonth -> \"month\"\n InputNumber -> \"number\"\n InputPassword -> \"password\"\n InputRadio -> \"radio\"\n InputRange -> \"range\"\n InputReset -> \"reset\"\n InputSearch -> \"search\"\n InputSubmit -> \"submit\"\n InputTel -> \"tel\"\n InputText -> \"text\"\n InputTime -> \"time\"\n InputUrl -> \"url\"\n InputWeek -> \"week\"\n", "/* global exports history */\n\n// https://stackoverflow.com/questions/1397329\nexport function removeHash () {\n var scrollV, scrollH, loc = window.location;\n if (\"pushState\" in history)\n history.pushState(\"\", document.title, loc.pathname + loc.search);\n else {\n scrollV = document.body.scrollTop;\n scrollH = document.body.scrollLeft;\n\n loc.hash = \"\";\n\n document.body.scrollTop = scrollV;\n document.body.scrollLeft = scrollH;\n }\n}\n", "// A helper which transforms the result of encodeURIComponent to be compliant\n// with RFC3986, as described in the MDN documentation here:\n//\n// https://web.archive.org/web/20201206001047/https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/encodeURIComponent\nfunction encodeURIComponent_to_RFC3986(input) {\n return input.replace(/[!'()*]/g, function (c) {\n return \"%\" + c.charCodeAt(0).toString(16);\n });\n}\n\n// A helper which transforms the result of encodeURI to be compliant\n// with RFC3986, as described in the MDN documentation here:\n//\n// https://web.archive.org/web/20210117175449/https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/encodeURI#encoding_for_ipv6\nfunction encodeURI_to_RFC3986(input) {\n return input.replace(/%5B/g, \"[\").replace(/%5D/g, \"]\");\n}\n\nexport function _encodeURIComponent(fail, succeed, input) {\n try {\n return succeed(encodeURIComponent_to_RFC3986(encodeURIComponent(input)));\n } catch (err) {\n return fail(err);\n }\n}\n\nexport function _encodeFormURLComponent(fail, succeed, input) {\n try {\n return succeed(encodeURIComponent_to_RFC3986(encodeURIComponent(input)).replace(/%20/g, \"+\"));\n } catch (err) {\n return fail(err);\n }\n}\n\nexport function _decodeURIComponent(fail, succeed, input) {\n try {\n return succeed(decodeURIComponent(input));\n } catch (err) {\n return fail(err);\n }\n}\n\nexport function _decodeFormURLComponent(fail, succeed, input) {\n return _decodeURIComponent(fail, succeed, input.replace(/\\+/g, \" \"));\n}\n\nexport function _encodeURI(fail, succeed, input) {\n try {\n return succeed(encodeURI_to_RFC3986(encodeURI(input)));\n } catch (err) {\n return fail(err);\n }\n}\n\nexport function _decodeURI(fail, succeed, input) {\n try {\n return succeed(decodeURI(input));\n } catch (err) {\n return fail(err);\n }\n}\n", "module JSURI\n ( encodeURIComponent\n , encodeFormURLComponent\n , encodeURI\n , decodeURIComponent\n , decodeFormURLComponent\n , decodeURI\n ) where\n\nimport Prelude\n\nimport Data.Function.Uncurried (Fn3, runFn3)\nimport Data.Maybe (Maybe(..))\n\nforeign import _encodeURIComponent :: Fn3 (String -> Maybe String) (String -> Maybe String) String (Maybe String)\n\n-- | URI-encode a string according to RFC3896. Implemented using JavaScript's\n-- | `encodeURIComponent`.\n-- |\n-- | ```purs\n-- | > encodeURIComponent \"https://purescript.org\"\n-- | Just \"https%3A%2F%2Fpurescript.org\"\n-- | ```\n-- |\n-- | Encoding a URI can fail with a `URIError` if the string contains malformed\n-- | characters. If you are confident you are encoding a well-formed string then\n-- | you can run this function unsafely:\n-- |\n-- | ```purs\n-- | import Partial.Unsafe (unsafePartial)\n-- | import Data.Maybe (fromJust)\n-- |\n-- | unsafeEncode :: String -> String\n-- | unsafeEncode str = unsafePartial $ fromJust $ encodeURIComponent str\n-- | ```\nencodeURIComponent :: String -> Maybe String\nencodeURIComponent = runFn3 _encodeURIComponent (const Nothing) Just\n\nforeign import _encodeFormURLComponent :: Fn3 (String -> Maybe String) (String -> Maybe String) String (Maybe String)\n\n-- | URI-encode a string according to RFC3896, except with spaces encoded using\n-- | '+' instead of '%20' to comply with application/x-www-form-urlencoded.\n-- |\n-- | ```purs\n-- | > encodeURIComponent \"abc ABC\"\n-- | Just \"abc%20ABC\"\n-- |\n-- | > encodeFormURLComponent \"abc ABC\"\n-- | Just \"abc+ABC\"\n-- | ```\nencodeFormURLComponent :: String -> Maybe String\nencodeFormURLComponent = runFn3 _encodeFormURLComponent (const Nothing) Just\n\nforeign import _decodeURIComponent :: Fn3 (String -> Maybe String) (String -> Maybe String) String (Maybe String)\n\n-- | Decode a URI string according to RFC3896. Implemented using JavaScript's\n-- | `decodeURIComponent`.\n-- |\n-- | ```purs\n-- | > decodeURIComponent \"https%3A%2F%2Fpurescript.org\"\n-- | Just \"https://purescript.org\"\n-- | ```\n-- |\n-- | Decoding a URI can fail with a `URIError` if the string contains malformed\n-- | characters. If you are confident you are encoding a well-formed string then\n-- | you can run this function unsafely:\n-- |\n-- | ```purs\n-- | import Partial.Unsafe (unsafePartial)\n-- | import Data.Maybe (fromJust)\n-- |\n-- | unsafeDecode :: String -> String\n-- | unsafeDecode str = unsafePartial $ fromJust $ decodeURIComponent str\n-- | ```\ndecodeURIComponent :: String -> Maybe String\ndecodeURIComponent = runFn3 _decodeURIComponent (const Nothing) Just\n\nforeign import _decodeFormURLComponent :: Fn3 (String -> Maybe String) (String -> Maybe String) String (Maybe String)\n\n-- | Decode a URI according to application/x-www-form-urlencoded (for example,\n-- | a string containing '+' for spaces or query parameters).\n-- |\n-- | ```purs\n-- | > decodeURIComponent \"https%3A%2F%2Fpurescript.org?search+query\"\n-- | Just \"https://purescript.org?search+query\"\n-- |\n-- | > decodeFormURLComponent \"https%3A%2F%2Fpurescript.org?search+query\"\n-- | Just \"https://purescript.org?search query\"\n-- | ```\ndecodeFormURLComponent :: String -> Maybe String\ndecodeFormURLComponent = runFn3 _decodeFormURLComponent (const Nothing) Just\n\nforeign import _encodeURI :: Fn3 (String -> Maybe String) (String -> Maybe String) String (Maybe String)\n\nencodeURI :: String -> Maybe String\nencodeURI = runFn3 _encodeURI (const Nothing) Just\n\nforeign import _decodeURI :: Fn3 (String -> Maybe String) (String -> Maybe String) String (Maybe String)\n\ndecodeURI :: String -> Maybe String\ndecodeURI = runFn3 _decodeURI (const Nothing) Just\n", "const windowImpl = function () {\n return window;\n};\nexport { windowImpl as window };\n", "export function _unsafeReadProtoTagged(nothing, just, name, value) {\n if (typeof window !== \"undefined\") {\n var ty = window[name];\n if (ty != null && value instanceof ty) {\n return just(value);\n }\n }\n var obj = value;\n while (obj != null) {\n var proto = Object.getPrototypeOf(obj);\n var constructorName = proto.constructor.name;\n if (constructorName === name) {\n return just(value);\n } else if (constructorName === \"Object\") {\n return nothing;\n }\n obj = proto;\n }\n return nothing;\n}\n", "module Web.Internal.FFI (unsafeReadProtoTagged) where\n\nimport Data.Function.Uncurried (Fn4, runFn4)\nimport Data.Maybe (Maybe(..))\n\nunsafeReadProtoTagged :: forall a b. String -> a -> Maybe b\nunsafeReadProtoTagged name value =\n runFn4 _unsafeReadProtoTagged Nothing Just name value\n\nforeign import _unsafeReadProtoTagged\n :: forall a b\n . Fn4\n (forall x. Maybe x)\n (forall x. x -> Maybe x)\n String\n a\n (Maybe b)\n", "/* eslint-disable no-eq-null, eqeqeq */\n\nconst nullImpl = null;\nexport { nullImpl as null };\n\nexport function nullable(a, r, f) {\n return a == null ? r : f(a);\n}\n\nexport function notNull(x) {\n return x;\n}\n", "-- | This module defines types and functions for working with nullable types\n-- | using the FFI.\n\nmodule Data.Nullable\n ( Nullable\n , null\n , notNull\n , toMaybe\n , toNullable\n ) where\n\nimport Prelude\n\nimport Data.Eq (class Eq1)\nimport Data.Function (on)\nimport Data.Function.Uncurried (Fn3, runFn3)\nimport Data.Maybe (Maybe(..), maybe)\nimport Data.Ord (class Ord1)\n\n-- | A nullable type. This type constructor is intended to be used for\n-- | interoperating with JavaScript functions which accept or return null\n-- | values.\n-- |\n-- | The runtime representation of `Nullable T` is the same as that of `T`,\n-- | except that it may also be `null`. For example, the JavaScript values\n-- | `null`, `[]`, and `[1,2,3]` may all be given the type\n-- | `Nullable (Array Int)`. Similarly, the JavaScript values `[]`, `[null]`,\n-- | and `[1,2,null,3]` may all be given the type `Array (Nullable Int)`.\n-- |\n-- | There is one pitfall with `Nullable`, which is that values of the type\n-- | `Nullable T` will not function as you might expect if the type `T` happens\n-- | to itself permit `null` as a valid runtime representation.\n-- |\n-- | In particular, values of the type `Nullable (Nullable T)` will \u2018collapse\u2019,\n-- | in the sense that the PureScript expressions `notNull null` and `null`\n-- | will both leave you with a value whose runtime representation is just\n-- | `null`. Therefore it is important to avoid using `Nullable T` in\n-- | situations where `T` itself can take `null` as a runtime representation.\n-- | If in doubt, use `Maybe` instead.\n-- |\n-- | `Nullable` does not permit lawful `Functor`, `Applicative`, or `Monad`\n-- | instances as a result of this pitfall, which is why these instances are\n-- | not provided.\nforeign import data Nullable :: Type -> Type\n\ntype role Nullable representational\n\n-- | The null value.\nforeign import null :: forall a. Nullable a\n\nforeign import nullable :: forall a r. Fn3 (Nullable a) r (a -> r) r\n\n-- | Wrap a non-null value.\nforeign import notNull :: forall a. a -> Nullable a\n\n-- | Takes `Nothing` to `null`, and `Just a` to `a`.\ntoNullable :: forall a. Maybe a -> Nullable a\ntoNullable = maybe null notNull\n\n-- | Represent `null` using `Maybe a` as `Nothing`. Note that this function\n-- | can violate parametricity, as it inspects the runtime representation of\n-- | its argument (see the warning about the pitfall of `Nullable` above).\ntoMaybe :: forall a. Nullable a -> Maybe a\ntoMaybe n = runFn3 nullable n Nothing Just\n\ninstance showNullable :: Show a => Show (Nullable a) where\n show = maybe \"null\" show <<< toMaybe\n\ninstance eqNullable :: Eq a => Eq (Nullable a) where\n eq = eq `on` toMaybe\n\ninstance eq1Nullable :: Eq1 Nullable where\n eq1 = eq\n\ninstance ordNullable :: Ord a => Ord (Nullable a) where\n compare = compare `on` toMaybe\n\ninstance ord1Nullable :: Ord1 Nullable where\n compare1 = compare\n", "module Web.HTML.HTMLDocument\n ( HTMLDocument\n , fromDocument\n , fromNode\n , fromParentNode\n , fromNonElementParentNode\n , fromEventTarget\n , toDocument\n , toNode\n , toParentNode\n , toNonElementParentNode\n , toEventTarget\n , documentElement\n , head\n , body\n , readyState\n , visibilityState\n , activeElement\n , currentScript\n , referrer\n , title\n , setTitle\n ) where\n\nimport Prelude\n\nimport Data.Maybe (Maybe, fromMaybe)\nimport Data.Nullable (Nullable, toMaybe)\nimport Effect (Effect)\nimport Effect.Uncurried (EffectFn1, EffectFn2, runEffectFn1, runEffectFn2)\nimport Unsafe.Coerce (unsafeCoerce)\nimport Web.DOM.Document (Document)\nimport Web.DOM.Internal.Types (Node)\nimport Web.DOM.NonElementParentNode (NonElementParentNode)\nimport Web.DOM.ParentNode (ParentNode)\nimport Web.Event.EventTarget (EventTarget)\nimport Web.HTML.HTMLDocument.ReadyState (ReadyState)\nimport Web.HTML.HTMLDocument.ReadyState as ReadyState\nimport Web.HTML.HTMLDocument.VisibilityState (VisibilityState)\nimport Web.HTML.HTMLDocument.VisibilityState as VisibilityState\nimport Web.HTML.HTMLElement (HTMLElement)\nimport Web.HTML.HTMLHtmlElement (HTMLHtmlElement)\nimport Web.HTML.HTMLScriptElement (HTMLScriptElement)\nimport Web.Internal.FFI (unsafeReadProtoTagged)\n\nforeign import data HTMLDocument :: Type\n\nfromDocument :: Document -> Maybe HTMLDocument\nfromDocument = unsafeReadProtoTagged \"HTMLDocument\"\n\nfromNode :: Node -> Maybe HTMLDocument\nfromNode = unsafeReadProtoTagged \"HTMLDocument\"\n\nfromParentNode :: ParentNode -> Maybe HTMLDocument\nfromParentNode = unsafeReadProtoTagged \"HTMLDocument\"\n\nfromNonElementParentNode :: NonElementParentNode -> Maybe HTMLDocument\nfromNonElementParentNode = unsafeReadProtoTagged \"HTMLDocument\"\n\nfromEventTarget :: EventTarget -> Maybe HTMLDocument\nfromEventTarget = unsafeReadProtoTagged \"HTMLDocument\"\n\ntoDocument :: HTMLDocument -> Document\ntoDocument = unsafeCoerce\n\ntoNode :: HTMLDocument -> Node\ntoNode = unsafeCoerce\n\ntoParentNode :: HTMLDocument -> ParentNode\ntoParentNode = unsafeCoerce\n\ntoNonElementParentNode :: HTMLDocument -> NonElementParentNode\ntoNonElementParentNode = unsafeCoerce\n\ntoEventTarget :: HTMLDocument -> EventTarget\ntoEventTarget = unsafeCoerce\n\nforeign import _documentElement :: EffectFn1 HTMLDocument (Nullable HTMLHtmlElement)\n\ndocumentElement :: HTMLDocument -> Effect (Maybe HTMLHtmlElement)\ndocumentElement doc = toMaybe <$> runEffectFn1 _documentElement doc\n\nforeign import _head :: EffectFn1 HTMLDocument (Nullable HTMLElement)\n\nhead :: HTMLDocument -> Effect (Maybe HTMLElement)\nhead doc = toMaybe <$> runEffectFn1 _head doc\n\nforeign import _body :: EffectFn1 HTMLDocument (Nullable HTMLElement)\n\nbody :: HTMLDocument -> Effect (Maybe HTMLElement)\nbody doc = toMaybe <$> runEffectFn1 _body doc\n\nforeign import _readyState :: EffectFn1 HTMLDocument String\n\nreadyState :: HTMLDocument -> Effect ReadyState\nreadyState doc = (fromMaybe ReadyState.Loading <<< ReadyState.parse) <$> (runEffectFn1 _readyState doc)\n\nforeign import _visibilityState :: EffectFn1 HTMLDocument String\n\nvisibilityState :: HTMLDocument -> Effect VisibilityState\nvisibilityState doc = (fromMaybe VisibilityState.Visible <<< VisibilityState.parse) <$> (runEffectFn1 _visibilityState doc)\n\nforeign import _activeElement :: EffectFn1 HTMLDocument (Nullable HTMLElement)\n\nactiveElement :: HTMLDocument -> Effect (Maybe HTMLElement)\nactiveElement doc = toMaybe <$> (runEffectFn1 _activeElement doc)\n\nforeign import _currentScript :: EffectFn1 HTMLDocument (Nullable HTMLScriptElement)\n\ncurrentScript :: HTMLDocument -> Effect (Maybe HTMLScriptElement)\ncurrentScript doc = toMaybe <$> (runEffectFn1 _currentScript doc)\n\nforeign import _referrer :: EffectFn1 HTMLDocument String\n\nreferrer :: HTMLDocument -> Effect String\nreferrer doc = runEffectFn1 _referrer doc\n\nforeign import _title :: EffectFn1 HTMLDocument String\n\ntitle :: HTMLDocument -> Effect String\ntitle doc = runEffectFn1 _title doc\n\nforeign import _setTitle :: EffectFn2 String HTMLDocument Unit\n\nsetTitle :: String -> HTMLDocument -> Effect Unit\nsetTitle newTitle doc = runEffectFn2 _setTitle newTitle doc\n", "export function _read(nothing, just, value) {\n var tag = Object.prototype.toString.call(value);\n if (tag.indexOf(\"[object HTML\") === 0 && tag.indexOf(\"Element]\") === tag.length - 8) {\n return just(value);\n } else {\n return nothing;\n }\n}\n\n// ----------------------------------------------------------------------------\n\nexport function title(elt) {\n return function () {\n return elt.title;\n };\n}\n\nexport function setTitle(title) {\n return function (elt) {\n return function () {\n elt.title = title;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function lang(elt) {\n return function () {\n return elt.lang;\n };\n}\n\nexport function setLang(lang) {\n return function (elt) {\n return function () {\n elt.lang = lang;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function dir(elt) {\n return function () {\n return elt.dir;\n };\n}\n\nexport function setDir(dir) {\n return function (elt) {\n return function () {\n elt.dir = dir;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function hidden(elt) {\n return function () {\n return elt.hidden;\n };\n}\n\nexport function setHidden(hidden) {\n return function (elt) {\n return function () {\n elt.hidden = hidden;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function tabIndex(elt) {\n return function () {\n return elt.tabIndex;\n };\n}\n\nexport function setTabIndex(tabIndex) {\n return function (elt) {\n return function () {\n elt.tabIndex = tabIndex;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function draggable(elt) {\n return function () {\n return elt.draggable;\n };\n}\n\nexport function setDraggable(draggable) {\n return function (elt) {\n return function () {\n elt.draggable = draggable;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function contentEditable(elt) {\n return function () {\n return elt.contentEditable;\n };\n}\n\nexport function setContentEditable(contentEditable) {\n return function (elt) {\n return function () {\n elt.contentEditable = contentEditable;\n };\n };\n}\n\nexport function isContentEditable(elt) {\n return function () {\n return elt.isContentEditable;\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function spellcheck(elt) {\n return function () {\n return elt.spellcheck;\n };\n}\n\nexport function setSpellcheck(spellcheck) {\n return function (elt) {\n return function () {\n elt.spellcheck = spellcheck;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function click(elt) {\n return function () {\n return elt.click();\n };\n}\n\nexport function focus(elt) {\n return function () {\n return elt.focus();\n };\n}\n\nexport function blur(elt) {\n return function () {\n return elt.blur();\n };\n}\n\n// - CSSOM ---------------------------------------------------------------------\n\nexport function _offsetParent(el) {\n return function () {\n return el.offsetParent;\n };\n}\n\nexport function offsetTop(el) {\n return function () {\n return el.offsetTop;\n };\n}\n\nexport function offsetLeft(el) {\n return function () {\n return el.offsetLeft;\n };\n}\n\nexport function offsetWidth(el) {\n return function () {\n return el.offsetWidth;\n };\n}\n\nexport function offsetHeight(el) {\n return function () {\n return el.offsetHeight;\n };\n}\n", "module Web.HTML.HTMLElement\n ( HTMLElement\n , fromElement\n , fromNode\n , fromChildNode\n , fromNonDocumentTypeChildNode\n , fromParentNode\n , fromEventTarget\n , toElement\n , toNode\n , toChildNode\n , toNonDocumentTypeChildNode\n , toParentNode\n , toEventTarget\n , title\n , setTitle\n , lang\n , setLang\n , dir\n , setDir\n , hidden\n , setHidden\n , tabIndex\n , setTabIndex\n , draggable\n , setDraggable\n , contentEditable\n , setContentEditable\n , isContentEditable\n , spellcheck\n , setSpellcheck\n , click\n , focus\n , blur\n , offsetParent\n , offsetTop\n , offsetLeft\n , offsetWidth\n , offsetHeight\n ) where\n\nimport Prelude\n\nimport Data.Function.Uncurried (Fn3, runFn3)\nimport Data.Maybe (Maybe(..))\nimport Data.Nullable (Nullable, toMaybe)\nimport Effect (Effect)\nimport Unsafe.Coerce (unsafeCoerce)\nimport Web.DOM (ChildNode)\nimport Web.DOM.Element (Element)\nimport Web.DOM.Internal.Types (Node)\nimport Web.DOM.NonDocumentTypeChildNode (NonDocumentTypeChildNode)\nimport Web.DOM.ParentNode (ParentNode)\nimport Web.Event.EventTarget (EventTarget)\n\nforeign import data HTMLElement :: Type\n\nforeign import _read :: forall a. Fn3 (forall x. Maybe x) (forall x. x -> Maybe x) a (Maybe HTMLElement)\n\nfromElement :: Element -> Maybe HTMLElement\nfromElement x = runFn3 _read Nothing Just x\n\nfromNode :: Node -> Maybe HTMLElement\nfromNode x = runFn3 _read Nothing Just x\n\nfromChildNode :: ChildNode -> Maybe HTMLElement\nfromChildNode x = runFn3 _read Nothing Just x\n\nfromNonDocumentTypeChildNode :: NonDocumentTypeChildNode -> Maybe HTMLElement\nfromNonDocumentTypeChildNode x = runFn3 _read Nothing Just x\n\nfromParentNode :: ParentNode -> Maybe HTMLElement\nfromParentNode x = runFn3 _read Nothing Just x\n\nfromEventTarget :: EventTarget -> Maybe HTMLElement\nfromEventTarget x = runFn3 _read Nothing Just x\n\ntoElement :: HTMLElement -> Element\ntoElement = unsafeCoerce\n\ntoNode :: HTMLElement -> Node\ntoNode = unsafeCoerce\n\ntoChildNode :: HTMLElement -> ChildNode\ntoChildNode = unsafeCoerce\n\ntoNonDocumentTypeChildNode :: HTMLElement -> NonDocumentTypeChildNode\ntoNonDocumentTypeChildNode = unsafeCoerce\n\ntoParentNode :: HTMLElement -> ParentNode\ntoParentNode = unsafeCoerce\n\ntoEventTarget :: HTMLElement -> EventTarget\ntoEventTarget = unsafeCoerce\n\nforeign import title :: HTMLElement -> Effect String\nforeign import setTitle :: String -> HTMLElement -> Effect Unit\n\nforeign import lang :: HTMLElement -> Effect String\nforeign import setLang :: String -> HTMLElement -> Effect Unit\n\nforeign import dir :: HTMLElement -> Effect String\nforeign import setDir :: String -> HTMLElement -> Effect Unit\n\nforeign import hidden :: HTMLElement -> Effect Boolean\nforeign import setHidden :: Boolean -> HTMLElement -> Effect Unit\n\nforeign import tabIndex :: HTMLElement -> Effect Int\nforeign import setTabIndex :: Int -> HTMLElement -> Effect Unit\n\nforeign import draggable :: HTMLElement -> Effect Boolean\nforeign import setDraggable :: Boolean -> HTMLElement -> Effect Unit\n\nforeign import contentEditable :: HTMLElement -> Effect String\nforeign import setContentEditable :: String -> HTMLElement -> Effect Unit\nforeign import isContentEditable :: HTMLElement -> Effect Boolean\n\nforeign import spellcheck :: HTMLElement -> Effect Boolean\nforeign import setSpellcheck :: Boolean -> HTMLElement -> Effect Unit\n\nforeign import click :: HTMLElement -> Effect Unit\nforeign import focus :: HTMLElement -> Effect Unit\nforeign import blur :: HTMLElement -> Effect Unit\n\nforeign import _offsetParent :: HTMLElement -> Effect (Nullable Element)\n\noffsetParent :: HTMLElement -> Effect (Maybe Element)\noffsetParent = map toMaybe <<< _offsetParent\n\nforeign import offsetTop :: HTMLElement -> Effect Number\nforeign import offsetLeft :: HTMLElement -> Effect Number\nforeign import offsetWidth :: HTMLElement -> Effect Number\nforeign import offsetHeight :: HTMLElement -> Effect Number\n", "export const mkEffectFn1 = function mkEffectFn1(fn) {\n return function(x) {\n return fn(x)();\n };\n};\n\nexport const mkEffectFn2 = function mkEffectFn2(fn) {\n return function(a, b) {\n return fn(a)(b)();\n };\n};\n\nexport const mkEffectFn3 = function mkEffectFn3(fn) {\n return function(a, b, c) {\n return fn(a)(b)(c)();\n };\n};\n\nexport const mkEffectFn4 = function mkEffectFn4(fn) {\n return function(a, b, c, d) {\n return fn(a)(b)(c)(d)();\n };\n};\n\nexport const mkEffectFn5 = function mkEffectFn5(fn) {\n return function(a, b, c, d, e) {\n return fn(a)(b)(c)(d)(e)();\n };\n};\n\nexport const mkEffectFn6 = function mkEffectFn6(fn) {\n return function(a, b, c, d, e, f) {\n return fn(a)(b)(c)(d)(e)(f)();\n };\n};\n\nexport const mkEffectFn7 = function mkEffectFn7(fn) {\n return function(a, b, c, d, e, f, g) {\n return fn(a)(b)(c)(d)(e)(f)(g)();\n };\n};\n\nexport const mkEffectFn8 = function mkEffectFn8(fn) {\n return function(a, b, c, d, e, f, g, h) {\n return fn(a)(b)(c)(d)(e)(f)(g)(h)();\n };\n};\n\nexport const mkEffectFn9 = function mkEffectFn9(fn) {\n return function(a, b, c, d, e, f, g, h, i) {\n return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)();\n };\n};\n\nexport const mkEffectFn10 = function mkEffectFn10(fn) {\n return function(a, b, c, d, e, f, g, h, i, j) {\n return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(j)();\n };\n};\n\nexport const runEffectFn1 = function runEffectFn1(fn) {\n return function(a) {\n return function() {\n return fn(a);\n };\n };\n};\n\nexport const runEffectFn2 = function runEffectFn2(fn) {\n return function(a) {\n return function(b) {\n return function() {\n return fn(a, b);\n };\n };\n };\n};\n\nexport const runEffectFn3 = function runEffectFn3(fn) {\n return function(a) {\n return function(b) {\n return function(c) {\n return function() {\n return fn(a, b, c);\n };\n };\n };\n };\n};\n\nexport const runEffectFn4 = function runEffectFn4(fn) {\n return function(a) {\n return function(b) {\n return function(c) {\n return function(d) {\n return function() {\n return fn(a, b, c, d);\n };\n };\n };\n };\n };\n};\n\nexport const runEffectFn5 = function runEffectFn5(fn) {\n return function(a) {\n return function(b) {\n return function(c) {\n return function(d) {\n return function(e) {\n return function() {\n return fn(a, b, c, d, e);\n };\n };\n };\n };\n };\n };\n};\n\nexport const runEffectFn6 = function runEffectFn6(fn) {\n return function(a) {\n return function(b) {\n return function(c) {\n return function(d) {\n return function(e) {\n return function(f) {\n return function() {\n return fn(a, b, c, d, e, f);\n };\n };\n };\n };\n };\n };\n };\n};\n\nexport const runEffectFn7 = function runEffectFn7(fn) {\n return function(a) {\n return function(b) {\n return function(c) {\n return function(d) {\n return function(e) {\n return function(f) {\n return function(g) {\n return function() {\n return fn(a, b, c, d, e, f, g);\n };\n };\n };\n };\n };\n };\n };\n };\n};\n\nexport const runEffectFn8 = function runEffectFn8(fn) {\n return function(a) {\n return function(b) {\n return function(c) {\n return function(d) {\n return function(e) {\n return function(f) {\n return function(g) {\n return function(h) {\n return function() {\n return fn(a, b, c, d, e, f, g, h);\n };\n };\n };\n };\n };\n };\n };\n };\n };\n};\n\nexport const runEffectFn9 = function runEffectFn9(fn) {\n return function(a) {\n return function(b) {\n return function(c) {\n return function(d) {\n return function(e) {\n return function(f) {\n return function(g) {\n return function(h) {\n return function(i) {\n return function() {\n return fn(a, b, c, d, e, f, g, h, i);\n };\n };\n };\n };\n };\n };\n };\n };\n };\n };\n};\n\nexport const runEffectFn10 = function runEffectFn10(fn) {\n return function(a) {\n return function(b) {\n return function(c) {\n return function(d) {\n return function(e) {\n return function(f) {\n return function(g) {\n return function(h) {\n return function(i) {\n return function(j) {\n return function() {\n return fn(a, b, c, d, e, f, g, h, i, j);\n };\n };\n };\n };\n };\n };\n };\n };\n };\n };\n };\n};\n", "export function accept(input) {\n return function () {\n return input.accept;\n };\n}\n\nexport function setAccept(accept) {\n return function (input) {\n return function () {\n input.accept = accept;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function alt(input) {\n return function () {\n return input.alt;\n };\n}\n\nexport function setAlt(alt) {\n return function (input) {\n return function () {\n input.alt = alt;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function autocomplete(input) {\n return function () {\n return input.autocomplete;\n };\n}\n\nexport function setAutocomplete(autocomplete) {\n return function (input) {\n return function () {\n input.autocomplete = autocomplete;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function autofocus(input) {\n return function () {\n return input.autofocus;\n };\n}\n\nexport function setAutofocus(autofocus) {\n return function (input) {\n return function () {\n input.autofocus = autofocus;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function defaultChecked(input) {\n return function () {\n return input.defaultChecked;\n };\n}\n\nexport function setDefaultChecked(defaultChecked) {\n return function (input) {\n return function () {\n input.defaultChecked = defaultChecked;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function checked(input) {\n return function () {\n return input.checked;\n };\n}\n\nexport function setChecked(checked) {\n return function (input) {\n return function () {\n input.checked = checked;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function dirName(input) {\n return function () {\n return input.dirName;\n };\n}\n\nexport function setDirName(dirName) {\n return function (input) {\n return function () {\n input.dirName = dirName;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function disabled(input) {\n return function () {\n return input.disabled;\n };\n}\n\nexport function setDisabled(disabled) {\n return function (input) {\n return function () {\n input.disabled = disabled;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function _form(input) {\n return function () {\n return input.form;\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function _files(input) {\n return function () {\n return input.files;\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function formAction(input) {\n return function () {\n return input.formAction;\n };\n}\n\nexport function setFormAction(formAction) {\n return function (input) {\n return function () {\n input.formAction = formAction;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function formEnctype(input) {\n return function () {\n return input.formEnctype;\n };\n}\n\nexport function setFormEnctype(formEnctype) {\n return function (input) {\n return function () {\n input.formEnctype = formEnctype;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function formMethod(input) {\n return function () {\n return input.formMethod;\n };\n}\n\nexport function setFormMethod(formMethod) {\n return function (input) {\n return function () {\n input.formMethod = formMethod;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function formNoValidate(input) {\n return function () {\n return input.formNoValidate;\n };\n}\n\nexport function setFormNoValidate(formNoValidate) {\n return function (input) {\n return function () {\n input.formNoValidate = formNoValidate;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function formTarget(input) {\n return function () {\n return input.formTarget;\n };\n}\n\nexport function setFormTarget(formTarget) {\n return function (input) {\n return function () {\n input.formTarget = formTarget;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function height(input) {\n return function () {\n return input.height;\n };\n}\n\nexport function setHeight(height) {\n return function (input) {\n return function () {\n input.height = height;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function indeterminate(input) {\n return function () {\n return input.indeterminate;\n };\n}\n\nexport function setIndeterminate(indeterminate) {\n return function (input) {\n return function () {\n input.indeterminate = indeterminate;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function _list(input) {\n return function () {\n return input.list;\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function max(input) {\n return function () {\n return input.max;\n };\n}\n\nexport function setMax(max) {\n return function (input) {\n return function () {\n input.max = max;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function maxLength(input) {\n return function () {\n return input.maxLength;\n };\n}\n\nexport function setMaxLength(maxLength) {\n return function (input) {\n return function () {\n input.maxLength = maxLength;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function min(input) {\n return function () {\n return input.min;\n };\n}\n\nexport function setMin(min) {\n return function (input) {\n return function () {\n input.min = min;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function minLength(input) {\n return function () {\n return input.minLength;\n };\n}\n\nexport function setMinLength(minLength) {\n return function (input) {\n return function () {\n input.minLength = minLength;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function multiple(input) {\n return function () {\n return input.multiple;\n };\n}\n\nexport function setMultiple(multiple) {\n return function (input) {\n return function () {\n input.multiple = multiple;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function name(input) {\n return function () {\n return input.name;\n };\n}\n\nexport function setName(name) {\n return function (input) {\n return function () {\n input.name = name;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function pattern(input) {\n return function () {\n return input.pattern;\n };\n}\n\nexport function setPattern(pattern) {\n return function (input) {\n return function () {\n input.pattern = pattern;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function placeholder(input) {\n return function () {\n return input.placeholder;\n };\n}\n\nexport function setPlaceholder(placeholder) {\n return function (input) {\n return function () {\n input.placeholder = placeholder;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function readOnly(input) {\n return function () {\n return input.readOnly;\n };\n}\n\nexport function setReadOnly(readOnly) {\n return function (input) {\n return function () {\n input.readOnly = readOnly;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function required(input) {\n return function () {\n return input.required;\n };\n}\n\nexport function setRequired(required) {\n return function (input) {\n return function () {\n input.required = required;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function size(input) {\n return function () {\n return input.size;\n };\n}\n\nexport function setSize(size) {\n return function (input) {\n return function () {\n input.size = size;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function src(input) {\n return function () {\n return input.src;\n };\n}\n\nexport function setSrc(src) {\n return function (input) {\n return function () {\n input.src = src;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function step(input) {\n return function () {\n return input.step;\n };\n}\n\nexport function setStep(step) {\n return function (input) {\n return function () {\n input.step = step;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function type_(input) {\n return function () {\n return input.type;\n };\n}\n\nexport function setType(type) {\n return function (input) {\n return function () {\n input.type = type;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function defaultValue(input) {\n return function () {\n return input.defaultValue;\n };\n}\n\nexport function setDefaultValue(defaultValue) {\n return function (input) {\n return function () {\n input.defaultValue = defaultValue;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function value(input) {\n return function () {\n return input.value;\n };\n}\n\nexport function setValue(value) {\n return function (input) {\n return function () {\n input.value = value;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function valueAsDate(input) {\n return function () {\n return input.valueAsDate;\n };\n}\n\nexport function setValueAsDate(valueAsDate) {\n return function (input) {\n return function () {\n input.valueAsDate = valueAsDate;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function valueAsNumber(input) {\n return function () {\n return input.valueAsNumber;\n };\n}\n\nexport function setValueAsNumber(valueAsNumber) {\n return function (input) {\n return function () {\n input.valueAsNumber = valueAsNumber;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function width(input) {\n return function () {\n return input.width;\n };\n}\n\nexport function setWidth(width) {\n return function (input) {\n return function () {\n input.width = width;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function stepUpBy(n) {\n return function (input) {\n return function () {\n input.stepUp(n);\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function stepDownBy(n) {\n return function (input) {\n return function () {\n input.stepDown(n);\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function willValidate(input) {\n return function () {\n return input.willValidate;\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function validity(input) {\n return function () {\n return input.validity;\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function validationMessage(input) {\n return function () {\n return input.validationMessage;\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function checkValidity(input) {\n return function () {\n return input.checkValidity();\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function reportValidity(input) {\n return function () {\n return input.reportValidity();\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function setCustomValidity(value) {\n return function (input) {\n return function () {\n input.setCustomValidity(value);\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function labels(input) {\n return function () {\n return input.labels;\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function select(input) {\n return function () {\n input.select();\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function selectionStart(input) {\n return function () {\n return input.selectionStart;\n };\n}\n\nexport function setSelectionStart(selectionStart) {\n return function (input) {\n return function () {\n input.selectionStart = selectionStart;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function selectionEnd(input) {\n return function () {\n return input.selectionEnd;\n };\n}\n\nexport function setSelectionEnd(selectionEnd) {\n return function (input) {\n return function () {\n input.selectionEnd = selectionEnd;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function selectionDirection(input) {\n return function () {\n return input.selectionDirection;\n };\n}\n\nexport function setSelectionDirection(selectionDirection) {\n return function (input) {\n return function () {\n input.selectionDirection = selectionDirection;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function setRangeText(replacement) {\n return function (input) {\n return function () {\n input.setRangeText(replacement);\n };\n };\n}\n\nexport function _setRangeText(replacement, start, end, selectionMode, textarea) {\n textarea.setRangeText(replacement, start, end, selectionMode);\n}\n\n// ----------------------------------------------------------------------------\n\nexport function setSelectionRange(start) {\n return function (end) {\n return function (direction) {\n return function (input) {\n return function () {\n input.setSelectionRange(start, end, direction, input);\n };\n };\n };\n };\n}\n", "module Web.HTML.HTMLInputElement\n ( HTMLInputElement\n , fromHTMLElement\n , fromElement\n , fromNode\n , fromChildNode\n , fromNonDocumentTypeChildNode\n , fromParentNode\n , fromEventTarget\n , toHTMLElement\n , toElement\n , toNode\n , toChildNode\n , toNonDocumentTypeChildNode\n , toParentNode\n , toEventTarget\n , accept\n , setAccept\n , alt\n , setAlt\n , autocomplete\n , setAutocomplete\n , autofocus\n , setAutofocus\n , defaultChecked\n , setDefaultChecked\n , checked\n , setChecked\n , dirName\n , setDirName\n , disabled\n , setDisabled\n , form\n , files\n , formAction\n , setFormAction\n , formEnctype\n , setFormEnctype\n , formMethod\n , setFormMethod\n , formNoValidate\n , setFormNoValidate\n , formTarget\n , setFormTarget\n , height\n , setHeight\n , indeterminate\n , setIndeterminate\n , list\n , max\n , setMax\n , maxLength\n , setMaxLength\n , min\n , setMin\n , minLength\n , setMinLength\n , multiple\n , setMultiple\n , name\n , setName\n , pattern\n , setPattern\n , placeholder\n , setPlaceholder\n , readOnly\n , setReadOnly\n , required\n , setRequired\n , size\n , setSize\n , src\n , setSrc\n , step\n , setStep\n , type_\n , setType\n , defaultValue\n , setDefaultValue\n , value\n , setValue\n , valueAsDate\n , setValueAsDate\n , valueAsNumber\n , setValueAsNumber\n , width\n , setWidth\n , stepUp\n , stepUp'\n , stepDown\n , stepDown'\n , willValidate\n , validity\n , validationMessage\n , checkValidity\n , reportValidity\n , setCustomValidity\n , labels\n , select\n , selectionStart\n , setSelectionStart\n , selectionEnd\n , setSelectionEnd\n , selectionDirection\n , setSelectionDirection\n , setRangeText\n , setRangeText'\n , setSelectionRange\n ) where\n\nimport Prelude\n\nimport Data.JSDate (JSDate)\nimport Data.Maybe (Maybe)\nimport Data.Nullable (Nullable, toMaybe)\nimport Effect (Effect)\nimport Effect.Uncurried (EffectFn5, runEffectFn5)\nimport Unsafe.Coerce (unsafeCoerce)\nimport Web.DOM (ChildNode, Element, Node, NonDocumentTypeChildNode, ParentNode)\nimport Web.DOM.NodeList (NodeList)\nimport Web.Event.EventTarget (EventTarget)\nimport Web.File.FileList (FileList)\nimport Web.HTML.HTMLElement (HTMLElement)\nimport Web.HTML.HTMLFormElement (HTMLFormElement)\nimport Web.HTML.SelectionMode (SelectionMode)\nimport Web.HTML.SelectionMode as SelectionMode\nimport Web.HTML.ValidityState (ValidityState)\nimport Web.Internal.FFI (unsafeReadProtoTagged)\n\nforeign import data HTMLInputElement :: Type\n\nfromHTMLElement :: HTMLElement -> Maybe HTMLInputElement\nfromHTMLElement = unsafeReadProtoTagged \"HTMLInputElement\"\n\nfromElement :: Element -> Maybe HTMLInputElement\nfromElement = unsafeReadProtoTagged \"HTMLInputElement\"\n\nfromNode :: Node -> Maybe HTMLInputElement\nfromNode = unsafeReadProtoTagged \"HTMLInputElement\"\n\nfromChildNode :: ChildNode -> Maybe HTMLInputElement\nfromChildNode = unsafeReadProtoTagged \"HTMLInputElement\"\n\nfromNonDocumentTypeChildNode :: NonDocumentTypeChildNode -> Maybe HTMLInputElement\nfromNonDocumentTypeChildNode = unsafeReadProtoTagged \"HTMLInputElement\"\n\nfromParentNode :: ParentNode -> Maybe HTMLInputElement\nfromParentNode = unsafeReadProtoTagged \"HTMLInputElement\"\n\nfromEventTarget :: EventTarget -> Maybe HTMLInputElement\nfromEventTarget = unsafeReadProtoTagged \"HTMLInputElement\"\n\ntoHTMLElement :: HTMLInputElement -> HTMLElement\ntoHTMLElement = unsafeCoerce\n\ntoElement :: HTMLInputElement -> Element\ntoElement = unsafeCoerce\n\ntoNode :: HTMLInputElement -> Node\ntoNode = unsafeCoerce\n\ntoChildNode :: HTMLInputElement -> ChildNode\ntoChildNode = unsafeCoerce\n\ntoNonDocumentTypeChildNode :: HTMLInputElement -> NonDocumentTypeChildNode\ntoNonDocumentTypeChildNode = unsafeCoerce\n\ntoParentNode :: HTMLInputElement -> ParentNode\ntoParentNode = unsafeCoerce\n\ntoEventTarget :: HTMLInputElement -> EventTarget\ntoEventTarget = unsafeCoerce\n\nforeign import accept :: HTMLInputElement -> Effect String\nforeign import setAccept :: String -> HTMLInputElement -> Effect Unit\n\nforeign import alt :: HTMLInputElement -> Effect Boolean\nforeign import setAlt :: Boolean -> HTMLInputElement -> Effect Unit\n\nforeign import autocomplete :: HTMLInputElement -> Effect String\nforeign import setAutocomplete :: String -> HTMLInputElement -> Effect Unit\n\nforeign import autofocus :: HTMLInputElement -> Effect Boolean\nforeign import setAutofocus :: Boolean -> HTMLInputElement -> Effect Unit\n\nforeign import defaultChecked :: HTMLInputElement -> Effect Boolean\nforeign import setDefaultChecked :: Boolean -> HTMLInputElement -> Effect Unit\n\nforeign import checked :: HTMLInputElement -> Effect Boolean\nforeign import setChecked :: Boolean -> HTMLInputElement -> Effect Unit\n\nforeign import dirName :: HTMLInputElement -> Effect String\nforeign import setDirName :: String -> HTMLInputElement -> Effect Unit\n\nforeign import disabled :: HTMLInputElement -> Effect Boolean\nforeign import setDisabled :: Boolean -> HTMLInputElement -> Effect Unit\n\nform :: HTMLInputElement -> Effect (Maybe HTMLFormElement)\nform = map toMaybe <<< _form\n\nforeign import _form :: HTMLInputElement -> Effect (Nullable HTMLFormElement)\n\nfiles :: HTMLInputElement -> Effect (Maybe FileList)\nfiles = map toMaybe <<< _files\n\nforeign import _files :: HTMLInputElement -> Effect (Nullable FileList)\n\nforeign import formAction :: HTMLInputElement -> Effect String\nforeign import setFormAction :: String -> HTMLInputElement -> Effect Unit\n\nforeign import formEnctype :: HTMLInputElement -> Effect String\nforeign import setFormEnctype :: String -> HTMLInputElement -> Effect Unit\n\nforeign import formMethod :: HTMLInputElement -> Effect String\nforeign import setFormMethod :: String -> HTMLInputElement -> Effect Unit\n\nforeign import formNoValidate :: HTMLInputElement -> Effect Boolean\nforeign import setFormNoValidate :: Boolean -> HTMLInputElement -> Effect Unit\n\nforeign import formTarget :: HTMLInputElement -> Effect String\nforeign import setFormTarget :: String -> HTMLInputElement -> Effect Unit\n\nforeign import height :: HTMLInputElement -> Effect Int\nforeign import setHeight :: Int -> HTMLInputElement -> Effect Unit\n\nforeign import indeterminate :: HTMLInputElement -> Effect Boolean\nforeign import setIndeterminate :: Boolean -> HTMLInputElement -> Effect Unit\n\nlist :: HTMLInputElement -> Effect (Maybe HTMLElement)\nlist = map toMaybe <<< _list\n\nforeign import _list :: HTMLInputElement -> Effect (Nullable HTMLElement)\n\nforeign import max :: HTMLInputElement -> Effect String\nforeign import setMax :: String -> HTMLInputElement -> Effect Unit\n\nforeign import maxLength :: HTMLInputElement -> Effect Int\nforeign import setMaxLength :: Int -> HTMLInputElement -> Effect Unit\n\nforeign import min :: HTMLInputElement -> Effect String\nforeign import setMin :: String -> HTMLInputElement -> Effect Unit\n\nforeign import minLength :: HTMLInputElement -> Effect Int\nforeign import setMinLength :: Int -> HTMLInputElement -> Effect Unit\n\nforeign import multiple :: HTMLInputElement -> Effect Boolean\nforeign import setMultiple :: Boolean -> HTMLInputElement -> Effect Unit\n\nforeign import name :: HTMLInputElement -> Effect String\nforeign import setName :: String -> HTMLInputElement -> Effect Unit\n\nforeign import pattern :: HTMLInputElement -> Effect String\nforeign import setPattern :: String -> HTMLInputElement -> Effect Unit\n\nforeign import placeholder :: HTMLInputElement -> Effect String\nforeign import setPlaceholder :: String -> HTMLInputElement -> Effect Unit\n\nforeign import readOnly :: HTMLInputElement -> Effect Boolean\nforeign import setReadOnly :: Boolean -> HTMLInputElement -> Effect Unit\n\nforeign import required :: HTMLInputElement -> Effect Boolean\nforeign import setRequired :: Boolean -> HTMLInputElement -> Effect Unit\n\nforeign import size :: HTMLInputElement -> Effect Int\nforeign import setSize :: Int -> HTMLInputElement -> Effect Unit\n\nforeign import src :: HTMLInputElement -> Effect String\nforeign import setSrc :: String -> HTMLInputElement -> Effect Unit\n\nforeign import step :: HTMLInputElement -> Effect String\nforeign import setStep :: String -> HTMLInputElement -> Effect Unit\n\nforeign import type_ :: HTMLInputElement -> Effect String\nforeign import setType :: String -> HTMLInputElement -> Effect Unit\n\nforeign import defaultValue :: HTMLInputElement -> Effect String\nforeign import setDefaultValue :: String -> HTMLInputElement -> Effect Unit\n\nforeign import value :: HTMLInputElement -> Effect String\nforeign import setValue :: String -> HTMLInputElement -> Effect Unit\n\nforeign import valueAsDate :: HTMLInputElement -> Effect JSDate\nforeign import setValueAsDate :: JSDate -> HTMLInputElement -> Effect Unit\n\nforeign import valueAsNumber :: HTMLInputElement -> Effect Number\nforeign import setValueAsNumber :: Number -> HTMLInputElement -> Effect Unit\n\nforeign import width :: HTMLInputElement -> Effect Int\nforeign import setWidth :: Int -> HTMLInputElement -> Effect Unit\n\nstepUp :: HTMLInputElement -> Effect Unit\nstepUp = stepUp' 1\n\nforeign import stepUpBy :: Int -> HTMLInputElement -> Effect Unit\n\nstepUp' :: Int -> HTMLInputElement -> Effect Unit\nstepUp' = stepUpBy\n\nstepDown :: HTMLInputElement -> Effect Unit\nstepDown = stepDown' 1\n\nforeign import stepDownBy :: Int -> HTMLInputElement -> Effect Unit\n\nstepDown' :: Int -> HTMLInputElement -> Effect Unit\nstepDown' = stepDownBy\n\nforeign import willValidate :: HTMLInputElement -> Effect Boolean\n\nforeign import validity :: HTMLInputElement -> Effect ValidityState\n\nforeign import validationMessage :: HTMLInputElement -> Effect String\n\nforeign import checkValidity :: HTMLInputElement -> Effect Boolean\n\nforeign import reportValidity :: HTMLInputElement -> Effect Boolean\n\nforeign import setCustomValidity :: String -> HTMLInputElement -> Effect Unit\n\nforeign import labels :: HTMLInputElement -> Effect NodeList\n\nforeign import select :: HTMLInputElement -> Effect Unit\n\nforeign import selectionStart :: HTMLInputElement -> Effect Int\nforeign import setSelectionStart :: Int -> HTMLInputElement -> Effect Unit\n\nforeign import selectionEnd :: HTMLInputElement -> Effect Int\nforeign import setSelectionEnd :: Int -> HTMLInputElement -> Effect Unit\n\nforeign import selectionDirection :: HTMLInputElement -> Effect String\nforeign import setSelectionDirection :: String -> HTMLInputElement -> Effect Unit\n\nforeign import setRangeText :: String -> HTMLInputElement -> Effect Unit\n\nsetRangeText' :: String -> Int -> Int -> SelectionMode -> HTMLInputElement -> Effect Unit\nsetRangeText' rpl s e mode area =\n runEffectFn5 _setRangeText rpl s e (SelectionMode.print mode) area\n\nforeign import _setRangeText :: EffectFn5 String Int Int String HTMLInputElement Unit\n\nforeign import setSelectionRange :: Int -> Int -> String -> HTMLInputElement -> Effect Unit\n", "export function hash(location) {\n return function () {\n return location.hash;\n };\n}\n\nexport function setHash(hash) {\n return function (location) {\n return function () {\n location.hash = hash;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function host(location) {\n return function () {\n return location.host;\n };\n}\n\nexport function setHost(host) {\n return function (location) {\n return function () {\n location.host = host;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function hostname(location) {\n return function () {\n return location.hostname;\n };\n}\n\nexport function setHostname(hostname) {\n return function (location) {\n return function () {\n location.hostname = hostname;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function href(location) {\n return function () {\n return location.href;\n };\n}\n\nexport function setHref(href) {\n return function (location) {\n return function () {\n location.href = href;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function origin(location) {\n return function () {\n return location.origin;\n };\n}\n\nexport function setOrigin(origin) {\n return function (location) {\n return function () {\n location.origin = origin;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function pathname(location) {\n return function () {\n return location.pathname;\n };\n}\n\nexport function setPathname(pathname) {\n return function (location) {\n return function () {\n location.pathname = pathname;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function port(location) {\n return function () {\n return location.port;\n };\n}\n\nexport function setPort(port) {\n return function (location) {\n return function () {\n location.port = port;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function protocol(location) {\n return function () {\n return location.protocol;\n };\n}\n\nexport function setProtocol(protocol) {\n return function (location) {\n return function () {\n location.protocol = protocol;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function search(location) {\n return function () {\n return location.search;\n };\n}\n\nexport function setSearch(search) {\n return function (location) {\n return function () {\n location.search = search;\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function assign(url) {\n return function (location) {\n return function () {\n location.assign(url);\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function replace(url) {\n return function (location) {\n return function () {\n location.replace(url);\n };\n };\n}\n\n// ----------------------------------------------------------------------------\n\nexport function reload(location) {\n return function () {\n location.reload();\n };\n}\n", "export function document(window) {\n return function () {\n return window.document;\n };\n}\n\nexport function navigator(window) {\n return function () {\n return window.navigator;\n };\n}\n\nexport function location(window) {\n return function () {\n return window.location;\n };\n}\n\nexport function history(window) {\n return function() {\n return window.history;\n };\n}\n\nexport function innerWidth(window) {\n return function () {\n return window.innerWidth;\n };\n}\n\nexport function innerHeight(window) {\n return function () {\n return window.innerHeight;\n };\n}\n\nexport function alert(str) {\n return function (window) {\n return function () {\n window.alert(str);\n };\n };\n}\n\nexport function confirm(str) {\n return function (window) {\n return function () {\n return window.confirm(str);\n };\n };\n}\n\nexport function moveBy(xDelta) {\n return function (yDelta) {\n return function (window) {\n return function () {\n window.moveBy(xDelta, yDelta);\n };\n };\n };\n}\n\nexport function moveTo(width) {\n return function (height) {\n return function (window) {\n return function () {\n window.moveTo(width, height);\n };\n };\n };\n}\n\nexport function _open(url) {\n return function (name) {\n return function (features) {\n return function (window) {\n return function () {\n return window.open(url, name, features);\n };\n };\n };\n };\n}\n\nexport function close(window) {\n return function () {\n return window.close();\n };\n}\n\nexport function outerHeight(window) {\n return function () {\n return window.outerHeight;\n };\n}\n\nexport function outerWidth(window) {\n return function () {\n return window.outerWidth;\n };\n}\n\nexport function print(window) {\n return function () {\n window.print();\n };\n}\n\nexport function _prompt(str) {\n return function (defaultText) {\n return function (window) {\n return function () {\n return window.prompt(str, defaultText);\n };\n };\n };\n}\n\nexport function resizeBy(xDelta) {\n return function (yDelta) {\n return function (window) {\n return function () {\n window.resizeBy(xDelta, yDelta);\n };\n };\n };\n}\n\nexport function resizeTo(width) {\n return function (height) {\n return function (window) {\n return function () {\n window.resizeTo(width, height);\n };\n };\n };\n}\n\nexport function screenX(window) {\n return function () {\n return window.screenX;\n };\n}\n\nexport function screenY(window) {\n return function () {\n return window.screenY;\n };\n}\n\nexport function scroll(xCoord) {\n return function (yCoord) {\n return function (window) {\n return function () {\n window.scroll(xCoord, yCoord);\n };\n };\n };\n}\n\nexport function scrollBy(xCoord) {\n return function (yCoord) {\n return function (window) {\n return function () {\n window.scrollBy(xCoord, yCoord);\n };\n };\n };\n}\n\nexport function scrollX(window) {\n return function () {\n return window.scrollX;\n };\n}\n\nexport function scrollY(window) {\n return function () {\n return window.scrollY;\n };\n}\n\nexport function localStorage(window) {\n return function () {\n return window.localStorage;\n };\n}\n\nexport function sessionStorage(window) {\n return function () {\n return window.sessionStorage;\n };\n}\n\nexport function requestAnimationFrame(fn) {\n return function(window) {\n return function() {\n return window.requestAnimationFrame(fn);\n };\n };\n}\n\nexport function cancelAnimationFrame(id) {\n return function(window) {\n return function() {\n return window.cancelAnimationFrame(id);\n };\n };\n}\n\nexport function requestIdleCallback(opts) {\n return function(fn) {\n return function(window) {\n return function() {\n return window.requestIdleCallback(fn, opts);\n };\n };\n };\n}\n\nexport function cancelIdleCallback(id) {\n return function(window) {\n return function() {\n return window.cancelIdleCallback(id);\n };\n };\n}\n\nexport function parent(window) {\n return function() {\n return window.parent;\n };\n}\n\nexport function _opener(window) {\n return function() {\n return window.opener;\n };\n}\n", "module Web.HTML.Window\n ( Window\n , toEventTarget\n , fromEventTarget\n , document\n , navigator\n , location\n , history\n , innerWidth\n , innerHeight\n , alert\n , confirm\n , moveBy\n , moveTo\n , open\n , close\n , outerHeight\n , outerWidth\n , print\n , prompt\n , promptDefault\n , resizeBy\n , resizeTo\n , screenX\n , screenY\n , scroll\n , scrollBy\n , scrollX\n , scrollY\n , localStorage\n , sessionStorage\n , requestAnimationFrame\n , cancelAnimationFrame\n , RequestAnimationFrameId\n , requestIdleCallback\n , cancelIdleCallback\n , RequestIdleCallbackId\n , parent\n , opener\n ) where\n\nimport Data.Maybe (Maybe)\nimport Data.Nullable (Nullable, toMaybe)\nimport Effect (Effect)\nimport Prelude (class Eq, class Ord, Unit, (<$>))\nimport Unsafe.Coerce (unsafeCoerce)\nimport Web.Event.EventTarget (EventTarget)\nimport Web.HTML.HTMLDocument (HTMLDocument)\nimport Web.HTML.History (History)\nimport Web.HTML.Location (Location)\nimport Web.HTML.Navigator (Navigator)\nimport Web.Internal.FFI (unsafeReadProtoTagged)\nimport Web.Storage.Storage (Storage)\n\nforeign import data Window :: Type\n\ntoEventTarget :: Window -> EventTarget\ntoEventTarget = unsafeCoerce\n\nfromEventTarget :: EventTarget -> Maybe Window\nfromEventTarget = unsafeReadProtoTagged \"Window\"\n\nforeign import document :: Window -> Effect HTMLDocument\n\nforeign import navigator :: Window -> Effect Navigator\n\nforeign import location :: Window -> Effect Location\n\nforeign import history :: Window -> Effect History\n\nforeign import innerWidth :: Window -> Effect Int\n\nforeign import innerHeight :: Window -> Effect Int\n\nforeign import alert :: String -> Window -> Effect Unit\n\nforeign import confirm :: String -> Window -> Effect Boolean\n\nforeign import moveBy :: Int -> Int -> Window -> Effect Unit\n\nforeign import moveTo :: Int -> Int -> Window -> Effect Unit\n\nopen :: String -> String -> String -> Window -> Effect (Maybe Window)\nopen url' name features window = toMaybe <$> _open url' name features window\n\nforeign import _open\n :: String\n -> String\n -> String\n -> Window\n -> Effect (Nullable Window)\n\nforeign import close :: Window -> Effect Unit\n\nforeign import outerHeight :: Window -> Effect Int\n\nforeign import outerWidth :: Window -> Effect Int\n\nforeign import print :: Window -> Effect Unit\n\nprompt :: String -> Window -> Effect (Maybe String)\nprompt msg window = toMaybe <$> _prompt msg \"\" window\n\npromptDefault :: String -> String -> Window -> Effect (Maybe String)\npromptDefault msg defaultText window = toMaybe <$> _prompt msg defaultText window\n\nforeign import _prompt :: String -> String -> Window -> Effect (Nullable String)\n\nforeign import resizeBy :: Int -> Int -> Window -> Effect Unit\n\nforeign import resizeTo :: Int -> Int -> Window -> Effect Unit\n\nforeign import screenX :: Window -> Effect Int\n\nforeign import screenY :: Window -> Effect Int\n\nforeign import scroll :: Int -> Int -> Window -> Effect Unit\n\nforeign import scrollBy :: Int -> Int -> Window -> Effect Unit\n\nforeign import scrollX :: Window -> Effect Number\n\nforeign import scrollY :: Window -> Effect Number\n\nforeign import localStorage :: Window -> Effect Storage\n\nforeign import sessionStorage :: Window -> Effect Storage\n\nnewtype RequestAnimationFrameId = RequestAnimationFrameId Int\n\nderive instance eqRequestAnimationFrameId :: Eq RequestAnimationFrameId\nderive instance ordRequestAnimationFrameId :: Ord RequestAnimationFrameId\n\nforeign import requestAnimationFrame :: Effect Unit -> Window -> Effect RequestAnimationFrameId\n\nforeign import cancelAnimationFrame :: RequestAnimationFrameId -> Window -> Effect Unit\n\nnewtype RequestIdleCallbackId = RequestIdleCallbackId Int\n\nderive instance eqRequestIdleCallbackId :: Eq RequestIdleCallbackId\nderive instance ordRequestIdleCallbackId :: Ord RequestIdleCallbackId\n\n-- | Set timeout to `0` to get the same behaviour as when it is `undefined` in\n-- | [JavaScript](https://w3c.github.io/requestidlecallback/#h-the-requestidle-callback-method).\nforeign import requestIdleCallback :: { timeout :: Int } -> Effect Unit -> Window -> Effect RequestIdleCallbackId\n\nforeign import cancelIdleCallback :: RequestIdleCallbackId -> Window -> Effect Unit\n\nforeign import parent :: Window -> Effect Window\n\nforeign import _opener :: Window -> Effect (Nullable Window)\n\nopener :: Window -> Effect (Maybe Window)\nopener window = toMaybe <$> _opener window\n", "module Docs.Search.URIHash\n ( getInput\n , setInput\n , removeHash\n ) where\n\nimport Prelude\n\nimport Data.Maybe (fromMaybe)\nimport Data.String.CodeUnits as String\nimport Effect (Effect)\nimport JSURI (decodeURIComponent, encodeURIComponent)\nimport Web.HTML as HTML\nimport Web.HTML.Location as Location\nimport Web.HTML.Window as Window\n\nforeign import removeHash :: Effect Unit\n\nsetInput :: String -> Effect Unit\nsetInput \"\" = removeHash\nsetInput input = do\n window <- HTML.window\n location <- Window.location window\n let hash = \"search:\" <> fromMaybe \"\" (encodeURIComponent input)\n Location.setHash hash location\n\ngetInput :: Effect String\ngetInput = do\n window <- HTML.window\n location <- Window.location window\n hash <- Location.hash location\n pure $\n if String.slice 0 8 hash == \"#search:\" then fromMaybe \"\"\n $ decodeURIComponent\n $\n String.drop 8 hash\n else \"\"\n", "/* globals setImmediate, clearImmediate, setTimeout, clearTimeout */\n/* eslint-disable no-unused-vars, no-prototype-builtins, no-use-before-define, no-unused-labels, no-param-reassign */\nvar Aff = function () {\n // A unique value for empty.\n var EMPTY = {};\n\n /*\n\n An awkward approximation. We elide evidence we would otherwise need in PS for\n efficiency sake.\n\n data Aff eff a\n = Pure a\n | Throw Error\n | Catch (Aff eff a) (Error -> Aff eff a)\n | Sync (Eff eff a)\n | Async ((Either Error a -> Eff eff Unit) -> Eff eff (Canceler eff))\n | forall b. Bind (Aff eff b) (b -> Aff eff a)\n | forall b. Bracket (Aff eff b) (BracketConditions eff b) (b -> Aff eff a)\n | forall b. Fork Boolean (Aff eff b) ?(Fiber eff b -> a)\n | Sequential (ParAff aff a)\n\n */\n var PURE = \"Pure\";\n var THROW = \"Throw\";\n var CATCH = \"Catch\";\n var SYNC = \"Sync\";\n var ASYNC = \"Async\";\n var BIND = \"Bind\";\n var BRACKET = \"Bracket\";\n var FORK = \"Fork\";\n var SEQ = \"Sequential\";\n\n /*\n\n data ParAff eff a\n = forall b. Map (b -> a) (ParAff eff b)\n | forall b. Apply (ParAff eff (b -> a)) (ParAff eff b)\n | Alt (ParAff eff a) (ParAff eff a)\n | ?Par (Aff eff a)\n\n */\n var MAP = \"Map\";\n var APPLY = \"Apply\";\n var ALT = \"Alt\";\n\n // Various constructors used in interpretation\n var CONS = \"Cons\"; // Cons-list, for stacks\n var RESUME = \"Resume\"; // Continue indiscriminately\n var RELEASE = \"Release\"; // Continue with bracket finalizers\n var FINALIZER = \"Finalizer\"; // A non-interruptible effect\n var FINALIZED = \"Finalized\"; // Marker for finalization\n var FORKED = \"Forked\"; // Reference to a forked fiber, with resumption stack\n var FIBER = \"Fiber\"; // Actual fiber reference\n var THUNK = \"Thunk\"; // Primed effect, ready to invoke\n\n function Aff(tag, _1, _2, _3) {\n this.tag = tag;\n this._1 = _1;\n this._2 = _2;\n this._3 = _3;\n }\n\n function AffCtr(tag) {\n var fn = function (_1, _2, _3) {\n return new Aff(tag, _1, _2, _3);\n };\n fn.tag = tag;\n return fn;\n }\n\n function nonCanceler(error) {\n return new Aff(PURE, void 0);\n }\n\n function runEff(eff) {\n try {\n eff();\n } catch (error) {\n setTimeout(function () {\n throw error;\n }, 0);\n }\n }\n\n function runSync(left, right, eff) {\n try {\n return right(eff());\n } catch (error) {\n return left(error);\n }\n }\n\n function runAsync(left, eff, k) {\n try {\n return eff(k)();\n } catch (error) {\n k(left(error))();\n return nonCanceler;\n }\n }\n\n var Scheduler = function () {\n var limit = 1024;\n var size = 0;\n var ix = 0;\n var queue = new Array(limit);\n var draining = false;\n\n function drain() {\n var thunk;\n draining = true;\n while (size !== 0) {\n size--;\n thunk = queue[ix];\n queue[ix] = void 0;\n ix = (ix + 1) % limit;\n thunk();\n }\n draining = false;\n }\n\n return {\n isDraining: function () {\n return draining;\n },\n enqueue: function (cb) {\n var i, tmp;\n if (size === limit) {\n tmp = draining;\n drain();\n draining = tmp;\n }\n\n queue[(ix + size) % limit] = cb;\n size++;\n\n if (!draining) {\n drain();\n }\n }\n };\n }();\n\n function Supervisor(util) {\n var fibers = {};\n var fiberId = 0;\n var count = 0;\n\n return {\n register: function (fiber) {\n var fid = fiberId++;\n fiber.onComplete({\n rethrow: true,\n handler: function (result) {\n return function () {\n count--;\n delete fibers[fid];\n };\n }\n })();\n fibers[fid] = fiber;\n count++;\n },\n isEmpty: function () {\n return count === 0;\n },\n killAll: function (killError, cb) {\n return function () {\n if (count === 0) {\n return cb();\n }\n\n var killCount = 0;\n var kills = {};\n\n function kill(fid) {\n kills[fid] = fibers[fid].kill(killError, function (result) {\n return function () {\n delete kills[fid];\n killCount--;\n if (util.isLeft(result) && util.fromLeft(result)) {\n setTimeout(function () {\n throw util.fromLeft(result);\n }, 0);\n }\n if (killCount === 0) {\n cb();\n }\n };\n })();\n }\n\n for (var k in fibers) {\n if (fibers.hasOwnProperty(k)) {\n killCount++;\n kill(k);\n }\n }\n\n fibers = {};\n fiberId = 0;\n count = 0;\n\n return function (error) {\n return new Aff(SYNC, function () {\n for (var k in kills) {\n if (kills.hasOwnProperty(k)) {\n kills[k]();\n }\n }\n });\n };\n };\n }\n };\n }\n\n // Fiber state machine\n var SUSPENDED = 0; // Suspended, pending a join.\n var CONTINUE = 1; // Interpret the next instruction.\n var STEP_BIND = 2; // Apply the next bind.\n var STEP_RESULT = 3; // Handle potential failure from a result.\n var PENDING = 4; // An async effect is running.\n var RETURN = 5; // The current stack has returned.\n var COMPLETED = 6; // The entire fiber has completed.\n\n function Fiber(util, supervisor, aff) {\n // Monotonically increasing tick, increased on each asynchronous turn.\n var runTick = 0;\n\n // The current branch of the state machine.\n var status = SUSPENDED;\n\n // The current point of interest for the state machine branch.\n var step = aff; // Successful step\n var fail = null; // Failure step\n var interrupt = null; // Asynchronous interrupt\n\n // Stack of continuations for the current fiber.\n var bhead = null;\n var btail = null;\n\n // Stack of attempts and finalizers for error recovery. Every `Cons` is also\n // tagged with current `interrupt` state. We use this to track which items\n // should be ignored or evaluated as a result of a kill.\n var attempts = null;\n\n // A special state is needed for Bracket, because it cannot be killed. When\n // we enter a bracket acquisition or finalizer, we increment the counter,\n // and then decrement once complete.\n var bracketCount = 0;\n\n // Each join gets a new id so they can be revoked.\n var joinId = 0;\n var joins = null;\n var rethrow = true;\n\n // Each invocation of `run` requires a tick. When an asynchronous effect is\n // resolved, we must check that the local tick coincides with the fiber\n // tick before resuming. This prevents multiple async continuations from\n // accidentally resuming the same fiber. A common example may be invoking\n // the provided callback in `makeAff` more than once, but it may also be an\n // async effect resuming after the fiber was already cancelled.\n function run(localRunTick) {\n var tmp, result, attempt;\n while (true) {\n tmp = null;\n result = null;\n attempt = null;\n\n switch (status) {\n case STEP_BIND:\n status = CONTINUE;\n try {\n step = bhead(step);\n if (btail === null) {\n bhead = null;\n } else {\n bhead = btail._1;\n btail = btail._2;\n }\n } catch (e) {\n status = RETURN;\n fail = util.left(e);\n step = null;\n }\n break;\n\n case STEP_RESULT:\n if (util.isLeft(step)) {\n status = RETURN;\n fail = step;\n step = null;\n } else if (bhead === null) {\n status = RETURN;\n } else {\n status = STEP_BIND;\n step = util.fromRight(step);\n }\n break;\n\n case CONTINUE:\n switch (step.tag) {\n case BIND:\n if (bhead) {\n btail = new Aff(CONS, bhead, btail);\n }\n bhead = step._2;\n status = CONTINUE;\n step = step._1;\n break;\n\n case PURE:\n if (bhead === null) {\n status = RETURN;\n step = util.right(step._1);\n } else {\n status = STEP_BIND;\n step = step._1;\n }\n break;\n\n case SYNC:\n status = STEP_RESULT;\n step = runSync(util.left, util.right, step._1);\n break;\n\n case ASYNC:\n status = PENDING;\n step = runAsync(util.left, step._1, function (result) {\n return function () {\n if (runTick !== localRunTick) {\n return;\n }\n runTick++;\n Scheduler.enqueue(function () {\n // It's possible to interrupt the fiber between enqueuing and\n // resuming, so we need to check that the runTick is still\n // valid.\n if (runTick !== localRunTick + 1) {\n return;\n }\n status = STEP_RESULT;\n step = result;\n run(runTick);\n });\n };\n });\n return;\n\n case THROW:\n status = RETURN;\n fail = util.left(step._1);\n step = null;\n break;\n\n // Enqueue the Catch so that we can call the error handler later on\n // in case of an exception.\n case CATCH:\n if (bhead === null) {\n attempts = new Aff(CONS, step, attempts, interrupt);\n } else {\n attempts = new Aff(CONS, step, new Aff(CONS, new Aff(RESUME, bhead, btail), attempts, interrupt), interrupt);\n }\n bhead = null;\n btail = null;\n status = CONTINUE;\n step = step._1;\n break;\n\n // Enqueue the Bracket so that we can call the appropriate handlers\n // after resource acquisition.\n case BRACKET:\n bracketCount++;\n if (bhead === null) {\n attempts = new Aff(CONS, step, attempts, interrupt);\n } else {\n attempts = new Aff(CONS, step, new Aff(CONS, new Aff(RESUME, bhead, btail), attempts, interrupt), interrupt);\n }\n bhead = null;\n btail = null;\n status = CONTINUE;\n step = step._1;\n break;\n\n case FORK:\n status = STEP_RESULT;\n tmp = Fiber(util, supervisor, step._2);\n if (supervisor) {\n supervisor.register(tmp);\n }\n if (step._1) {\n tmp.run();\n }\n step = util.right(tmp);\n break;\n\n case SEQ:\n status = CONTINUE;\n step = sequential(util, supervisor, step._1);\n break;\n }\n break;\n\n case RETURN:\n bhead = null;\n btail = null;\n // If the current stack has returned, and we have no other stacks to\n // resume or finalizers to run, the fiber has halted and we can\n // invoke all join callbacks. Otherwise we need to resume.\n if (attempts === null) {\n status = COMPLETED;\n step = interrupt || fail || step;\n } else {\n // The interrupt status for the enqueued item.\n tmp = attempts._3;\n attempt = attempts._1;\n attempts = attempts._2;\n\n switch (attempt.tag) {\n // We cannot recover from an unmasked interrupt. Otherwise we should\n // continue stepping, or run the exception handler if an exception\n // was raised.\n case CATCH:\n // We should compare the interrupt status as well because we\n // only want it to apply if there has been an interrupt since\n // enqueuing the catch.\n if (interrupt && interrupt !== tmp && bracketCount === 0) {\n status = RETURN;\n } else if (fail) {\n status = CONTINUE;\n step = attempt._2(util.fromLeft(fail));\n fail = null;\n }\n break;\n\n // We cannot resume from an unmasked interrupt or exception.\n case RESUME:\n // As with Catch, we only want to ignore in the case of an\n // interrupt since enqueing the item.\n if (interrupt && interrupt !== tmp && bracketCount === 0 || fail) {\n status = RETURN;\n } else {\n bhead = attempt._1;\n btail = attempt._2;\n status = STEP_BIND;\n step = util.fromRight(step);\n }\n break;\n\n // If we have a bracket, we should enqueue the handlers,\n // and continue with the success branch only if the fiber has\n // not been interrupted. If the bracket acquisition failed, we\n // should not run either.\n case BRACKET:\n bracketCount--;\n if (fail === null) {\n result = util.fromRight(step);\n // We need to enqueue the Release with the same interrupt\n // status as the Bracket that is initiating it.\n attempts = new Aff(CONS, new Aff(RELEASE, attempt._2, result), attempts, tmp);\n // We should only coninue as long as the interrupt status has not changed or\n // we are currently within a non-interruptable finalizer.\n if (interrupt === tmp || bracketCount > 0) {\n status = CONTINUE;\n step = attempt._3(result);\n }\n }\n break;\n\n // Enqueue the appropriate handler. We increase the bracket count\n // because it should not be cancelled.\n case RELEASE:\n attempts = new Aff(CONS, new Aff(FINALIZED, step, fail), attempts, interrupt);\n status = CONTINUE;\n // It has only been killed if the interrupt status has changed\n // since we enqueued the item, and the bracket count is 0. If the\n // bracket count is non-zero then we are in a masked state so it's\n // impossible to be killed.\n if (interrupt && interrupt !== tmp && bracketCount === 0) {\n step = attempt._1.killed(util.fromLeft(interrupt))(attempt._2);\n } else if (fail) {\n step = attempt._1.failed(util.fromLeft(fail))(attempt._2);\n } else {\n step = attempt._1.completed(util.fromRight(step))(attempt._2);\n }\n fail = null;\n bracketCount++;\n break;\n\n case FINALIZER:\n bracketCount++;\n attempts = new Aff(CONS, new Aff(FINALIZED, step, fail), attempts, interrupt);\n status = CONTINUE;\n step = attempt._1;\n break;\n\n case FINALIZED:\n bracketCount--;\n status = RETURN;\n step = attempt._1;\n fail = attempt._2;\n break;\n }\n }\n break;\n\n case COMPLETED:\n for (var k in joins) {\n if (joins.hasOwnProperty(k)) {\n rethrow = rethrow && joins[k].rethrow;\n runEff(joins[k].handler(step));\n }\n }\n joins = null;\n // If we have an interrupt and a fail, then the thread threw while\n // running finalizers. This should always rethrow in a fresh stack.\n if (interrupt && fail) {\n setTimeout(function () {\n throw util.fromLeft(fail);\n }, 0);\n // If we have an unhandled exception, and no other fiber has joined\n // then we need to throw the exception in a fresh stack.\n } else if (util.isLeft(step) && rethrow) {\n setTimeout(function () {\n // Guard on reathrow because a completely synchronous fiber can\n // still have an observer which was added after-the-fact.\n if (rethrow) {\n throw util.fromLeft(step);\n }\n }, 0);\n }\n return;\n case SUSPENDED:\n status = CONTINUE;\n break;\n case PENDING: return;\n }\n }\n }\n\n function onComplete(join) {\n return function () {\n if (status === COMPLETED) {\n rethrow = rethrow && join.rethrow;\n join.handler(step)();\n return function () {};\n }\n\n var jid = joinId++;\n joins = joins || {};\n joins[jid] = join;\n\n return function() {\n if (joins !== null) {\n delete joins[jid];\n }\n };\n };\n }\n\n function kill(error, cb) {\n return function () {\n if (status === COMPLETED) {\n cb(util.right(void 0))();\n return function () {};\n }\n\n var canceler = onComplete({\n rethrow: false,\n handler: function (/* unused */) {\n return cb(util.right(void 0));\n }\n })();\n\n switch (status) {\n case SUSPENDED:\n interrupt = util.left(error);\n status = COMPLETED;\n step = interrupt;\n run(runTick);\n break;\n case PENDING:\n if (interrupt === null) {\n interrupt = util.left(error);\n }\n if (bracketCount === 0) {\n if (status === PENDING) {\n attempts = new Aff(CONS, new Aff(FINALIZER, step(error)), attempts, interrupt);\n }\n status = RETURN;\n step = null;\n fail = null;\n run(++runTick);\n }\n break;\n default:\n if (interrupt === null) {\n interrupt = util.left(error);\n }\n if (bracketCount === 0) {\n status = RETURN;\n step = null;\n fail = null;\n }\n }\n\n return canceler;\n };\n }\n\n function join(cb) {\n return function () {\n var canceler = onComplete({\n rethrow: false,\n handler: cb\n })();\n if (status === SUSPENDED) {\n run(runTick);\n }\n return canceler;\n };\n }\n\n return {\n kill: kill,\n join: join,\n onComplete: onComplete,\n isSuspended: function () {\n return status === SUSPENDED;\n },\n run: function () {\n if (status === SUSPENDED) {\n if (!Scheduler.isDraining()) {\n Scheduler.enqueue(function () {\n run(runTick);\n });\n } else {\n run(runTick);\n }\n }\n }\n };\n }\n\n function runPar(util, supervisor, par, cb) {\n // Table of all forked fibers.\n var fiberId = 0;\n var fibers = {};\n\n // Table of currently running cancelers, as a product of `Alt` behavior.\n var killId = 0;\n var kills = {};\n\n // Error used for early cancelation on Alt branches.\n var early = new Error(\"[ParAff] Early exit\");\n\n // Error used to kill the entire tree.\n var interrupt = null;\n\n // The root pointer of the tree.\n var root = EMPTY;\n\n // Walks a tree, invoking all the cancelers. Returns the table of pending\n // cancellation fibers.\n function kill(error, par, cb) {\n var step = par;\n var head = null;\n var tail = null;\n var count = 0;\n var kills = {};\n var tmp, kid;\n\n loop: while (true) {\n tmp = null;\n\n switch (step.tag) {\n case FORKED:\n if (step._3 === EMPTY) {\n tmp = fibers[step._1];\n kills[count++] = tmp.kill(error, function (result) {\n return function () {\n count--;\n if (count === 0) {\n cb(result)();\n }\n };\n });\n }\n // Terminal case.\n if (head === null) {\n break loop;\n }\n // Go down the right side of the tree.\n step = head._2;\n if (tail === null) {\n head = null;\n } else {\n head = tail._1;\n tail = tail._2;\n }\n break;\n case MAP:\n step = step._2;\n break;\n case APPLY:\n case ALT:\n if (head) {\n tail = new Aff(CONS, head, tail);\n }\n head = step;\n step = step._1;\n break;\n }\n }\n\n if (count === 0) {\n cb(util.right(void 0))();\n } else {\n // Run the cancelation effects. We alias `count` because it's mutable.\n kid = 0;\n tmp = count;\n for (; kid < tmp; kid++) {\n kills[kid] = kills[kid]();\n }\n }\n\n return kills;\n }\n\n // When a fiber resolves, we need to bubble back up the tree with the\n // result, computing the applicative nodes.\n function join(result, head, tail) {\n var fail, step, lhs, rhs, tmp, kid;\n\n if (util.isLeft(result)) {\n fail = result;\n step = null;\n } else {\n step = result;\n fail = null;\n }\n\n loop: while (true) {\n lhs = null;\n rhs = null;\n tmp = null;\n kid = null;\n\n // We should never continue if the entire tree has been interrupted.\n if (interrupt !== null) {\n return;\n }\n\n // We've made it all the way to the root of the tree, which means\n // the tree has fully evaluated.\n if (head === null) {\n cb(fail || step)();\n return;\n }\n\n // The tree has already been computed, so we shouldn't try to do it\n // again. This should never happen.\n // TODO: Remove this?\n if (head._3 !== EMPTY) {\n return;\n }\n\n switch (head.tag) {\n case MAP:\n if (fail === null) {\n head._3 = util.right(head._1(util.fromRight(step)));\n step = head._3;\n } else {\n head._3 = fail;\n }\n break;\n case APPLY:\n lhs = head._1._3;\n rhs = head._2._3;\n // If we have a failure we should kill the other side because we\n // can't possible yield a result anymore.\n if (fail) {\n head._3 = fail;\n tmp = true;\n kid = killId++;\n\n kills[kid] = kill(early, fail === lhs ? head._2 : head._1, function (/* unused */) {\n return function () {\n delete kills[kid];\n if (tmp) {\n tmp = false;\n } else if (tail === null) {\n join(fail, null, null);\n } else {\n join(fail, tail._1, tail._2);\n }\n };\n });\n\n if (tmp) {\n tmp = false;\n return;\n }\n } else if (lhs === EMPTY || rhs === EMPTY) {\n // We can only proceed if both sides have resolved.\n return;\n } else {\n step = util.right(util.fromRight(lhs)(util.fromRight(rhs)));\n head._3 = step;\n }\n break;\n case ALT:\n lhs = head._1._3;\n rhs = head._2._3;\n // We can only proceed if both have resolved or we have a success\n if (lhs === EMPTY && util.isLeft(rhs) || rhs === EMPTY && util.isLeft(lhs)) {\n return;\n }\n // If both sides resolve with an error, we should continue with the\n // first error\n if (lhs !== EMPTY && util.isLeft(lhs) && rhs !== EMPTY && util.isLeft(rhs)) {\n fail = step === lhs ? rhs : lhs;\n step = null;\n head._3 = fail;\n } else {\n head._3 = step;\n tmp = true;\n kid = killId++;\n // Once a side has resolved, we need to cancel the side that is still\n // pending before we can continue.\n kills[kid] = kill(early, step === lhs ? head._2 : head._1, function (/* unused */) {\n return function () {\n delete kills[kid];\n if (tmp) {\n tmp = false;\n } else if (tail === null) {\n join(step, null, null);\n } else {\n join(step, tail._1, tail._2);\n }\n };\n });\n\n if (tmp) {\n tmp = false;\n return;\n }\n }\n break;\n }\n\n if (tail === null) {\n head = null;\n } else {\n head = tail._1;\n tail = tail._2;\n }\n }\n }\n\n function resolve(fiber) {\n return function (result) {\n return function () {\n delete fibers[fiber._1];\n fiber._3 = result;\n join(result, fiber._2._1, fiber._2._2);\n };\n };\n }\n\n // Walks the applicative tree, substituting non-applicative nodes with\n // `FORKED` nodes. In this tree, all applicative nodes use the `_3` slot\n // as a mutable slot for memoization. In an unresolved state, the `_3`\n // slot is `EMPTY`. In the cases of `ALT` and `APPLY`, we always walk\n // the left side first, because both operations are left-associative. As\n // we `RETURN` from those branches, we then walk the right side.\n function run() {\n var status = CONTINUE;\n var step = par;\n var head = null;\n var tail = null;\n var tmp, fid;\n\n loop: while (true) {\n tmp = null;\n fid = null;\n\n switch (status) {\n case CONTINUE:\n switch (step.tag) {\n case MAP:\n if (head) {\n tail = new Aff(CONS, head, tail);\n }\n head = new Aff(MAP, step._1, EMPTY, EMPTY);\n step = step._2;\n break;\n case APPLY:\n if (head) {\n tail = new Aff(CONS, head, tail);\n }\n head = new Aff(APPLY, EMPTY, step._2, EMPTY);\n step = step._1;\n break;\n case ALT:\n if (head) {\n tail = new Aff(CONS, head, tail);\n }\n head = new Aff(ALT, EMPTY, step._2, EMPTY);\n step = step._1;\n break;\n default:\n // When we hit a leaf value, we suspend the stack in the `FORKED`.\n // When the fiber resolves, it can bubble back up the tree.\n fid = fiberId++;\n status = RETURN;\n tmp = step;\n step = new Aff(FORKED, fid, new Aff(CONS, head, tail), EMPTY);\n tmp = Fiber(util, supervisor, tmp);\n tmp.onComplete({\n rethrow: false,\n handler: resolve(step)\n })();\n fibers[fid] = tmp;\n if (supervisor) {\n supervisor.register(tmp);\n }\n }\n break;\n case RETURN:\n // Terminal case, we are back at the root.\n if (head === null) {\n break loop;\n }\n // If we are done with the right side, we need to continue down the\n // left. Otherwise we should continue up the stack.\n if (head._1 === EMPTY) {\n head._1 = step;\n status = CONTINUE;\n step = head._2;\n head._2 = EMPTY;\n } else {\n head._2 = step;\n step = head;\n if (tail === null) {\n head = null;\n } else {\n head = tail._1;\n tail = tail._2;\n }\n }\n }\n }\n\n // Keep a reference to the tree root so it can be cancelled.\n root = step;\n\n for (fid = 0; fid < fiberId; fid++) {\n fibers[fid].run();\n }\n }\n\n // Cancels the entire tree. If there are already subtrees being canceled,\n // we need to first cancel those joins. We will then add fresh joins for\n // all pending branches including those that were in the process of being\n // canceled.\n function cancel(error, cb) {\n interrupt = util.left(error);\n var innerKills;\n for (var kid in kills) {\n if (kills.hasOwnProperty(kid)) {\n innerKills = kills[kid];\n for (kid in innerKills) {\n if (innerKills.hasOwnProperty(kid)) {\n innerKills[kid]();\n }\n }\n }\n }\n\n kills = null;\n var newKills = kill(error, root, cb);\n\n return function (killError) {\n return new Aff(ASYNC, function (killCb) {\n return function () {\n for (var kid in newKills) {\n if (newKills.hasOwnProperty(kid)) {\n newKills[kid]();\n }\n }\n return nonCanceler;\n };\n });\n };\n }\n\n run();\n\n return function (killError) {\n return new Aff(ASYNC, function (killCb) {\n return function () {\n return cancel(killError, killCb);\n };\n });\n };\n }\n\n function sequential(util, supervisor, par) {\n return new Aff(ASYNC, function (cb) {\n return function () {\n return runPar(util, supervisor, par, cb);\n };\n });\n }\n\n Aff.EMPTY = EMPTY;\n Aff.Pure = AffCtr(PURE);\n Aff.Throw = AffCtr(THROW);\n Aff.Catch = AffCtr(CATCH);\n Aff.Sync = AffCtr(SYNC);\n Aff.Async = AffCtr(ASYNC);\n Aff.Bind = AffCtr(BIND);\n Aff.Bracket = AffCtr(BRACKET);\n Aff.Fork = AffCtr(FORK);\n Aff.Seq = AffCtr(SEQ);\n Aff.ParMap = AffCtr(MAP);\n Aff.ParApply = AffCtr(APPLY);\n Aff.ParAlt = AffCtr(ALT);\n Aff.Fiber = Fiber;\n Aff.Supervisor = Supervisor;\n Aff.Scheduler = Scheduler;\n Aff.nonCanceler = nonCanceler;\n\n return Aff;\n}();\n\nexport const _pure = Aff.Pure;\nexport const _throwError = Aff.Throw;\n\nexport function _catchError(aff) {\n return function (k) {\n return Aff.Catch(aff, k);\n };\n}\n\nexport function _map(f) {\n return function (aff) {\n if (aff.tag === Aff.Pure.tag) {\n return Aff.Pure(f(aff._1));\n } else {\n return Aff.Bind(aff, function (value) {\n return Aff.Pure(f(value));\n });\n }\n };\n}\n\nexport function _bind(aff) {\n return function (k) {\n return Aff.Bind(aff, k);\n };\n}\n\nexport function _fork(immediate) {\n return function (aff) {\n return Aff.Fork(immediate, aff);\n };\n}\n\nexport const _liftEffect = Aff.Sync;\n\nexport function _parAffMap(f) {\n return function (aff) {\n return Aff.ParMap(f, aff);\n };\n}\n\nexport function _parAffApply(aff1) {\n return function (aff2) {\n return Aff.ParApply(aff1, aff2);\n };\n}\n\nexport function _parAffAlt(aff1) {\n return function (aff2) {\n return Aff.ParAlt(aff1, aff2);\n };\n}\n\nexport const makeAff = Aff.Async;\n\nexport function generalBracket(acquire) {\n return function (options) {\n return function (k) {\n return Aff.Bracket(acquire, options, k);\n };\n };\n}\n\nexport function _makeFiber(util, aff) {\n return function () {\n return Aff.Fiber(util, null, aff);\n };\n}\n\nexport function _makeSupervisedFiber(util, aff) {\n return function () {\n var supervisor = Aff.Supervisor(util);\n return {\n fiber: Aff.Fiber(util, supervisor, aff),\n supervisor: supervisor\n };\n };\n}\n\nexport function _killAll(error, supervisor, cb) {\n return supervisor.killAll(error, cb);\n}\n\nexport const _delay = function () {\n function setDelay(n, k) {\n if (n === 0 && typeof setImmediate !== \"undefined\") {\n return setImmediate(k);\n } else {\n return setTimeout(k, n);\n }\n }\n\n function clearDelay(n, t) {\n if (n === 0 && typeof clearImmediate !== \"undefined\") {\n return clearImmediate(t);\n } else {\n return clearTimeout(t);\n }\n }\n\n return function (right, ms) {\n return Aff.Async(function (cb) {\n return function () {\n var timer = setDelay(ms, cb(right()));\n return function () {\n return Aff.Sync(function () {\n return right(clearDelay(ms, timer));\n });\n };\n };\n });\n };\n}();\n\nexport const _sequential = Aff.Seq;\n", "module Type.Equality\n ( class TypeEquals\n , proof\n , to\n , from\n ) where\n\nimport Prim.Coerce (class Coercible)\n\n-- | This type class asserts that types `a` and `b`\n-- | are equal.\n-- |\n-- | The functional dependencies and the single\n-- | instance below will force the two type arguments\n-- | to unify when either one is known.\n-- |\n-- | Note: any instance will necessarily overlap with\n-- | `refl` below, so instances of this class should\n-- | not be defined in libraries.\nclass TypeEquals :: forall k. k -> k -> Constraint\nclass Coercible a b <= TypeEquals a b | a -> b, b -> a where\n proof :: forall p. p a -> p b\n\ninstance refl :: TypeEquals a a where\n proof a = a\n\nnewtype To a b = To (a -> b)\n\nto :: forall a b. TypeEquals a b => a -> b\nto = case proof (To (\\a -> a)) of To f -> f\n\nnewtype From a b = From (b -> a)\n\nfrom :: forall a b. TypeEquals a b => b -> a\nfrom = case proof (From (\\a -> a)) of From f -> f\n", "module Control.Parallel.Class where\n\nimport Prelude\n\nimport Control.Alt (class Alt)\nimport Control.Alternative (class Alternative)\nimport Control.Monad.Cont.Trans (ContT(..), runContT)\nimport Control.Monad.Except.Trans (ExceptT(..))\nimport Control.Monad.Maybe.Trans (MaybeT(..))\nimport Control.Monad.Reader.Trans (mapReaderT, ReaderT)\nimport Control.Monad.Writer.Trans (mapWriterT, WriterT)\nimport Control.Plus (class Plus)\nimport Data.Either (Either)\nimport Data.Functor.Compose (Compose(..))\nimport Data.Functor.Costar (Costar(..))\nimport Data.Maybe (Maybe(..))\nimport Data.Newtype (class Newtype)\nimport Data.Profunctor.Star (Star(..))\nimport Effect.Class (class MonadEffect, liftEffect)\nimport Effect.Ref as Ref\n\n-- | The `Parallel` class abstracts over pairs of `Apply`s where one of them\n-- | (`m`) composes sequentially, and the other (`f`) composes in parallel.\n-- | `m` is usually a `Monad`, which enforces the sequential nature of its\n-- | composition, but it doesn't need to be.\nclass (Apply m, Apply f) <= Parallel f m | m -> f, f -> m where\n parallel :: m ~> f\n sequential :: f ~> m\n\ninstance monadParExceptT :: (Parallel f m, Monad m) => Parallel (Compose f (Either e)) (ExceptT e m) where\n parallel (ExceptT ma) = Compose (parallel ma)\n sequential (Compose fa) = ExceptT (sequential fa)\n\ninstance monadParReaderT :: Parallel f m => Parallel (ReaderT e f) (ReaderT e m) where\n parallel = mapReaderT parallel\n sequential = mapReaderT sequential\n\ninstance monadParWriterT :: (Monoid w, Parallel f m) => Parallel (WriterT w f) (WriterT w m) where\n parallel = mapWriterT parallel\n sequential = mapWriterT sequential\n\ninstance monadParMaybeT :: (Parallel f m, Monad m) => Parallel (Compose f Maybe) (MaybeT m) where\n parallel (MaybeT ma) = Compose (parallel ma)\n sequential (Compose fa) = MaybeT (sequential fa)\n\ninstance monadParStar :: Parallel f m => Parallel (Star f a) (Star m a) where\n parallel (Star f) = (Star $ parallel <<< f)\n sequential (Star f) = (Star $ sequential <<< f)\n\ninstance monadParCostar :: Parallel f m => Parallel (Costar f a) (Costar m a) where\n parallel (Costar f) = (Costar $ sequential >>> f)\n sequential (Costar f) = (Costar $ parallel >>> f)\n\n-- | The `ParCont` type constructor provides an `Applicative` instance\n-- | based on `ContT Unit m`, which waits for multiple continuations to be\n-- | resumed simultaneously.\n-- |\n-- | ParCont sections of code can be embedded in sequential code by using\n-- | the `parallel` and `sequential` functions:\n-- |\n-- | ```purescript\n-- | loadModel :: ContT Unit (Eff (ajax :: AJAX)) Model\n-- | loadModel = do\n-- | token <- authenticate\n-- | sequential $\n-- | Model <$> parallel (get \"/products/popular/\" token)\n-- | <*> parallel (get \"/categories/all\" token)\n-- | ```\nnewtype ParCont m a = ParCont (ContT Unit m a)\n\nderive instance newtypeParCont :: Newtype (ParCont m a) _\n\ninstance functorParCont :: MonadEffect m => Functor (ParCont m) where\n map f = parallel <<< map f <<< sequential\n\ninstance applyParCont :: MonadEffect m => Apply (ParCont m) where\n apply (ParCont ca) (ParCont cb) = ParCont $ ContT \\k -> do\n ra <- liftEffect (Ref.new Nothing)\n rb <- liftEffect (Ref.new Nothing)\n\n runContT ca \\a -> do\n mb <- liftEffect (Ref.read rb)\n case mb of\n Nothing -> liftEffect (Ref.write (Just a) ra)\n Just b -> k (a b)\n\n runContT cb \\b -> do\n ma <- liftEffect (Ref.read ra)\n case ma of\n Nothing -> liftEffect (Ref.write (Just b) rb)\n Just a -> k (a b)\n\ninstance applicativeParCont :: MonadEffect m => Applicative (ParCont m) where\n pure = parallel <<< pure\n\ninstance altParCont :: MonadEffect m => Alt (ParCont m) where\n alt (ParCont c1) (ParCont c2) = ParCont $ ContT \\k -> do\n done <- liftEffect (Ref.new false)\n\n runContT c1 \\a -> do\n b <- liftEffect (Ref.read done)\n if b\n then pure unit\n else do\n liftEffect (Ref.write true done)\n k a\n\n runContT c2 \\a -> do\n b <- liftEffect (Ref.read done)\n if b\n then pure unit\n else do\n liftEffect (Ref.write true done)\n k a\n\ninstance plusParCont :: MonadEffect m => Plus (ParCont m) where\n empty = ParCont $ ContT \\_ -> pure unit\n\ninstance alternativeParCont :: MonadEffect m => Alternative (ParCont m)\n\ninstance monadParParCont :: MonadEffect m => Parallel (ParCont m) (ContT Unit m) where\n parallel = ParCont\n sequential (ParCont ma) = ma\n", "module Control.Parallel\n ( parApply\n , parTraverse\n , parTraverse_\n , parSequence\n , parSequence_\n , parOneOf\n , parOneOfMap\n , module Control.Parallel.Class\n ) where\n\nimport Prelude\n\nimport Control.Alternative (class Alternative)\nimport Control.Parallel.Class (class Parallel, parallel, sequential, ParCont(..))\n\nimport Data.Foldable (class Foldable, traverse_, oneOfMap)\nimport Data.Traversable (class Traversable, traverse)\n\n-- | Apply a function to an argument under a type constructor in parallel.\nparApply\n :: forall f m a b\n . Parallel f m\n => m (a -> b)\n -> m a\n -> m b\nparApply mf ma = sequential(apply (parallel mf) (parallel ma))\n\n-- | Traverse a collection in parallel.\nparTraverse\n :: forall f m t a b\n . Parallel f m\n => Applicative f\n => Traversable t\n => (a -> m b)\n -> t a\n -> m (t b)\nparTraverse f = sequential <<< traverse (parallel <<< f)\n\n-- | Traverse a collection in parallel, discarding any results.\nparTraverse_\n :: forall f m t a b\n . Parallel f m\n => Applicative f\n => Foldable t\n => (a -> m b)\n -> t a\n -> m Unit\nparTraverse_ f = sequential <<< traverse_ (parallel <<< f)\n\nparSequence\n :: forall a t m f\n . Parallel f m\n => Applicative f\n => Traversable t\n => t (m a)\n -> m (t a)\nparSequence = parTraverse identity\n\nparSequence_\n :: forall a t m f\n . Parallel f m\n => Applicative f\n => Foldable t\n => t (m a)\n -> m Unit\nparSequence_ = parTraverse_ identity\n\n-- | Race a collection in parallel.\nparOneOf\n :: forall a t m f\n . Parallel f m\n => Alternative f\n => Foldable t\n => Functor t\n => t (m a)\n -> m a\nparOneOf = sequential <<< oneOfMap parallel\n\n-- | Race a collection in parallel while mapping to some effect.\nparOneOfMap\n :: forall a b t m f\n . Parallel f m\n => Alternative f\n => Foldable t\n => Functor t\n => (a -> m b)\n -> t a\n -> m b\nparOneOfMap f = sequential <<< oneOfMap (parallel <<< f)\n", "export const unsafePerformEffect = function (f) {\n return f();\n};\n", "module Effect.Aff\n ( Aff\n , Fiber\n , ParAff(..)\n , Canceler(..)\n , makeAff\n , launchAff\n , launchAff_\n , launchSuspendedAff\n , runAff\n , runAff_\n , runSuspendedAff\n , forkAff\n , suspendAff\n , supervise\n , attempt\n , apathize\n , delay\n , never\n , finally\n , invincible\n , killFiber\n , joinFiber\n , cancelWith\n , bracket\n , BracketConditions\n , generalBracket\n , nonCanceler\n , effectCanceler\n , fiberCanceler\n , module Exports\n ) where\n\nimport Prelude\n\nimport Control.Alt (class Alt)\nimport Control.Alternative (class Alternative)\nimport Control.Apply (lift2)\nimport Control.Lazy (class Lazy)\nimport Control.Monad.Error.Class (class MonadError, class MonadThrow, throwError, catchError, try)\nimport Control.Monad.Error.Class (try, throwError, catchError) as Exports\nimport Control.Monad.Rec.Class (class MonadRec, Step(..))\nimport Control.Monad.ST.Class (class MonadST, liftST)\nimport Control.Monad.ST.Global (Global)\nimport Control.Parallel (parSequence_, parallel)\nimport Control.Parallel.Class (class Parallel)\nimport Control.Parallel.Class (sequential, parallel) as Exports\nimport Control.Plus (class Plus, empty)\nimport Data.Either (Either(..))\nimport Data.Function.Uncurried as Fn\nimport Data.Newtype (class Newtype)\nimport Data.Time.Duration (Milliseconds(..))\nimport Data.Time.Duration (Milliseconds(..)) as Exports\nimport Effect (Effect)\nimport Effect.Class (class MonadEffect, liftEffect)\nimport Effect.Exception (Error, error)\nimport Effect.Exception (Error, error, message) as Exports\nimport Effect.Unsafe (unsafePerformEffect)\nimport Partial.Unsafe (unsafeCrashWith)\nimport Unsafe.Coerce (unsafeCoerce)\n\n-- | An `Aff a` is an asynchronous computation with effects. The\n-- | computation may either error with an exception, or produce a result of\n-- | type `a`. `Aff` effects are assembled from primitive `Effect` effects using\n-- | `makeAff` or `liftEffect`.\nforeign import data Aff :: Type -> Type\n\ntype role Aff representational\n\ninstance functorAff :: Functor Aff where\n map = _map\n\ninstance applyAff :: Apply Aff where\n apply = ap\n\ninstance applicativeAff :: Applicative Aff where\n pure = _pure\n\ninstance bindAff :: Bind Aff where\n bind = _bind\n\ninstance monadAff :: Monad Aff\n\ninstance semigroupAff :: Semigroup a => Semigroup (Aff a) where\n append = lift2 append\n\ninstance monoidAff :: Monoid a => Monoid (Aff a) where\n mempty = pure mempty\n\ninstance altAff :: Alt Aff where\n alt a1 a2 = catchError a1 (const a2)\n\ninstance plusAff :: Plus Aff where\n empty = throwError (error \"Always fails\")\n\n-- | This instance is provided for compatibility. `Aff` is always stack-safe\n-- | within a given fiber. This instance will just result in unnecessary\n-- | bind overhead.\ninstance monadRecAff :: MonadRec Aff where\n tailRecM k = go\n where\n go a = do\n res <- k a\n case res of\n Done r -> pure r\n Loop b -> go b\n\ninstance monadThrowAff :: MonadThrow Error Aff where\n throwError = _throwError\n\ninstance monadErrorAff :: MonadError Error Aff where\n catchError = _catchError\n\ninstance monadEffectAff :: MonadEffect Aff where\n liftEffect = _liftEffect\n\ninstance lazyAff :: Lazy (Aff a) where\n defer f = pure unit >>= f\n\ninstance monadSTAff :: MonadST Global Aff where\n liftST = liftST >>> liftEffect\n\n-- | Applicative for running parallel effects. Any `Aff` can be coerced to a\n-- | `ParAff` and back using the `Parallel` class.\nforeign import data ParAff :: Type -> Type\n\ntype role ParAff representational\n\ninstance functorParAff :: Functor ParAff where\n map = _parAffMap\n\n-- | Runs effects in parallel, combining their results.\ninstance applyParAff :: Apply ParAff where\n apply = _parAffApply\n\ninstance applicativeParAff :: Applicative ParAff where\n pure = parallel <<< pure\n\ninstance semigroupParAff :: Semigroup a => Semigroup (ParAff a) where\n append = lift2 append\n\ninstance monoidParAff :: Monoid a => Monoid (ParAff a) where\n mempty = pure mempty\n\n-- | Races effects in parallel. Returns the first successful result or the\n-- | first error if all fail with an exception. Losing branches will be\n-- | cancelled.\ninstance altParAff :: Alt ParAff where\n alt = _parAffAlt\n\ninstance plusParAff :: Plus ParAff where\n empty = parallel empty\n\ninstance alternativeParAff :: Alternative ParAff\n\ninstance parallelAff :: Parallel ParAff Aff where\n parallel = (unsafeCoerce :: forall a. Aff a -> ParAff a)\n sequential = _sequential\n\ntype OnComplete a =\n { rethrow :: Boolean\n , handler :: (Either Error a -> Effect Unit) -> Effect Unit\n }\n\n-- | Represents a forked computation by way of `forkAff`. `Fiber`s are\n-- | memoized, so their results are only computed once.\nnewtype Fiber a = Fiber\n { run :: Effect Unit\n , kill :: Fn.Fn2 Error (Either Error Unit -> Effect Unit) (Effect (Effect Unit))\n , join :: (Either Error a -> Effect Unit) -> Effect (Effect Unit)\n , onComplete :: OnComplete a -> Effect (Effect Unit)\n , isSuspended :: Effect Boolean\n }\n\ninstance functorFiber :: Functor Fiber where\n map f t = unsafePerformEffect (makeFiber (f <$> joinFiber t))\n\ninstance applyFiber :: Apply Fiber where\n apply t1 t2 = unsafePerformEffect (makeFiber (joinFiber t1 <*> joinFiber t2))\n\ninstance applicativeFiber :: Applicative Fiber where\n pure a = unsafePerformEffect (makeFiber (pure a))\n\n-- | Invokes pending cancelers in a fiber and runs cleanup effects. Blocks\n-- | until the fiber has fully exited.\nkillFiber :: forall a. Error -> Fiber a -> Aff Unit\nkillFiber e (Fiber t) = do\n suspended <- liftEffect t.isSuspended\n if suspended then\n liftEffect $ void $ Fn.runFn2 t.kill e (const (pure unit))\n else\n makeAff \\k -> effectCanceler <$> Fn.runFn2 t.kill e k\n\n-- | Blocks until the fiber completes, yielding the result. If the fiber\n-- | throws an exception, it is rethrown in the current fiber.\njoinFiber :: Fiber ~> Aff\njoinFiber (Fiber t) = makeAff \\k -> effectCanceler <$> t.join k\n\n-- | A cancellation effect for actions run via `makeAff`. If a `Fiber` is\n-- | killed, and an async action is pending, the canceler will be called to\n-- | clean it up.\nnewtype Canceler = Canceler (Error -> Aff Unit)\n\nderive instance newtypeCanceler :: Newtype Canceler _\n\ninstance semigroupCanceler :: Semigroup Canceler where\n append (Canceler c1) (Canceler c2) =\n Canceler \\err -> parSequence_ [ c1 err, c2 err ]\n\n-- | A no-op `Canceler` can be constructed with `mempty`.\ninstance monoidCanceler :: Monoid Canceler where\n mempty = nonCanceler\n\n-- | A canceler which does not cancel anything.\nnonCanceler :: Canceler\nnonCanceler = Canceler (const (pure unit))\n\n-- | A canceler from an Effect action.\neffectCanceler :: Effect Unit -> Canceler\neffectCanceler = Canceler <<< const <<< liftEffect\n\n-- | A canceler from a Fiber.\nfiberCanceler :: forall a. Fiber a -> Canceler\nfiberCanceler = Canceler <<< flip killFiber\n\n-- | Forks an `Aff` from an `Effect` context, returning the `Fiber`.\nlaunchAff :: forall a. Aff a -> Effect (Fiber a)\nlaunchAff aff = do\n fiber <- makeFiber aff\n case fiber of Fiber f -> f.run\n pure fiber\n\n-- | Forks an `Aff` from an `Effect` context, discarding the `Fiber`.\nlaunchAff_ :: Aff Unit -> Effect Unit\nlaunchAff_ = void <<< launchAff\n\n-- | Suspends an `Aff` from an `Effect` context, returning the `Fiber`.\nlaunchSuspendedAff :: forall a. Aff a -> Effect (Fiber a)\nlaunchSuspendedAff = makeFiber\n\n-- | Forks an `Aff` from an `Effect` context and also takes a callback to run when\n-- | it completes. Returns the pending `Fiber`.\nrunAff :: forall a. (Either Error a -> Effect Unit) -> Aff a -> Effect (Fiber Unit)\nrunAff k aff = launchAff $ liftEffect <<< k =<< try aff\n\n-- | Forks an `Aff` from an `Effect` context and also takes a callback to run when\n-- | it completes, discarding the `Fiber`.\nrunAff_ :: forall a. (Either Error a -> Effect Unit) -> Aff a -> Effect Unit\nrunAff_ k aff = void $ runAff k aff\n\n-- | Suspends an `Aff` from an `Effect` context and also takes a callback to run\n-- | when it completes. Returns the suspended `Fiber`.\nrunSuspendedAff :: forall a. (Either Error a -> Effect Unit) -> Aff a -> Effect (Fiber Unit)\nrunSuspendedAff k aff = launchSuspendedAff $ liftEffect <<< k =<< try aff\n\n-- | Forks an `Aff` from within a parent `Aff` context, returning the `Fiber`.\nforkAff :: forall a. Aff a -> Aff (Fiber a)\nforkAff = _fork true\n\n-- | Suspends an `Aff` from within a parent `Aff` context, returning the `Fiber`.\n-- | A suspended `Aff` is not executed until a consumer observes the result\n-- | with `joinFiber`.\nsuspendAff :: forall a. Aff a -> Aff (Fiber a)\nsuspendAff = _fork false\n\n-- | Pauses the running fiber.\ndelay :: Milliseconds -> Aff Unit\ndelay (Milliseconds n) = Fn.runFn2 _delay Right n\n\n-- | An async computation which does not resolve.\nnever :: forall a. Aff a\nnever = makeAff \\_ -> pure mempty\n\n-- | A monomorphic version of `try`. Catches thrown errors and lifts them\n-- | into an `Either`.\nattempt :: forall a. Aff a -> Aff (Either Error a)\nattempt = try\n\n-- | Ignores any errors.\napathize :: forall a. Aff a -> Aff Unit\napathize = attempt >>> map (const unit)\n\n-- | Runs the first effect after the second, regardless of whether it completed\n-- | successfully or the fiber was cancelled.\nfinally :: forall a. Aff Unit -> Aff a -> Aff a\nfinally fin a = bracket (pure unit) (const fin) (const a)\n\n-- | Runs an effect such that it cannot be killed.\ninvincible :: forall a. Aff a -> Aff a\ninvincible a = bracket a (const (pure unit)) pure\n\n-- | Attaches a custom `Canceler` to an action. If the computation is canceled,\n-- | then the custom `Canceler` will be run afterwards.\ncancelWith :: forall a. Aff a -> Canceler -> Aff a\ncancelWith aff (Canceler cancel) =\n generalBracket (pure unit)\n { killed: \\e _ -> cancel e\n , failed: const pure\n , completed: const pure\n }\n (const aff)\n\n-- | Guarantees resource acquisition and cleanup. The first effect may acquire\n-- | some resource, while the second will dispose of it. The third effect makes\n-- | use of the resource. Disposal is always run last, regardless. Neither\n-- | acquisition nor disposal may be cancelled and are guaranteed to run until\n-- | they complete.\nbracket :: forall a b. Aff a -> (a -> Aff Unit) -> (a -> Aff b) -> Aff b\nbracket acquire completed =\n generalBracket acquire\n { killed: const completed\n , failed: const completed\n , completed: const completed\n }\n\ntype Supervised a =\n { fiber :: Fiber a\n , supervisor :: Supervisor\n }\n\n-- | Creates a new supervision context for some `Aff`, guaranteeing fiber\n-- | cleanup when the parent completes. Any pending fibers forked within\n-- | the context will be killed and have their cancelers run.\nsupervise :: forall a. Aff a -> Aff a\nsupervise aff =\n generalBracket (liftEffect acquire)\n { killed: \\err sup -> parSequence_ [ killFiber err sup.fiber, killAll err sup ]\n , failed: const (killAll killError)\n , completed: const (killAll killError)\n }\n (joinFiber <<< _.fiber)\n where\n killError :: Error\n killError =\n error \"[Aff] Child fiber outlived parent\"\n\n killAll :: Error -> Supervised a -> Aff Unit\n killAll err sup = makeAff \\k ->\n Fn.runFn3 _killAll err sup.supervisor (k (pure unit))\n\n acquire :: Effect (Supervised a)\n acquire = do\n sup <- Fn.runFn2 _makeSupervisedFiber ffiUtil aff\n case sup.fiber of Fiber f -> f.run\n pure sup\n\nforeign import data Supervisor :: Type\nforeign import _pure :: forall a. a -> Aff a\nforeign import _throwError :: forall a. Error -> Aff a\nforeign import _catchError :: forall a. Aff a -> (Error -> Aff a) -> Aff a\nforeign import _fork :: forall a. Boolean -> Aff a -> Aff (Fiber a)\nforeign import _map :: forall a b. (a -> b) -> Aff a -> Aff b\nforeign import _bind :: forall a b. Aff a -> (a -> Aff b) -> Aff b\nforeign import _delay :: forall a. Fn.Fn2 (Unit -> Either a Unit) Number (Aff Unit)\nforeign import _liftEffect :: forall a. Effect a -> Aff a\nforeign import _parAffMap :: forall a b. (a -> b) -> ParAff a -> ParAff b\nforeign import _parAffApply :: forall a b. ParAff (a -> b) -> ParAff a -> ParAff b\nforeign import _parAffAlt :: forall a. ParAff a -> ParAff a -> ParAff a\nforeign import _makeFiber :: forall a. Fn.Fn2 FFIUtil (Aff a) (Effect (Fiber a))\nforeign import _makeSupervisedFiber :: forall a. Fn.Fn2 FFIUtil (Aff a) (Effect (Supervised a))\nforeign import _killAll :: Fn.Fn3 Error Supervisor (Effect Unit) (Effect Canceler)\nforeign import _sequential :: ParAff ~> Aff\n\ntype BracketConditions a b =\n { killed :: Error -> a -> Aff Unit\n , failed :: Error -> a -> Aff Unit\n , completed :: b -> a -> Aff Unit\n }\n\n-- | A general purpose bracket which lets you observe the status of the\n-- | bracketed action. The bracketed action may have been killed with an\n-- | exception, thrown an exception, or completed successfully.\nforeign import generalBracket :: forall a b. Aff a -> BracketConditions a b -> (a -> Aff b) -> Aff b\n\n-- | Constructs an `Aff` from low-level `Effect` effects using a callback. A\n-- | `Canceler` effect should be returned to cancel the pending action. The\n-- | supplied callback may be invoked only once. Subsequent invocation are\n-- | ignored.\nforeign import makeAff :: forall a. ((Either Error a -> Effect Unit) -> Effect Canceler) -> Aff a\n\nmakeFiber :: forall a. Aff a -> Effect (Fiber a)\nmakeFiber aff = Fn.runFn2 _makeFiber ffiUtil aff\n\nnewtype FFIUtil = FFIUtil\n { isLeft :: forall a b. Either a b -> Boolean\n , fromLeft :: forall a b. Either a b -> a\n , fromRight :: forall a b. Either a b -> b\n , left :: forall a b. a -> Either a b\n , right :: forall a b. b -> Either a b\n }\n\nffiUtil :: FFIUtil\nffiUtil = FFIUtil\n { isLeft\n , fromLeft: unsafeFromLeft\n , fromRight: unsafeFromRight\n , left: Left\n , right: Right\n }\n where\n isLeft :: forall a b. Either a b -> Boolean\n isLeft = case _ of\n Left _ -> true\n Right _ -> false\n\n unsafeFromLeft :: forall a b. Either a b -> a\n unsafeFromLeft = case _ of\n Left a -> a\n Right _ -> unsafeCrashWith \"unsafeFromLeft: Right\"\n\n unsafeFromRight :: forall a b. Either a b -> b\n unsafeFromRight = case _ of\n Right a -> a\n Left _ -> unsafeCrashWith \"unsafeFromRight: Left\"\n", "module Data.Coyoneda\n ( Coyoneda(..)\n , CoyonedaF\n , coyoneda\n , unCoyoneda\n , liftCoyoneda\n , lowerCoyoneda\n , hoistCoyoneda\n ) where\n\nimport Prelude\n\nimport Control.Alt (class Alt, alt)\nimport Control.Alternative (class Alternative, class Plus, empty)\nimport Control.Comonad (class Comonad, extract)\nimport Control.Extend (class Extend, (<<=))\nimport Control.Monad.Trans.Class (class MonadTrans)\nimport Control.MonadPlus (class MonadPlus)\nimport Data.Distributive (class Distributive, collect)\nimport Data.Eq (class Eq1, eq1)\nimport Data.Exists (Exists, runExists, mkExists)\nimport Data.Foldable (class Foldable, foldMap, foldl, foldr)\nimport Data.Functor.Invariant (class Invariant, imapF)\nimport Data.Ord (class Ord1, compare1)\nimport Data.Semigroup.Foldable (class Foldable1, foldMap1, foldr1Default, foldl1Default)\nimport Data.Semigroup.Traversable (class Traversable1, sequence1, traverse1)\nimport Data.Traversable (class Traversable, traverse)\n\n-- | `Coyoneda` is encoded as an existential type using `Data.Exists`.\n-- |\n-- | This type constructor encodes the contents of the existential package.\ndata CoyonedaF f a i = CoyonedaF (i -> a) (f i)\n\n-- | The `Coyoneda` `Functor`.\n-- |\n-- | `Coyoneda f` is a `Functor` for any type constructor `f`. In fact,\n-- | it is the _free_ `Functor` for `f`, i.e. any natural transformation\n-- | `nat :: f ~> g`, can be factor through `liftCoyoneda`. The natural\n-- | transformation from `Coyoneda f ~> g` is given by `lowerCoyoneda <<<\n-- | hoistCoyoneda nat`:\n-- | ```purescript\n-- | lowerCoyoneda <<< hoistCoyoneda nat <<< liftCoyoneda $ fi\n-- | = lowerCoyoneda (hoistCoyoneda nat (Coyoneda $ mkExists $ CoyonedaF identity fi)) (by definition of liftCoyoneda)\n-- | = lowerCoyoneda (coyoneda identity (nat fi)) (by definition of hoistCoyoneda)\n-- | = unCoyoneda map (coyoneda identity (nat fi)) (by definition of lowerCoyoneda)\n-- | = unCoyoneda map (Coyoneda $ mkExists $ CoyonedaF identity (nat fi)) (by definition of coyoneda)\n-- | = map identity (nat fi) (by definition of unCoyoneda)\n-- | = nat fi (since g is a Functor)\n-- | ```\nnewtype Coyoneda f a = Coyoneda (Exists (CoyonedaF f a))\n\ninstance eqCoyoneda :: (Functor f, Eq1 f, Eq a) => Eq (Coyoneda f a) where\n eq x y = lowerCoyoneda x `eq1` lowerCoyoneda y\n\ninstance eq1Coyoneda :: (Functor f, Eq1 f) => Eq1 (Coyoneda f) where\n eq1 = eq\n\ninstance ordCoyoneda :: (Functor f, Ord1 f, Ord a) => Ord (Coyoneda f a) where\n compare x y = lowerCoyoneda x `compare1` lowerCoyoneda y\n\ninstance ord1Coyoneda :: (Functor f, Ord1 f) => Ord1 (Coyoneda f) where\n compare1 = compare\n\ninstance functorCoyoneda :: Functor (Coyoneda f) where\n map f (Coyoneda e) = runExists (\\(CoyonedaF k fi) -> coyoneda (f <<< k) fi) e\n\ninstance invatiantCoyoneda :: Invariant (Coyoneda f) where\n imap = imapF\n\ninstance applyCoyoneda :: Apply f => Apply (Coyoneda f) where\n apply f g = liftCoyoneda $ lowerCoyoneda f <*> lowerCoyoneda g\n\ninstance applicativeCoyoneda :: Applicative f => Applicative (Coyoneda f) where\n pure = liftCoyoneda <<< pure\n\ninstance altCoyoneda :: Alt f => Alt (Coyoneda f) where\n alt x y = liftCoyoneda $ alt (lowerCoyoneda x) (lowerCoyoneda y)\n\ninstance plusCoyoneda :: Plus f => Plus (Coyoneda f) where\n empty = liftCoyoneda empty\n\ninstance alternativeCoyoneda :: Alternative f => Alternative (Coyoneda f)\n\ninstance bindCoyoneda :: Bind f => Bind (Coyoneda f) where\n bind (Coyoneda e) f =\n liftCoyoneda $\n runExists (\\(CoyonedaF k fi) -> lowerCoyoneda <<< f <<< k =<< fi) e\n\n-- | When `f` is a Monad then it is a functor as well. In this case\n-- | `liftCoyoneda` is not only a functor isomorphism but also a monad\n-- | isomorphism, i.e. the following law holds\n-- | ```purescript\n-- | liftCoyoneda fa >>= liftCoyoneda <<< g = liftCoyoneda $ fa >>= g\n-- | ```\ninstance monadCoyoneda :: Monad f => Monad (Coyoneda f)\n\ninstance monadTransCoyoneda :: MonadTrans Coyoneda where\n lift = liftCoyoneda\n\ninstance monadPlusCoyoneda :: MonadPlus f => MonadPlus (Coyoneda f)\n\ninstance extendCoyoneda :: Extend w => Extend (Coyoneda w) where\n extend f (Coyoneda e) =\n runExists (\\(CoyonedaF k fi) -> liftCoyoneda $ f <<< coyoneda k <<= fi) e\n\n-- | As in the monad case: if `w` is a comonad, then it is a functor, thus\n-- | `liftCoyoneda` is an iso of functors, but moreover it is an iso of\n-- | comonads, i.e. the following law holds:\n-- | ```purescript\n-- | g <<= liftCoyoneda w = liftCoyoneda $ g <<< liftCoyoneda <<= w\n-- | ```\ninstance comonadCoyoneda :: Comonad w => Comonad (Coyoneda w) where\n extract (Coyoneda e) = runExists (\\(CoyonedaF k fi) -> k $ extract fi) e\n\ninstance foldableCoyoneda :: Foldable f => Foldable (Coyoneda f) where\n foldr f z = unCoyoneda \\k -> foldr (f <<< k) z\n foldl f z = unCoyoneda \\k -> foldl (\\x -> f x <<< k) z\n foldMap f = unCoyoneda \\k -> foldMap (f <<< k)\n\ninstance traversableCoyoneda :: Traversable f => Traversable (Coyoneda f) where\n traverse f = unCoyoneda \\k -> map liftCoyoneda <<< traverse (f <<< k)\n sequence = unCoyoneda \\k -> map liftCoyoneda <<< traverse k\n\ninstance foldable1Coyoneda :: Foldable1 f => Foldable1 (Coyoneda f) where\n foldMap1 f = unCoyoneda \\k -> foldMap1 (f <<< k)\n foldr1 = foldr1Default\n foldl1 = foldl1Default\n\ninstance traversable1Coyoneda :: Traversable1 f => Traversable1 (Coyoneda f) where\n traverse1 f = unCoyoneda \\k -> map liftCoyoneda <<< traverse1 (f <<< k)\n sequence1 = unCoyoneda \\k -> map liftCoyoneda <<< sequence1 <<< map k\n\ninstance distributiveCoyoneda :: Distributive f => Distributive (Coyoneda f) where\n collect f = liftCoyoneda <<< collect (lowerCoyoneda <<< f)\n distribute = liftCoyoneda <<< collect lowerCoyoneda\n\n-- | Construct a value of type `Coyoneda f b` from a mapping function and a\n-- | value of type `f a`.\ncoyoneda :: forall f a b. (a -> b) -> f a -> Coyoneda f b\ncoyoneda k fi = Coyoneda $ mkExists $ CoyonedaF k fi\n\n-- | Deconstruct a value of `Coyoneda a` to retrieve the mapping function and\n-- | original value.\nunCoyoneda :: forall f a r. (forall b. (b -> a) -> f b -> r) -> Coyoneda f a -> r\nunCoyoneda f (Coyoneda e) = runExists (\\(CoyonedaF k fi) -> f k fi) e\n\n-- | Lift a value described by the type constructor `f` to `Coyoneda f`.\n-- |\n-- | Note that for any functor `f` `liftCoyoneda` has a right inverse\n-- | `lowerCoyoneda`:\n-- | ```purescript\n-- | liftCoyoneda <<< lowerCoyoneda $ (Coyoneda e)\n-- | = liftCoyoneda <<< unCoyoneda map $ (Coyoneda e)\n-- | = liftCoyonead (runExists (\\(CoyonedaF k fi) -> map k fi) e)\n-- | = liftCoyonead (Coyoneda e)\n-- | = coyoneda identity (Coyoneda e)\n-- | = Coyoneda e\n-- | ```\n-- | Moreover if `f` is a `Functor` then `liftCoyoneda` is an isomorphism of\n-- | functors with inverse `lowerCoyoneda`: we already showed that\n-- | `lowerCoyoneda <<< hoistCoyoneda identity = lowerCoyoneda` is its left inverse\n-- | whenever `f` is a functor.\nliftCoyoneda :: forall f. f ~> Coyoneda f\nliftCoyoneda = coyoneda identity\n\n-- | Lower a value of type `Coyoneda f a` to the `Functor` `f`.\nlowerCoyoneda :: forall f. Functor f => Coyoneda f ~> f\nlowerCoyoneda = unCoyoneda map\n\n-- | Use a natural transformation to change the generating type constructor of a\n-- | `Coyoneda`.\nhoistCoyoneda :: forall f g. (f ~> g) -> Coyoneda f ~> Coyoneda g\nhoistCoyoneda nat (Coyoneda e) =\n runExists (\\(CoyonedaF k fi) -> coyoneda k (nat fi)) e\n", "module Halogen.Data.Slot\n ( Slot\n , SlotStorage\n , empty\n , lookup\n , insert\n , pop\n , slots\n , foreachSlot\n ) where\n\nimport Prelude\n\nimport Data.Foldable (traverse_)\nimport Data.Map (Map)\nimport Data.Map as Map\nimport Data.Maybe (Maybe(..))\nimport Data.Monoid.Alternate (Alternate(..))\nimport Data.Newtype (un)\nimport Data.Symbol (class IsSymbol, reflectSymbol)\nimport Data.Tuple (Tuple(..))\nimport Halogen.Data.OrdBox (OrdBox, mkOrdBox, unOrdBox)\nimport Prim.Row as Row\nimport Type.Proxy (Proxy)\nimport Unsafe.Coerce (unsafeCoerce)\n\nforeign import data Any :: Type\n\n-- | A type which records the queries, output messages, and slot identifier for\n-- | a particular slot (ie. a location in HTML where a component is rendered).\n-- | For example:\n-- |\n-- | ```purescript\n-- | type ButtonSlot slot = Slot Button.Query Button.Output slot\n-- |\n-- | -- A component using this slot type can have one type of child component,\n-- | -- which supports `Button.Query` queries, `Button.Output` outputs, and\n-- | -- which can be uniquely identified by an integer.\n-- | type Slots = ( button :: ButtonSlot Int )\n-- | ```\n-- |\n-- | - `query` represents the requests that can be made of this component\n-- | - `output` represents the output messages that can be raised by this component\n-- | - `slot` represents the unique identifier for this component\ndata Slot :: (Type -> Type) -> Type -> Type -> Type\ndata Slot (query :: Type -> Type) output slot\n\nnewtype SlotStorage (slots :: Row Type) (slot :: (Type -> Type) -> Type -> Type) =\n SlotStorage (Map (Tuple String (OrdBox Any)) Any)\n\nempty :: forall slots slot. SlotStorage slots slot\nempty = SlotStorage Map.empty\n\nlookup\n :: forall sym px slots slot query output s\n . Row.Cons sym (Slot query output s) px slots\n => IsSymbol sym\n => Ord s\n => Proxy sym\n -> s\n -> SlotStorage slots slot\n -> Maybe (slot query output)\nlookup sym key (SlotStorage m) =\n coerceSlot (Map.lookup (Tuple (reflectSymbol sym) (coerceBox (mkOrdBox key))) m)\n where\n coerceSlot :: Maybe Any -> Maybe (slot query output)\n coerceSlot = unsafeCoerce\n\n coerceBox :: OrdBox s -> OrdBox Any\n coerceBox = unsafeCoerce\n\npop\n :: forall sym px slots slot query output s\n . Row.Cons sym (Slot query output s) px slots\n => IsSymbol sym\n => Ord s\n => Proxy sym\n -> s\n -> SlotStorage slots slot\n -> Maybe (Tuple (slot query output) (SlotStorage slots slot))\npop sym key (SlotStorage m) =\n coercePop (Map.pop (Tuple (reflectSymbol sym) (coerceBox (mkOrdBox key))) m)\n where\n coercePop :: Maybe (Tuple Any (Map (Tuple String (OrdBox Any)) Any)) -> Maybe (Tuple (slot query output) (SlotStorage slots slot))\n coercePop = unsafeCoerce\n\n coerceBox :: OrdBox s -> OrdBox Any\n coerceBox = unsafeCoerce\n\ninsert\n :: forall sym px slots slot query output s\n . Row.Cons sym (Slot query output s) px slots\n => IsSymbol sym\n => Ord s\n => Proxy sym\n -> s\n -> slot query output\n -> SlotStorage slots slot\n -> SlotStorage slots slot\ninsert sym key val (SlotStorage m) =\n SlotStorage (Map.insert (Tuple (reflectSymbol sym) (coerceBox (mkOrdBox key))) (coerceVal val) m)\n where\n coerceBox :: OrdBox s -> OrdBox Any\n coerceBox = unsafeCoerce\n\n coerceVal :: slot query output -> Any\n coerceVal = unsafeCoerce\n\nslots\n :: forall sym px slots slot query output s\n . Row.Cons sym (Slot query output s) px slots\n => IsSymbol sym\n => Ord s\n => Proxy sym\n -> SlotStorage slots slot\n -> Map s (slot query output)\nslots sym (SlotStorage m) = un Alternate $ Map.foldSubmap Nothing Nothing go m\n where\n key = reflectSymbol sym\n\n go (Tuple key' ob) val\n | key == key' = Alternate $ Map.singleton (unOrdBox (coerceBox ob)) (coerceVal val)\n | otherwise = Alternate Map.empty\n\n coerceBox :: OrdBox Any -> OrdBox s\n coerceBox = unsafeCoerce\n\n coerceVal :: Any -> slot query output\n coerceVal = unsafeCoerce\n\nforeachSlot\n :: forall m slots slot\n . Applicative m\n => SlotStorage slots slot\n -> (forall query output. slot query output -> m Unit)\n -> m Unit\nforeachSlot (SlotStorage m) k = traverse_ (k <<< coerceVal) m\n where\n coerceVal :: forall query output. Any -> slot query output\n coerceVal = unsafeCoerce\n", "module Halogen.Query.Input where\n\nimport Prelude\n\nimport Data.Maybe (Maybe)\nimport Data.Newtype (class Newtype)\nimport Web.DOM (Element)\n\nnewtype RefLabel = RefLabel String\n\nderive instance newtypeRefLabel :: Newtype RefLabel _\nderive newtype instance eqRefLabel :: Eq RefLabel\nderive newtype instance ordRefLabel :: Ord RefLabel\n\ndata Input action\n = RefUpdate RefLabel (Maybe Element)\n | Action action\n\nderive instance functorInput :: Functor Input\n", "module Halogen.VDom.Machine\n ( Machine\n , Step'(..)\n , Step\n , mkStep\n , unStep\n , extract\n , step\n , halt\n ) where\n\nimport Prelude\n\nimport Effect.Uncurried (EffectFn1, EffectFn2, mkEffectFn1, mkEffectFn2, runEffectFn1, runEffectFn2)\nimport Unsafe.Coerce (unsafeCoerce)\n\ntype Machine a b = EffectFn1 a (Step a b)\n\ndata Step' a b s = Step b s (EffectFn2 s a (Step a b)) (EffectFn1 s Unit)\n\nforeign import data Step \u2237 Type \u2192 Type \u2192 Type\n\nmkStep \u2237 \u2200 a b s. Step' a b s \u2192 Step a b\nmkStep = unsafeCoerce\n\nunStep :: \u2200 a b r. (\u2200 s. Step' a b s \u2192 r) \u2192 Step a b \u2192 r\nunStep = unsafeCoerce\n\n-- | Returns the output value of a `Step`.\nextract \u2237 \u2200 a b. Step a b \u2192 b\nextract = unStep \\(Step x _ _ _) \u2192 x\n\n-- | Runs the next step.\nstep \u2237 \u2200 a b. EffectFn2 (Step a b) a (Step a b)\nstep = coerce $ mkEffectFn2 \\(Step _ s k _) a \u2192 runEffectFn2 k s a\n where\n coerce \u2237 \u2200 s. EffectFn2 (Step' a b s) a (Step a b) \u2192 EffectFn2 (Step a b) a (Step a b)\n coerce = unsafeCoerce\n\n-- | Runs the finalizer associated with a `Step`\nhalt \u2237 \u2200 a b. EffectFn1 (Step a b) Unit\nhalt = coerce $ mkEffectFn1 \\(Step _ s _ k) \u2192 runEffectFn1 k s\n where\n coerce \u2237 \u2200 s. EffectFn1 (Step' a b s) Unit \u2192 EffectFn1 (Step a b) Unit\n coerce = unsafeCoerce\n", "module Halogen.VDom.Types\n ( VDom(..)\n , renderWidget\n , Graft\n , GraftX(..)\n , graft\n , unGraft\n , runGraft\n , ElemName(..)\n , Namespace(..)\n ) where\n\nimport Prelude\nimport Data.Bifunctor (class Bifunctor, bimap)\nimport Data.Maybe (Maybe)\nimport Data.Newtype (class Newtype)\nimport Data.Tuple (Tuple)\nimport Unsafe.Coerce (unsafeCoerce)\n\n-- | The core virtual-dom tree type, where `a` is the type of attributes,\n-- | and `w` is the type of \"widgets\". Widgets are machines that have complete\n-- | control over the lifecycle of some `DOM.Node`.\n-- |\n-- | The `Grafted` constructor and associated machinery enables `bimap`\n-- | fusion using a Coyoneda-like encoding.\ndata VDom a w\n = Text String\n | Elem (Maybe Namespace) ElemName a (Array (VDom a w))\n | Keyed (Maybe Namespace) ElemName a (Array (Tuple String (VDom a w)))\n | Widget w\n | Grafted (Graft a w)\n\ninstance functorVDom \u2237 Functor (VDom a) where\n map _ (Text a) = Text a\n map g (Grafted a) = Grafted (map g a)\n map g a = Grafted (graft (Graft identity g a))\n\ninstance bifunctorVDom \u2237 Bifunctor VDom where\n bimap _ _ (Text a) = Text a\n bimap f g (Grafted a) = Grafted (bimap f g a)\n bimap f g a = Grafted (graft (Graft f g a))\n\n-- | Replaces \"widgets\" in the `VDom` with the ability to turn them into other\n-- | `VDom` nodes.\n-- |\n-- | Using this function will fuse any `Graft`s present in the `VDom`.\nrenderWidget \u2237 \u2200 a b w x. (a \u2192 b) \u2192 (w \u2192 VDom b x) \u2192 VDom a w \u2192 VDom b x\nrenderWidget f g = case _ of\n Text a \u2192 Text a\n Elem ns n a ch \u2192 Elem ns n (f a) (map (renderWidget f g) ch)\n Keyed ns n a ch \u2192 Keyed ns n (f a) (map (map (renderWidget f g)) ch)\n Widget w \u2192 g w\n Grafted gaw \u2192 renderWidget f g (runGraft gaw)\n\nforeign import data Graft \u2237 Type \u2192 Type \u2192 Type\n\ninstance functorGraft \u2237 Functor (Graft a) where\n map g = unGraft \\(Graft f' g' a) \u2192 graft (Graft f' (g <<< g') a)\n\ninstance bifunctorGraft \u2237 Bifunctor Graft where\n bimap f g = unGraft \\(Graft f' g' a) \u2192 graft (Graft (f <<< f') (g <<< g') a)\n\ndata GraftX a a' w w' =\n Graft (a \u2192 a') (w \u2192 w') (VDom a w)\n\ngraft\n \u2237 \u2200 a a' w w'\n . GraftX a a' w w'\n \u2192 Graft a' w'\ngraft = unsafeCoerce\n\nunGraft\n \u2237 \u2200 a' w' r\n . (\u2200 a w. GraftX a a' w w' \u2192 r)\n \u2192 Graft a' w'\n \u2192 r\nunGraft f = f <<< unsafeCoerce\n\nrunGraft\n \u2237 \u2200 a' w'\n . Graft a' w'\n \u2192 VDom a' w'\nrunGraft =\n unGraft \\(Graft fa fw v) \u2192\n let\n go (Text s) = Text s\n go (Elem ns n a ch) = Elem ns n (fa a) (map go ch)\n go (Keyed ns n a ch) = Keyed ns n (fa a) (map (map go) ch)\n go (Widget w) = Widget (fw w)\n go (Grafted g) = Grafted (bimap fa fw g)\n in\n go v\n\nnewtype ElemName = ElemName String\n\nderive instance newtypeElemName \u2237 Newtype ElemName _\nderive newtype instance eqElemName \u2237 Eq ElemName\nderive newtype instance ordElemName \u2237 Ord ElemName\n\nnewtype Namespace = Namespace String\n\nderive instance newtypeNamespace \u2237 Newtype Namespace _\nderive newtype instance eqNamespace \u2237 Eq Namespace\nderive newtype instance ordNamespace \u2237 Ord Namespace\n", "\"use strict\";\n\nexport function unsafeGetAny(key, obj) {\n return obj[key];\n}\n\nexport function unsafeHasAny(key, obj) {\n return obj.hasOwnProperty(key);\n}\n\nexport function unsafeSetAny(key, val, obj) {\n obj[key] = val;\n}\n\nexport function unsafeDeleteAny(key, obj) {\n delete obj[key];\n}\n\nexport function forE(a, f) {\n var b = [];\n for (var i = 0; i < a.length; i++) {\n b.push(f(i, a[i]));\n }\n return b;\n}\n\nexport function forEachE(a, f) {\n for (var i = 0; i < a.length; i++) {\n f(a[i]);\n }\n}\n\nexport function forInE(o, f) {\n var ks = Object.keys(o);\n for (var i = 0; i < ks.length; i++) {\n var k = ks[i];\n f(k, o[k]);\n }\n}\n\nexport function replicateE(n, f) {\n for (var i = 0; i < n; i++) {\n f();\n }\n}\n\nexport function diffWithIxE(a1, a2, f1, f2, f3) {\n var a3 = [];\n var l1 = a1.length;\n var l2 = a2.length;\n var i = 0;\n while (1) {\n if (i < l1) {\n if (i < l2) {\n a3.push(f1(i, a1[i], a2[i]));\n } else {\n f2(i, a1[i]);\n }\n } else if (i < l2) {\n a3.push(f3(i, a2[i]));\n } else {\n break;\n }\n i++;\n }\n return a3;\n}\n\nexport function strMapWithIxE(as, fk, f) {\n var o = {};\n for (var i = 0; i < as.length; i++) {\n var a = as[i];\n var k = fk(a);\n o[k] = f(k, i, a);\n }\n return o;\n}\n\nexport function diffWithKeyAndIxE(o1, as, fk, f1, f2, f3) {\n var o2 = {};\n for (var i = 0; i < as.length; i++) {\n var a = as[i];\n var k = fk(a);\n if (o1.hasOwnProperty(k)) {\n o2[k] = f1(k, i, o1[k], a);\n } else {\n o2[k] = f3(k, i, a);\n }\n }\n for (var k in o1) {\n if (k in o2) {\n continue;\n }\n f2(k, o1[k]);\n }\n return o2;\n}\n\nexport function refEq(a, b) {\n return a === b;\n}\n\nexport function createTextNode(s, doc) {\n return doc.createTextNode(s);\n}\n\nexport function setTextContent(s, n) {\n n.textContent = s;\n}\n\nexport function createElement(ns, name, doc) {\n if (ns != null) {\n return doc.createElementNS(ns, name);\n } else {\n return doc.createElement(name)\n }\n}\n\nexport function insertChildIx(i, a, b) {\n var n = b.childNodes.item(i) || null;\n if (n !== a) {\n b.insertBefore(a, n);\n }\n}\n\nexport function removeChild(a, b) {\n if (b && a.parentNode === b) {\n b.removeChild(a);\n }\n}\n\nexport function parentNode(a) {\n return a.parentNode;\n}\n\nexport function setAttribute(ns, attr, val, el) {\n if (ns != null) {\n el.setAttributeNS(ns, attr, val);\n } else {\n el.setAttribute(attr, val);\n }\n}\n\nexport function removeAttribute(ns, attr, el) {\n if (ns != null) {\n el.removeAttributeNS(ns, attr);\n } else {\n el.removeAttribute(attr);\n }\n}\n\nexport function hasAttribute(ns, attr, el) {\n if (ns != null) {\n return el.hasAttributeNS(ns, attr);\n } else {\n return el.hasAttribute(attr);\n }\n}\n\nexport function addEventListener(ev, listener, el) {\n el.addEventListener(ev, listener, false);\n}\n\nexport function removeEventListener(ev, listener, el) {\n el.removeEventListener(ev, listener, false);\n}\n\nexport var jsUndefined = void 0;\n", "module Halogen.VDom.Util\n ( newMutMap\n , pokeMutMap\n , deleteMutMap\n , unsafeFreeze\n , unsafeLookup\n , unsafeGetAny\n , unsafeHasAny\n , unsafeSetAny\n , unsafeDeleteAny\n , forE\n , forEachE\n , forInE\n , replicateE\n , diffWithIxE\n , diffWithKeyAndIxE\n , strMapWithIxE\n , refEq\n , createTextNode\n , setTextContent\n , createElement\n , insertChildIx\n , removeChild\n , parentNode\n , setAttribute\n , removeAttribute\n , hasAttribute\n , addEventListener\n , removeEventListener\n , JsUndefined\n , jsUndefined\n ) where\n\nimport Prelude\n\nimport Data.Function.Uncurried as Fn\nimport Data.Nullable (Nullable)\nimport Effect (Effect)\nimport Effect.Uncurried as EFn\nimport Foreign.Object (Object)\nimport Foreign.Object as Object\nimport Foreign.Object.ST (STObject)\nimport Foreign.Object.ST as STObject\nimport Halogen.VDom.Types (Namespace, ElemName)\nimport Unsafe.Coerce (unsafeCoerce)\nimport Web.DOM.Document (Document) as DOM\nimport Web.DOM.Element (Element) as DOM\nimport Web.DOM.Node (Node) as DOM\nimport Web.Event.EventTarget (EventListener) as DOM\n\nnewMutMap \u2237 \u2200 r a. Effect (STObject r a)\nnewMutMap = unsafeCoerce STObject.new\n\npokeMutMap \u2237 \u2200 r a. EFn.EffectFn3 String a (STObject r a) Unit\npokeMutMap = unsafeSetAny\n\ndeleteMutMap \u2237 \u2200 r a. EFn.EffectFn2 String (STObject r a) Unit\ndeleteMutMap = unsafeDeleteAny\n\nunsafeFreeze \u2237 \u2200 r a. STObject r a \u2192 Object a\nunsafeFreeze = unsafeCoerce\n\nunsafeLookup \u2237 \u2200 a. Fn.Fn2 String (Object a) a\nunsafeLookup = unsafeGetAny\n\nforeign import unsafeGetAny\n \u2237 \u2200 a b. Fn.Fn2 String a b\n\nforeign import unsafeHasAny\n \u2237 \u2200 a. Fn.Fn2 String a Boolean\n\nforeign import unsafeSetAny \u2237 \u2200 a b. EFn.EffectFn3 String a b Unit\n\nforeign import unsafeDeleteAny\n \u2237 \u2200 a. EFn.EffectFn2 String a Unit\n\nforeign import forE\n \u2237 \u2200 a b\n . EFn.EffectFn2\n (Array a)\n (EFn.EffectFn2 Int a b)\n (Array b)\n\nforeign import forEachE\n \u2237 \u2200 a\n . EFn.EffectFn2\n (Array a)\n (EFn.EffectFn1 a Unit)\n Unit\n\nforeign import forInE\n \u2237 \u2200 a\n . EFn.EffectFn2\n (Object.Object a)\n (EFn.EffectFn2 String a Unit)\n Unit\n\nforeign import replicateE\n \u2237 \u2200 a\n . EFn.EffectFn2\n Int\n (Effect a)\n Unit\n\nforeign import diffWithIxE\n \u2237 \u2200 b c d\n . EFn.EffectFn5\n (Array b)\n (Array c)\n (EFn.EffectFn3 Int b c d)\n (EFn.EffectFn2 Int b Unit)\n (EFn.EffectFn2 Int c d)\n (Array d)\n\nforeign import diffWithKeyAndIxE\n \u2237 \u2200 a b c d\n . EFn.EffectFn6\n (Object.Object a)\n (Array b)\n (b \u2192 String)\n (EFn.EffectFn4 String Int a b c)\n (EFn.EffectFn2 String a d)\n (EFn.EffectFn3 String Int b c)\n (Object.Object c)\n\nforeign import strMapWithIxE\n \u2237 \u2200 a b\n . EFn.EffectFn3\n (Array a)\n (a \u2192 String)\n (EFn.EffectFn3 String Int a b)\n (Object.Object b)\n\nforeign import refEq\n \u2237 \u2200 a b. Fn.Fn2 a b Boolean\n\nforeign import createTextNode\n \u2237 EFn.EffectFn2 String DOM.Document DOM.Node\n\nforeign import setTextContent\n \u2237 EFn.EffectFn2 String DOM.Node Unit\n\nforeign import createElement\n \u2237 EFn.EffectFn3 (Nullable Namespace) ElemName DOM.Document DOM.Element\n\nforeign import insertChildIx\n \u2237 EFn.EffectFn3 Int DOM.Node DOM.Node Unit\n\nforeign import removeChild\n \u2237 EFn.EffectFn2 DOM.Node DOM.Node Unit\n\nforeign import parentNode\n \u2237 EFn.EffectFn1 DOM.Node DOM.Node\n\nforeign import setAttribute\n \u2237 EFn.EffectFn4 (Nullable Namespace) String String DOM.Element Unit\n\nforeign import removeAttribute\n \u2237 EFn.EffectFn3 (Nullable Namespace) String DOM.Element Unit\n\nforeign import hasAttribute\n \u2237 EFn.EffectFn3 (Nullable Namespace) String DOM.Element Boolean\n\nforeign import addEventListener\n \u2237 EFn.EffectFn3 String DOM.EventListener DOM.Element Unit\n\nforeign import removeEventListener\n \u2237 EFn.EffectFn3 String DOM.EventListener DOM.Element Unit\n\nforeign import data JsUndefined \u2237 Type\n\nforeign import jsUndefined \u2237 JsUndefined\n", "var getProp = function (name) {\n return function (doctype) {\n return doctype[name];\n };\n};\n\nexport const _namespaceURI = getProp(\"namespaceURI\");\nexport const _prefix = getProp(\"prefix\");\nexport const localName = getProp(\"localName\");\nexport const tagName = getProp(\"tagName\");\n\nexport function id(node) {\n return function () {\n return node.id;\n };\n}\n\nexport function setId(id) {\n return function (node) {\n return function () {\n node.id = id;\n };\n };\n}\n\nexport function className(node) {\n return function () {\n return node.className;\n };\n}\n\nexport function classList(element) {\n return function () {\n return element.classList;\n };\n}\n\nexport function setClassName(className) {\n return function (node) {\n return function () {\n node.className = className;\n };\n };\n}\n\nexport function getElementsByTagName(localName) {\n return function (doc) {\n return function () {\n return doc.getElementsByTagName(localName);\n };\n };\n}\n\nexport function _getElementsByTagNameNS(ns) {\n return function (localName) {\n return function (doc) {\n return function () {\n return doc.getElementsByTagNameNS(ns, localName);\n };\n };\n };\n}\n\nexport function getElementsByClassName(classNames) {\n return function (doc) {\n return function () {\n return doc.getElementsByClassName(classNames);\n };\n };\n}\n\nexport function setAttribute(name) {\n return function (value) {\n return function (element) {\n return function () {\n element.setAttribute(name, value);\n };\n };\n };\n}\n\nexport function _getAttribute(name) {\n return function (element) {\n return function () {\n return element.getAttribute(name);\n };\n };\n}\n\nexport function hasAttribute(name) {\n return function (element) {\n return function () {\n return element.hasAttribute(name);\n };\n };\n}\n\nexport function removeAttribute(name) {\n return function (element) {\n return function () {\n element.removeAttribute(name);\n };\n };\n}\n\nexport function matches(selector) {\n return function(element) {\n return function () {\n return element.matches(selector);\n };\n };\n}\n\nexport function _closest(selector) {\n return function(element) {\n return function () {\n return element.closest(selector);\n };\n };\n}\n\n// - CSSOM ---------------------------------------------------------------------\n\nexport function scrollTop(node) {\n return function () {\n return node.scrollTop;\n };\n}\n\nexport function setScrollTop(scrollTop) {\n return function (node) {\n return function () {\n node.scrollTop = scrollTop;\n };\n };\n}\n\nexport function scrollLeft(node) {\n return function () {\n return node.scrollLeft;\n };\n}\n\nexport function setScrollLeft(scrollLeft) {\n return function (node) {\n return function () {\n node.scrollLeft = scrollLeft;\n };\n };\n}\n\nexport function scrollWidth(el) {\n return function () {\n return el.scrollWidth;\n };\n}\n\nexport function scrollHeight(el) {\n return function () {\n return el.scrollHeight;\n };\n}\n\nexport function clientTop(el) {\n return function () {\n return el.clientTop;\n };\n}\n\nexport function clientLeft(el) {\n return function () {\n return el.clientLeft;\n };\n}\n\nexport function clientWidth(el) {\n return function () {\n return el.clientWidth;\n };\n}\n\nexport function clientHeight(el) {\n return function () {\n return el.clientHeight;\n };\n}\n\nexport function getBoundingClientRect(el) {\n return function () {\n var rect = el.getBoundingClientRect();\n return {\n top: rect.top,\n right: rect.right,\n bottom: rect.bottom,\n left: rect.left,\n width: rect.width,\n height: rect.height,\n x: rect.x,\n y: rect.y\n };\n };\n}\n\nexport function _attachShadow(props) {\n return function (el) {\n return function() {\n return el.attachShadow(props);\n };\n };\n}\n", "var getEffProp = function (name) {\n return function (node) {\n return function () {\n return node[name];\n };\n };\n};\n\nexport const children = getEffProp(\"children\");\nexport const _firstElementChild = getEffProp(\"firstElementChild\");\nexport const _lastElementChild = getEffProp(\"lastElementChild\");\nexport const childElementCount = getEffProp(\"childElementCount\");\n\nexport function _querySelector(selector) {\n return function (node) {\n return function () {\n return node.querySelector(selector);\n };\n };\n}\n\nexport function querySelectorAll(selector) {\n return function (node) {\n return function () {\n return node.querySelectorAll(selector);\n };\n };\n}\n", "module Web.DOM.ParentNode\n ( ParentNode\n , children\n , firstElementChild\n , lastElementChild\n , childElementCount\n , QuerySelector(..)\n , querySelector\n , querySelectorAll\n ) where\n\nimport Prelude\n\nimport Data.Maybe (Maybe)\nimport Data.Newtype (class Newtype)\nimport Data.Nullable (Nullable, toMaybe)\nimport Effect (Effect)\nimport Web.DOM.Internal.Types (Element)\nimport Web.DOM.HTMLCollection (HTMLCollection)\nimport Web.DOM.NodeList (NodeList)\n\nforeign import data ParentNode :: Type\n\n-- | The child elements for the node.\nforeign import children :: ParentNode -> Effect HTMLCollection\n\n-- | The first child that is an element, or Nothing if no such element exists.\nfirstElementChild :: ParentNode -> Effect (Maybe Element)\nfirstElementChild = map toMaybe <<< _firstElementChild\n\nforeign import _firstElementChild :: ParentNode -> Effect (Nullable Element)\n\n-- | The last child that is an element, or Nothing if no such element exists.\nlastElementChild :: ParentNode -> Effect (Maybe Element)\nlastElementChild = map toMaybe <<< _lastElementChild\n\nforeign import _lastElementChild :: ParentNode -> Effect (Nullable Element)\n\n-- | The number of child elements.\nforeign import childElementCount :: ParentNode -> Effect Int\n\nnewtype QuerySelector = QuerySelector String\n\nderive newtype instance eqQuerySelector :: Eq QuerySelector\nderive newtype instance ordQuerySelector :: Ord QuerySelector\nderive instance newtypeQuerySelector :: Newtype QuerySelector _\n\n-- | Finds the first child that is an element that matches the selector(s), or\n-- | Nothing if no such element exists.\nquerySelector :: QuerySelector -> ParentNode -> Effect (Maybe Element)\nquerySelector qs = map toMaybe <<< _querySelector qs\n\nforeign import _querySelector :: QuerySelector -> ParentNode -> Effect (Nullable Element)\n\n-- | Finds all the child elements that matches the selector(s).\nforeign import querySelectorAll :: QuerySelector -> ParentNode -> Effect NodeList\n", "module Web.DOM.Element\n ( module Exports\n , fromNode\n , fromChildNode\n , fromNonDocumentTypeChildNode\n , fromParentNode\n , fromEventTarget\n , toNode\n , toChildNode\n , toNonDocumentTypeChildNode\n , toParentNode\n , toEventTarget\n , namespaceURI\n , prefix\n , localName\n , tagName\n , id\n , setId\n , className\n , classList\n , setClassName\n , getElementsByTagName\n , getElementsByTagNameNS\n , getElementsByClassName\n , setAttribute\n , getAttribute\n , hasAttribute\n , removeAttribute\n , matches\n , closest\n , scrollTop\n , setScrollTop\n , scrollLeft\n , setScrollLeft\n , scrollWidth\n , scrollHeight\n , clientTop\n , clientLeft\n , clientWidth\n , clientHeight\n , getBoundingClientRect\n , DOMRect\n , ShadowRootInit\n , attachShadow\n ) where\n\nimport Prelude\n\nimport Data.Maybe (Maybe)\nimport Data.Nullable (Nullable, toMaybe, toNullable)\nimport Effect (Effect)\nimport Unsafe.Coerce (unsafeCoerce)\nimport Web.DOM.ChildNode (ChildNode)\nimport Web.DOM.DOMTokenList (DOMTokenList)\nimport Web.DOM.Internal.Types (Element) as Exports\nimport Web.DOM.Internal.Types (Element, HTMLCollection, Node)\nimport Web.DOM.NonDocumentTypeChildNode (NonDocumentTypeChildNode)\nimport Web.DOM.ParentNode (QuerySelector) as Exports\nimport Web.DOM.ParentNode (ParentNode, QuerySelector)\nimport Web.DOM.ShadowRoot (ShadowRoot, ShadowRootMode)\nimport Web.Event.EventTarget (EventTarget)\nimport Web.Internal.FFI (unsafeReadProtoTagged)\n\nfromNode :: Node -> Maybe Element\nfromNode = unsafeReadProtoTagged \"Element\"\n\nfromChildNode :: ChildNode -> Maybe Element\nfromChildNode = unsafeReadProtoTagged \"Element\"\n\nfromNonDocumentTypeChildNode :: NonDocumentTypeChildNode -> Maybe Element\nfromNonDocumentTypeChildNode = unsafeReadProtoTagged \"Element\"\n\nfromParentNode :: ParentNode -> Maybe Element\nfromParentNode = unsafeReadProtoTagged \"Element\"\n\nfromEventTarget :: EventTarget -> Maybe Element\nfromEventTarget = unsafeReadProtoTagged \"Element\"\n\ntoNode :: Element -> Node\ntoNode = unsafeCoerce\n\ntoChildNode :: Element -> ChildNode\ntoChildNode = unsafeCoerce\n\ntoNonDocumentTypeChildNode :: Element -> NonDocumentTypeChildNode\ntoNonDocumentTypeChildNode = unsafeCoerce\n\ntoParentNode :: Element -> ParentNode\ntoParentNode = unsafeCoerce\n\ntoEventTarget :: Element -> EventTarget\ntoEventTarget = unsafeCoerce\n\nnamespaceURI :: Element -> Maybe String\nnamespaceURI = toMaybe <<< _namespaceURI\n\nprefix :: Element -> Maybe String\nprefix = toMaybe <<< _prefix\n\nforeign import _namespaceURI :: Element -> Nullable String\nforeign import _prefix :: Element -> Nullable String\nforeign import localName :: Element -> String\nforeign import tagName :: Element -> String\n\nforeign import id :: Element -> Effect String\nforeign import setId :: String -> Element -> Effect Unit\nforeign import className :: Element -> Effect String\nforeign import classList :: Element -> Effect DOMTokenList\nforeign import setClassName :: String -> Element -> Effect Unit\n\nforeign import getElementsByTagName :: String -> Element -> Effect HTMLCollection\n\ngetElementsByTagNameNS :: Maybe String -> String -> Element -> Effect HTMLCollection\ngetElementsByTagNameNS = _getElementsByTagNameNS <<< toNullable\n\nforeign import _getElementsByTagNameNS :: Nullable String -> String -> Element -> Effect HTMLCollection\n\nforeign import getElementsByClassName :: String -> Element -> Effect HTMLCollection\n\nforeign import setAttribute :: String -> String -> Element -> Effect Unit\n\ngetAttribute :: String -> Element -> Effect (Maybe String)\ngetAttribute attr = map toMaybe <<< _getAttribute attr\n\nforeign import _getAttribute :: String -> Element -> Effect (Nullable String)\nforeign import hasAttribute :: String -> Element -> Effect Boolean\nforeign import removeAttribute :: String -> Element -> Effect Unit\n\nforeign import matches :: QuerySelector -> Element -> Effect Boolean\n\nclosest :: QuerySelector -> Element -> Effect (Maybe Element)\nclosest qs = map toMaybe <<< _closest qs\n\nforeign import _closest :: QuerySelector -> Element -> Effect (Nullable Element)\n\nforeign import scrollTop :: Element -> Effect Number\nforeign import setScrollTop :: Number -> Element -> Effect Unit\n\nforeign import scrollLeft :: Element -> Effect Number\nforeign import setScrollLeft :: Number -> Element -> Effect Unit\n\nforeign import scrollWidth :: Element -> Effect Number\nforeign import scrollHeight :: Element -> Effect Number\nforeign import clientTop :: Element -> Effect Number\nforeign import clientLeft :: Element -> Effect Number\nforeign import clientWidth :: Element -> Effect Number\nforeign import clientHeight :: Element -> Effect Number\n\ntype DOMRect =\n { top :: Number\n , right :: Number\n , bottom :: Number\n , left :: Number\n , width :: Number\n , height :: Number\n , x :: Number\n , y :: Number\n }\n\nforeign import getBoundingClientRect :: Element -> Effect DOMRect\n\ntype ShadowRootInit = {\n mode :: ShadowRootMode,\n delegatesFocus :: Boolean\n}\n\nattachShadow :: ShadowRootInit -> Element -> Effect ShadowRoot\nattachShadow = _attachShadow <<< initToProps\n\ntype ShadowRootProps = {\n mode :: String,\n delegatesFocus :: Boolean\n}\n\ninitToProps :: ShadowRootInit -> ShadowRootProps\ninitToProps init = {\n mode: show init.mode,\n delegatesFocus: init.delegatesFocus\n}\n\nforeign import _attachShadow :: ShadowRootProps -> Element -> Effect ShadowRoot\n", "module Halogen.VDom.DOM\n ( VDomSpec(..)\n , buildVDom\n , buildText\n , buildElem\n , buildKeyed\n , buildWidget\n ) where\n\nimport Prelude\n\nimport Data.Array as Array\nimport Data.Function.Uncurried as Fn\nimport Data.Maybe (Maybe(..))\nimport Data.Nullable (toNullable)\nimport Data.Tuple (Tuple(..), fst)\nimport Effect.Uncurried as EFn\nimport Foreign.Object as Object\nimport Halogen.VDom.Machine (Machine, Step, Step'(..), extract, halt, mkStep, step, unStep)\nimport Halogen.VDom.Machine as Machine\nimport Halogen.VDom.Types (ElemName(..), Namespace(..), VDom(..), runGraft)\nimport Halogen.VDom.Util as Util\nimport Web.DOM.Document (Document) as DOM\nimport Web.DOM.Element (Element) as DOM\nimport Web.DOM.Element as DOMElement\nimport Web.DOM.Node (Node) as DOM\n\ntype VDomMachine a w = Machine (VDom a w) DOM.Node\n\ntype VDomStep a w = Step (VDom a w) DOM.Node\n\ntype VDomInit i a w = EFn.EffectFn1 i (VDomStep a w)\n\ntype VDomBuilder i a w = EFn.EffectFn3 (VDomSpec a w) (VDomMachine a w) i (VDomStep a w)\n\ntype VDomBuilder4 i j k l a w = EFn.EffectFn6 (VDomSpec a w) (VDomMachine a w) i j k l (VDomStep a w)\n\n-- | Widget machines recursively reference the configured spec to potentially\n-- | enable recursive trees of Widgets.\nnewtype VDomSpec a w = VDomSpec\n { buildWidget \u2237 VDomSpec a w \u2192 Machine w DOM.Node\n , buildAttributes \u2237 DOM.Element \u2192 Machine a Unit\n , document \u2237 DOM.Document\n }\n\n-- | Starts an initial `VDom` machine by providing a `VDomSpec`.\n-- |\n-- | ```purescript\n-- | main = do\n-- | machine1 \u2190 buildVDom spec vdomTree1\n-- | machine2 \u2190 Machine.step machine1 vdomTree2\n-- | machine3 \u2190 Machine.step machine2 vdomTree3\n-- | ...\n-- | ````\nbuildVDom \u2237 \u2200 a w. VDomSpec a w \u2192 VDomMachine a w\nbuildVDom spec = build\n where\n build = EFn.mkEffectFn1 case _ of\n Text s \u2192 EFn.runEffectFn3 buildText spec build s\n Elem ns n a ch \u2192 EFn.runEffectFn6 buildElem spec build ns n a ch\n Keyed ns n a ch \u2192 EFn.runEffectFn6 buildKeyed spec build ns n a ch\n Widget w \u2192 EFn.runEffectFn3 buildWidget spec build w\n Grafted g \u2192 EFn.runEffectFn1 build (runGraft g)\n\ntype TextState a w =\n { build \u2237 VDomMachine a w\n , node \u2237 DOM.Node\n , value \u2237 String\n }\n\nbuildText \u2237 \u2200 a w. VDomBuilder String a w\nbuildText = EFn.mkEffectFn3 \\(VDomSpec spec) build s \u2192 do\n node \u2190 EFn.runEffectFn2 Util.createTextNode s spec.document\n let state = { build, node, value: s }\n pure $ mkStep $ Step node state patchText haltText\n\npatchText \u2237 \u2200 a w. EFn.EffectFn2 (TextState a w) (VDom a w) (VDomStep a w)\npatchText = EFn.mkEffectFn2 \\state vdom \u2192 do\n let { build, node, value: value1 } = state\n case vdom of\n Grafted g \u2192\n EFn.runEffectFn2 patchText state (runGraft g)\n Text value2\n | value1 == value2 \u2192\n pure $ mkStep $ Step node state patchText haltText\n | otherwise \u2192 do\n let nextState = { build, node, value: value2 }\n EFn.runEffectFn2 Util.setTextContent value2 node\n pure $ mkStep $ Step node nextState patchText haltText\n _ \u2192 do\n EFn.runEffectFn1 haltText state\n EFn.runEffectFn1 build vdom\n\nhaltText \u2237 \u2200 a w. EFn.EffectFn1 (TextState a w) Unit\nhaltText = EFn.mkEffectFn1 \\{ node } \u2192 do\n parent \u2190 EFn.runEffectFn1 Util.parentNode node\n EFn.runEffectFn2 Util.removeChild node parent\n\ntype ElemState a w =\n { build \u2237 VDomMachine a w\n , node \u2237 DOM.Node\n , attrs \u2237 Step a Unit\n , ns \u2237 Maybe Namespace\n , name \u2237 ElemName\n , children \u2237 Array (VDomStep a w)\n }\n\nbuildElem \u2237 \u2200 a w. VDomBuilder4 (Maybe Namespace) ElemName a (Array (VDom a w)) a w\nbuildElem = EFn.mkEffectFn6 \\(VDomSpec spec) build ns1 name1 as1 ch1 \u2192 do\n el \u2190 EFn.runEffectFn3 Util.createElement (toNullable ns1) name1 spec.document\n let\n node = DOMElement.toNode el\n onChild = EFn.mkEffectFn2 \\ix child \u2192 do\n res \u2190 EFn.runEffectFn1 build child\n EFn.runEffectFn3 Util.insertChildIx ix (extract res) node\n pure res\n children \u2190 EFn.runEffectFn2 Util.forE ch1 onChild\n attrs \u2190 EFn.runEffectFn1 (spec.buildAttributes el) as1\n let\n state =\n { build\n , node\n , attrs\n , ns: ns1\n , name: name1\n , children\n }\n pure $ mkStep $ Step node state patchElem haltElem\n\npatchElem \u2237 \u2200 a w. EFn.EffectFn2 (ElemState a w) (VDom a w) (VDomStep a w)\npatchElem = EFn.mkEffectFn2 \\state vdom \u2192 do\n let { build, node, attrs, ns: ns1, name: name1, children: ch1 } = state\n case vdom of\n Grafted g \u2192\n EFn.runEffectFn2 patchElem state (runGraft g)\n Elem ns2 name2 as2 ch2 | Fn.runFn4 eqElemSpec ns1 name1 ns2 name2 \u2192 do\n case Array.length ch1, Array.length ch2 of\n 0, 0 \u2192 do\n attrs2 \u2190 EFn.runEffectFn2 step attrs as2\n let\n nextState =\n { build\n , node\n , attrs: attrs2\n , ns: ns2\n , name: name2\n , children: ch1\n }\n pure $ mkStep $ Step node nextState patchElem haltElem\n _, _ \u2192 do\n let\n onThese = EFn.mkEffectFn3 \\ix s v \u2192 do\n res \u2190 EFn.runEffectFn2 step s v\n EFn.runEffectFn3 Util.insertChildIx ix (extract res) node\n pure res\n onThis = EFn.mkEffectFn2 \\_ s \u2192 EFn.runEffectFn1 halt s\n onThat = EFn.mkEffectFn2 \\ix v \u2192 do\n res \u2190 EFn.runEffectFn1 build v\n EFn.runEffectFn3 Util.insertChildIx ix (extract res) node\n pure res\n children2 \u2190 EFn.runEffectFn5 Util.diffWithIxE ch1 ch2 onThese onThis onThat\n attrs2 \u2190 EFn.runEffectFn2 step attrs as2\n let\n nextState =\n { build\n , node\n , attrs: attrs2\n , ns: ns2\n , name: name2\n , children: children2\n }\n pure $ mkStep $ Step node nextState patchElem haltElem\n _ \u2192 do\n EFn.runEffectFn1 haltElem state\n EFn.runEffectFn1 build vdom\n\nhaltElem \u2237 \u2200 a w. EFn.EffectFn1 (ElemState a w) Unit\nhaltElem = EFn.mkEffectFn1 \\{ node, attrs, children } \u2192 do\n parent \u2190 EFn.runEffectFn1 Util.parentNode node\n EFn.runEffectFn2 Util.removeChild node parent\n EFn.runEffectFn2 Util.forEachE children halt\n EFn.runEffectFn1 halt attrs\n\ntype KeyedState a w =\n { build \u2237 VDomMachine a w\n , node \u2237 DOM.Node\n , attrs \u2237 Step a Unit\n , ns \u2237 Maybe Namespace\n , name \u2237 ElemName\n , children \u2237 Object.Object (VDomStep a w)\n , length \u2237 Int\n }\n\nbuildKeyed \u2237 \u2200 a w. VDomBuilder4 (Maybe Namespace) ElemName a (Array (Tuple String (VDom a w))) a w\nbuildKeyed = EFn.mkEffectFn6 \\(VDomSpec spec) build ns1 name1 as1 ch1 \u2192 do\n el \u2190 EFn.runEffectFn3 Util.createElement (toNullable ns1) name1 spec.document\n let\n node = DOMElement.toNode el\n onChild = EFn.mkEffectFn3 \\_ ix (Tuple _ vdom) \u2192 do\n res \u2190 EFn.runEffectFn1 build vdom\n EFn.runEffectFn3 Util.insertChildIx ix (extract res) node\n pure res\n children \u2190 EFn.runEffectFn3 Util.strMapWithIxE ch1 fst onChild\n attrs \u2190 EFn.runEffectFn1 (spec.buildAttributes el) as1\n let\n state =\n { build\n , node\n , attrs\n , ns: ns1\n , name: name1\n , children\n , length: Array.length ch1\n }\n pure $ mkStep $ Step node state patchKeyed haltKeyed\n\npatchKeyed \u2237 \u2200 a w. EFn.EffectFn2 (KeyedState a w) (VDom a w) (VDomStep a w)\npatchKeyed = EFn.mkEffectFn2 \\state vdom \u2192 do\n let { build, node, attrs, ns: ns1, name: name1, children: ch1, length: len1 } = state\n case vdom of\n Grafted g \u2192\n EFn.runEffectFn2 patchKeyed state (runGraft g)\n Keyed ns2 name2 as2 ch2 | Fn.runFn4 eqElemSpec ns1 name1 ns2 name2 \u2192\n case len1, Array.length ch2 of\n 0, 0 \u2192 do\n attrs2 \u2190 EFn.runEffectFn2 Machine.step attrs as2\n let\n nextState =\n { build\n , node\n , attrs: attrs2\n , ns: ns2\n , name: name2\n , children: ch1\n , length: 0\n }\n pure $ mkStep $ Step node nextState patchKeyed haltKeyed\n _, len2 \u2192 do\n let\n onThese = EFn.mkEffectFn4 \\_ ix' s (Tuple _ v) \u2192 do\n res \u2190 EFn.runEffectFn2 step s v\n EFn.runEffectFn3 Util.insertChildIx ix' (extract res) node\n pure res\n onThis = EFn.mkEffectFn2 \\_ s \u2192 EFn.runEffectFn1 halt s\n onThat = EFn.mkEffectFn3 \\_ ix (Tuple _ v) \u2192 do\n res \u2190 EFn.runEffectFn1 build v\n EFn.runEffectFn3 Util.insertChildIx ix (extract res) node\n pure res\n children2 \u2190 EFn.runEffectFn6 Util.diffWithKeyAndIxE ch1 ch2 fst onThese onThis onThat\n attrs2 \u2190 EFn.runEffectFn2 step attrs as2\n let\n nextState =\n { build\n , node\n , attrs: attrs2\n , ns: ns2\n , name: name2\n , children: children2\n , length: len2\n }\n pure $ mkStep $ Step node nextState patchKeyed haltKeyed\n _ \u2192 do\n EFn.runEffectFn1 haltKeyed state\n EFn.runEffectFn1 build vdom\n\nhaltKeyed \u2237 \u2200 a w. EFn.EffectFn1 (KeyedState a w) Unit\nhaltKeyed = EFn.mkEffectFn1 \\{ node, attrs, children } \u2192 do\n parent \u2190 EFn.runEffectFn1 Util.parentNode node\n EFn.runEffectFn2 Util.removeChild node parent\n EFn.runEffectFn2 Util.forInE children (EFn.mkEffectFn2 \\_ s \u2192 EFn.runEffectFn1 halt s)\n EFn.runEffectFn1 halt attrs\n\ntype WidgetState a w =\n { build \u2237 VDomMachine a w\n , widget \u2237 Step w DOM.Node\n }\n\nbuildWidget \u2237 \u2200 a w. VDomBuilder w a w\nbuildWidget = EFn.mkEffectFn3 \\(VDomSpec spec) build w \u2192 do\n res \u2190 EFn.runEffectFn1 (spec.buildWidget (VDomSpec spec)) w\n let\n res' = res # unStep \\(Step n _ _ _) \u2192\n mkStep $ Step n { build, widget: res } patchWidget haltWidget\n pure res'\n\npatchWidget \u2237 \u2200 a w. EFn.EffectFn2 (WidgetState a w) (VDom a w) (VDomStep a w)\npatchWidget = EFn.mkEffectFn2 \\state vdom \u2192 do\n let { build, widget } = state\n case vdom of\n Grafted g \u2192\n EFn.runEffectFn2 patchWidget state (runGraft g)\n Widget w \u2192 do\n res \u2190 EFn.runEffectFn2 step widget w\n let\n res' = res # unStep \\(Step n _ _ _) \u2192\n mkStep $ Step n { build, widget: res } patchWidget haltWidget\n pure res'\n _ \u2192 do\n EFn.runEffectFn1 haltWidget state\n EFn.runEffectFn1 build vdom\n\nhaltWidget \u2237 forall a w. EFn.EffectFn1 (WidgetState a w) Unit\nhaltWidget = EFn.mkEffectFn1 \\{ widget } \u2192 do\n EFn.runEffectFn1 halt widget\n\neqElemSpec \u2237 Fn.Fn4 (Maybe Namespace) ElemName (Maybe Namespace) ElemName Boolean\neqElemSpec = Fn.mkFn4 \\ns1 (ElemName name1) ns2 (ElemName name2) \u2192\n if name1 == name2\n then case ns1, ns2 of\n Just (Namespace ns1'), Just (Namespace ns2') | ns1' == ns2' \u2192 true\n Nothing, Nothing \u2192 true\n _, _ \u2192 false\n else false\n", "export function eventListener(fn) {\n return function () {\n return function (event) {\n return fn(event)();\n };\n };\n}\n\nexport function addEventListenerWithOptions(type) {\n return function (listener) {\n return function (options) {\n return function (target) {\n return function () {\n return target.addEventListener(type, listener, options);\n };\n };\n };\n };\n}\n\nexport function addEventListener(type) {\n return function (listener) {\n return function (useCapture) {\n return function (target) {\n return function () {\n return target.addEventListener(type, listener, useCapture);\n };\n };\n };\n };\n}\n\nexport function removeEventListener(type) {\n return function (listener) {\n return function (useCapture) {\n return function (target) {\n return function () {\n return target.removeEventListener(type, listener, useCapture);\n };\n };\n };\n };\n}\n\nexport function dispatchEvent(event) {\n return function (target) {\n return function () {\n return target.dispatchEvent(event);\n };\n };\n}\n", "module Halogen.VDom.DOM.Prop\n ( Prop(..)\n , ElemRef(..)\n , PropValue\n , propFromString\n , propFromBoolean\n , propFromInt\n , propFromNumber\n , buildProp\n ) where\n\nimport Prelude\n\nimport Data.Function.Uncurried as Fn\nimport Data.Maybe (Maybe(..))\nimport Data.Nullable (null, toNullable)\nimport Data.Tuple (Tuple(..), fst, snd)\nimport Effect (Effect)\nimport Effect.Ref as Ref\nimport Effect.Uncurried as EFn\nimport Foreign (typeOf)\nimport Foreign.Object as Object\nimport Halogen.VDom as V\nimport Halogen.VDom.Machine (Step'(..), mkStep)\nimport Halogen.VDom.Types (Namespace(..))\nimport Halogen.VDom.Util as Util\nimport Unsafe.Coerce (unsafeCoerce)\nimport Web.DOM.Element (Element) as DOM\nimport Web.Event.Event (EventType(..), Event) as DOM\nimport Web.Event.EventTarget (eventListener) as DOM\n\n-- | Attributes, properties, event handlers, and element lifecycles.\n-- | Parameterized by the type of handlers outputs.\ndata Prop a\n = Attribute (Maybe Namespace) String String\n | Property String PropValue\n | Handler DOM.EventType (DOM.Event \u2192 Maybe a)\n | Ref (ElemRef DOM.Element \u2192 Maybe a)\n\ninstance functorProp \u2237 Functor Prop where\n map f (Handler ty g) = Handler ty (map f <$> g)\n map f (Ref g) = Ref (map f <$> g)\n map _ p = unsafeCoerce p\n\ndata ElemRef a\n = Created a\n | Removed a\n\ninstance functorElemRef \u2237 Functor ElemRef where\n map f (Created a) = Created (f a)\n map f (Removed a) = Removed (f a)\n\nforeign import data PropValue \u2237 Type\n\npropFromString \u2237 String \u2192 PropValue\npropFromString = unsafeCoerce\n\npropFromBoolean \u2237 Boolean \u2192 PropValue\npropFromBoolean = unsafeCoerce\n\npropFromInt \u2237 Int \u2192 PropValue\npropFromInt = unsafeCoerce\n\npropFromNumber \u2237 Number \u2192 PropValue\npropFromNumber = unsafeCoerce\n\n-- | A `Machine`` for applying attributes, properties, and event handlers.\n-- | An emitter effect must be provided to respond to events. For example,\n-- | to allow arbitrary effects in event handlers, one could use `id`.\nbuildProp\n \u2237 \u2200 a\n . (a \u2192 Effect Unit)\n \u2192 DOM.Element\n \u2192 V.Machine (Array (Prop a)) Unit\nbuildProp emit el = renderProp\n where\n renderProp = EFn.mkEffectFn1 \\ps1 \u2192 do\n events \u2190 Util.newMutMap\n ps1' \u2190 EFn.runEffectFn3 Util.strMapWithIxE ps1 propToStrKey (applyProp events)\n let\n state =\n { events: Util.unsafeFreeze events\n , props: ps1'\n }\n pure $ mkStep $ Step unit state patchProp haltProp\n\n patchProp = EFn.mkEffectFn2 \\state ps2 \u2192 do\n events \u2190 Util.newMutMap\n let\n { events: prevEvents, props: ps1 } = state\n onThese = Fn.runFn2 diffProp prevEvents events\n onThis = removeProp prevEvents\n onThat = applyProp events\n props \u2190 EFn.runEffectFn6 Util.diffWithKeyAndIxE ps1 ps2 propToStrKey onThese onThis onThat\n let\n nextState =\n { events: Util.unsafeFreeze events\n , props\n }\n pure $ mkStep $ Step unit nextState patchProp haltProp\n\n haltProp = EFn.mkEffectFn1 \\state \u2192 do\n case Object.lookup \"ref\" state.props of\n Just (Ref f) \u2192\n EFn.runEffectFn1 mbEmit (f (Removed el))\n _ \u2192 pure unit\n\n mbEmit = EFn.mkEffectFn1 case _ of\n Just a \u2192 emit a\n _ \u2192 pure unit\n\n applyProp events = EFn.mkEffectFn3 \\_ _ v \u2192\n case v of\n Attribute ns attr val \u2192 do\n EFn.runEffectFn4 Util.setAttribute (toNullable ns) attr val el\n pure v\n Property prop val \u2192 do\n EFn.runEffectFn3 setProperty prop val el\n pure v\n Handler (DOM.EventType ty) f \u2192 do\n case Fn.runFn2 Util.unsafeGetAny ty events of\n handler | Fn.runFn2 Util.unsafeHasAny ty events \u2192 do\n Ref.write f (snd handler)\n pure v\n _ \u2192 do\n ref \u2190 Ref.new f\n listener \u2190 DOM.eventListener \\ev \u2192 do\n f' \u2190 Ref.read ref\n EFn.runEffectFn1 mbEmit (f' ev)\n EFn.runEffectFn3 Util.pokeMutMap ty (Tuple listener ref) events\n EFn.runEffectFn3 Util.addEventListener ty listener el\n pure v\n Ref f \u2192 do\n EFn.runEffectFn1 mbEmit (f (Created el))\n pure v\n\n diffProp = Fn.mkFn2 \\prevEvents events \u2192 EFn.mkEffectFn4 \\_ _ v1 v2 \u2192\n case v1, v2 of\n Attribute _ _ val1, Attribute ns2 attr2 val2 \u2192\n if val1 == val2\n then pure v2\n else do\n EFn.runEffectFn4 Util.setAttribute (toNullable ns2) attr2 val2 el\n pure v2\n Property _ val1, Property prop2 val2 \u2192\n case Fn.runFn2 Util.refEq val1 val2, prop2 of\n true, _ \u2192\n pure v2\n _, \"value\" \u2192 do\n let elVal = Fn.runFn2 unsafeGetProperty \"value\" el\n if Fn.runFn2 Util.refEq elVal val2\n then pure v2\n else do\n EFn.runEffectFn3 setProperty prop2 val2 el\n pure v2\n _, _ \u2192 do\n EFn.runEffectFn3 setProperty prop2 val2 el\n pure v2\n Handler _ _, Handler (DOM.EventType ty) f \u2192 do\n let\n handler = Fn.runFn2 Util.unsafeLookup ty prevEvents\n Ref.write f (snd handler)\n EFn.runEffectFn3 Util.pokeMutMap ty handler events\n pure v2\n _, _ \u2192\n pure v2\n\n removeProp prevEvents = EFn.mkEffectFn2 \\_ v \u2192\n case v of\n Attribute ns attr _ \u2192\n EFn.runEffectFn3 Util.removeAttribute (toNullable ns) attr el\n Property prop _ \u2192\n EFn.runEffectFn2 removeProperty prop el\n Handler (DOM.EventType ty) _ \u2192 do\n let\n handler = Fn.runFn2 Util.unsafeLookup ty prevEvents\n EFn.runEffectFn3 Util.removeEventListener ty (fst handler) el\n Ref _ \u2192\n pure unit\n\npropToStrKey \u2237 \u2200 i. Prop i \u2192 String\npropToStrKey = case _ of\n Attribute (Just (Namespace ns)) attr _ \u2192 \"attr/\" <> ns <> \":\" <> attr\n Attribute _ attr _ \u2192 \"attr/:\" <> attr\n Property prop _ \u2192 \"prop/\" <> prop\n Handler (DOM.EventType ty) _ \u2192 \"handler/\" <> ty\n Ref _ \u2192 \"ref\"\n\nsetProperty \u2237 EFn.EffectFn3 String PropValue DOM.Element Unit\nsetProperty = Util.unsafeSetAny\n\nunsafeGetProperty \u2237 Fn.Fn2 String DOM.Element PropValue\nunsafeGetProperty = Util.unsafeGetAny\n\nremoveProperty \u2237 EFn.EffectFn2 String DOM.Element Unit\nremoveProperty = EFn.mkEffectFn2 \\key el \u2192\n EFn.runEffectFn3 Util.hasAttribute null key el >>= if _\n then EFn.runEffectFn3 Util.removeAttribute null key el\n else case typeOf (Fn.runFn2 Util.unsafeGetAny key el) of\n \"string\" \u2192 EFn.runEffectFn3 Util.unsafeSetAny key \"\" el\n _ \u2192 case key of\n \"rowSpan\" \u2192 EFn.runEffectFn3 Util.unsafeSetAny key 1 el\n \"colSpan\" \u2192 EFn.runEffectFn3 Util.unsafeSetAny key 1 el\n _ \u2192 EFn.runEffectFn3 Util.unsafeSetAny key Util.jsUndefined el\n", "module Halogen.HTML.Core\n ( HTML(..)\n , renderWidget\n , widget\n , text\n , element\n , keyed\n , prop\n , attr\n , handler\n , ref\n , class IsProp\n , toPropValue\n , module Exports\n ) where\n\nimport Prelude\n\nimport DOM.HTML.Indexed.AutocompleteType (AutocompleteType, renderAutocompleteType)\nimport DOM.HTML.Indexed.ButtonType (ButtonType, renderButtonType)\nimport DOM.HTML.Indexed.CrossOriginValue (CrossOriginValue, renderCrossOriginValue)\nimport DOM.HTML.Indexed.DirValue (DirValue, renderDirValue)\nimport DOM.HTML.Indexed.FormMethod (FormMethod, renderFormMethod)\nimport DOM.HTML.Indexed.InputAcceptType (InputAcceptType, renderInputAcceptType)\nimport DOM.HTML.Indexed.InputType (InputType, renderInputType)\nimport DOM.HTML.Indexed.KindValue (KindValue, renderKindValue)\nimport DOM.HTML.Indexed.MenuType (MenuType, renderMenuType)\nimport DOM.HTML.Indexed.MenuitemType (MenuitemType, renderMenuitemType)\nimport DOM.HTML.Indexed.OrderedListType (OrderedListType, renderOrderedListType)\nimport DOM.HTML.Indexed.PreloadValue (PreloadValue, renderPreloadValue)\nimport DOM.HTML.Indexed.ScopeValue (ScopeValue, renderScopeValue)\nimport DOM.HTML.Indexed.StepValue (StepValue, renderStepValue)\nimport DOM.HTML.Indexed.WrapValue (WrapValue, renderWrapValue)\nimport Data.Bifunctor (class Bifunctor, bimap, rmap)\nimport Data.Maybe (Maybe(..))\nimport Data.MediaType (MediaType)\nimport Data.Newtype (class Newtype, un, unwrap)\nimport Data.Tuple (Tuple)\nimport Halogen.Query.Input (Input)\nimport Halogen.VDom (ElemName(..), Namespace(..)) as Exports\nimport Halogen.VDom.DOM.Prop (ElemRef(..), Prop(..), PropValue, propFromBoolean, propFromInt, propFromNumber, propFromString)\nimport Halogen.VDom.DOM.Prop (Prop(..), PropValue) as Exports\nimport Halogen.VDom.Types as VDom\nimport Unsafe.Coerce (unsafeCoerce)\nimport Web.DOM.Element (Element)\nimport Web.Event.Event (Event, EventType)\nimport Web.HTML.Common (AttrName(..), ClassName(..), PropName(..)) as Exports\nimport Web.HTML.Common (AttrName(..), PropName(..))\n\nnewtype HTML w i = HTML (VDom.VDom (Array (Prop (Input i))) w)\n\nderive instance newtypeHTML :: Newtype (HTML w i) _\n\ninstance bifunctorHTML :: Bifunctor HTML where\n bimap f g (HTML vdom) = HTML (bimap (map (map (map g))) f vdom)\n\ninstance functorHTML :: Functor (HTML p) where\n map = rmap\n\nrenderWidget :: forall w x i j. (i -> j) -> (w -> HTML x j) -> HTML w i -> HTML x j\nrenderWidget f g (HTML vdom) =\n HTML (VDom.renderWidget (map (map (map f))) (un HTML <<< g) vdom)\n\nwidget :: forall p q. p -> HTML p q\nwidget = HTML <<< VDom.Widget\n\n-- | Constructs a text node `HTML` value.\ntext :: forall w i. String -> HTML w i\ntext = HTML <<< VDom.Text\n\n-- | A smart constructor for HTML elements.\nelement :: forall w i. Maybe VDom.Namespace -> VDom.ElemName -> Array (Prop i) -> Array (HTML w i) -> HTML w i\nelement ns =\n coe (\\name props children -> VDom.Elem ns name props children)\n where\n coe\n :: (VDom.ElemName -> Array (Prop i) -> Array (VDom.VDom (Array (Prop i)) w) -> VDom.VDom (Array (Prop i)) w)\n -> VDom.ElemName\n -> Array (Prop i)\n -> Array (HTML w i)\n -> HTML w i\n coe = unsafeCoerce\n\n-- | A smart constructor for HTML elements with keyed children.\nkeyed :: forall w i. Maybe VDom.Namespace -> VDom.ElemName -> Array (Prop i) -> Array (Tuple String (HTML w i)) -> HTML w i\nkeyed ns = coe (\\name props children -> VDom.Keyed ns name props children)\n where\n coe\n :: (VDom.ElemName -> Array (Prop i) -> Array (Tuple String (VDom.VDom (Array (Prop i)) w)) -> VDom.VDom (Array (Prop i)) w)\n -> VDom.ElemName\n -> Array (Prop i)\n -> Array (Tuple String (HTML w i))\n -> HTML w i\n coe = unsafeCoerce\n\n-- | Create a HTML property.\nprop :: forall value i. IsProp value => PropName value -> value -> Prop i\nprop (PropName name) = Property name <<< toPropValue\n\n-- | Create a HTML attribute.\nattr :: forall i. Maybe VDom.Namespace -> AttrName -> String -> Prop i\nattr ns (AttrName name) = Attribute ns name\n\n-- | Create an event handler.\nhandler :: forall i. EventType -> (Event -> Maybe i) -> Prop i\nhandler = Handler\n\nref :: forall i. (Maybe Element -> Maybe i) -> Prop i\nref f = Ref $ f <<< case _ of\n Created x -> Just x\n Removed _ -> Nothing\n\nclass IsProp a where\n toPropValue :: a -> PropValue\n\ninstance isPropString :: IsProp String where\n toPropValue = propFromString\n\ninstance isPropInt :: IsProp Int where\n toPropValue = propFromInt\n\ninstance isPropNumber :: IsProp Number where\n toPropValue = propFromNumber\n\ninstance isPropBoolean :: IsProp Boolean where\n toPropValue = propFromBoolean\n\ninstance isPropMediaType :: IsProp MediaType where\n toPropValue = propFromString <<< unwrap\n\ninstance isPropButtonType :: IsProp ButtonType where\n toPropValue = propFromString <<< renderButtonType\n\ninstance isPropCrossOriginValue :: IsProp CrossOriginValue where\n toPropValue = propFromString <<< renderCrossOriginValue\n\ninstance isPropDirValue :: IsProp DirValue where\n toPropValue = propFromString <<< renderDirValue\n\ninstance isPropFormMethod :: IsProp FormMethod where\n toPropValue = propFromString <<< renderFormMethod\n\ninstance isPropInputType :: IsProp InputType where\n toPropValue = propFromString <<< renderInputType\n\ninstance isPropKindValue :: IsProp KindValue where\n toPropValue = propFromString <<< renderKindValue\n\ninstance isPropMenuitemType :: IsProp MenuitemType where\n toPropValue = propFromString <<< renderMenuitemType\n\ninstance isPropMenuType :: IsProp MenuType where\n toPropValue = propFromString <<< renderMenuType\n\ninstance isPropAutocompleteType :: IsProp AutocompleteType where\n toPropValue = propFromString <<< renderAutocompleteType\n\ninstance isPropOrderedListType :: IsProp OrderedListType where\n toPropValue = propFromString <<< renderOrderedListType\n\ninstance isPropPreloadValue :: IsProp PreloadValue where\n toPropValue = propFromString <<< renderPreloadValue\n\ninstance isPropScopeValue :: IsProp ScopeValue where\n toPropValue = propFromString <<< renderScopeValue\n\ninstance isPropStepValue :: IsProp StepValue where\n toPropValue = propFromString <<< renderStepValue\n\ninstance isPropWrapValue :: IsProp WrapValue where\n toPropValue = propFromString <<< renderWrapValue\n\ninstance isPropInputAcceptType :: IsProp InputAcceptType where\n toPropValue = propFromString <<< renderInputAcceptType\n", "module Control.Applicative.Free\n ( FreeAp\n , liftFreeAp\n , retractFreeAp\n , foldFreeAp\n , hoistFreeAp\n , analyzeFreeAp\n ) where\n\nimport Prelude\n\nimport Data.Const (Const(..))\nimport Data.Either (Either(..))\nimport Data.List (List(..))\nimport Data.List.NonEmpty as NEL\nimport Data.Newtype (unwrap)\nimport Data.NonEmpty ((:|))\nimport Data.Tuple (Tuple(..))\nimport Unsafe.Coerce (unsafeCoerce)\n\n-- | The free applicative functor for a type constructor `f`.\ndata FreeAp f a\n = Pure a\n | Lift (f a)\n | Ap (FreeAp f (Val -> a)) (FreeAp f Val)\n\ndata Val\n\n-- | Lift a value described by the type constructor `f` into\n-- | the free applicative functor.\nliftFreeAp :: forall f a. f a -> FreeAp f a\nliftFreeAp = Lift\n\ntype ApFunc g = { func :: g (Val -> Val), count :: Int }\ntype FuncStack g = List (ApFunc g)\ntype ValStack f = NEL.NonEmptyList (FreeAp f Val)\ntype Stack f g = Tuple (FuncStack g) (ValStack f)\n\n-- | Run a free applicative functor with a natural transformation from\n-- | the type constructor `f` to the applicative functor `g`.\nfoldFreeAp :: forall f g a. Applicative g => (f ~> g) -> FreeAp f a -> g a\nfoldFreeAp nat z =\n unsafeToG $ go $ Tuple Nil (NEL.singleton $ unsafeToFVal z)\n where\n unsafeToG :: g Val -> g a\n unsafeToG = unsafeCoerce\n\n unsafeToFVal :: forall f' a'. FreeAp f' a' -> FreeAp f' Val\n unsafeToFVal = unsafeCoerce\n\n go :: Stack f g -> g Val\n go (Tuple fStack (NEL.NonEmptyList (val :| vals))) =\n case val of\n Pure a -> case goApply fStack vals (pure a) of\n Left x -> x\n Right s -> go s\n Lift a -> case goApply fStack vals (nat a) of\n Left x -> x\n Right s -> go s\n Ap l r ->\n let nextVals = NEL.NonEmptyList (r :| vals)\n in go $ goLeft fStack nextVals nat l 1\n\ngoApply\n :: forall f g\n . Applicative g\n => FuncStack g\n -> List (FreeAp f Val)\n -> g Val\n -> Either (g Val) (Stack f g)\ngoApply fStack vals gVal =\n case fStack of\n Nil -> Left gVal\n Cons f fs ->\n let gRes = f.func <*> gVal\n in if f.count == 1 then\n case fs of\n Nil ->\n -- here vals must be empty\n Left gRes\n _ -> goApply fs vals gRes\n else\n case vals of\n Nil -> Left gRes\n Cons val vals' ->\n Right $ Tuple\n (Cons { func: unsafeToGFunc gRes, count: f.count - 1 } fs)\n (NEL.NonEmptyList (val :| vals'))\n where\n unsafeToGFunc :: g Val -> g (Val -> Val)\n unsafeToGFunc = unsafeCoerce\n\ngoLeft\n :: forall f g\n . Applicative g\n => FuncStack g\n -> ValStack f\n -> (f ~> g)\n -> FreeAp f (Val -> Val)\n -> Int\n -> Stack f g\ngoLeft fStack valStack nat func count = case func of\n Pure a -> Tuple (Cons { func: pure a, count } fStack) valStack\n Lift a -> Tuple (Cons { func: nat a, count } fStack) valStack\n Ap l r -> goLeft fStack (NEL.cons r valStack) nat (unsafeToFunc l) (count + 1)\n where\n unsafeToFunc :: FreeAp f (Val -> Val -> Val) -> FreeAp f (Val -> Val)\n unsafeToFunc = unsafeCoerce\n\n-- | Run a free applicative functor using the applicative instance for\n-- | the type constructor `f`.\nretractFreeAp :: forall f a. Applicative f => FreeAp f a -> f a\nretractFreeAp = foldFreeAp identity\n\n-- | Natural transformation from `FreeAp f a` to `FreeAp g a` given a\n-- | natural transformation from `f` to `g`.\nhoistFreeAp :: forall f g a. (f ~> g) -> FreeAp f a -> FreeAp g a\nhoistFreeAp f = foldFreeAp (f >>> liftFreeAp)\n\n-- | Perform monoidal analysis over the free applicative functor `f`.\nanalyzeFreeAp :: forall f m a. Monoid m => (forall b. f b -> m) -> FreeAp f a -> m\nanalyzeFreeAp k = unwrap <<< foldFreeAp (Const <<< k)\n\nmkAp :: forall f a b. FreeAp f (b -> a) -> FreeAp f b -> FreeAp f a\nmkAp fba fb = Ap (coerceFunc fba) (coerceValue fb)\n where\n coerceFunc :: FreeAp f (b -> a) -> FreeAp f (Val -> a)\n coerceFunc = unsafeCoerce\n\n coerceValue :: FreeAp f b -> FreeAp f Val\n coerceValue = unsafeCoerce\n\ninstance functorFreeAp :: Functor (FreeAp f) where\n map f x = mkAp (Pure f) x\n\ninstance applyFreeAp :: Apply (FreeAp f) where\n apply fba fb = mkAp fba fb\n\ninstance applicativeFreeAp :: Applicative (FreeAp f) where\n pure = Pure\n", "-- | This module defines a strict double-ended queue.\n-- |\n-- | The queue implementation is based on a pair of lists where all\n-- | operations require `O(1)` amortized time.\n-- |\n-- | However, any single `uncons` operation may run in `O(n)` time.\n-- |\n-- | See [Simple and Efficient Purely Functional Queues and Dequeues](http://www.westpoint.edu/eecs/SiteAssets/SitePages/Faculty%20Publication%20Documents/Okasaki/jfp95queue.pdf) (Okasaki 1995)\nmodule Data.CatQueue\n ( CatQueue(..)\n , empty\n , null\n , singleton\n , length\n , cons\n , snoc\n , uncons\n , unsnoc\n , fromFoldable\n ) where\n\nimport Prelude\n\nimport Control.Alt (class Alt)\nimport Control.Alternative (class Alternative)\nimport Control.Apply (lift2)\nimport Control.MonadPlus (class MonadPlus)\nimport Control.Plus (class Plus)\nimport Data.Foldable (class Foldable, foldMap, foldMapDefaultL, foldl, foldrDefault)\nimport Data.List (List(..), reverse)\nimport Data.List as L\nimport Data.Maybe (Maybe(..))\nimport Data.Traversable (class Traversable, sequenceDefault)\nimport Data.Tuple (Tuple(..))\nimport Data.Unfoldable (class Unfoldable, class Unfoldable1)\n\n-- | A strict double-ended queue (dequeue) representated using a pair of lists.\ndata CatQueue a = CatQueue (List a) (List a)\n\n-- | Create an empty queue.\n-- |\n-- | Running time: `O(1)`\nempty :: forall a. CatQueue a\nempty = CatQueue Nil Nil\n\n-- | Test whether a queue is empty.\n-- |\n-- | Running time: `O(1)`\nnull :: forall a. CatQueue a -> Boolean\nnull (CatQueue Nil Nil) = true\nnull _ = false\n\n-- | Create a queue containing a single element.\n-- |\n-- | Running time: `O(1)`\nsingleton :: forall a. a -> CatQueue a\nsingleton = snoc empty\n\n-- | Number of elements in queue.\n-- |\n-- | Running time: `O(n)` in length of queue.\nlength :: forall a. CatQueue a -> Int\nlength (CatQueue l r) = L.length l + L.length r\n\n-- | Append an element to the beginning of the queue, creating a new queue.\n-- |\n-- | Running time: `O(1)`\ncons :: forall a. a -> CatQueue a -> CatQueue a\ncons a (CatQueue l r) = CatQueue (Cons a l) r\n\n-- | Append an element to the end of the queue, creating a new queue.\n-- |\n-- | Running time: `O(1)`\nsnoc :: forall a. CatQueue a -> a -> CatQueue a\nsnoc (CatQueue l r) a = CatQueue l (Cons a r)\n\n-- | Decompose a queue into a `Tuple` of the first element and the rest of the queue.\n-- |\n-- | Running time: `O(1)`\n-- |\n-- | Note that any single operation may run in `O(n)`.\nuncons :: forall a. CatQueue a -> Maybe (Tuple a (CatQueue a))\nuncons (CatQueue Nil Nil) = Nothing\nuncons (CatQueue Nil r) = uncons (CatQueue (reverse r) Nil)\nuncons (CatQueue (Cons a as) r) = Just (Tuple a (CatQueue as r))\n\n-- | Decompose a queue into a `Tuple` of the last element and the rest of the queue.\n-- |\n-- | Running time: `O(1)`\n-- |\n-- | Note that any single operation may run in `O(n)`.\nunsnoc :: forall a. CatQueue a -> Maybe (Tuple a (CatQueue a))\nunsnoc (CatQueue l (Cons a as)) = Just (Tuple a (CatQueue l as))\nunsnoc (CatQueue Nil Nil) = Nothing\nunsnoc (CatQueue l Nil) = unsnoc (CatQueue Nil (reverse l))\n\n-- | Convert any `Foldable` into a `CatQueue`.\n-- |\n-- | Running time: `O(n)`\nfromFoldable :: forall f a. Foldable f => f a -> CatQueue a\nfromFoldable f = foldMap singleton f\n\ncqEq :: forall a. Eq a => CatQueue a -> CatQueue a -> Boolean\ncqEq = go\n where\n elemEq = eq :: (a -> a -> Boolean)\n go xs ys = case uncons xs, uncons ys of\n Just (Tuple x xs'), Just (Tuple y ys')\n | x `elemEq` y -> go xs' ys'\n Nothing, Nothing -> true\n _ , _ -> false\n\ncqCompare :: forall a. Ord a => CatQueue a -> CatQueue a -> Ordering\ncqCompare = go\n where\n elemCompare = compare :: (a -> a -> Ordering)\n go xs ys = case uncons xs, uncons ys of\n Just (Tuple x xs'), Just (Tuple y ys') ->\n case elemCompare x y of\n EQ -> go xs' ys'\n ordering -> ordering\n Just _, Nothing -> GT\n Nothing, Just _ -> LT\n Nothing, Nothing -> EQ\n\ninstance eqCatQueue :: Eq a => Eq (CatQueue a) where\n eq = cqEq\n\ninstance ordCatQueue :: Ord a => Ord (CatQueue a) where\n compare = cqCompare\n\n-- | Running time: `O(n) in the length of the second queue`\ninstance semigroupCatQueue :: Semigroup (CatQueue a) where\n append = foldl snoc\n\ninstance monoidCatQueue :: Monoid (CatQueue a) where\n mempty = empty\n\ninstance showCatQueue :: Show a => Show (CatQueue a) where\n show (CatQueue l r) = \"(CatQueue \" <> show l <> \" \" <> show r <> \")\"\n\ninstance foldableCatQueue :: Foldable CatQueue where\n foldMap = foldMapDefaultL\n foldr f = foldrDefault f\n foldl f = go\n where\n go acc q = case uncons q of\n Just (Tuple x xs) -> go (f acc x) xs\n Nothing -> acc\n\ninstance unfoldable1CatQueue :: Unfoldable1 CatQueue where\n unfoldr1 f b = go b empty\n where\n go source memo = case f source of\n Tuple one Nothing -> snoc memo one\n Tuple one (Just rest) -> go rest (snoc memo one)\n\ninstance unfoldableCatQueue :: Unfoldable CatQueue where\n unfoldr f b = go b empty\n where\n go source memo = case f source of\n Nothing -> memo\n Just (Tuple one rest) -> go rest (snoc memo one)\n\ninstance traversableCatQueue :: Traversable CatQueue where\n traverse f =\n map (foldl snoc empty)\n <<< foldl (\\acc -> lift2 snoc acc <<< f) (pure empty)\n sequence = sequenceDefault\n\ninstance functorCatQueue :: Functor CatQueue where\n map f (CatQueue l r) = CatQueue (map f l) (map f r)\n\ninstance applyCatQueue :: Apply CatQueue where\n apply = ap\n\ninstance applicativeCatQueue :: Applicative CatQueue where\n pure = singleton\n\ninstance bindCatQueue :: Bind CatQueue where\n bind = flip foldMap\n\ninstance monadCatQueue :: Monad CatQueue\n\ninstance altCatQueue :: Alt CatQueue where\n alt = append\n\ninstance plusCatQueue :: Plus CatQueue where\n empty = empty\n\ninstance alternativeCatQueue :: Alternative CatQueue\n\ninstance monadPlusCatQueue :: MonadPlus CatQueue\n", "-- | This module defines a strict catenable list.\n-- |\n-- | The implementation is based on a queue where all operations require\n-- | `O(1)` amortized time.\n-- |\n-- | However, any single `uncons` operation may run in `O(n)` time.\n-- |\n-- | See [Purely Functional Data Structures](http://www.cs.cmu.edu/~rwh/theses/okasaki.pdf) (Okasaki 1996)\nmodule Data.CatList\n ( CatList(..)\n , empty\n , null\n , singleton\n , length\n , append\n , cons\n , snoc\n , uncons\n , fromFoldable\n ) where\n\nimport Prelude hiding (append)\n\nimport Control.Alt (class Alt)\nimport Control.Alternative (class Alternative)\nimport Control.MonadPlus (class MonadPlus)\nimport Control.Plus (class Plus)\nimport Data.CatQueue as Q\nimport Data.Foldable (class Foldable, foldMapDefaultL)\nimport Data.Foldable as Foldable\nimport Data.List as L\nimport Data.Maybe (Maybe(..))\nimport Data.Traversable (sequence, traverse, class Traversable)\nimport Data.Tuple (Tuple(..))\nimport Data.Unfoldable (class Unfoldable)\nimport Data.Unfoldable1 (class Unfoldable1)\n\n-- | A strict catenable list.\n-- |\n-- | `CatList` may be empty, represented by `CatNil`.\n-- |\n-- | `CatList` may be non-empty, represented by `CatCons`. The `CatCons`\n-- | data constructor takes the first element of the list and a queue of\n-- | `CatList`.\ndata CatList a = CatNil | CatCons a (Q.CatQueue (CatList a))\n\n-- | Create an empty catenable list.\n-- |\n-- | Running time: `O(1)`\nempty :: forall a. CatList a\nempty = CatNil\n\n-- | Test whether a catenable list is empty.\n-- |\n-- | Running time: `O(1)`\nnull :: forall a. CatList a -> Boolean\nnull CatNil = true\nnull _ = false\n\n-- | Number of elements in queue.\n-- |\n-- | Running time: `O(n)` in length of queue.\nlength :: forall a. CatList a -> Int\nlength = Foldable.length\n\n-- | Append all elements of a catenable list to the end of another\n-- | catenable list, create a new catenable list.\n-- |\n-- | Running time: `O(1)`\nappend :: forall a. CatList a -> CatList a -> CatList a\nappend = link\n\n-- | Append an element to the beginning of the catenable list, creating a new\n-- | catenable list.\n-- |\n-- | Running time: `O(1)`\ncons :: forall a. a -> CatList a -> CatList a\ncons a cat = append (CatCons a Q.empty) cat\n\n-- | Create a catenable list with a single item.\n-- |\n-- | Running time: `O(1)`\nsingleton :: forall a. a -> CatList a\nsingleton a = cons a CatNil\n\n-- | Append an element to the end of the catenable list, creating a new\n-- | catenable list.\n-- |\n-- | Running time: `O(1)`\nsnoc :: forall a. CatList a -> a -> CatList a\nsnoc cat a = append cat (CatCons a Q.empty)\n\n-- | Decompose a catenable list into a `Tuple` of the first element and\n-- | the rest of the catenable list.\n-- |\n-- | Running time: `O(1)`\n-- |\n-- | Note that any single operation may run in `O(n)`.\nuncons :: forall a. CatList a -> Maybe (Tuple a (CatList a))\nuncons CatNil = Nothing\nuncons (CatCons a q) = Just (Tuple a (if Q.null q then CatNil else (foldr link CatNil q)))\n\n-- | Links two catenable lists by making appending the queue in the\n-- | first catenable list to the second catenable list. This operation\n-- | creates a new catenable list.\n-- |\n-- | Running time: `O(1)`\nlink :: forall a. CatList a -> CatList a -> CatList a\nlink CatNil cat = cat\nlink cat CatNil = cat\nlink (CatCons a q) cat = CatCons a (Q.snoc q cat)\n\n-- | Tail recursive version of foldr on `CatList`.\n-- |\n-- | Ensures foldl on `List` is tail-recursive.\nfoldr :: forall a. (CatList a -> CatList a -> CatList a) -> CatList a -> Q.CatQueue (CatList a) -> CatList a\nfoldr k b q = go q L.Nil\n where\n go :: Q.CatQueue (CatList a) -> L.List (CatList a -> CatList a) -> CatList a\n go xs ys = case Q.uncons xs of\n Nothing -> foldl (\\x i -> i x) b ys\n Just (Tuple a rest) -> go rest (L.Cons (k a) ys)\n\n foldl :: forall b c. (c -> b -> c) -> c -> L.List b -> c\n foldl _ c L.Nil = c\n foldl k' c (L.Cons b' as) = foldl k' (k' c b') as\n\n-- | Convert any `Foldable` into a `CatList`.\n-- |\n-- | Running time: `O(n)`\nfromFoldable :: forall f. Foldable f => f ~> CatList\nfromFoldable f = Foldable.foldMap singleton f\n\nfoldMap :: forall a m. Monoid m => (a -> m) -> CatList a -> m\nfoldMap _ CatNil = mempty\nfoldMap f (CatCons a q) =\n let d = if Q.null q then CatNil else (foldr link CatNil q)\n in f a <> foldMap f d\n\n-- | Running time: `O(1)`\ninstance semigroupCatList :: Semigroup (CatList a) where\n append = append\n\ninstance monoidCatList :: Monoid (CatList a) where\n mempty = CatNil\n\ninstance showCatList :: Show a => Show (CatList a) where\n show CatNil = \"CatNil\"\n show (CatCons a as) = \"(CatList \" <> show a <> \" \" <> show as <> \")\"\n\ninstance foldableCatList :: Foldable CatList where\n foldMap = foldMapDefaultL\n foldr f s l = Foldable.foldrDefault f s l\n foldl f = go\n where\n go acc q = case uncons q of\n Just (Tuple x xs) -> go (f acc x) xs\n Nothing -> acc\n\ninstance unfoldableCatList :: Unfoldable CatList where\n unfoldr f b = go b CatNil\n where\n go source memo = case f source of\n Nothing -> memo\n Just (Tuple one rest) -> go rest (snoc memo one)\n\ninstance unfoldable1CatList :: Unfoldable1 CatList where\n unfoldr1 f b = go b CatNil\n where\n go source memo = case f source of\n Tuple one Nothing -> snoc memo one\n Tuple one (Just rest) -> go rest (snoc memo one)\n\ninstance traversableCatList :: Traversable CatList where\n traverse _ CatNil = pure CatNil\n traverse f (CatCons a q) =\n let d = if Q.null q then CatNil else (foldr link CatNil q)\n in cons <$> f a <*> traverse f d\n sequence CatNil = pure CatNil\n sequence (CatCons a q) =\n let d = if Q.null q then CatNil else (foldr link CatNil q)\n in cons <$> a <*> sequence d\n\ninstance functorCatList :: Functor CatList where\n map _ CatNil = CatNil\n map f (CatCons a q) =\n let d = if Q.null q then CatNil else (foldr link CatNil q)\n in f a `cons` map f d\n\ninstance applyCatList :: Apply CatList where\n apply = ap\n\ninstance applicativeCatList :: Applicative CatList where\n pure = singleton\n\ninstance bindCatList :: Bind CatList where\n bind = flip foldMap\n\ninstance monadCatList :: Monad CatList\n\ninstance altCatList :: Alt CatList where\n alt = append\n\ninstance plusCatList :: Plus CatList where\n empty = empty\n\ninstance alternativeCatList :: Alternative CatList\n\ninstance monadPlusCatList :: MonadPlus CatList\n", "module Control.Monad.Free\n ( Free\n , suspendF\n , wrap\n , liftF\n , hoistFree\n , foldFree\n , substFree\n , runFree\n , runFreeM\n , resume\n , resume'\n ) where\n\nimport Prelude\n\nimport Control.Apply (lift2)\nimport Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)\nimport Control.Monad.Trans.Class (class MonadTrans)\n\nimport Data.CatList (CatList, empty, snoc, uncons)\nimport Data.Either (Either(..))\nimport Data.Eq (class Eq1, eq1)\nimport Data.Foldable (class Foldable, foldMap, foldl, foldr)\nimport Data.Maybe (Maybe(..))\nimport Data.Ord (class Ord1, compare1)\nimport Data.Traversable (class Traversable, traverse)\nimport Data.Tuple (Tuple(..))\n\nimport Unsafe.Coerce (unsafeCoerce)\n\n-- | The free monad for a type constructor `f`.\n-- |\n-- | Implemented in the spirit of [Reflection without Remorse](http://okmij.org/ftp/Haskell/zseq.pdf),\n-- | the free monad is represented using a sequential data structure in\n-- | order to overcome the quadratic complexity of left-associated binds\n-- | and traversal through the free monad structure.\ndata Free f a = Free (FreeView f Val Val) (CatList (ExpF f))\n\nnewtype ExpF f = ExpF (Val -> Free f Val)\n\ndata FreeView f a b = Return a | Bind (f b) (b -> Free f a)\n\ndata Val\n\ninstance eqFree :: (Functor f, Eq1 f, Eq a) => Eq (Free f a) where\n eq x y = case resume x, resume y of\n Left fa, Left fb -> eq1 fa fb\n Right a, Right b -> a == b\n _, _ -> false\n\ninstance eq1Free :: (Functor f, Eq1 f) => Eq1 (Free f) where\n eq1 = eq\n\ninstance ordFree :: (Functor f, Ord1 f, Ord a) => Ord (Free f a) where\n compare x y = case resume x, resume y of\n Left fa, Left fb -> compare1 fa fb\n Left _, _ -> LT\n _, Left _ -> GT\n Right a, Right b -> compare a b\n\ninstance ord1Free :: (Functor f, Ord1 f) => Ord1 (Free f) where\n compare1 = compare\n\ninstance freeFunctor :: Functor (Free f) where\n map k f = pure <<< k =<< f\n\ninstance freeBind :: Bind (Free f) where\n bind (Free v s) k = Free v (snoc s (ExpF (unsafeCoerceBind k)))\n where\n unsafeCoerceBind :: forall a b. (a -> Free f b) -> Val -> Free f Val\n unsafeCoerceBind = unsafeCoerce\n\ninstance freeApplicative :: Applicative (Free f) where\n pure = fromView <<< Return\n\ninstance freeApply :: Apply (Free f) where\n apply = ap\n\ninstance freeMonad :: Monad (Free f)\n\ninstance freeMonadTrans :: MonadTrans Free where\n lift = liftF\n\ninstance freeMonadRec :: MonadRec (Free f) where\n tailRecM k a = k a >>= case _ of\n Loop b -> tailRecM k b\n Done r -> pure r\n\ninstance foldableFree :: (Functor f, Foldable f) => Foldable (Free f) where\n foldMap f = go\n where\n go = resume >>> case _ of\n Left fa -> foldMap go fa\n Right a -> f a\n foldl f = go\n where\n go r = resume >>> case _ of\n Left fa -> foldl go r fa\n Right a -> f r a\n foldr f = go\n where\n go r = resume >>> case _ of\n Left fa -> foldr (flip go) r fa\n Right a -> f a r\n\ninstance traversableFree :: Traversable f => Traversable (Free f) where\n traverse f = go\n where\n go = resume >>> case _ of\n Left fa -> join <<< liftF <$> traverse go fa\n Right a -> pure <$> f a\n sequence tma = traverse identity tma\n\ninstance semigroupFree :: Semigroup a => Semigroup (Free f a) where\n append = lift2 append\n\ninstance monoidFree :: Monoid a => Monoid (Free f a) where\n mempty = pure mempty\n \n-- | Lift an impure value described by the generating type constructor `f` into\n-- | the free monad.\nliftF :: forall f. f ~> Free f\nliftF f = fromView (Bind (unsafeCoerceF f) (pure <<< unsafeCoerceVal))\n where\n unsafeCoerceF :: forall a. f a -> f Val\n unsafeCoerceF = unsafeCoerce\n\n unsafeCoerceVal :: forall a. Val -> a\n unsafeCoerceVal = unsafeCoerce\n\n-- | Add a layer.\nwrap :: forall f a. f (Free f a) -> Free f a\nwrap f = fromView (Bind (unsafeCoerceF f) unsafeCoerceVal)\n where\n unsafeCoerceF :: forall b. f (Free f b) -> f Val\n unsafeCoerceF = unsafeCoerce\n\n unsafeCoerceVal :: forall b. Val -> Free f b\n unsafeCoerceVal = unsafeCoerce\n\n-- | Suspend a value given the applicative functor `f` into the free monad.\nsuspendF :: forall f. Applicative f => Free f ~> Free f\nsuspendF f = wrap (pure f)\n\n-- | Use a natural transformation to change the generating type constructor of a\n-- | free monad.\nhoistFree :: forall f g. (f ~> g) -> Free f ~> Free g\nhoistFree k = substFree (liftF <<< k)\n\n-- | Run a free monad with a natural transformation from the type constructor `f`\n-- | to the tail-recursive monad `m`. See the `MonadRec` type class for more\n-- | details.\nfoldFree :: forall f m. MonadRec m => (f ~> m) -> Free f ~> m\nfoldFree k = tailRecM go\n where\n go :: forall a. Free f a -> m (Step (Free f a) a)\n go f = case toView f of\n Return a -> Done <$> pure a\n Bind g i -> (Loop <<< i) <$> k g\n\n-- | Like `foldFree`, but for folding into some other Free monad without the\n-- | overhead that `MonadRec` incurs.\nsubstFree :: forall f g. (f ~> Free g) -> Free f ~> Free g\nsubstFree k = go\n where\n go :: Free f ~> Free g\n go f = case toView f of\n Return a -> pure a\n Bind g i -> k g >>= go <$> i\n\n-- | Run a free monad with a function that unwraps a single layer of the functor\n-- | `f` at a time.\nrunFree :: forall f a. Functor f => (f (Free f a) -> Free f a) -> Free f a -> a\nrunFree k = go\n where\n go :: Free f a -> a\n go f = case toView f of\n Return a -> a\n Bind g i -> go (k (i <$> g))\n\n-- | Run a free monad with a function mapping a functor `f` to a tail-recursive\n-- | monad `m`. See the `MonadRec` type class for more details.\nrunFreeM\n :: forall f m a\n . Functor f\n => MonadRec m\n => (f (Free f a) -> m (Free f a))\n -> Free f a\n -> m a\nrunFreeM k = tailRecM go\n where\n go :: Free f a -> m (Step (Free f a) a)\n go f = case toView f of\n Return a -> Done <$> pure a\n Bind g i -> Loop <$> k (i <$> g)\n\n-- | Unwraps a single layer of the functor `f`.\nresume\n :: forall f a\n . Functor f\n => Free f a\n -> Either (f (Free f a)) a\nresume = resume' (\\g i -> Left (i <$> g)) Right\n\n-- | Unwraps a single layer of `f`, providing the continuation.\nresume'\n :: forall f a r\n . (forall b. f b -> (b -> Free f a) -> r)\n -> (a -> r)\n -> Free f a\n -> r\nresume' k j f = case toView f of\n Return a -> j a\n Bind g i -> k g i\n\nfromView :: forall f a. FreeView f a Val -> Free f a\nfromView f = Free (unsafeCoerceFreeView f) empty\n where\n unsafeCoerceFreeView :: FreeView f a Val -> FreeView f Val Val\n unsafeCoerceFreeView = unsafeCoerce\n\ntoView :: forall f a. Free f a -> FreeView f a Val\ntoView (Free v s) =\n case v of\n Return a ->\n case uncons s of\n Nothing ->\n Return (unsafeCoerceVal a)\n Just (Tuple h t) ->\n toView (unsafeCoerceFree (concatF ((runExpF h) a) t))\n Bind f k ->\n Bind f (\\a -> unsafeCoerceFree (concatF (k a) s))\n where\n concatF :: Free f Val -> CatList (ExpF f) -> Free f Val\n concatF (Free v' l) r = Free v' (l <> r)\n\n runExpF :: ExpF f -> (Val -> Free f Val)\n runExpF (ExpF k) = k\n\n unsafeCoerceFree :: Free f Val -> Free f a\n unsafeCoerceFree = unsafeCoerce\n\n unsafeCoerceVal :: Val -> a\n unsafeCoerceVal = unsafeCoerce\n", "-- | This module defines the state monad transformer, `StateT`.\n\nmodule Control.Monad.State.Trans\n ( StateT(..), runStateT, evalStateT, execStateT, mapStateT, withStateT\n , module Control.Monad.Trans.Class\n , module Control.Monad.State.Class\n ) where\n\nimport Prelude\n\nimport Control.Alt (class Alt, (<|>))\nimport Control.Alternative (class Alternative)\nimport Control.Apply (lift2)\nimport Control.Lazy (class Lazy)\nimport Control.Monad.Cont.Class (class MonadCont, callCC)\nimport Control.Monad.Error.Class (class MonadThrow, class MonadError, catchError, throwError)\nimport Control.Monad.Reader.Class (class MonadAsk, class MonadReader, ask, local)\nimport Control.Monad.Rec.Class (class MonadRec, tailRecM, Step(..))\nimport Control.Monad.ST.Class (class MonadST, liftST)\nimport Control.Monad.State.Class (class MonadState, get, gets, modify, modify_, put, state)\nimport Control.Monad.Trans.Class (class MonadTrans, lift)\nimport Control.Monad.Writer.Class (class MonadWriter, class MonadTell, pass, listen, tell)\nimport Control.MonadPlus (class MonadPlus)\nimport Control.Plus (class Plus, empty)\nimport Data.Newtype (class Newtype)\nimport Data.Tuple (Tuple(..), fst, snd)\nimport Effect.Class (class MonadEffect, liftEffect)\n\n-- | The state monad transformer.\n-- |\n-- | This monad transformer extends the base monad with the operations `get`\n-- | and `put` which can be used to model a single piece of mutable state.\n-- |\n-- | The `MonadState` type class describes the operations supported by this monad.\nnewtype StateT s m a = StateT (s -> m (Tuple a s))\n\n-- | Run a computation in the `StateT` monad.\nrunStateT :: forall s m a. StateT s m a -> s -> m (Tuple a s)\nrunStateT (StateT s) = s\n\n-- | Run a computation in the `StateT` monad, discarding the final state.\nevalStateT :: forall s m a. Functor m => StateT s m a -> s -> m a\nevalStateT (StateT m) s = fst <$> m s\n\n-- | Run a computation in the `StateT` monad discarding the result.\nexecStateT :: forall s m a. Functor m => StateT s m a -> s -> m s\nexecStateT (StateT m) s = snd <$> m s\n\n-- | Change the result type in a `StateT` monad action.\nmapStateT :: forall s m1 m2 a b. (m1 (Tuple a s) -> m2 (Tuple b s)) -> StateT s m1 a -> StateT s m2 b\nmapStateT f (StateT m) = StateT (f <<< m)\n\n-- | Modify the final state in a `StateT` monad action.\nwithStateT :: forall s m a. (s -> s) -> StateT s m a -> StateT s m a\nwithStateT f (StateT s) = StateT (s <<< f)\n\nderive instance newtypeStateT :: Newtype (StateT s m a) _\n\ninstance functorStateT :: Functor m => Functor (StateT s m) where\n map f (StateT a) = StateT (\\s -> map (\\(Tuple b s') -> Tuple (f b) s') (a s))\n\ninstance applyStateT :: Monad m => Apply (StateT s m) where\n apply = ap\n\ninstance applicativeStateT :: Monad m => Applicative (StateT s m) where\n pure a = StateT \\s -> pure $ Tuple a s\n\ninstance altStateT :: (Monad m, Alt m) => Alt (StateT s m) where\n alt (StateT x) (StateT y) = StateT \\s -> x s <|> y s\n\ninstance plusStateT :: (Monad m, Plus m) => Plus (StateT s m) where\n empty = StateT \\_ -> empty\n\ninstance alternativeStateT :: (Monad m, Alternative m) => Alternative (StateT s m)\n\ninstance bindStateT :: Monad m => Bind (StateT s m) where\n bind (StateT x) f = StateT \\s ->\n x s >>= \\(Tuple v s') -> case f v of StateT st -> st s'\n\ninstance monadStateT :: Monad m => Monad (StateT s m)\n\ninstance monadRecStateT :: MonadRec m => MonadRec (StateT s m) where\n tailRecM f a = StateT \\s -> tailRecM f' (Tuple a s)\n where\n f' (Tuple a' s) =\n case f a' of\n StateT st -> st s >>= \\(Tuple m s1) ->\n pure case m of\n Loop x -> Loop (Tuple x s1)\n Done y -> Done (Tuple y s1)\n\ninstance monadPlusStateT :: MonadPlus m => MonadPlus (StateT s m)\n\ninstance monadTransStateT :: MonadTrans (StateT s) where\n lift m = StateT \\s -> do\n x <- m\n pure $ Tuple x s\n\ninstance lazyStateT :: Lazy (StateT s m a) where\n defer f = StateT \\s -> case f unit of StateT f' -> f' s\n\ninstance monadEffectState :: MonadEffect m => MonadEffect (StateT s m) where\n liftEffect = lift <<< liftEffect\n\ninstance monadContStateT :: MonadCont m => MonadCont (StateT s m) where\n callCC f = StateT \\s -> callCC \\c ->\n case f (\\a -> StateT \\s' -> c (Tuple a s')) of StateT f' -> f' s\n\ninstance monadThrowStateT :: MonadThrow e m => MonadThrow e (StateT s m) where\n throwError e = lift (throwError e)\n\ninstance monadErrorStateT :: MonadError e m => MonadError e (StateT s m) where\n catchError (StateT m) h =\n StateT \\s -> catchError (m s) (\\e -> case h e of StateT f -> f s)\n\ninstance monadAskStateT :: MonadAsk r m => MonadAsk r (StateT s m) where\n ask = lift ask\n\ninstance monadReaderStateT :: MonadReader r m => MonadReader r (StateT s m) where\n local = mapStateT <<< local\n\ninstance monadStateStateT :: Monad m => MonadState s (StateT s m) where\n state f = StateT $ pure <<< f\n\ninstance monadTellStateT :: MonadTell w m => MonadTell w (StateT s m) where\n tell = lift <<< tell\n\ninstance monadWriterStateT :: MonadWriter w m => MonadWriter w (StateT s m) where\n listen m = StateT \\s ->\n case m of\n StateT m' -> do\n Tuple (Tuple a s') w <- listen (m' s)\n pure $ Tuple (Tuple a w) s'\n pass m = StateT \\s -> pass\n case m of\n StateT m' -> do\n Tuple (Tuple a f) s' <- m' s\n pure $ Tuple (Tuple a s') f\n\ninstance semigroupStateT :: (Monad m, Semigroup a) => Semigroup (StateT s m a) where\n append = lift2 (<>)\n\ninstance monoidStateT :: (Monad m, Monoid a) => Monoid (StateT s m a) where\n mempty = pure mempty\n\ninstance MonadST s m => MonadST s (StateT s' m) where\n liftST = lift <<< liftST\n", "module Effect.Aff.Class where\n\nimport Prelude\nimport Control.Monad.Cont.Trans (ContT)\nimport Control.Monad.Except.Trans (ExceptT)\nimport Control.Monad.List.Trans (ListT)\nimport Control.Monad.Maybe.Trans (MaybeT)\nimport Control.Monad.Reader.Trans (ReaderT)\nimport Control.Monad.RWS.Trans (RWST)\nimport Control.Monad.State.Trans (StateT)\nimport Control.Monad.Trans.Class (lift)\nimport Control.Monad.Writer.Trans (WriterT)\nimport Effect.Aff (Aff)\nimport Effect.Class (class MonadEffect)\n\nclass MonadEffect m <= MonadAff m where\n liftAff :: Aff ~> m\n\ninstance monadAffAff :: MonadAff Aff where\n liftAff = identity\n\ninstance monadAffContT :: MonadAff m => MonadAff (ContT r m) where\n liftAff = lift <<< liftAff\n\ninstance monadAffExceptT :: MonadAff m => MonadAff (ExceptT e m) where\n liftAff = lift <<< liftAff\n\ninstance monadAffListT :: MonadAff m => MonadAff (ListT m) where\n liftAff = lift <<< liftAff\n\ninstance monadAffMaybe :: MonadAff m => MonadAff (MaybeT m) where\n liftAff = lift <<< liftAff\n\ninstance monadAffReader :: MonadAff m => MonadAff (ReaderT r m) where\n liftAff = lift <<< liftAff\n\ninstance monadAffRWS :: (MonadAff m, Monoid w) => MonadAff (RWST r w s m) where\n liftAff = lift <<< liftAff\n\ninstance monadAffState :: MonadAff m => MonadAff (StateT s m) where\n liftAff = lift <<< liftAff\n\ninstance monadAffWriter :: (MonadAff m, Monoid w) => MonadAff (WriterT w m) where\n liftAff = lift <<< liftAff\n", "module Halogen.Query.ChildQuery where\n\nimport Prelude\n\nimport Data.Maybe (Maybe)\nimport Halogen.Data.Slot (SlotStorage)\nimport Unsafe.Coerce (unsafeCoerce)\n\ndata ChildQueryBox :: Row Type -> Type -> Type\ndata ChildQueryBox (ps :: Row Type) a\n\ndata ChildQuery ps g o a f b =\n ChildQuery\n (forall slot m. Applicative m => (slot g o -> m (Maybe b)) -> SlotStorage ps slot -> m (f b))\n (g b)\n (f b -> a)\n\ninstance functorChildQuery :: Functor (ChildQueryBox ps) where\n map f = unChildQueryBox \\(ChildQuery u q k) ->\n mkChildQueryBox (ChildQuery u q (f <<< k))\n\nmkChildQueryBox\n :: forall ps g o a f b\n . ChildQuery ps g o a f b\n -> ChildQueryBox ps a\nmkChildQueryBox = unsafeCoerce\n\nunChildQueryBox\n :: forall ps a r\n . (forall g o f b. ChildQuery ps g o a f b -> r)\n -> ChildQueryBox ps a\n -> r\nunChildQueryBox = unsafeCoerce\n", "export function reallyUnsafeRefEq(a) {\n return function (b) {\n return a === b;\n };\n}\n", "module Unsafe.Reference\n ( unsafeRefEq\n , reallyUnsafeRefEq\n , UnsafeRefEq(..)\n , UnsafeRefEqFallback(..)\n ) where\n\nimport Prelude\n\n-- | Compares two values of the same type using strict (`===`) equality.\nunsafeRefEq :: forall a. a -> a -> Boolean\nunsafeRefEq = reallyUnsafeRefEq\n\n-- | Compares two values of different types using strict (`===`) equality.\nforeign import reallyUnsafeRefEq :: forall a b. a -> b -> Boolean\n\n-- | The `Eq` instance is defined by `unsafeRefEq`.\nnewtype UnsafeRefEq a = UnsafeRefEq a\n\ninstance eqUnsafeRefEq :: Eq (UnsafeRefEq a) where\n eq (UnsafeRefEq l) (UnsafeRefEq r) = unsafeRefEq l r\n\n-- | The `Eq` instance first checks `unsafeRefEq`, if `false` falls back to\n-- | the underlying `Eq` instance.\nnewtype UnsafeRefEqFallback a = UnsafeRefEqFallback a\n\ninstance eqUnsafeRefEqFallback ::\n Eq a =>\n Eq (UnsafeRefEqFallback a) where\n eq (UnsafeRefEqFallback l) (UnsafeRefEqFallback r) =\n unsafeRefEq l r || l == r\n\n", "module Halogen.Subscription\n ( SubscribeIO(..)\n , create\n , Listener\n , notify\n , Emitter\n , makeEmitter\n , Subscription\n , subscribe\n , unsubscribe\n , fold\n , filter\n , fix\n ) where\n\nimport Prelude\n\nimport Control.Alt (class Alt)\nimport Control.Alternative (class Alternative)\nimport Control.Apply (lift2)\nimport Control.Plus (class Plus)\nimport Data.Array (deleteBy)\nimport Data.Foldable (traverse_)\nimport Data.Functor.Contravariant (class Contravariant)\nimport Data.Maybe (Maybe(..))\nimport Effect (Effect)\nimport Effect.Ref as Ref\nimport Effect.Unsafe (unsafePerformEffect)\nimport Safe.Coerce (coerce)\nimport Unsafe.Reference (unsafeRefEq)\n\n-- | A paired `Listener` and `Emitter` produced with the `create` function.\ntype SubscribeIO a =\n { listener :: Listener a\n , emitter :: Emitter a\n }\n\n-- | Create a paired `Listener` and `Emitter`, where you can push values to\n-- | the listener and subscribe to values from the emitter.\n-- |\n-- | ```purs\n-- | { emitter, listener } <- create\n-- |\n-- | -- Push values into the listener:\n-- | notify listener \"hello\"\n-- |\n-- | -- Subscribe to outputs from the emitter with a callback:\n-- | subscription <- subscribe emitter \\value ->\n-- | Console.log value\n-- |\n-- | -- Unsubscribe at any time:\n-- | unsubscribe subscription\n-- | ```\ncreate :: forall a. Effect (SubscribeIO a)\ncreate = do\n subscribers <- Ref.new []\n pure\n { emitter: Emitter \\k -> do\n Ref.modify_ (_ <> [k]) subscribers\n pure $ Subscription do\n Ref.modify_ (deleteBy unsafeRefEq k) subscribers\n , listener: Listener \\a -> do\n Ref.read subscribers >>= traverse_ \\k -> k a\n }\n\n-- | An `Emitter` represents a collection of discrete occurrences of an event;\n-- | conceptually, an emitter is a possibly-infinite list of values.\n-- |\n-- | Emitters are created from real events like timers or mouse clicks and can\n-- | be combined or transformed with the functions and instances in this module.\n-- |\n-- | Emitters are consumed by providing a callback via the `subscribe` function.\nnewtype Emitter a = Emitter ((a -> Effect Unit) -> Effect Subscription)\n\ninstance functorEmitter :: Functor Emitter where\n map f (Emitter e) = Emitter \\k -> e (k <<< f)\n\ninstance applyEmitter :: Apply Emitter where\n apply (Emitter e1) (Emitter e2) = Emitter \\k -> do\n latestA <- Ref.new Nothing\n latestB <- Ref.new Nothing\n Subscription c1 <- e1 \\a -> do\n Ref.write (Just a) latestA\n Ref.read latestB >>= traverse_ (k <<< a)\n Subscription c2 <- e2 \\b -> do\n Ref.write (Just b) latestB\n Ref.read latestA >>= traverse_ (k <<< (_ $ b))\n pure (Subscription (c1 *> c2))\n\ninstance applicativeEmitter :: Applicative Emitter where\n pure a = Emitter \\k -> do\n k a\n pure (Subscription (pure unit))\n\ninstance altEmitter :: Alt Emitter where\n alt (Emitter f) (Emitter g) = Emitter \\k -> do\n Subscription c1 <- f k\n Subscription c2 <- g k\n pure (Subscription (c1 *> c2))\n\ninstance plusEmitter :: Plus Emitter where\n empty = Emitter \\_ -> pure (Subscription (pure unit))\n\ninstance alternativeEmitter :: Alternative Emitter\n\ninstance semigroupEmitter :: Semigroup a => Semigroup (Emitter a) where\n append = lift2 append\n\ninstance monoidEmitter :: Monoid a => Monoid (Emitter a) where\n mempty = Emitter mempty\n\n-- | Make an `Emitter` from a function which accepts a callback and returns an\n-- | unsubscription function.\n-- |\n-- | Note: You should use `create` unless you need explicit control over\n-- | unsubscription.\nmakeEmitter\n :: forall a\n . ((a -> Effect Unit) -> Effect (Effect Unit))\n -> Emitter a\nmakeEmitter = coerce\n\n-- | Conceptually, a `Listener` represents an input source to an `Emitter`. You\n-- | can push a value to its paired emitter with the `notify` function.\nnewtype Listener a = Listener (a -> Effect Unit)\n\ninstance contravariantListener :: Contravariant Listener where\n cmap f (Listener g) = coerce (g <<< f)\n\n-- | Push a value to the `Emitter` paired with the provided `Listener` argument.\n-- |\n-- | ```purs\n-- | -- Create an emitter and listener with `create`:\n-- | { emitter, listener } <- create\n-- |\n-- | -- Then, push values to the emitter via the listener with `notify`:\n-- | notify listener \"hello\"\n-- | ```\nnotify :: forall a. Listener a -> a -> Effect Unit\nnotify (Listener f) a = f a\n\n-- | A `Subscription` results from subscribing to an `Emitter` with `subscribe`;\n-- | the subscription can be ended at any time with `unsubscribe`.\nnewtype Subscription = Subscription (Effect Unit)\n\nderive newtype instance semigroupSubscription :: Semigroup Subscription\nderive newtype instance monoidSubscription :: Monoid Subscription\n\n-- | Subscribe to an `Emitter` by providing a callback to run on values produced\n-- | by the emitter:\n-- |\n-- | ```purs\n-- | -- Produce an emitter / listener pair with `create`:\n-- | { emitter, listener } <- create\n-- |\n-- | -- Then, subscribe to the emitter by providing a callback:\n-- | subscription <- subscribe emitter \\emitted ->\n-- | doSomethingWith emitted\n-- |\n-- | -- End the subscription at any time with `unsubscribe`:\n-- | unsubscribe subscription\n-- | ```\nsubscribe\n :: forall r a\n . Emitter a\n -> (a -> Effect r)\n -> Effect Subscription\nsubscribe (Emitter e) k = e (void <<< k)\n\n-- | End a subscription to an `Emitter`.\nunsubscribe :: Subscription -> Effect Unit\nunsubscribe (Subscription unsub) = unsub\n\n-- | Fold over values received from some `Emitter`, creating a new `Emitter`.\nfold :: forall a b. (a -> b -> b) -> Emitter a -> b -> Emitter b\nfold f (Emitter e) b = Emitter \\k -> do\n result <- Ref.new b\n e \\a -> Ref.modify (f a) result >>= k\n\n-- | Create an `Emitter` which only fires when a predicate holds.\nfilter :: forall a. (a -> Boolean) -> Emitter a -> Emitter a\nfilter p (Emitter e) = Emitter \\k -> e \\a -> if p a then k a else pure unit\n\n-- | Compute a fixed point.\nfix :: forall i o. (Emitter i -> { input :: Emitter i, output :: Emitter o }) -> Emitter o\nfix f = Emitter \\k -> do\n Subscription c1 <- subscribe input (notify listener)\n Subscription c2 <- subscribe output k\n pure (Subscription (c1 *> c2))\n where\n { emitter, listener } = unsafePerformEffect create\n { input, output } = f emitter\n", "module Halogen.Query.HalogenM where\n\nimport Prelude\n\nimport Control.Applicative.Free (FreeAp, liftFreeAp, hoistFreeAp)\nimport Control.Monad.Error.Class (class MonadThrow, throwError)\nimport Control.Monad.Free (Free, hoistFree, liftF)\nimport Control.Monad.Reader.Class (class MonadAsk, ask)\nimport Control.Monad.Rec.Class (class MonadRec, tailRecM, Step(..))\nimport Control.Monad.State.Class (class MonadState)\nimport Control.Monad.Trans.Class (class MonadTrans)\nimport Control.Monad.Writer.Class (class MonadTell, tell)\nimport Control.Parallel.Class (class Parallel)\nimport Data.Bifunctor (lmap)\nimport Data.FoldableWithIndex (foldrWithIndex)\nimport Data.Map (Map)\nimport Data.Map as Map\nimport Data.Maybe (Maybe(..), maybe)\nimport Data.Newtype (class Newtype, over)\nimport Data.Symbol (class IsSymbol)\nimport Data.Traversable (traverse)\nimport Data.Tuple (Tuple)\nimport Effect.Aff.Class (class MonadAff, liftAff)\nimport Effect.Class (class MonadEffect, liftEffect)\nimport Halogen.Data.Slot (Slot)\nimport Halogen.Data.Slot as Slot\nimport Halogen.Query.ChildQuery as CQ\nimport Halogen.Query.Input (RefLabel)\nimport Halogen.Subscription as HS\nimport Prim.Row as Row\nimport Type.Proxy (Proxy)\nimport Web.DOM (Element)\n\n-- | The Halogen component eval algebra.\n-- |\n-- | - `state` is the component's state\n-- | - `action` is the type of actions; events internal to the component that\n-- | can be evaluated\n-- | - `slots` is the set of slots for addressing child components\n-- | - `output` is the type of output messages the component can raise\n-- | - `m` is the monad used during evaluation\n-- | - `a` is the result of the HalogenF expression (see HalogenM for an example).\ndata HalogenF state action slots output m a\n = State (state -> Tuple a state)\n | Subscribe (SubscriptionId -> HS.Emitter action) (SubscriptionId -> a)\n | Unsubscribe SubscriptionId a\n | Lift (m a)\n | ChildQuery (CQ.ChildQueryBox slots a)\n | Raise output a\n | Par (HalogenAp state action slots output m a)\n | Fork (HalogenM state action slots output m Unit) (ForkId -> a)\n | Join ForkId a\n | Kill ForkId a\n | GetRef RefLabel (Maybe Element -> a)\n\ninstance functorHalogenF :: Functor m => Functor (HalogenF state action slots output m) where\n map f = case _ of\n State k -> State (lmap f <<< k)\n Subscribe fes k -> Subscribe fes (f <<< k)\n Unsubscribe sid a -> Unsubscribe sid (f a)\n Lift q -> Lift (map f q)\n ChildQuery cq -> ChildQuery (map f cq)\n Raise o a -> Raise o (f a)\n Par pa -> Par (map f pa)\n Fork hmu k -> Fork hmu (f <<< k)\n Join fid a -> Join fid (f a)\n Kill fid a -> Kill fid (f a)\n GetRef p k -> GetRef p (f <<< k)\n\n-- | The Halogen component eval effect monad.\n-- |\n-- | - `state` is the component's state\n-- | - `action` is the type of actions; events internal to the component that\n-- | can be evaluated\n-- | - `slots` is the set of slots for addressing child components\n-- | - `output` is the type of output messages the component can raise\n-- | - `m` is the monad used during evaluation\n-- | - `a` is the result of the HalogenM expression. Use the following pattern:\n-- | `handleAction :: Action -> H.HalogenM State Action Slots Output m Unit`\n-- | `handleQuery :: forall a. Query a -> H.HalogenM State Action Slots Output m (Maybe a)`\nnewtype HalogenM state action slots output m a = HalogenM (Free (HalogenF state action slots output m) a)\n\nderive newtype instance functorHalogenM :: Functor (HalogenM state action slots output m)\nderive newtype instance applyHalogenM :: Apply (HalogenM state action slots output m)\nderive newtype instance applicativeHalogenM :: Applicative (HalogenM state action slots output m)\nderive newtype instance bindHalogenM :: Bind (HalogenM state action slots output m)\nderive newtype instance monadHalogenM :: Monad (HalogenM state action slots output m)\nderive newtype instance semigroupHalogenM :: Semigroup a => Semigroup (HalogenM state action slots output m a)\nderive newtype instance monoidHalogenM :: Monoid a => Monoid (HalogenM state action slots output m a)\n\ninstance monadEffectHalogenM :: MonadEffect m => MonadEffect (HalogenM state action slots output m) where\n liftEffect = HalogenM <<< liftF <<< Lift <<< liftEffect\n\ninstance monadAffHalogenM :: MonadAff m => MonadAff (HalogenM state action slots output m) where\n liftAff = HalogenM <<< liftF <<< Lift <<< liftAff\n\ninstance parallelHalogenM :: Parallel (HalogenAp state action slots output m) (HalogenM state action slots output m) where\n parallel = HalogenAp <<< liftFreeAp\n sequential = HalogenM <<< liftF <<< Par\n\ninstance monadTransHalogenM :: MonadTrans (HalogenM state action slots o) where\n lift = HalogenM <<< liftF <<< Lift\n\ninstance monadRecHalogenM :: MonadRec (HalogenM state action slots output m) where\n tailRecM k a = k a >>= case _ of\n Loop x -> tailRecM k x\n Done y -> pure y\n\ninstance monadStateHalogenM :: MonadState state (HalogenM state action slots output m) where\n state = HalogenM <<< liftF <<< State\n\ninstance monadAskHalogenM :: MonadAsk r m => MonadAsk r (HalogenM state action slots output m) where\n ask = HalogenM $ liftF $ Lift ask\n\ninstance monadTellHalogenM :: MonadTell w m => MonadTell w (HalogenM state action slots output m) where\n tell = HalogenM <<< liftF <<< Lift <<< tell\n\ninstance monadThrowHalogenM :: MonadThrow e m => MonadThrow e (HalogenM state action slots output m) where\n throwError = HalogenM <<< liftF <<< Lift <<< throwError\n\n-- | An applicative-only version of `HalogenM` to allow for parallel evaluation.\nnewtype HalogenAp state action slots output m a = HalogenAp (FreeAp (HalogenM state action slots output m) a)\n\nderive instance newtypeHalogenAp :: Newtype (HalogenAp state query slots output m a) _\nderive newtype instance functorHalogenAp :: Functor (HalogenAp state query slots output m)\nderive newtype instance applyHalogenAp :: Apply (HalogenAp state query slots output m)\nderive newtype instance applicativeHalogenAp :: Applicative (HalogenAp state query slots output m)\n\n-- | Raises an output message for the component.\nraise :: forall state action slots output m. output -> HalogenM state action slots output m Unit\nraise o = HalogenM $ liftF $ Raise o unit\n\n-- | Sends a query to a child of a component at the specified slot.\nquery\n :: forall state action output m label slots query output' slot a _1\n . Row.Cons label (Slot query output' slot) _1 slots\n => IsSymbol label\n => Ord slot\n => Proxy label\n -> slot\n -> query a\n -> HalogenM state action slots output m (Maybe a)\nquery label p q = HalogenM $ liftF $ ChildQuery $ CQ.mkChildQueryBox $\n CQ.ChildQuery (\\k -> maybe (pure Nothing) k <<< Slot.lookup label p) q identity\n\n-- | Sends a query to all children of a component at a given slot label.\nqueryAll\n :: forall state action output m label slots query output' slot a _1\n . Row.Cons label (Slot query output' slot) _1 slots\n => IsSymbol label\n => Ord slot\n => Proxy label\n -> query a\n -> HalogenM state action slots output m (Map slot a)\nqueryAll label q =\n HalogenM $ liftF $ ChildQuery $ CQ.mkChildQueryBox $\n CQ.ChildQuery (\\k -> map catMapMaybes <<< traverse k <<< Slot.slots label) q identity\n where\n catMapMaybes :: forall k v. Ord k => Map k (Maybe v) -> Map k v\n catMapMaybes = foldrWithIndex (\\k v acc -> maybe acc (flip (Map.insert k) acc) v) Map.empty\n\n-- | The ID value associated with a subscription. Allows the subscription to be\n-- | stopped at a later time.\nnewtype SubscriptionId = SubscriptionId Int\n\nderive newtype instance eqSubscriptionId :: Eq SubscriptionId\nderive newtype instance ordSubscriptionId :: Ord SubscriptionId\n\n-- | Subscribes a component to an `Emitter`.\n-- |\n-- | When a component is disposed of any active subscriptions will automatically\n-- | be stopped and no further subscriptions will be possible during\n-- | finalization.\nsubscribe :: forall state action slots output m. HS.Emitter action -> HalogenM state action slots output m SubscriptionId\nsubscribe es = HalogenM $ liftF $ Subscribe (\\_ -> es) identity\n\n-- | An alternative to `subscribe`, intended for subscriptions that unsubscribe\n-- | themselves. Instead of returning the `SubscriptionId` from `subscribe'`, it\n-- | is passed into an `Emitter` constructor. This allows emitted queries\n-- | to include the `SubscriptionId`, rather than storing it in the state of the\n-- | component.\n-- |\n-- | When a component is disposed of any active subscriptions will automatically\n-- | be stopped and no further subscriptions will be possible during\n-- | finalization.\nsubscribe' :: forall state action slots output m. (SubscriptionId -> HS.Emitter action) -> HalogenM state action slots output m Unit\nsubscribe' esc = HalogenM $ liftF $ Subscribe esc (const unit)\n\n-- | Unsubscribes a component from a subscription. If the subscription associated\n-- | with the ID has already ended this will have no effect.\nunsubscribe :: forall state action slots output m. SubscriptionId -> HalogenM state action slots output m Unit\nunsubscribe sid = HalogenM $ liftF $ Unsubscribe sid unit\n\n-- | The ID value associated with a forked process. Allows the fork to be killed\n-- | at a later time.\nnewtype ForkId = ForkId Int\n\nderive newtype instance eqForkId :: Eq ForkId\nderive newtype instance ordForkId :: Ord ForkId\n\n-- | Starts a `HalogenM` process running independent from the current `eval`\n-- | \"thread\".\n-- |\n-- | A commonly use case for `fork` is in component initializers where some\n-- | async action is started. Normally all interaction with the component will\n-- | be blocked until the initializer completes, but if the async action is\n-- | `fork`ed instead, the initializer can complete synchronously while the\n-- | async action continues.\n-- |\n-- | Some care needs to be taken when using a `fork` that can modify the\n-- | component state, as it's easy for the forked process to \"clobber\" the state\n-- | (overwrite some or all of it with an old value) by mistake.\n-- |\n-- | When a component is disposed of any active forks will automatically\n-- | be killed. New forks can be started during finalization but there will be\n-- | no means of killing them.\nfork :: forall state action slots output m. HalogenM state action slots output m Unit -> HalogenM state action slots output m ForkId\nfork hmu = HalogenM $ liftF $ Fork hmu identity\n\n-- | Joins a forked process. Attempting to join a forked process that has\n-- | already ended will result in eval continuing immediately. Attempting\n-- | to join a forked process that has been killed will also terminate the\n-- | current eval.\njoin :: forall state action slots output m. ForkId -> HalogenM state action slots output m Unit\njoin fid = HalogenM $ liftF $ Join fid unit\n\n-- | Kills a forked process if it is still running. Attempting to kill a forked\n-- | process that has already ended will have no effect.\nkill :: forall state action slots output m. ForkId -> HalogenM state action slots output m Unit\nkill fid = HalogenM $ liftF $ Kill fid unit\n\n-- | Retrieves an `Element` value that is associated with a `Ref` in the\n-- | rendered output of a component. If there is no currently rendered value for\n-- | the requested ref this will return `Nothing`.\ngetRef :: forall state action slots output m. RefLabel -> HalogenM state action slots output m (Maybe Element)\ngetRef p = HalogenM $ liftF $ GetRef p identity\n\nimapState\n :: forall state state' action slots output m a\n . (state -> state')\n -> (state' -> state)\n -> HalogenM state action slots output m a\n -> HalogenM state' action slots output m a\nimapState f f' (HalogenM h) = HalogenM (hoistFree go h)\n where\n go :: HalogenF state action slots output m ~> HalogenF state' action slots output m\n go = case _ of\n State fs -> State (map f <<< fs <<< f')\n Subscribe fes k -> Subscribe fes k\n Unsubscribe sid a -> Unsubscribe sid a\n Lift q -> Lift q\n ChildQuery cq -> ChildQuery cq\n Raise o a -> Raise o a\n Par p -> Par (over HalogenAp (hoistFreeAp (imapState f f')) p)\n Fork hmu k -> Fork (imapState f f' hmu) k\n Join fid a -> Join fid a\n Kill fid a -> Kill fid a\n GetRef p k -> GetRef p k\n\nmapAction\n :: forall state action action' slots output m a\n . Functor m\n => (action -> action')\n -> HalogenM state action slots output m a\n -> HalogenM state action' slots output m a\nmapAction f (HalogenM h) = HalogenM (hoistFree go h)\n where\n go :: HalogenF state action slots output m ~> HalogenF state action' slots output m\n go = case _ of\n State fs -> State fs\n Subscribe fes k -> Subscribe (map f <<< fes) k\n Unsubscribe sid a -> Unsubscribe sid a\n Lift q -> Lift q\n ChildQuery cq -> ChildQuery cq\n Raise o a -> Raise o a\n Par p -> Par (over HalogenAp (hoistFreeAp (mapAction f)) p)\n Fork hmu k -> Fork (mapAction f hmu) k\n Join fid a -> Join fid a\n Kill fid a -> Kill fid a\n GetRef p k -> GetRef p k\n\nmapOutput\n :: forall state action slots output output' m a\n . (output -> output')\n -> HalogenM state action slots output m a\n -> HalogenM state action slots output' m a\nmapOutput f (HalogenM h) = HalogenM (hoistFree go h)\n where\n go :: HalogenF state action slots output m ~> HalogenF state action slots output' m\n go = case _ of\n State fs -> State fs\n Subscribe fes k -> Subscribe fes k\n Unsubscribe sid a -> Unsubscribe sid a\n Lift q -> Lift q\n ChildQuery cq -> ChildQuery cq\n Raise o a -> Raise (f o) a\n Par p -> Par (over HalogenAp (hoistFreeAp (mapOutput f)) p)\n Fork hmu k -> Fork (mapOutput f hmu) k\n Join fid a -> Join fid a\n Kill fid a -> Kill fid a\n GetRef p k -> GetRef p k\n\nhoist\n :: forall state action slots output m m' a\n . Functor m'\n => (m ~> m')\n -> HalogenM state action slots output m a\n -> HalogenM state action slots output m' a\nhoist nat (HalogenM fa) = HalogenM (hoistFree go fa)\n where\n go :: HalogenF state action slots output m ~> HalogenF state action slots output m'\n go = case _ of\n State f -> State f\n Subscribe fes k -> Subscribe fes k\n Unsubscribe sid a -> Unsubscribe sid a\n Lift q -> Lift (nat q)\n ChildQuery cq -> ChildQuery cq\n Raise o a -> Raise o a\n Par p -> Par (over HalogenAp (hoistFreeAp (hoist nat)) p)\n Fork hmu k -> Fork (hoist nat hmu) k\n Join fid a -> Join fid a\n Kill fid a -> Kill fid a\n GetRef p k -> GetRef p k\n", "module Halogen.Query.HalogenQ where\n\nimport Prelude\n\nimport Data.Bifunctor (class Bifunctor)\nimport Data.Coyoneda (Coyoneda)\n\ndata HalogenQ query action input a\n = Initialize a\n | Finalize a\n | Receive input a\n | Action action a\n | Query (Coyoneda query a) (Unit -> a)\n\ninstance bifunctorHalogenQ :: Bifunctor (HalogenQ query action) where\n bimap f g = case _ of\n Initialize a -> Initialize (g a)\n Finalize a -> Finalize (g a)\n Receive i a -> Receive (f i) (g a)\n Action action a -> Action action (g a)\n Query fa k -> Query (map g fa) (map g k)\n\nderive instance functorHalogenQ :: Functor (HalogenQ query action input)\n", "module Halogen.VDom.Thunk\n ( Thunk\n , buildThunk\n , runThunk\n , hoist\n , mapThunk\n , thunked\n , thunk1\n , thunk2\n , thunk3\n ) where\n\nimport Prelude\n\nimport Data.Function.Uncurried as Fn\nimport Effect.Uncurried as EFn\nimport Halogen.VDom as V\nimport Halogen.VDom.Machine as M\nimport Halogen.VDom.Util as Util\nimport Unsafe.Coerce (unsafeCoerce)\nimport Web.DOM.Node (Node)\n\nforeign import data ThunkArg \u2237 Type\n\nforeign import data ThunkId \u2237 Type\n\ndata Thunk :: (Type -> Type) -> Type -> Type\ndata Thunk f i = Thunk ThunkId (Fn.Fn2 ThunkArg ThunkArg Boolean) (ThunkArg \u2192 f i) ThunkArg\n\nunsafeThunkId \u2237 \u2200 a. a \u2192 ThunkId\nunsafeThunkId = unsafeCoerce\n\ninstance functorThunk \u2237 Functor f \u21D2 Functor (Thunk f) where\n map f (Thunk a b c d) = Thunk a b (c >>> map f) d\n\nhoist \u2237 \u2200 f g. (f ~> g) \u2192 Thunk f ~> Thunk g\nhoist = mapThunk\n\nmapThunk \u2237 \u2200 f g i j. (f i -> g j) \u2192 Thunk f i -> Thunk g j\nmapThunk k (Thunk a b c d) = Thunk a b (c >>> k) d\n\nthunk \u2237 \u2200 a f i. Fn.Fn4 ThunkId (Fn.Fn2 a a Boolean) (a \u2192 f i) a (Thunk f i)\nthunk = Fn.mkFn4 \\tid eqFn f a \u2192\n Thunk tid\n (unsafeCoerce eqFn \u2237 Fn.Fn2 ThunkArg ThunkArg Boolean)\n (unsafeCoerce f \u2237 ThunkArg \u2192 f i)\n (unsafeCoerce a \u2237 ThunkArg)\n\nthunked \u2237 \u2200 a f i. (a \u2192 a \u2192 Boolean) \u2192 (a \u2192 f i) \u2192 a \u2192 Thunk f i\nthunked eqFn f =\n let\n tid = unsafeThunkId { f }\n eqFn' = Fn.mkFn2 eqFn\n in\n \\a \u2192 Fn.runFn4 thunk tid eqFn' f a\n\nthunk1 \u2237 \u2200 a f i. Fn.Fn2 (a \u2192 f i) a (Thunk f i)\nthunk1 = Fn.mkFn2 \\f a \u2192 Fn.runFn4 thunk (unsafeThunkId f) Util.refEq f a\n\nthunk2 \u2237 \u2200 a b f i. Fn.Fn3 (a \u2192 b \u2192 f i) a b (Thunk f i)\nthunk2 =\n let\n eqFn = Fn.mkFn2 \\a b \u2192\n Fn.runFn2 Util.refEq a._1 b._1 &&\n Fn.runFn2 Util.refEq a._2 b._2\n in\n Fn.mkFn3 \\f a b \u2192\n Fn.runFn4 thunk (unsafeThunkId f) eqFn (\\{ _1, _2 } \u2192 f _1 _2) { _1: a, _2: b }\n\nthunk3 \u2237 \u2200 a b c f i. Fn.Fn4 (a \u2192 b \u2192 c \u2192 f i) a b c (Thunk f i)\nthunk3 =\n let\n eqFn = Fn.mkFn2 \\a b \u2192\n Fn.runFn2 Util.refEq a._1 b._1 &&\n Fn.runFn2 Util.refEq a._2 b._2 &&\n Fn.runFn2 Util.refEq a._3 b._3\n in\n Fn.mkFn4 \\f a b c \u2192\n Fn.runFn4 thunk (unsafeThunkId f) eqFn (\\{ _1, _2, _3 } \u2192 f _1 _2 _3) { _1: a, _2: b, _3: c }\n\nrunThunk \u2237 \u2200 f i. Thunk f i \u2192 f i\nrunThunk (Thunk _ _ render arg) = render arg\n\nunsafeEqThunk \u2237 \u2200 f i. Fn.Fn2 (Thunk f i) (Thunk f i) Boolean\nunsafeEqThunk = Fn.mkFn2 \\(Thunk a1 b1 _ d1) (Thunk a2 b2 _ d2) \u2192\n Fn.runFn2 Util.refEq a1 a2 &&\n Fn.runFn2 Util.refEq b1 b2 &&\n Fn.runFn2 b1 d1 d2\n\ntype ThunkState :: (Type -> Type) -> Type -> Type -> Type -> Type\ntype ThunkState f i a w =\n { thunk \u2237 Thunk f i\n , vdom \u2237 M.Step (V.VDom a w) Node\n }\n\nbuildThunk\n \u2237 \u2200 f i a w\n . (f i \u2192 V.VDom a w)\n \u2192 V.VDomSpec a w\n \u2192 V.Machine (Thunk f i) Node\nbuildThunk toVDom = renderThunk\n where\n renderThunk \u2237 V.VDomSpec a w \u2192 V.Machine (Thunk f i) Node\n renderThunk spec = EFn.mkEffectFn1 \\t \u2192 do\n vdom \u2190 EFn.runEffectFn1 (V.buildVDom spec) (toVDom (runThunk t))\n pure $ M.mkStep $ M.Step (M.extract vdom) { thunk: t, vdom } patchThunk haltThunk\n\n patchThunk \u2237 EFn.EffectFn2 (ThunkState f i a w) (Thunk f i) (V.Step (Thunk f i) Node)\n patchThunk = EFn.mkEffectFn2 \\state t2 \u2192 do\n let { vdom: prev, thunk: t1 } = state\n if Fn.runFn2 unsafeEqThunk t1 t2\n then pure $ M.mkStep $ M.Step (M.extract prev) state patchThunk haltThunk\n else do\n vdom \u2190 EFn.runEffectFn2 M.step prev (toVDom (runThunk t2))\n pure $ M.mkStep $ M.Step (M.extract vdom) { vdom, thunk: t2 } patchThunk haltThunk\n\n haltThunk \u2237 EFn.EffectFn1 (ThunkState f i a w) Unit\n haltThunk = EFn.mkEffectFn1 \\state \u2192 do\n EFn.runEffectFn1 M.halt state.vdom\n", "module Halogen.Component\n ( Component\n , ComponentSpec\n , mkComponent\n , unComponent\n , hoist\n , EvalSpec\n , mkEval\n , defaultEval\n , ComponentSlotBox\n , ComponentSlot(..)\n , componentSlot\n , ComponentSlotSpec\n , mkComponentSlot\n , unComponentSlot\n , hoistSlot\n ) where\n\nimport Prelude\n\nimport Data.Bifunctor (bimap, lmap)\nimport Data.Coyoneda (unCoyoneda)\nimport Data.Foldable (traverse_)\nimport Data.Maybe (Maybe(..), maybe)\nimport Data.Symbol (class IsSymbol)\nimport Data.Tuple (Tuple)\nimport Halogen.Data.Slot (Slot, SlotStorage)\nimport Halogen.Data.Slot as Slot\nimport Halogen.HTML.Core as HC\nimport Halogen.Query.HalogenM (HalogenM)\nimport Halogen.Query.HalogenM as HM\nimport Halogen.Query.HalogenQ (HalogenQ(..))\nimport Halogen.VDom.Thunk (Thunk)\nimport Halogen.VDom.Thunk as Thunk\nimport Prim.Row as Row\nimport Type.Proxy (Proxy)\nimport Unsafe.Coerce (unsafeCoerce)\n\n-- | The \"public\" type for a component, with details of the component internals\n-- | existentially hidden.\n-- |\n-- | `HTML`\n-- | - `query` is the query algebra; the requests that can be made of the\n-- | component\n-- | - `input` is the input value that will be received when the parent of\n-- | this component renders\n-- | - `output` is the type of messages the component can raise\n-- | - `m` is the effect monad used during evaluation\ndata Component\n (query :: Type -> Type)\n (input :: Type)\n (output :: Type)\n (m :: Type -> Type)\n\n-- | The spec for a component.\n-- |\n-- | The type variables involved:\n-- | - `state` is the component's state\n-- | - `query` is the query algebra; the requests that can be made of the\n-- | component\n-- | - `action` is the type of actions; messages internal to the component that\n-- | can be evaluated\n-- | - `slots` is the set of slots for addressing child components\n-- | - `input` is the input value that will be received when the parent of\n-- | this component renders\n-- | - `output` is the type of messages the component can raise\n-- | - `m` is the effect monad used during evaluation\n-- |\n-- | The values in the record:\n-- | - `initialState` is a function that accepts an input value and produces the\n-- | state the component will start with. If the input value is unused\n-- | (`Unit`), or irrelevant to the state construction, this will often be\n-- | `const ?someInitialStateValue`.\n-- | - `render` is a function that accepts the component's current state and\n-- | produces a value to render (`HTML` usually). The rendered output can\n-- | raise actions that will be handled in `eval`.\n-- | - `eval` is a function that handles the `HalogenQ` algebra that deals with\n-- | component lifecycle, handling actions, and responding to requests.\ntype ComponentSpec state query action slots input output m =\n { initialState :: input -> state\n , render :: state -> HC.HTML (ComponentSlot slots m action) action\n , eval :: HalogenQ query action input ~> HalogenM state action slots output m\n }\n\n-- | Constructs a [`Component`](#t:Component) from a [`ComponentSpec`](#t:ComponentSpec).\nmkComponent\n :: forall state query action slots input output m\n . ComponentSpec state query action slots input output m\n -> Component query input output m\nmkComponent = unsafeCoerce\n\n-- | Exposes the inner details of a [`Component`](#t:Component) to a function\n-- | to produce a new result.\n-- |\n-- | The hidden details will not be allowed to be revealed in the result\n-- | of the function - if any of the hidden types (state, action, set of slots)\n-- | appear in the result, the compiler will complain about an escaped skolem.\nunComponent\n :: forall query input output m a\n . (forall state action slots. ComponentSpec state query action slots input output m -> a)\n -> Component query input output m\n -> a\nunComponent = unsafeCoerce\n\n-- | Changes the [`Component`](#t:Component)'s `m` type. A use case for this\n-- | might be to interpret some `Free` monad as `Aff` so the component can be\n-- | used with `runUI`.\nhoist\n :: forall query input output m m'\n . Functor m'\n => (m ~> m')\n -> Component query input output m\n -> Component query input output m'\nhoist nat = unComponent \\c ->\n mkComponent\n { initialState: c.initialState\n , render: lmap (hoistSlot nat) <<< c.render\n , eval: HM.hoist nat <<< c.eval\n }\n\n-- | The spec record that `mkEval` accepts to construct a component `eval`\n-- | function.\n-- |\n-- | It's not a requirement to use `mkEval`, and sometimes it's preferrable\n-- | to write a component `eval` function from scratch, but often `mkEval` is\n-- | more convenient for common cases.\n-- |\n-- | See below for more details about `mkEval` and `defaultEval`.\ntype EvalSpec state query action slots input output m =\n { handleAction :: action -> HalogenM state action slots output m Unit\n , handleQuery :: forall a. query a -> HalogenM state action slots output m (Maybe a)\n , receive :: input -> Maybe action\n , initialize :: Maybe action\n , finalize :: Maybe action\n }\n\n-- | A default value for `mkEval` that will result in an `eval` that nothing at\n-- | all - all incoming actions and queries will be ignored, and no receiver,\n-- | initializer, or finalizer will be specified.\n-- |\n-- | Usually this will be used with record update syntax to override fields to\n-- | specify things as needed. If a component only needs to handle actions,\n-- | for instance, a usage might be something like this:\n-- |\n-- | ```purescript\n-- | H.mkComponent\n-- | { initialState\n-- | , render\n-- | , eval: H.mkEval (H.defaultEval { handleAction = ?handleAction })\n-- | }\n-- | ```\ndefaultEval :: forall state query action slots input output m. EvalSpec state query action slots input output m\ndefaultEval =\n { handleAction: const (pure unit)\n , handleQuery: const (pure Nothing)\n , receive: const Nothing\n , initialize: Nothing\n , finalize: Nothing\n }\n\n-- | Accepts an `EvalSpec` to produce an `eval` function for a component. For\n-- | example:\n-- |\n-- | ```purescript\n-- | -- use `defaultEval` and override fields selectively\n-- | H.mkEval (H.defaultEval { handleAction = ?handleAction })\n-- |\n-- | -- or specify all the fields in the `EvalSpec`\n-- | H.mkEval\n-- | { handleAction: ?handleAction\n-- | , handleQuery: ?handleQuery\n-- | , receive: ?receive\n-- | , initialize: ?initialize\n-- | , finalize: ?finalize\n-- | }\n-- | ```\nmkEval\n :: forall state query action slots input output m a\n . EvalSpec state query action slots input output m\n -> HalogenQ query action input a\n -> HalogenM state action slots output m a\nmkEval args = case _ of\n Initialize a ->\n traverse_ args.handleAction args.initialize $> a\n Finalize a ->\n traverse_ args.handleAction args.finalize $> a\n Receive i a ->\n traverse_ args.handleAction (args.receive i) $> a\n Action action a ->\n args.handleAction action $> a\n Query req f ->\n unCoyoneda (\\g -> map (maybe (f unit) g) <<< args.handleQuery) req\n\n-- | A slot for a child component in a component's rendered content.\ndata ComponentSlotBox\n (slots :: Row Type)\n (m :: Type -> Type)\n (action :: Type)\n\ninstance functorComponentSlotBox :: Functor (ComponentSlotBox slots m) where\n map f = unComponentSlot \\slot ->\n mkComponentSlot $ slot { output = map f <$> slot.output }\n\ndata ComponentSlot slots m action\n = ComponentSlot (ComponentSlotBox slots m action)\n | ThunkSlot (Thunk (HC.HTML (ComponentSlot slots m action)) action)\n\ninstance functorComponentSlot :: Functor (ComponentSlot slots m) where\n map f = case _ of\n ComponentSlot box -> ComponentSlot (map f box)\n ThunkSlot thunk -> ThunkSlot (Thunk.mapThunk (bimap (map f) f) thunk)\n\n-- | Constructs a [`ComponentSlot`](#t:ComponentSlot).\n-- |\n-- | Takes:\n-- | - the slot address label\n-- | - the slot address index\n-- | - the component for the slot\n-- | - the input value to pass to the component\n-- | - a function mapping outputs from the component to a query in the parent\ncomponentSlot\n :: forall query input output slots m action label slot _1\n . Row.Cons label (Slot query output slot) _1 slots\n => IsSymbol label\n => Ord slot\n => Proxy label\n -> slot\n -> Component query input output m\n -> input\n -> (output -> Maybe action)\n -> ComponentSlotBox slots m action\ncomponentSlot label p comp input output =\n mkComponentSlot\n { get: Slot.lookup label p\n , pop: Slot.pop label p\n , set: Slot.insert label p\n , component: comp\n , input: input\n , output\n }\n\n-- | The internal representation used for a [`ComponentSlot`](#t:ComponentSlot).\ntype ComponentSlotSpec query input output slots m action =\n { get :: forall slot. SlotStorage slots slot -> Maybe (slot query output)\n , pop :: forall slot. SlotStorage slots slot -> Maybe (Tuple (slot query output) (SlotStorage slots slot))\n , set :: forall slot. slot query output -> SlotStorage slots slot -> SlotStorage slots slot\n , component :: Component query input output m\n , input :: input\n , output :: output -> Maybe action\n }\n\n-- | Constructs [`ComponentSlotBox`](#t:ComponentSlot) from a [`ComponentSlotSpec`](#t:ComponentSlotSpec).\nmkComponentSlot\n :: forall query input output slots m action\n . ComponentSlotSpec query input output slots m action\n -> ComponentSlotBox slots m action\nmkComponentSlot = unsafeCoerce\n\n-- | Exposes the inner details of a [`ComponentSlot`](#t:ComponentSlot) to a\n-- | function to produce a new result.\n-- |\n-- | The hidden details will not be allowed to be revealed in the result\n-- | of the function - if any of the hidden types (state, action, set of slots)\n-- | appear in the result, the compiler will complain about an escaped skolem.\nunComponentSlot\n :: forall slots m action a\n . (forall query input output. ComponentSlotSpec query input output slots m action -> a)\n -> ComponentSlotBox slots m action\n -> a\nunComponentSlot = unsafeCoerce\n\n-- | Changes the [`ComponentSlot`](#t:ComponentSlot)'s `m` type.\nhoistSlot\n :: forall slots m m' action\n . Functor m'\n => (m ~> m')\n -> ComponentSlot slots m action\n -> ComponentSlot slots m' action\nhoistSlot nat = case _ of\n ComponentSlot cs ->\n cs # unComponentSlot \\slot ->\n ComponentSlot $ mkComponentSlot $ slot { component = hoist nat slot.component }\n ThunkSlot t ->\n ThunkSlot $ Thunk.hoist (lmap (hoistSlot nat)) t\n", "export const log = function (s) {\n return function () {\n console.log(s);\n };\n};\n\nexport const warn = function (s) {\n return function () {\n console.warn(s);\n };\n};\n\nexport const error = function (s) {\n return function () {\n console.error(s);\n };\n};\n\nexport const info = function (s) {\n return function () {\n console.info(s);\n };\n};\n\nexport const debug = function (s) {\n return function () {\n console.debug(s);\n };\n};\n\nexport const time = function (s) {\n return function () {\n console.time(s);\n };\n};\n\nexport const timeLog = function (s) {\n return function () {\n console.timeLog(s);\n };\n};\n\nexport const timeEnd = function (s) {\n return function () {\n console.timeEnd(s);\n };\n};\n\nexport const clear = function () {\n console.clear();\n};\n\nexport const group = function (s) {\n return function () {\n console.group(s);\n };\n};\n\nexport const groupCollapsed = function (s) {\n return function () {\n console.groupCollapsed(s);\n };\n};\n\nexport const groupEnd = function () {\n console.groupEnd();\n};\n", "module CSS.Render where\n\nimport Prelude\n\nimport CSS.Property (Key(..), Prefixed(..), Value(..), plain)\nimport CSS.Selector (Path(..), Predicate(..), Refinement(..), Selector(..), with, star, element, (|*), (|>))\nimport CSS.String (fromString)\nimport CSS.Stylesheet (CSS, StyleM, App(..), Feature(..), Keyframes(..), MediaQuery(..), MediaType(..), Rule(..), runS)\nimport Data.Array (null, (:), drop, sort, uncons, mapMaybe)\nimport Data.Either (Either(..), either)\nimport Data.Foldable (fold, foldMap, intercalate, lookup)\nimport Data.Maybe (Maybe(..), fromMaybe, maybe)\nimport Data.NonEmpty (NonEmpty(..), (:|), oneOf)\nimport Data.Semigroup.Foldable (foldl1)\nimport Data.These (These(..), theseLeft, theseRight)\nimport Data.Tuple (Tuple(..), uncurry)\nimport Effect (Effect)\nimport Effect.Console (log)\n\nnewtype Inline = Inline String\n\nderive instance eqInline :: Eq Inline\nderive instance ordInline :: Ord Inline\n\ngetInline :: Inline -> String\ngetInline (Inline s) = s\n\ninstance semigroupInline :: Semigroup Inline where\n append (Inline a) (Inline b) = Inline (a <> b)\n\ninstance monoidInline :: Monoid Inline where\n mempty = Inline mempty\n\nnewtype Sheet = Sheet String\n\nderive instance eqSheet :: Eq Sheet\nderive instance ordSheet :: Ord Sheet\n\ngetSheet :: Sheet -> String\ngetSheet (Sheet s) = s\n\ninstance semigroupFile :: Semigroup Sheet where\n append (Sheet a) (Sheet b) = Sheet (a <> b)\n\ninstance monoidFile :: Monoid Sheet where\n mempty = Sheet mempty\n\ntype Rendered = Maybe (These Inline Sheet)\n\nrenderedInline :: Rendered -> Maybe String\nrenderedInline = (_ >>= (map getInline <<< theseLeft))\n\nrenderedSheet :: Rendered -> Maybe String\nrenderedSheet = (_ >>= (map getSheet <<< theseRight))\n\nrender :: forall a. StyleM a -> Rendered\nrender = rules [] <<< runS\n\nputInline :: CSS -> Effect Unit\nputInline s = log <<< fromMaybe \"\" <<< renderedInline <<< render $ s\n\nputStyleSheet :: CSS -> Effect Unit\nputStyleSheet s = log <<< fromMaybe \"\" <<< renderedSheet <<< render $ s\n\nkframe :: Keyframes -> Rendered\nkframe (Keyframes ident xs) =\n Just $ That $ Sheet $ allKeywordsWithContent\n where\n renderContent =\n \" \" <> ident <> \" { \" <> intercalate \" \" (uncurry frame <$> xs) <> \" }\\n\"\n\n keywords =\n [ \"@keyframes\"\n , \"@-webkit-keyframes\"\n , \"@-moz-keyframes\"\n , \"@-o-keyframes\"\n ]\n\n allKeywordsWithContent =\n fold $ map (_ <> renderContent) keywords\n\nframe :: Number -> Array Rule -> String\nframe p rs = show p <> \"% \" <> \"{ \" <> x <> \" }\"\n where\n x = fromMaybe \"\" <<< renderedInline $ rules [] rs\n\nquery' :: MediaQuery -> Array App -> Array Rule -> Rendered\nquery' q sel rs = Just <<< That <<< Sheet $ mediaQuery q <> \" { \" <> fromMaybe \"\" (renderedSheet $ rules sel rs) <> \" }\\n\"\n\nmediaQuery :: MediaQuery -> String\nmediaQuery (MediaQuery _ ty fs) = \"@media \" <> mediaType ty <> foldl1 (<>) ((\" and \" <> _) <<< feature <$> fs)\n\nmediaType :: MediaType -> String\nmediaType (MediaType (Value s)) = plain s\n\nfeature :: Feature -> String\nfeature (Feature k mv) = maybe k (\\(Value v) -> \"(\" <> k <> \": \" <> plain v <> \")\") mv\n\nface :: Array Rule -> Rendered\nface rs = Just <<< That <<< Sheet $ \"@font-face { \" <> fromMaybe \"\" (renderedInline $ rules [] rs) <> \" }\\n\"\n\nrules :: Array App -> Array Rule -> Rendered\nrules sel rs = topRules <> importRules <> keyframeRules <> faceRules <> nestedSheets <> queryRules\n where\n property (Property k v) = Just (Tuple k v)\n property _ = Nothing\n nested (Nested a ns) = Just (Tuple a ns)\n nested _ = Nothing\n queries (Query q ns) = Just (Tuple q ns)\n queries _ = Nothing\n kframes (Keyframe fs) = Just fs\n kframes _ = Nothing\n faces (Face ns) = Just ns\n faces _ = Nothing\n imports (Import i) = Just i\n imports _ = Nothing\n topRules = do\n let rs' = mapMaybe property rs\n if not null rs' then rule' sel rs' else Nothing\n nestedSheets = fold $ uncurry nestedRules <$> mapMaybe nested rs\n nestedRules a = rules (a : sel)\n queryRules = foldMap (uncurry $ flip query' sel) $ mapMaybe queries rs\n keyframeRules = foldMap kframe $ mapMaybe kframes rs\n faceRules = foldMap face $ mapMaybe faces rs\n importRules = foldMap imp $ mapMaybe imports rs\n\nimp :: String -> Rendered\nimp t = Just <<< That <<< Sheet <<< fromString $ \"@import url(\" <> t <> \");\\n\"\n\nrule' :: forall a. Array App -> Array (Tuple (Key a) Value) -> Rendered\nrule' sel props = maybe q o $ nel sel\n where\n p = props >>= collect\n q = (This <<< Inline <<< properties <<< oneOf) <$> nel p\n o sel' = Just <<< That <<< Sheet $ intercalate \" \" [ selector (merger sel'), \"{\", properties p, \"}\\n\" ]\n\nselector :: Selector -> String\nselector = intercalate \", \" <<< selector'\n\nselector' :: Selector -> Array String\nselector' (Selector (Refinement ft) p) = (_ <> (foldMap predicate (sort ft))) <$> selector'' ft p\n\nselector'' :: Array Predicate -> Path Selector -> Array String\nselector'' [] Star = [ \"*\" ]\nselector'' _ Star = [ \"\" ]\nselector'' _ (Elem t) = [ t ]\nselector'' _ (PathChild a b) = sepWith \" > \" <$> selector' a <*> selector' b\nselector'' _ (Deep a b) = sepWith \" \" <$> selector' a <*> selector' b\nselector'' _ (Adjacent a b) = sepWith \" + \" <$> selector' a <*> selector' b\nselector'' _ (Combined a b) = selector' a <> selector' b\n\nsepWith :: String -> String -> String -> String\nsepWith s a b = a <> s <> b\n\ncollect :: forall a. Tuple (Key a) Value -> Array (Either String (Tuple String String))\ncollect (Tuple (Key ky) (Value v1)) = collect' ky v1\n\ncollect' :: Prefixed -> Prefixed -> Array (Either String (Tuple String String))\ncollect' (Plain k) (Plain v) = [ Right (Tuple k v) ]\ncollect' (Prefixed ks) (Plain v) = (\\(Tuple p k) -> Right $ Tuple (p <> k) v) <$> ks\ncollect' (Plain k) (Prefixed vs) = (\\(Tuple p v) -> Right $ Tuple k (p <> v)) <$> vs\ncollect' (Prefixed ks) (Prefixed vs) = (\\(Tuple p k) -> maybe (Left (p <> k)) (Right <<< Tuple (p <> k) <<< (p <> _)) $ lookup p vs) <$> ks\n\nproperties :: Array (Either String (Tuple String String)) -> String\nproperties xs = intercalate \"; \" $ sheetRules <$> xs\n where\n sheetRules = either (\\_ -> mempty) (\\(Tuple k v) -> fold [ k, \": \", v ])\n\nmerger :: NonEmpty Array App -> Selector\nmerger (NonEmpty x xs) =\n case x of\n Child s -> maybe s (\\xs' -> merger xs' |> s) $ nel xs\n Sub s -> maybe s (\\xs' -> merger xs' |* s) $ nel xs\n Root s -> maybe s (\\xs' -> s |* merger xs') $ nel xs\n Pop i -> maybe (element \"TODO\") merger <<< nel <<< drop i $ x : xs\n Self sheetRules -> maybe (star `with` sheetRules) (\\xs' -> merger xs' `with` sheetRules) $ nel xs\n\npredicate :: Predicate -> String\npredicate (Id a) = \"#\" <> a\npredicate (Class a) = \".\" <> a\npredicate (Attr a) = \"[\" <> a <> \"]\"\npredicate (AttrVal a v) = \"[\" <> a <> \"='\" <> v <> \"']\"\npredicate (AttrBegins a v) = \"[\" <> a <> \"^='\" <> v <> \"']\"\npredicate (AttrEnds a v) = \"[\" <> a <> \"$='\" <> v <> \"']\"\npredicate (AttrContains a v) = \"[\" <> a <> \"*='\" <> v <> \"']\"\npredicate (AttrSpace a v) = \"[\" <> a <> \"~='\" <> v <> \"']\"\npredicate (AttrHyph a v) = \"[\" <> a <> \"|='\" <> v <> \"']\"\npredicate (Pseudo a) = \":\" <> a\npredicate (PseudoFunc a p) = \":\" <> a <> \"(\" <> intercalate \",\" p <> \")\"\n\nnel :: forall a. Array a -> Maybe (NonEmpty Array a)\nnel [] = Nothing\nnel xs = (\\{ head: head, tail: tail } -> head :| tail) <$> uncons xs\n", "module Halogen.HTML.Elements\n ( Node\n , Leaf\n , element\n , elementNS\n , keyed\n , keyedNS\n , withKeys\n , withKeys_\n , a\n , a_\n , abbr\n , abbr_\n , address\n , address_\n , area\n , article\n , article_\n , aside\n , aside_\n , audio\n , audio_\n , b\n , b_\n , base\n , bdi\n , bdi_\n , bdo\n , bdo_\n , blockquote\n , blockquote_\n , body\n , body_\n , br\n , br_\n , button\n , button_\n , canvas\n , caption\n , caption_\n , cite\n , cite_\n , code\n , code_\n , col\n , colgroup\n , colgroup_\n , command\n , datalist\n , datalist_\n , dd\n , dd_\n , del\n , del_\n , details\n , details_\n , dfn\n , dfn_\n , dialog\n , dialog_\n , div\n , div_\n , dl\n , dl_\n , dt\n , dt_\n , em\n , em_\n , embed\n , embed_\n , fieldset\n , fieldset_\n , figcaption\n , figcaption_\n , figure\n , figure_\n , footer\n , footer_\n , form\n , form_\n , h1\n , h1_\n , h2\n , h2_\n , h3\n , h3_\n , h4\n , h4_\n , h5\n , h5_\n , h6\n , h6_\n , head\n , head_\n , header\n , header_\n , hr\n , hr_\n , html\n , html_\n , i\n , i_\n , iframe\n , img\n , input\n , ins\n , ins_\n , kbd\n , kbd_\n , label\n , label_\n , legend\n , legend_\n , li\n , li_\n , link\n , main\n , main_\n , map\n , map_\n , mark\n , mark_\n , menu\n , menu_\n , menuitem\n , menuitem_\n , meta\n , meter\n , meter_\n , nav\n , nav_\n , noscript\n , noscript_\n , object\n , object_\n , ol\n , ol_\n , optgroup\n , optgroup_\n , option\n , option_\n , output\n , output_\n , p\n , p_\n , param\n , pre\n , pre_\n , progress\n , progress_\n , q\n , q_\n , rp\n , rp_\n , rt\n , rt_\n , ruby\n , ruby_\n , samp\n , samp_\n , script\n , script_\n , section\n , section_\n , select\n , select_\n , small\n , small_\n , source\n , span\n , span_\n , strong\n , strong_\n , style\n , style_\n , sub\n , sub_\n , summary\n , summary_\n , sup\n , sup_\n , table\n , table_\n , tbody\n , tbody_\n , td\n , td_\n , textarea\n , tfoot\n , tfoot_\n , th\n , th_\n , thead\n , thead_\n , time\n , time_\n , title\n , title_\n , tr\n , tr_\n , track\n , u\n , u_\n , ul\n , ul_\n , var\n , var_\n , video\n , video_\n , wbr\n ) where\n\nimport Prelude ((#), (>>>), pure)\nimport Data.Maybe (Maybe(Nothing))\nimport Data.Tuple (Tuple)\n\nimport DOM.HTML.Indexed as I\n\nimport Halogen.HTML.Core (ElemName(..), HTML(..), Namespace, Prop)\nimport Halogen.HTML.Core as Core\nimport Halogen.HTML.Properties (IProp)\nimport Halogen.Query.Input (Input)\nimport Halogen.VDom as VDom\n\nimport Unsafe.Coerce (unsafeCoerce)\n\n-- | An HTML element that admits children.\ntype Node r w i = Array (IProp r i) -> Array (HTML w i) -> HTML w i\n\n-- | An HTML element that does not admit children.\ntype Leaf r w i = Array (IProp r i) -> HTML w i\n\n-- | Creates an HTML element that expects indexed properties.\nelement :: forall r w i. ElemName -> Array (IProp r i) -> Array (HTML w i) -> HTML w i\nelement =\n Core.element Nothing #\n ( unsafeCoerce\n :: (ElemName -> Array (Prop i) -> Array (HTML w i) -> HTML w i)\n -> ElemName\n -> Array (IProp r i)\n -> Array (HTML w i)\n -> HTML w i\n )\n\n-- | Creates a Namespaced HTML element that expects indexed properties.\nelementNS :: forall r w i. Namespace -> ElemName -> Array (IProp r i) -> Array (HTML w i) -> HTML w i\nelementNS =\n pure >>> Core.element >>>\n ( unsafeCoerce\n :: (ElemName -> Array (Prop i) -> Array (HTML w i) -> HTML w i)\n -> ElemName\n -> Array (IProp r i)\n -> Array (HTML w i)\n -> HTML w i\n )\n\n-- | Creates an HTML element that expects indexed properties, with keyed\n-- | children.\nkeyed :: forall r w i. ElemName -> Array (IProp r i) -> Array (Tuple String (HTML w i)) -> HTML w i\nkeyed =\n Core.keyed Nothing #\n ( unsafeCoerce\n :: (ElemName -> Array (Prop i) -> Array (Tuple String (HTML w i)) -> HTML w i)\n -> ElemName\n -> Array (IProp r i)\n -> Array (Tuple String (HTML w i))\n -> HTML w i\n )\n\n-- | Creates a Namespaced HTML element that expects indexed properties, with\n-- | keyed children.\nkeyedNS :: forall r w i. Namespace -> ElemName -> Array (IProp r i) -> Array (Tuple String (HTML w i)) -> HTML w i\nkeyedNS =\n pure >>> Core.keyed >>>\n ( unsafeCoerce\n :: (ElemName -> Array (Prop i) -> Array (Tuple String (HTML w i)) -> HTML w i)\n -> ElemName\n -> Array (IProp r i)\n -> Array (Tuple String (HTML w i))\n -> HTML w i\n )\n\nwithKeys :: forall r w i. (Array (IProp r i) -> Array (HTML w i) -> HTML w i) -> Array (IProp r i) -> Array (Tuple String (HTML w i)) -> HTML w i\nwithKeys ctor props children =\n case ctor props [] of\n HTML (VDom.Elem x y z _) -> HTML (VDom.Keyed x y z (coe children))\n h -> h\n where\n coe :: Array (Tuple String (HTML w i)) -> Array (Tuple String (VDom.VDom (Array (Prop (Input i))) w))\n coe = unsafeCoerce\n\nwithKeys_ :: forall w i. (Array (HTML w i) -> HTML w i) -> Array (Tuple String (HTML w i)) -> HTML w i\nwithKeys_ ctor children =\n case ctor [] of\n HTML (VDom.Elem x y z _) -> HTML (VDom.Keyed x y z (coe children))\n h -> h\n where\n coe :: Array (Tuple String (HTML w i)) -> Array (Tuple String (VDom.VDom (Array (Prop (Input i))) w))\n coe = unsafeCoerce\n\na :: forall w i. Node I.HTMLa w i\na = element (ElemName \"a\")\n\na_ :: forall w i. Array (HTML w i) -> HTML w i\na_ = a []\n\nabbr :: forall w i. Node I.HTMLabbr w i\nabbr = element (ElemName \"abbr\")\n\nabbr_ :: forall w i. Array (HTML w i) -> HTML w i\nabbr_ = abbr []\n\naddress :: forall w i. Node I.HTMLaddress w i\naddress = element (ElemName \"address\")\n\naddress_ :: forall w i. Array (HTML w i) -> HTML w i\naddress_ = address []\n\narea :: forall w i. Leaf I.HTMLarea w i\narea props = element (ElemName \"area\") props []\n\narticle :: forall w i. Node I.HTMLarticle w i\narticle = element (ElemName \"article\")\n\narticle_ :: forall w i. Array (HTML w i) -> HTML w i\narticle_ = article []\n\naside :: forall w i. Node I.HTMLaside w i\naside = element (ElemName \"aside\")\n\naside_ :: forall w i. Array (HTML w i) -> HTML w i\naside_ = aside []\n\naudio :: forall w i. Node I.HTMLaudio w i\naudio = element (ElemName \"audio\")\n\naudio_ :: forall w i. Array (HTML w i) -> HTML w i\naudio_ = audio []\n\nb :: forall w i. Node I.HTMLb w i\nb = element (ElemName \"b\")\n\nb_ :: forall w i. Array (HTML w i) -> HTML w i\nb_ = b []\n\nbase :: forall w i. Leaf I.HTMLbase w i\nbase props = element (ElemName \"base\") props []\n\nbdi :: forall w i. Node I.HTMLbdi w i\nbdi = element (ElemName \"bdi\")\n\nbdi_ :: forall w i. Array (HTML w i) -> HTML w i\nbdi_ = bdi []\n\nbdo :: forall w i. Node I.HTMLbdo w i\nbdo = element (ElemName \"bdo\")\n\nbdo_ :: forall w i. Array (HTML w i) -> HTML w i\nbdo_ = bdo []\n\nblockquote :: forall w i. Node I.HTMLblockquote w i\nblockquote = element (ElemName \"blockquote\")\n\nblockquote_ :: forall w i. Array (HTML w i) -> HTML w i\nblockquote_ = blockquote []\n\nbody :: forall w i. Node I.HTMLbody w i\nbody = element (ElemName \"body\")\n\nbody_ :: forall w i. Array (HTML w i) -> HTML w i\nbody_ = body []\n\nbr :: forall w i. Leaf I.HTMLbr w i\nbr props = element (ElemName \"br\") props []\n\nbr_ :: forall w i. HTML w i\nbr_ = br []\n\nbutton :: forall w i. Node I.HTMLbutton w i\nbutton = element (ElemName \"button\")\n\nbutton_ :: forall w i. Array (HTML w i) -> HTML w i\nbutton_ = button []\n\ncanvas :: forall w i. Leaf I.HTMLcanvas w i\ncanvas props = element (ElemName \"canvas\") props []\n\ncaption :: forall w i. Node I.HTMLcaption w i\ncaption = element (ElemName \"caption\")\n\ncaption_ :: forall w i. Array (HTML w i) -> HTML w i\ncaption_ = caption []\n\ncite :: forall w i. Node I.HTMLcite w i\ncite = element (ElemName \"cite\")\n\ncite_ :: forall w i. Array (HTML w i) -> HTML w i\ncite_ = cite []\n\ncode :: forall w i. Node I.HTMLcode w i\ncode = element (ElemName \"code\")\n\ncode_ :: forall w i. Array (HTML w i) -> HTML w i\ncode_ = code []\n\ncol :: forall w i. Leaf I.HTMLcol w i\ncol props = element (ElemName \"col\") props []\n\ncolgroup :: forall w i. Node I.HTMLcolgroup w i\ncolgroup = element (ElemName \"colgroup\")\n\ncolgroup_ :: forall w i. Array (HTML w i) -> HTML w i\ncolgroup_ = colgroup []\n\ncommand :: forall w i. Leaf I.HTMLcommand w i\ncommand props = element (ElemName \"command\") props []\n\ndatalist :: forall w i. Node I.HTMLdatalist w i\ndatalist = element (ElemName \"datalist\")\n\ndatalist_ :: forall w i. Array (HTML w i) -> HTML w i\ndatalist_ = datalist []\n\ndd :: forall w i. Node I.HTMLdd w i\ndd = element (ElemName \"dd\")\n\ndd_ :: forall w i. Array (HTML w i) -> HTML w i\ndd_ = dd []\n\ndel :: forall w i. Node I.HTMLdel w i\ndel = element (ElemName \"del\")\n\ndel_ :: forall w i. Array (HTML w i) -> HTML w i\ndel_ = del []\n\ndetails :: forall w i. Node I.HTMLdetails w i\ndetails = element (ElemName \"details\")\n\ndetails_ :: forall w i. Array (HTML w i) -> HTML w i\ndetails_ = details []\n\ndfn :: forall w i. Node I.HTMLdfn w i\ndfn = element (ElemName \"dfn\")\n\ndfn_ :: forall w i. Array (HTML w i) -> HTML w i\ndfn_ = dfn []\n\ndialog :: forall w i. Node I.HTMLdialog w i\ndialog = element (ElemName \"dialog\")\n\ndialog_ :: forall w i. Array (HTML w i) -> HTML w i\ndialog_ = dialog []\n\ndiv :: forall w i. Node I.HTMLdiv w i\ndiv = element (ElemName \"div\")\n\ndiv_ :: forall w i. Array (HTML w i) -> HTML w i\ndiv_ = div []\n\ndl :: forall w i. Node I.HTMLdl w i\ndl = element (ElemName \"dl\")\n\ndl_ :: forall w i. Array (HTML w i) -> HTML w i\ndl_ = dl []\n\ndt :: forall w i. Node (I.HTMLdt) w i\ndt = element (ElemName \"dt\")\n\ndt_ :: forall w i. Array (HTML w i) -> HTML w i\ndt_ = dt []\n\nem :: forall w i. Node I.HTMLem w i\nem = element (ElemName \"em\")\n\nem_ :: forall w i. Array (HTML w i) -> HTML w i\nem_ = em []\n\nembed :: forall w i. Node I.HTMLembed w i\nembed = element (ElemName \"embed\")\n\nembed_ :: forall w i. Array (HTML w i) -> HTML w i\nembed_ = embed []\n\nfieldset :: forall w i. Node I.HTMLfieldset w i\nfieldset = element (ElemName \"fieldset\")\n\nfieldset_ :: forall w i. Array (HTML w i) -> HTML w i\nfieldset_ = fieldset []\n\nfigcaption :: forall w i. Node I.HTMLfigcaption w i\nfigcaption = element (ElemName \"figcaption\")\n\nfigcaption_ :: forall w i. Array (HTML w i) -> HTML w i\nfigcaption_ = figcaption []\n\nfigure :: forall w i. Node I.HTMLfigure w i\nfigure = element (ElemName \"figure\")\n\nfigure_ :: forall w i. Array (HTML w i) -> HTML w i\nfigure_ = figure []\n\nfooter :: forall w i. Node I.HTMLfooter w i\nfooter = element (ElemName \"footer\")\n\nfooter_ :: forall w i. Array (HTML w i) -> HTML w i\nfooter_ = footer []\n\nform :: forall w i. Node I.HTMLform w i\nform = element (ElemName \"form\")\n\nform_ :: forall w i. Array (HTML w i) -> HTML w i\nform_ = form []\n\nh1 :: forall w i. Node I.HTMLh1 w i\nh1 = element (ElemName \"h1\")\n\nh1_ :: forall w i. Array (HTML w i) -> HTML w i\nh1_ = h1 []\n\nh2 :: forall w i. Node I.HTMLh2 w i\nh2 = element (ElemName \"h2\")\n\nh2_ :: forall w i. Array (HTML w i) -> HTML w i\nh2_ = h2 []\n\nh3 :: forall w i. Node I.HTMLh3 w i\nh3 = element (ElemName \"h3\")\n\nh3_ :: forall w i. Array (HTML w i) -> HTML w i\nh3_ = h3 []\n\nh4 :: forall w i. Node I.HTMLh4 w i\nh4 = element (ElemName \"h4\")\n\nh4_ :: forall w i. Array (HTML w i) -> HTML w i\nh4_ = h4 []\n\nh5 :: forall w i. Node I.HTMLh5 w i\nh5 = element (ElemName \"h5\")\n\nh5_ :: forall w i. Array (HTML w i) -> HTML w i\nh5_ = h5 []\n\nh6 :: forall w i. Node I.HTMLh6 w i\nh6 = element (ElemName \"h6\")\n\nh6_ :: forall w i. Array (HTML w i) -> HTML w i\nh6_ = h6 []\n\nhead :: forall w i. Node I.HTMLhead w i\nhead = element (ElemName \"head\")\n\nhead_ :: forall w i. Array (HTML w i) -> HTML w i\nhead_ = head []\n\nheader :: forall w i. Node I.HTMLheader w i\nheader = element (ElemName \"header\")\n\nheader_ :: forall w i. Array (HTML w i) -> HTML w i\nheader_ = header []\n\nhr :: forall w i. Leaf I.HTMLhr w i\nhr props = element (ElemName \"hr\") props []\n\nhr_ :: forall w i. HTML w i\nhr_ = hr []\n\nhtml :: forall w i. Node I.HTMLhtml w i\nhtml = element (ElemName \"html\")\n\nhtml_ :: forall w i. Array (HTML w i) -> HTML w i\nhtml_ = html []\n\ni :: forall w i. Node I.HTMLi w i\ni = element (ElemName \"i\")\n\ni_ :: forall w i. Array (HTML w i) -> HTML w i\ni_ = i []\n\niframe :: forall w i. Leaf I.HTMLiframe w i\niframe props = element (ElemName \"iframe\") props []\n\nimg :: forall w i. Leaf I.HTMLimg w i\nimg props = element (ElemName \"img\") props []\n\ninput :: forall w i. Leaf I.HTMLinput w i\ninput props = element (ElemName \"input\") props []\n\nins :: forall w i. Node I.HTMLins w i\nins = element (ElemName \"ins\")\n\nins_ :: forall w i. Array (HTML w i) -> HTML w i\nins_ = ins []\n\nkbd :: forall w i. Node I.HTMLkbd w i\nkbd = element (ElemName \"kbd\")\n\nkbd_ :: forall w i. Array (HTML w i) -> HTML w i\nkbd_ = kbd []\n\nlabel :: forall w i. Node I.HTMLlabel w i\nlabel = element (ElemName \"label\")\n\nlabel_ :: forall w i. Array (HTML w i) -> HTML w i\nlabel_ = label []\n\nlegend :: forall w i. Node I.HTMLlegend w i\nlegend = element (ElemName \"legend\")\n\nlegend_ :: forall w i. Array (HTML w i) -> HTML w i\nlegend_ = legend []\n\nli :: forall w i. Node I.HTMLli w i\nli = element (ElemName \"li\")\n\nli_ :: forall w i. Array (HTML w i) -> HTML w i\nli_ = li []\n\nlink :: forall w i. Leaf I.HTMLlink w i\nlink props = element (ElemName \"link\") props []\n\nmain :: forall w i. Node I.HTMLmain w i\nmain = element (ElemName \"main\")\n\nmain_ :: forall w i. Array (HTML w i) -> HTML w i\nmain_ = main []\n\nmap :: forall w i. Node I.HTMLmap w i\nmap = element (ElemName \"map\")\n\nmap_ :: forall w i. Array (HTML w i) -> HTML w i\nmap_ = map []\n\nmark :: forall w i. Node I.HTMLmark w i\nmark = element (ElemName \"mark\")\n\nmark_ :: forall w i. Array (HTML w i) -> HTML w i\nmark_ = mark []\n\nmenu :: forall w i. Node I.HTMLmenu w i\nmenu = element (ElemName \"menu\")\n\nmenu_ :: forall w i. Array (HTML w i) -> HTML w i\nmenu_ = menu []\n\nmenuitem :: forall w i. Node I.HTMLmenuitem w i\nmenuitem = element (ElemName \"menuitem\")\n\nmenuitem_ :: forall w i. Array (HTML w i) -> HTML w i\nmenuitem_ = menuitem []\n\nmeta :: forall w i. Leaf I.HTMLmeta w i\nmeta props = element (ElemName \"meta\") props []\n\nmeter :: forall w i. Node I.HTMLmeter w i\nmeter = element (ElemName \"meter\")\n\nmeter_ :: forall w i. Array (HTML w i) -> HTML w i\nmeter_ = meter []\n\nnav :: forall w i. Node I.HTMLnav w i\nnav = element (ElemName \"nav\")\n\nnav_ :: forall w i. Array (HTML w i) -> HTML w i\nnav_ = nav []\n\nnoscript :: forall w i. Node I.HTMLnoscript w i\nnoscript = element (ElemName \"noscript\")\n\nnoscript_ :: forall w i. Array (HTML w i) -> HTML w i\nnoscript_ = noscript []\n\nobject :: forall w i. Node I.HTMLobject w i\nobject = element (ElemName \"object\")\n\nobject_ :: forall w i. Array (HTML w i) -> HTML w i\nobject_ = object []\n\nol :: forall w i. Node I.HTMLol w i\nol = element (ElemName \"ol\")\n\nol_ :: forall w i. Array (HTML w i) -> HTML w i\nol_ = ol []\n\noptgroup :: forall w i. Node I.HTMLoptgroup w i\noptgroup = element (ElemName \"optgroup\")\n\noptgroup_ :: forall w i. Array (HTML w i) -> HTML w i\noptgroup_ = optgroup []\n\noption :: forall w i. Node I.HTMLoption w i\noption = element (ElemName \"option\")\n\noption_ :: forall w i. Array (HTML w i) -> HTML w i\noption_ = option []\n\noutput :: forall w i. Node I.HTMLoutput w i\noutput = element (ElemName \"output\")\n\noutput_ :: forall w i. Array (HTML w i) -> HTML w i\noutput_ = output []\n\np :: forall w i. Node I.HTMLp w i\np = element (ElemName \"p\")\n\np_ :: forall w i. Array (HTML w i) -> HTML w i\np_ = p []\n\nparam :: forall w i. Leaf I.HTMLparam w i\nparam props = element (ElemName \"param\") props []\n\npre :: forall w i. Node I.HTMLpre w i\npre = element (ElemName \"pre\")\n\npre_ :: forall w i. Array (HTML w i) -> HTML w i\npre_ = pre []\n\nprogress :: forall w i. Node I.HTMLprogress w i\nprogress = element (ElemName \"progress\")\n\nprogress_ :: forall w i. Array (HTML w i) -> HTML w i\nprogress_ = progress []\n\nq :: forall w i. Node I.HTMLq w i\nq = element (ElemName \"q\")\n\nq_ :: forall w i. Array (HTML w i) -> HTML w i\nq_ = q []\n\nrp :: forall w i. Node I.HTMLrp w i\nrp = element (ElemName \"rp\")\n\nrp_ :: forall w i. Array (HTML w i) -> HTML w i\nrp_ = rp []\n\nrt :: forall w i. Node I.HTMLrt w i\nrt = element (ElemName \"rt\")\n\nrt_ :: forall w i. Array (HTML w i) -> HTML w i\nrt_ = rt []\n\nruby :: forall w i. Node I.HTMLruby w i\nruby = element (ElemName \"ruby\")\n\nruby_ :: forall w i. Array (HTML w i) -> HTML w i\nruby_ = ruby []\n\nsamp :: forall w i. Node I.HTMLsamp w i\nsamp = element (ElemName \"samp\")\n\nsamp_ :: forall w i. Array (HTML w i) -> HTML w i\nsamp_ = samp []\n\nscript :: forall w i. Node I.HTMLscript w i\nscript = element (ElemName \"script\")\n\nscript_ :: forall w i. Array (HTML w i) -> HTML w i\nscript_ = script []\n\nsection :: forall w i. Node I.HTMLsection w i\nsection = element (ElemName \"section\")\n\nsection_ :: forall w i. Array (HTML w i) -> HTML w i\nsection_ = section []\n\nselect :: forall w i. Node I.HTMLselect w i\nselect = element (ElemName \"select\")\n\nselect_ :: forall w i. Array (HTML w i) -> HTML w i\nselect_ = select []\n\nsmall :: forall w i. Node I.HTMLsmall w i\nsmall = element (ElemName \"small\")\n\nsmall_ :: forall w i. Array (HTML w i) -> HTML w i\nsmall_ = small []\n\nsource :: forall w i. Leaf I.HTMLsource w i\nsource props = element (ElemName \"source\") props []\n\nspan :: forall w i. Node I.HTMLspan w i\nspan = element (ElemName \"span\")\n\nspan_ :: forall w i. Array (HTML w i) -> HTML w i\nspan_ = span []\n\nstrong :: forall w i. Node I.HTMLstrong w i\nstrong = element (ElemName \"strong\")\n\nstrong_ :: forall w i. Array (HTML w i) -> HTML w i\nstrong_ = strong []\n\nstyle :: forall w i. Node I.HTMLstyle w i\nstyle = element (ElemName \"style\")\n\nstyle_ :: forall w i. Array (HTML w i) -> HTML w i\nstyle_ = style []\n\nsub :: forall w i. Node I.HTMLsub w i\nsub = element (ElemName \"sub\")\n\nsub_ :: forall w i. Array (HTML w i) -> HTML w i\nsub_ = sub []\n\nsummary :: forall w i. Node I.HTMLsummary w i\nsummary = element (ElemName \"summary\")\n\nsummary_ :: forall w i. Array (HTML w i) -> HTML w i\nsummary_ = summary []\n\nsup :: forall w i. Node I.HTMLsup w i\nsup = element (ElemName \"sup\")\n\nsup_ :: forall w i. Array (HTML w i) -> HTML w i\nsup_ = sup []\n\ntable :: forall w i. Node I.HTMLtable w i\ntable = element (ElemName \"table\")\n\ntable_ :: forall w i. Array (HTML w i) -> HTML w i\ntable_ = table []\n\ntbody :: forall w i. Node I.HTMLtbody w i\ntbody = element (ElemName \"tbody\")\n\ntbody_ :: forall w i. Array (HTML w i) -> HTML w i\ntbody_ = tbody []\n\ntd :: forall w i. Node I.HTMLtd w i\ntd = element (ElemName \"td\")\n\ntd_ :: forall w i. Array (HTML w i) -> HTML w i\ntd_ = td []\n\ntextarea :: forall w i. Leaf I.HTMLtextarea w i\ntextarea es = element (ElemName \"textarea\") es []\n\ntfoot :: forall w i. Node I.HTMLtfoot w i\ntfoot = element (ElemName \"tfoot\")\n\ntfoot_ :: forall w i. Array (HTML w i) -> HTML w i\ntfoot_ = tfoot []\n\nth :: forall w i. Node I.HTMLth w i\nth = element (ElemName \"th\")\n\nth_ :: forall w i. Array (HTML w i) -> HTML w i\nth_ = th []\n\nthead :: forall w i. Node I.HTMLthead w i\nthead = element (ElemName \"thead\")\n\nthead_ :: forall w i. Array (HTML w i) -> HTML w i\nthead_ = thead []\n\ntime :: forall w i. Node I.HTMLtime w i\ntime = element (ElemName \"time\")\n\ntime_ :: forall w i. Array (HTML w i) -> HTML w i\ntime_ = time []\n\ntitle :: forall w i. Node I.HTMLtitle w i\ntitle = element (ElemName \"title\")\n\ntitle_ :: forall w i. Array (HTML w i) -> HTML w i\ntitle_ = title []\n\ntr :: forall w i. Node I.HTMLtr w i\ntr = element (ElemName \"tr\")\n\ntr_ :: forall w i. Array (HTML w i) -> HTML w i\ntr_ = tr []\n\ntrack :: forall w i. Leaf I.HTMLtrack w i\ntrack props = element (ElemName \"track\") props []\n\nu :: forall w i. Node I.HTMLu w i\nu = element (ElemName \"u\")\n\nu_ :: forall w i. Array (HTML w i) -> HTML w i\nu_ = u []\n\nul :: forall w i. Node I.HTMLul w i\nul = element (ElemName \"ul\")\n\nul_ :: forall w i. Array (HTML w i) -> HTML w i\nul_ = ul []\n\nvar :: forall w i. Node I.HTMLvar w i\nvar = element (ElemName \"var\")\n\nvar_ :: forall w i. Array (HTML w i) -> HTML w i\nvar_ = var []\n\nvideo :: forall w i. Node I.HTMLvideo w i\nvideo = element (ElemName \"video\")\n\nvideo_ :: forall w i. Array (HTML w i) -> HTML w i\nvideo_ = video []\n\nwbr :: forall w i. Leaf I.HTMLwbr w i\nwbr props = element (ElemName \"wbr\") props []\n", "-- | A closed signature of type-indexed (refined) HTML properties; these can be\n-- | used to ensure correctness by construction, and then erased into the\n-- | standard unrefined versions.\nmodule Halogen.HTML.Properties\n ( IProp(..)\n , prop\n , attr\n , attrNS\n , ref\n , expand\n\n , alt\n , charset\n , class_\n , classes\n , cols\n , rows\n , colSpan\n , rowSpan\n , for\n , height\n , width\n , href\n , id\n , name\n , rel\n , src\n , srcDoc\n , style\n , scope\n , target\n , title\n , download\n\n , method\n , action\n , enctype\n , noValidate\n\n , type_\n , value\n , min\n , max\n , step\n , disabled\n , enabled\n , required\n , readOnly\n , spellcheck\n , checked\n , selected\n , selectedIndex\n , placeholder\n , autocomplete\n , list\n , autofocus\n , multiple\n , pattern\n , accept\n\n , autoplay\n , controls\n , loop\n , muted\n , poster\n , preload\n\n , draggable\n , tabIndex\n\n , module I\n ) where\n\nimport Prelude\n\nimport DOM.HTML.Indexed (CSSPixel) as I\nimport DOM.HTML.Indexed.AutocompleteType (AutocompleteType(..)) as I\nimport DOM.HTML.Indexed.ButtonType (ButtonType(..)) as I\nimport DOM.HTML.Indexed.FormMethod (FormMethod(..)) as I\nimport DOM.HTML.Indexed.InputAcceptType (InputAcceptType(..)) as I\nimport DOM.HTML.Indexed.InputType (InputType(..)) as I\nimport DOM.HTML.Indexed.MenuType (MenuType(..)) as I\nimport DOM.HTML.Indexed.MenuitemType (MenuitemType(..)) as I\nimport DOM.HTML.Indexed.OrderedListType (OrderedListType(..)) as I\nimport DOM.HTML.Indexed.PreloadValue (PreloadValue(..)) as I\nimport DOM.HTML.Indexed.ScopeValue (ScopeValue(..)) as I\nimport DOM.HTML.Indexed.StepValue (StepValue(..)) as I\nimport Data.Maybe (Maybe(..))\nimport Data.MediaType (MediaType)\nimport Data.Newtype (class Newtype, unwrap)\nimport Data.String (joinWith)\nimport Halogen.HTML.Core (class IsProp, AttrName(..), ClassName, Namespace, PropName(..), Prop)\nimport Halogen.HTML.Core as Core\nimport Halogen.Query.Input (Input(..), RefLabel)\nimport Prim.Row as Row\nimport Unsafe.Coerce (unsafeCoerce)\nimport Web.DOM.Element (Element)\n\n-- | The phantom row `r` can be thought of as a context which is synthesized in\n-- | the course of constructing a refined HTML expression.\nnewtype IProp (r :: Row Type) i = IProp (Prop (Input i))\n\nderive instance newtypeIProp :: Newtype (IProp r i) _\nderive instance functorIProp :: Functor (IProp r)\n\n-- | Creates an indexed HTML property.\nprop\n :: forall value r i\n . IsProp value\n => PropName value\n -> value\n -> IProp r i\nprop = (unsafeCoerce :: (PropName value -> value -> Prop (Input i)) -> PropName value -> value -> IProp r i) Core.prop\n\n-- | Creates an indexed HTML attribute.\nattr :: forall r i. AttrName -> String -> IProp r i\nattr =\n Core.attr Nothing #\n ( unsafeCoerce\n :: (AttrName -> String -> Prop (Input i))\n -> AttrName\n -> String\n -> IProp r i\n )\n\n-- | Creates an indexed HTML attribute.\nattrNS :: forall r i. Namespace -> AttrName -> String -> IProp r i\nattrNS =\n pure >>> Core.attr >>>\n ( unsafeCoerce\n :: (AttrName -> String -> Prop (Input i))\n -> AttrName\n -> String\n -> IProp r i\n )\n\n-- | The `ref` property allows an input to be raised once a `HTMLElement` has\n-- | been created or destroyed in the DOM for the element that the property is\n-- | attached to.\nref :: forall r i. RefLabel -> IProp r i\nref = (unsafeCoerce :: ((Maybe Element -> Maybe (Input i)) -> Prop (Input i)) -> (Maybe Element -> Maybe (Input i)) -> IProp r i) Core.ref <<< go\n where\n go :: RefLabel -> Maybe Element -> Maybe (Input i)\n go p mel = Just (RefUpdate p mel)\n\n-- | Every `IProp lt i` can be cast to some `IProp gt i` as long as `lt` is a\n-- | subset of `gt`.\nexpand :: forall lt gt a i. Row.Union lt a gt => IProp lt i -> IProp gt i\nexpand = unsafeCoerce\n\nalt :: forall r i. String -> IProp (alt :: String | r) i\nalt = prop (PropName \"alt\")\n\ncharset :: forall r i. String -> IProp (charset :: String | r) i\ncharset = prop (PropName \"charset\")\n\nclass_ :: forall r i. ClassName -> IProp (class :: String | r) i\nclass_ = prop (PropName \"className\") <<< unwrap\n\nclasses :: forall r i. Array ClassName -> IProp (class :: String | r) i\nclasses = prop (PropName \"className\") <<< joinWith \" \" <<< map unwrap\n\ncols :: forall r i. Int -> IProp (cols :: Int | r) i\ncols = prop (PropName \"cols\")\n\nrows :: forall r i. Int -> IProp (rows :: Int | r) i\nrows = prop (PropName \"rows\")\n\ncolSpan :: forall r i. Int -> IProp (colSpan :: Int | r) i\ncolSpan = prop (PropName \"colSpan\")\n\nrowSpan :: forall r i. Int -> IProp (rowSpan :: Int | r) i\nrowSpan = prop (PropName \"rowSpan\")\n\nfor :: forall r i. String -> IProp (for :: String | r) i\nfor = prop (PropName \"htmlFor\")\n\nheight :: forall r i. I.CSSPixel -> IProp (height :: I.CSSPixel | r) i\nheight = prop (PropName \"height\")\n\nwidth :: forall r i. I.CSSPixel -> IProp (width :: I.CSSPixel | r) i\nwidth = prop (PropName \"width\")\n\nhref :: forall r i. String -> IProp (href :: String | r) i\nhref = prop (PropName \"href\")\n\nid :: forall r i. String -> IProp (id :: String | r) i\nid = prop (PropName \"id\")\n\nname :: forall r i. String -> IProp (name :: String | r) i\nname = prop (PropName \"name\")\n\nrel :: forall r i. String -> IProp (rel :: String | r) i\nrel = prop (PropName \"rel\")\n\nsrc :: forall r i. String -> IProp (src :: String | r) i\nsrc = prop (PropName \"src\")\n\nsrcDoc :: forall r i. String -> IProp (srcDoc :: String | r) i\nsrcDoc = prop (PropName \"srcdoc\")\n\n-- | Sets the `style` attribute to the specified string.\n-- |\n-- | ```purs\n-- | ... [ style \"height: 50px;\" ]\n-- | ```\n-- |\n-- | If you prefer to use typed CSS for this attribute, you can use the purescript-halogen-css library:\n-- | https://github.com/purescript-halogen/purescript-halogen-css\nstyle :: forall r i. String -> IProp (style :: String | r) i\nstyle = attr (AttrName \"style\")\n\nscope :: forall r i. I.ScopeValue -> IProp (scope :: I.ScopeValue | r) i\nscope = prop (PropName \"scope\")\n\ntarget :: forall r i. String -> IProp (target :: String | r) i\ntarget = prop (PropName \"target\")\n\ntitle :: forall r i. String -> IProp (title :: String | r) i\ntitle = prop (PropName \"title\")\n\ndownload :: forall r i. String -> IProp (download :: String | r) i\ndownload = prop (PropName \"download\")\n\nmethod :: forall r i. I.FormMethod -> IProp (method :: I.FormMethod | r) i\nmethod = prop (PropName \"method\")\n\naction :: forall r i. String -> IProp (action :: String | r) i\naction = prop (PropName \"action\")\n\nenctype :: forall r i. MediaType -> IProp (enctype :: MediaType | r) i\nenctype = prop (PropName \"enctype\")\n\nnoValidate :: forall r i. Boolean -> IProp (noValidate :: Boolean | r) i\nnoValidate = prop (PropName \"noValidate\")\n\ntype_ :: forall r i value. IsProp value => value -> IProp (type :: value | r) i\ntype_ = prop (PropName \"type\")\n\nvalue :: forall r i value. IsProp value => value -> IProp (value :: value | r) i\nvalue = prop (PropName \"value\")\n\nmin :: forall r i. Number -> IProp (min :: Number | r) i\nmin = prop (PropName \"min\")\n\nmax :: forall r i. Number -> IProp (max :: Number | r) i\nmax = prop (PropName \"max\")\n\nstep :: forall r i. I.StepValue -> IProp (step :: I.StepValue | r) i\nstep = prop (PropName \"step\")\n\nenabled :: forall r i. Boolean -> IProp (disabled :: Boolean | r) i\nenabled = disabled <<< not\n\ndisabled :: forall r i. Boolean -> IProp (disabled :: Boolean | r) i\ndisabled = prop (PropName \"disabled\")\n\nrequired :: forall r i. Boolean -> IProp (required :: Boolean | r) i\nrequired = prop (PropName \"required\")\n\nreadOnly :: forall r i. Boolean -> IProp (readOnly :: Boolean | r) i\nreadOnly = prop (PropName \"readOnly\")\n\nspellcheck :: forall r i. Boolean -> IProp (spellcheck :: Boolean | r) i\nspellcheck = prop (PropName \"spellcheck\")\n\nchecked :: forall r i. Boolean -> IProp (checked :: Boolean | r) i\nchecked = prop (PropName \"checked\")\n\nselected :: forall r i. Boolean -> IProp (selected :: Boolean | r) i\nselected = prop (PropName \"selected\")\n\nselectedIndex :: forall r i. Int -> IProp (selectedIndex :: Int | r) i\nselectedIndex = prop (PropName \"selectedIndex\")\n\nplaceholder :: forall r i. String -> IProp (placeholder :: String | r) i\nplaceholder = prop (PropName \"placeholder\")\n\nautocomplete :: forall r i. I.AutocompleteType -> IProp (autocomplete :: I.AutocompleteType | r) i\nautocomplete = prop (PropName \"autocomplete\")\n\nlist :: forall r i. String -> IProp (list :: String | r) i\nlist = attr (AttrName \"list\")\n\nautofocus :: forall r i. Boolean -> IProp (autofocus :: Boolean | r) i\nautofocus = prop (PropName \"autofocus\")\n\nmultiple :: forall r i. Boolean -> IProp (multiple :: Boolean | r) i\nmultiple = prop (PropName \"multiple\")\n\naccept :: forall r i. I.InputAcceptType -> IProp (accept :: I.InputAcceptType | r) i\naccept = prop (PropName \"accept\")\n\npattern :: forall r i. String -> IProp (pattern :: String | r) i\npattern = prop (PropName \"pattern\")\n\nautoplay :: forall r i. Boolean -> IProp (autoplay :: Boolean | r) i\nautoplay = prop (PropName \"autoplay\")\n\ncontrols :: forall r i. Boolean -> IProp (controls :: Boolean | r) i\ncontrols = prop (PropName \"controls\")\n\nloop :: forall r i. Boolean -> IProp (loop :: Boolean | r) i\nloop = prop (PropName \"loop\")\n\nmuted :: forall r i. Boolean -> IProp (muted :: Boolean | r) i\nmuted = prop (PropName \"muted\")\n\nposter :: forall r i. String -> IProp (poster :: String | r) i\nposter = prop (PropName \"poster\")\n\npreload :: forall r i. I.PreloadValue -> IProp (preload :: I.PreloadValue | r) i\npreload = prop (PropName \"preload\")\n\ndraggable :: forall r i. Boolean -> IProp (draggable :: Boolean | r) i\ndraggable = prop (PropName \"draggable\")\n\ntabIndex :: forall r i. Int -> IProp (tabIndex :: Int | r) i\ntabIndex = prop (PropName \"tabIndex\")\n", "-- | This module defines an adapter between the `purescript-halogen` and\n-- | `purescript-css` libraries.\nmodule Halogen.HTML.CSS\n ( style\n , stylesheet\n ) where\n\nimport Prelude\n\nimport CSS.Property (Key, Value)\nimport CSS.Render (render, renderedSheet, collect)\nimport CSS.Stylesheet (CSS, Rule(..), runS)\n\nimport Data.Array (mapMaybe, concatMap, singleton)\nimport Data.Either (Either)\nimport Data.Foldable (foldMap)\nimport Data.Maybe (Maybe(..), fromMaybe)\nimport Data.MediaType (MediaType(..))\nimport Data.String (joinWith)\nimport Data.Tuple (Tuple(..))\nimport Foreign.Object as Object\n\nimport Halogen.HTML as HH\nimport Halogen.HTML.Elements as HE\nimport Halogen.HTML.Properties as HP\nimport Halogen.HTML.Core as HC\n\n-- | Render a set of rules as an inline style.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | HH.div [ CSS.style do color red\n-- | display block ]\n-- | [ ... ]\n-- | ```\nstyle \u2237 \u2200 i r. CSS \u2192 HP.IProp (style \u2237 String|r) i\nstyle =\n HP.attr (HC.AttrName \"style\")\n <<< toString\n <<< rules\n <<< runS\n where\n toString \u2237 Object.Object String \u2192 String\n toString = joinWith \"; \" <<< Object.foldMap (\\key val \u2192 [ key <> \": \" <> val])\n\n rules \u2237 Array Rule \u2192 Object.Object String\n rules rs = Object.fromFoldable properties\n where\n properties \u2237 Array (Tuple String String)\n properties = mapMaybe property rs >>= collect >>> rights\n\n property \u2237 Rule \u2192 Maybe (Tuple (Key Unit) Value)\n property (Property k v) = Just (Tuple k v)\n property _ = Nothing\n\n rights \u2237 \u2200 a b. Array (Either a b) \u2192 Array b\n rights = concatMap $ foldMap singleton\n\n-- | Render a set of rules as a `style` element.\nstylesheet \u2237 \u2200 p i. CSS \u2192 HC.HTML p i\nstylesheet css =\n HE.style [ HP.type_ $ MediaType \"text/css\" ] [ HH.text content ]\n where\n content = fromMaybe \"\" $ renderedSheet $ render css\n", "\nmodule Control.Monad.Except\n ( Except\n , runExcept\n , mapExcept\n , withExcept\n , module Control.Monad.Error.Class\n , module Control.Monad.Except.Trans\n ) where\n\nimport Prelude\n\nimport Control.Monad.Error.Class (class MonadError, catchError, catchJust, throwError)\nimport Control.Monad.Except.Trans (class MonadTrans, ExceptT(..), except, lift, mapExceptT, runExceptT, withExceptT)\n\nimport Data.Either (Either)\nimport Data.Identity (Identity(..))\nimport Data.Newtype (unwrap)\n\n-- | A parametrizable exception monad; computations are either exceptions or\n-- | pure values. If an exception is thrown (see `throwError`), the computation\n-- | terminates with that value. Exceptions may also be caught with `catchError`,\n-- | allowing the computation to resume and exit successfully.\n-- |\n-- | The type parameter `e` is the type of exceptions, and `a` is the type\n-- | of successful results.\n-- |\n-- | A mechanism for trying many different computations until one succeeds is\n-- | provided via the `Alt` instance, specifically the `(<|>)` function.\n-- | The first computation to succeed is returned; if all fail, the exceptions\n-- | are combined using their `Semigroup` instance. The `Plus` instance goes\n-- | further and adds the possibility of a computation failing with an 'empty'\n-- | exception; naturally, this requires the stronger constraint of a `Monoid`\n-- | instance for the exception type.\ntype Except e = ExceptT e Identity\n\n-- | Run a computation in the `Except` monad. The inverse of `except`.\nrunExcept :: forall e a. Except e a -> Either e a\nrunExcept = unwrap <<< runExceptT\n\n-- | Transform the unwrapped computation using the given function.\nmapExcept :: forall e e' a b. (Either e a -> Either e' b) -> Except e a -> Except e' b\nmapExcept f = mapExceptT (Identity <<< f <<< unwrap)\n\n-- | Transform any exceptions thrown by an `Except` computation using the given function.\nwithExcept :: forall e e' a. (e -> e') -> Except e a -> Except e' a\nwithExcept = withExceptT\n", "export function unsafeReadPropImpl(f, s, key, value) {\n return value == null ? f : s(value[key]);\n}\n\nexport function unsafeHasOwnProperty(prop, value) {\n return Object.prototype.hasOwnProperty.call(value, prop);\n}\n\nexport function unsafeHasProperty(prop, value) {\n return prop in value;\n}\n", "-- | This module defines a type class for types which act like\n-- | _property indices_.\n\nmodule Foreign.Index\n ( class Index\n , class Indexable\n , readProp\n , readIndex\n , ix, (!)\n , index\n , hasProperty\n , hasOwnProperty\n , errorAt\n ) where\n\nimport Prelude\n\nimport Control.Monad.Except.Trans (ExceptT)\n\nimport Foreign (Foreign, ForeignError(..), typeOf, isUndefined, isNull, fail)\nimport Data.Function.Uncurried (Fn2, runFn2, Fn4, runFn4)\nimport Data.List.NonEmpty (NonEmptyList)\n\n-- | This type class identifies types that act like _property indices_.\n-- |\n-- | The canonical instances are for `String`s and `Int`s.\nclass Index i m | i -> m where\n index :: Foreign -> i -> ExceptT (NonEmptyList ForeignError) m Foreign\n hasProperty :: i -> Foreign -> Boolean\n hasOwnProperty :: i -> Foreign -> Boolean\n errorAt :: i -> ForeignError -> ForeignError\n\nclass Indexable a m | a -> m where\n ix :: forall i. Index i m => a -> i -> ExceptT (NonEmptyList ForeignError) m Foreign\n\ninfixl 9 ix as !\n\nforeign import unsafeReadPropImpl :: forall r k. Fn4 r (Foreign -> r) k Foreign r\n\nunsafeReadProp :: forall k m. Monad m => k -> Foreign -> ExceptT (NonEmptyList ForeignError) m Foreign\nunsafeReadProp k value =\n runFn4 unsafeReadPropImpl (fail (TypeMismatch \"object\" (typeOf value))) pure k value\n\n-- | Attempt to read a value from a foreign value property\nreadProp :: forall m. Monad m => String -> Foreign -> ExceptT (NonEmptyList ForeignError) m Foreign\nreadProp = unsafeReadProp\n\n-- | Attempt to read a value from a foreign value at the specified numeric index\nreadIndex :: forall m. Monad m => Int -> Foreign -> ExceptT (NonEmptyList ForeignError) m Foreign\nreadIndex = unsafeReadProp\n\nforeign import unsafeHasOwnProperty :: forall k. Fn2 k Foreign Boolean\n\nhasOwnPropertyImpl :: forall k. k -> Foreign -> Boolean\nhasOwnPropertyImpl _ value | isNull value = false\nhasOwnPropertyImpl _ value | isUndefined value = false\nhasOwnPropertyImpl p value | typeOf value == \"object\" || typeOf value == \"function\" = runFn2 unsafeHasOwnProperty p value\nhasOwnPropertyImpl _ _ = false\n\nforeign import unsafeHasProperty :: forall k. Fn2 k Foreign Boolean\n\nhasPropertyImpl :: forall k. k -> Foreign -> Boolean\nhasPropertyImpl _ value | isNull value = false\nhasPropertyImpl _ value | isUndefined value = false\nhasPropertyImpl p value | typeOf value == \"object\" || typeOf value == \"function\" = runFn2 unsafeHasProperty p value\nhasPropertyImpl _ _ = false\n\ninstance indexString :: Monad m => Index String m where\n index = flip readProp\n hasProperty = hasPropertyImpl\n hasOwnProperty = hasOwnPropertyImpl\n errorAt = ErrorAtProperty\n\ninstance indexInt :: Monad m => Index Int m where\n index = flip readIndex\n hasProperty = hasPropertyImpl\n hasOwnProperty = hasOwnPropertyImpl\n errorAt = ErrorAtIndex\n\ninstance indexableForeign :: Monad m => Indexable Foreign m where\n ix = index\n\ninstance indexableExceptT :: Monad m => Indexable (ExceptT (NonEmptyList ForeignError) m Foreign) m where\n ix f i = flip index i =<< f\n", "export function bubbles(e) {\n return e.bubbles;\n}\n\nexport function cancelable(e) {\n return e.cancelable;\n}\n\nexport function _currentTarget(e) {\n return e.currentTarget;\n}\n\nexport function defaultPrevented(e) {\n return function() {\n return e.defaultPrevented;\n };\n}\n\nexport function eventPhaseIndex(e) {\n return e.eventPhase;\n}\n\nexport function _target(e) {\n return e.target;\n}\n\nexport function timeStamp(e) {\n return e.timeStamp;\n}\n\nexport function type_(e) {\n return e.type;\n}\n\nexport function preventDefault(e) {\n return function () {\n return e.preventDefault();\n };\n}\n\nexport function stopImmediatePropagation(e) {\n return function () {\n return e.stopImmediatePropagation();\n };\n}\n\nexport function stopPropagation(e) {\n return function () {\n return e.stopPropagation();\n };\n}\n", "module Web.Event.Event\n ( module Exports\n , EventType(..)\n , type_\n , target\n , currentTarget\n , eventPhase\n , stopPropagation\n , stopImmediatePropagation\n , bubbles\n , cancelable\n , preventDefault\n , defaultPrevented\n , timeStamp\n ) where\n\nimport Prelude\n\nimport Data.DateTime.Instant (Instant)\nimport Data.Enum (toEnum)\nimport Data.Maybe (Maybe, fromJust)\nimport Data.Newtype (class Newtype)\nimport Data.Nullable (Nullable, toMaybe)\nimport Effect (Effect)\nimport Web.Event.EventPhase (EventPhase)\nimport Web.Event.Internal.Types (Event) as Exports\nimport Web.Event.Internal.Types (Event, EventTarget)\n\n-- | The type of strings used for event types.\nnewtype EventType = EventType String\n\nderive instance newtypeEventType :: Newtype EventType _\nderive newtype instance eqEventType :: Eq EventType\nderive newtype instance ordEventType :: Ord EventType\n\n-- | The event type.\nforeign import type_ :: Event -> EventType\n\n-- | The element that was the source of the event.\ntarget :: Event -> Maybe EventTarget\ntarget = toMaybe <<< _target\n\nforeign import _target :: Event -> Nullable EventTarget\n\n-- | The element that the event listener was added to.\ncurrentTarget :: Event -> Maybe EventTarget\ncurrentTarget = toMaybe <<< _currentTarget\n\nforeign import _currentTarget :: Event -> Nullable EventTarget\n\n-- | Indicates which phase of the event flow that is currently being processed\n-- | for the event.\neventPhase :: Partial => Event -> EventPhase\neventPhase = fromJust <<< toEnum <<< eventPhaseIndex\n\n-- | The integer value for the current event phase.\nforeign import eventPhaseIndex :: Event -> Int\n\n-- | Prevents the event from bubbling up to futher event listeners. Other event\n-- | listeners on the current target will still fire.\nforeign import stopPropagation :: Event -> Effect Unit\n\n-- | Prevents all other listeners for the event from being called. This includes\n-- | event listeners added to the current target after the current listener.\nforeign import stopImmediatePropagation :: Event -> Effect Unit\n\n-- | Indicates whether the event will bubble up through the DOM or not.\nforeign import bubbles :: Event -> Boolean\n\n-- | Indicates whether the event can be cancelled.\nforeign import cancelable :: Event -> Boolean\n\n-- | Cancels the event if it can be cancelled.\nforeign import preventDefault :: Event -> Effect Unit\n\n-- | Indicates whether `preventDefault` was called on the event.\nforeign import defaultPrevented :: Event -> Effect Boolean\n\n-- | The time in milliseconds between 01/01/1970 and when the event was\n-- | dispatched.\nforeign import timeStamp :: Event -> Instant\n", "module Web.HTML.Event.EventTypes where\n\nimport Web.Event.Event (EventType(..))\n\nabort :: EventType\nabort = EventType \"abort\"\n\nafterprint :: EventType\nafterprint = EventType \"afterprint\"\n\nafterscriptexecute :: EventType\nafterscriptexecute = EventType \"afterscriptexecute\"\n\nbeforeprint :: EventType\nbeforeprint = EventType \"beforeprint\"\n\nbeforescriptexecute :: EventType\nbeforescriptexecute = EventType \"beforescriptexecute\"\n\nblur :: EventType\nblur = EventType \"blur\"\n\ncancel :: EventType\ncancel = EventType \"cancel\"\n\nchange :: EventType\nchange = EventType \"change\"\n\nclick :: EventType\nclick = EventType \"click\"\n\nclose :: EventType\nclose = EventType \"close\"\n\ncopy :: EventType\ncopy = EventType \"copy\"\n\ncut :: EventType\ncut = EventType \"cut\"\n\ndomcontentloaded :: EventType\ndomcontentloaded = EventType \"DOMContentLoaded\"\n\nerror :: EventType\nerror = EventType \"error\"\n\nfocus :: EventType\nfocus = EventType \"focus\"\n\ninput :: EventType\ninput = EventType \"input\"\n\ninvalid :: EventType\ninvalid = EventType \"invalid\"\n\nlanguagechange :: EventType\nlanguagechange = EventType \"languagechange\"\n\nload :: EventType\nload = EventType \"load\"\n\nloadend :: EventType\nloadend = EventType \"loadend\"\n\nloadstart :: EventType\nloadstart = EventType \"loadstart\"\n\nmessage :: EventType\nmessage = EventType \"message\"\n\noffline :: EventType\noffline = EventType \"offline\"\n\nonline :: EventType\nonline = EventType \"online\"\n\npaste :: EventType\npaste = EventType \"paste\"\n\nprogress :: EventType\nprogress = EventType \"progress\"\n\nreadystatechange :: EventType\nreadystatechange = EventType \"readystatechange\"\n\nreset :: EventType\nreset = EventType \"reset\"\n\nselect :: EventType\nselect = EventType \"select\"\n\nstorage :: EventType\nstorage = EventType \"storage\"\n\nsubmit :: EventType\nsubmit = EventType \"submit\"\n\ntoggle :: EventType\ntoggle = EventType \"toggle\"\n\nunload :: EventType\nunload = EventType \"unload\"\n", "module Web.UIEvent.FocusEvent.EventTypes where\n\nimport Web.Event.Event (EventType(..))\n\nblur :: EventType\nblur = EventType \"blur\"\n\nfocus :: EventType\nfocus = EventType \"focus\"\n\nfocusin :: EventType\nfocusin = EventType \"focusin\"\n\nfocusout :: EventType\nfocusout = EventType \"focusout\"\n", "module Web.UIEvent.KeyboardEvent.EventTypes where\n\nimport Web.Event.Event (EventType(..))\n\nkeydown :: EventType\nkeydown = EventType \"keydown\"\n\nkeyup :: EventType\nkeyup = EventType \"keyup\"\n", "module Web.UIEvent.MouseEvent.EventTypes where\n\nimport Web.Event.Event (EventType(..))\n\nauxclick :: EventType\nauxclick = EventType \"auxclick\"\n\nclick :: EventType\nclick = EventType \"click\"\n\ndblclick :: EventType\ndblclick = EventType \"dblclick\"\n\nmousedown :: EventType\nmousedown = EventType \"mousedown\"\n\nmouseenter :: EventType\nmouseenter = EventType \"mouseenter\"\n\nmouseleave :: EventType\nmouseleave = EventType \"mouseleave\"\n\nmousemove :: EventType\nmousemove = EventType \"mousemove\"\n\nmouseout :: EventType\nmouseout = EventType \"mouseout\"\n\nmouseover :: EventType\nmouseover = EventType \"mouseover\"\n\nmouseup :: EventType\nmouseup = EventType \"mouseup\"\n", "module Halogen.HTML.Events\n ( handler\n , handler'\n , onAbort\n , onError\n , onLoad\n , onScroll\n , onChange\n , onFileUpload\n , onInput\n , onInvalid\n , onReset\n , onSelect\n , onSubmit\n , onTransitionEnd\n , onCopy\n , onPaste\n , onCut\n , onAuxClick\n , onClick\n -- , onContextMenu\n , onDoubleClick\n , onMouseDown\n , onMouseEnter\n , onMouseLeave\n , onMouseMove\n , onMouseOver\n , onMouseOut\n , onMouseUp\n , onWheel\n , onKeyDown\n -- , onKeyPress\n , onKeyUp\n , onBlur\n , onFocus\n , onFocusIn\n , onFocusOut\n , onDrag\n , onDragEnd\n , onDragExit\n , onDragEnter\n , onDragLeave\n , onDragOver\n , onDragStart\n , onDrop\n , onTouchCancel\n , onTouchEnd\n , onTouchEnter\n , onTouchLeave\n , onTouchMove\n , onTouchStart\n , onResize\n , onValueChange\n , onValueInput\n , onSelectedIndexChange\n , onChecked\n ) where\n\nimport Prelude\n\nimport Control.Monad.Except (runExcept)\nimport Data.Either (either)\nimport Data.Maybe (Maybe(..), maybe)\nimport Data.Unfoldable (class Unfoldable, none)\nimport Foreign (F, Foreign, readBoolean, readInt, readString, unsafeToForeign)\nimport Foreign.Index (readProp)\nimport Halogen.HTML.Core (Prop)\nimport Halogen.HTML.Core as Core\nimport Halogen.HTML.Properties (IProp)\nimport Halogen.Query.Input (Input(..))\nimport Unsafe.Coerce (unsafeCoerce)\nimport Web.Clipboard.ClipboardEvent (ClipboardEvent)\nimport Web.Clipboard.ClipboardEvent.EventTypes as CET\nimport Web.Event.Event (Event, EventType(..))\nimport Web.Event.Event as EE\nimport Web.Event.Event as Event\nimport Web.File.File (File)\nimport Web.File.FileList (items)\nimport Web.HTML.Event.DragEvent (DragEvent)\nimport Web.HTML.Event.DragEvent.EventTypes as DET\nimport Web.HTML.Event.EventTypes as ET\nimport Web.HTML.HTMLInputElement as HTMLInputElement\nimport Web.TouchEvent.TouchEvent (TouchEvent)\nimport Web.UIEvent.FocusEvent (FocusEvent)\nimport Web.UIEvent.FocusEvent.EventTypes as FET\nimport Web.UIEvent.KeyboardEvent (KeyboardEvent)\nimport Web.UIEvent.KeyboardEvent.EventTypes as KET\nimport Web.UIEvent.MouseEvent (MouseEvent)\nimport Web.UIEvent.MouseEvent.EventTypes as MET\nimport Web.UIEvent.WheelEvent (WheelEvent)\nimport Web.UIEvent.WheelEvent.EventTypes as WET\nimport Effect.Unsafe (unsafePerformEffect)\n\nhandler :: forall r i. EventType -> (Event -> i) -> IProp r i\nhandler et f =\n (unsafeCoerce :: (EventType -> (Event -> Maybe i) -> Prop i) -> EventType -> (Event -> Maybe (Input i)) -> IProp r i)\n Core.handler\n et\n \\ev -> Just (Action (f ev))\n\nhandler' :: forall r i. EventType -> (Event -> Maybe i) -> IProp r i\nhandler' et f =\n (unsafeCoerce :: (EventType -> (Event -> Maybe i) -> Prop i) -> EventType -> (Event -> Maybe (Input i)) -> IProp r i)\n Core.handler\n et\n \\ev -> Action <$> f ev\n\nonAbort :: forall r i. (Event -> i) -> IProp (onAbort :: Event | r) i\nonAbort = handler (EventType \"abort\")\n\nonError :: forall r i. (Event -> i) -> IProp (onError :: Event | r) i\nonError = handler ET.error\n\nonLoad :: forall r i. (Event -> i) -> IProp (onLoad :: Event | r) i\nonLoad = handler ET.load\n\nonScroll :: forall r i. (Event -> i) -> IProp (onScroll :: Event | r) i\nonScroll = handler (EventType \"scroll\")\n\nonChange :: forall r i. (Event -> i) -> IProp (onChange :: Event | r) i\nonChange = handler ET.change\n\nonFileUpload\n :: forall r i t\n . Unfoldable t\n => (t File -> i)\n -> IProp (onChange :: Event | r) i\nonFileUpload f = handler ET.change $\n ( Event.target\n >=> HTMLInputElement.fromEventTarget\n >=>\n HTMLInputElement.files >>> unsafePerformEffect\n )\n >>> maybe none items\n >>> f\n\nonInput :: forall r i. (Event -> i) -> IProp (onInput :: Event | r) i\nonInput = handler ET.input\n\nonInvalid :: forall r i. (Event -> i) -> IProp (onInvalid :: Event | r) i\nonInvalid = handler ET.invalid\n\nonReset :: forall r i. (Event -> i) -> IProp (onReset :: Event | r) i\nonReset = handler (EventType \"reset\")\n\nonSelect :: forall r i. (Event -> i) -> IProp (onSelect :: Event | r) i\nonSelect = handler ET.select\n\nonSubmit :: forall r i. (Event -> i) -> IProp (onSubmit :: Event | r) i\nonSubmit = handler (EventType \"submit\")\n\nonTransitionEnd :: forall r i. (Event -> i) -> IProp (onTransitionEnd :: Event | r) i\nonTransitionEnd = handler (EventType \"transitionend\")\n\nonCopy :: forall r i. (ClipboardEvent -> i) -> IProp (onCopy :: ClipboardEvent | r) i\nonCopy = handler CET.copy <<< clipboardHandler\n\nonPaste :: forall r i. (ClipboardEvent -> i) -> IProp (onPaste :: ClipboardEvent | r) i\nonPaste = handler CET.paste <<< clipboardHandler\n\nonCut :: forall r i. (ClipboardEvent -> i) -> IProp (onCut :: ClipboardEvent | r) i\nonCut = handler CET.cut <<< clipboardHandler\n\nonAuxClick :: forall r i. (MouseEvent -> i) -> IProp (onAuxClick :: MouseEvent | r) i\nonAuxClick = handler MET.auxclick <<< mouseHandler\n\nonClick :: forall r i. (MouseEvent -> i) -> IProp (onClick :: MouseEvent | r) i\nonClick = handler MET.click <<< mouseHandler\n\n-- onContextMenu :: forall r i. (MouseEvent -> i) -> IProp (onContextMenu :: MouseEvent | r) i\n-- onContextMenu = handler ET.contextmenu <<< mouseHandler\n\nonDoubleClick :: forall r i. (MouseEvent -> i) -> IProp (onDoubleClick :: MouseEvent | r) i\nonDoubleClick = handler MET.dblclick <<< mouseHandler\n\nonMouseDown :: forall r i. (MouseEvent -> i) -> IProp (onMouseDown :: MouseEvent | r) i\nonMouseDown = handler MET.mousedown <<< mouseHandler\n\nonMouseEnter :: forall r i. (MouseEvent -> i) -> IProp (onMouseEnter :: MouseEvent | r) i\nonMouseEnter = handler MET.mouseenter <<< mouseHandler\n\nonMouseLeave :: forall r i. (MouseEvent -> i) -> IProp (onMouseLeave :: MouseEvent | r) i\nonMouseLeave = handler MET.mouseleave <<< mouseHandler\n\nonMouseMove :: forall r i. (MouseEvent -> i) -> IProp (onMouseMove :: MouseEvent | r) i\nonMouseMove = handler MET.mousemove <<< mouseHandler\n\nonMouseOver :: forall r i. (MouseEvent -> i) -> IProp (onMouseOver :: MouseEvent | r) i\nonMouseOver = handler MET.mouseover <<< mouseHandler\n\nonMouseOut :: forall r i. (MouseEvent -> i) -> IProp (onMouseOut :: MouseEvent | r) i\nonMouseOut = handler MET.mouseout <<< mouseHandler\n\nonMouseUp :: forall r i. (MouseEvent -> i) -> IProp (onMouseUp :: MouseEvent | r) i\nonMouseUp = handler MET.mouseup <<< mouseHandler\n\nonWheel :: forall r i. (WheelEvent -> i) -> IProp (onWheel :: WheelEvent | r) i\nonWheel = handler WET.wheel <<< wheelHandler\n\nonKeyDown :: forall r i. (KeyboardEvent -> i) -> IProp (onKeyDown :: KeyboardEvent | r) i\nonKeyDown = handler KET.keydown <<< keyHandler\n\n-- onKeyPress :: forall r i. (KeyboardEvent -> i) -> IProp (onKeyPress :: KeyboardEvent | r) i\n-- onKeyPress = handler KET.keypress <<< keyHandler\n\nonKeyUp :: forall r i. (KeyboardEvent -> i) -> IProp (onKeyUp :: KeyboardEvent | r) i\nonKeyUp = handler KET.keyup <<< keyHandler\n\nonBlur :: forall r i. (FocusEvent -> i) -> IProp (onBlur :: FocusEvent | r) i\nonBlur = handler ET.blur <<< focusHandler\n\nonFocus :: forall r i. (FocusEvent -> i) -> IProp (onFocus :: FocusEvent | r) i\nonFocus = handler FET.focus <<< focusHandler\n\nonFocusIn :: forall r i. (FocusEvent -> i) -> IProp (onFocusIn :: FocusEvent | r) i\nonFocusIn = handler FET.focusin <<< focusHandler\n\nonFocusOut :: forall r i. (FocusEvent -> i) -> IProp (onFocusOut :: FocusEvent | r) i\nonFocusOut = handler FET.focusout <<< focusHandler\n\nonDrag :: forall r i. (DragEvent -> i) -> IProp (onDrag :: DragEvent | r) i\nonDrag = handler DET.drag <<< dragHandler\n\nonDragEnd :: forall r i. (DragEvent -> i) -> IProp (onDragEnd :: DragEvent | r) i\nonDragEnd = handler DET.dragend <<< dragHandler\n\nonDragExit :: forall r i. (DragEvent -> i) -> IProp (onDragExit :: DragEvent | r) i\nonDragExit = handler DET.dragexit <<< dragHandler\n\nonDragEnter :: forall r i. (DragEvent -> i) -> IProp (onDragEnter :: DragEvent | r) i\nonDragEnter = handler DET.dragenter <<< dragHandler\n\nonDragLeave :: forall r i. (DragEvent -> i) -> IProp (onDragLeave :: DragEvent | r) i\nonDragLeave = handler DET.dragleave <<< dragHandler\n\nonDragOver :: forall r i. (DragEvent -> i) -> IProp (onDragOver :: DragEvent | r) i\nonDragOver = handler DET.dragover <<< dragHandler\n\nonDragStart :: forall r i. (DragEvent -> i) -> IProp (onDragStart :: DragEvent | r) i\nonDragStart = handler DET.dragstart <<< dragHandler\n\nonDrop :: forall r i. (DragEvent -> i) -> IProp (onDrop :: DragEvent | r) i\nonDrop = handler DET.drop <<< dragHandler\n\nonTouchCancel :: forall r i. (TouchEvent -> i) -> IProp (onTouchCancel :: TouchEvent | r) i\nonTouchCancel = handler (EventType \"touchcancel\") <<< touchHandler\n\nonTouchEnd :: forall r i. (TouchEvent -> i) -> IProp (onTouchEnd :: TouchEvent | r) i\nonTouchEnd = handler (EventType \"touchend\") <<< touchHandler\n\nonTouchEnter :: forall r i. (TouchEvent -> i) -> IProp (onTouchEnter :: TouchEvent | r) i\nonTouchEnter = handler (EventType \"touchenter\") <<< touchHandler\n\nonTouchLeave :: forall r i. (TouchEvent -> i) -> IProp (onTouchEnter :: TouchEvent | r) i\nonTouchLeave = handler (EventType \"touchleave\") <<< touchHandler\n\nonTouchMove :: forall r i. (TouchEvent -> i) -> IProp (onTouchMove :: TouchEvent | r) i\nonTouchMove = handler (EventType \"touchmove\") <<< touchHandler\n\nonTouchStart :: forall r i. (TouchEvent -> i) -> IProp (onTouchStart :: TouchEvent | r) i\nonTouchStart = handler (EventType \"touchstart\") <<< touchHandler\n\nonResize :: forall r i. (Event -> i) -> IProp (onResize :: Event | r) i\nonResize = handler (EventType \"resize\")\n\nkeyHandler :: forall i. (KeyboardEvent -> i) -> Event -> i\nkeyHandler = unsafeCoerce\n\nmouseHandler :: forall i. (MouseEvent -> i) -> Event -> i\nmouseHandler = unsafeCoerce\n\nwheelHandler :: forall i. (WheelEvent -> i) -> Event -> i\nwheelHandler = unsafeCoerce\n\nfocusHandler :: forall i. (FocusEvent -> i) -> Event -> i\nfocusHandler = unsafeCoerce\n\ndragHandler :: forall i. (DragEvent -> i) -> Event -> i\ndragHandler = unsafeCoerce\n\nclipboardHandler :: forall i. (ClipboardEvent -> i) -> Event -> i\nclipboardHandler = unsafeCoerce\n\ntouchHandler :: forall i. (TouchEvent -> i) -> Event -> i\ntouchHandler = unsafeCoerce\n\n-- | Attaches event handler to event `key` with getting `prop` field as an\n-- | argument of `handler`.\naddForeignPropHandler :: forall r i value. EventType -> String -> (Foreign -> F value) -> (value -> i) -> IProp r i\naddForeignPropHandler key prop reader f =\n handler' key $ EE.currentTarget >=> \\e -> either (const Nothing) (Just <<< f) $ runExcept $ go e\n where\n go a = reader <=< readProp prop $ unsafeToForeign a\n\n-- | Attaches an event handler which will produce an input when the value of an\n-- | input field changes.\nonValueChange :: forall r i. (String -> i) -> IProp (value :: String, onChange :: Event | r) i\nonValueChange = addForeignPropHandler ET.change \"value\" readString\n\n-- | Attaches an event handler which will produce an input when the seleced index of a\n-- | `select` element changes.\nonSelectedIndexChange :: forall r i. (Int -> i) -> IProp (selectedIndex :: Int, onChange :: Event | r) i\nonSelectedIndexChange = addForeignPropHandler ET.change \"selectedIndex\" readInt\n\n-- | Attaches an event handler which will fire on input.\nonValueInput :: forall r i. (String -> i) -> IProp (value :: String, onInput :: Event | r) i\nonValueInput = addForeignPropHandler ET.input \"value\" readString\n\n-- | Attaches an event handler which will fire when a checkbox is checked or\n-- | unchecked.\nonChecked :: forall r i. (Boolean -> i) -> IProp (checked :: Boolean, onChange :: Event | r) i\nonChecked = addForeignPropHandler ET.change \"checked\" readBoolean\n", "module Halogen.Query.Event where\n\nimport Prelude\n\nimport Data.Foldable (traverse_)\nimport Data.Maybe (Maybe)\nimport Halogen.Subscription as HS\nimport Web.Event.Event as Event\nimport Web.Event.EventTarget as EventTarget\n\n-- | Constructs an `Emitter` for a DOM event. Accepts a function that maps event\n-- | values to a `Maybe`-wrapped action, allowing it to filter events if\n-- | necessary.\neventListener\n :: forall a\n . Event.EventType\n -> EventTarget.EventTarget\n -> (Event.Event -> Maybe a)\n -> HS.Emitter a\neventListener eventType target f =\n HS.makeEmitter \\push -> do\n listener <- EventTarget.eventListener \\ev -> traverse_ push (f ev)\n EventTarget.addEventListener eventType listener false target\n pure do\n EventTarget.removeEventListener eventType listener false target\n", "var getEffProp = function (name) {\n return function (doc) {\n return function () {\n return doc[name];\n };\n };\n};\n\nexport const url = getEffProp(\"URL\");\nexport const documentURI = getEffProp(\"documentURI\");\nexport const origin = getEffProp(\"origin\");\nexport const compatMode = getEffProp(\"compatMode\");\nexport const characterSet = getEffProp(\"characterSet\");\nexport const contentType = getEffProp(\"contentType\");\nexport function _doctype(doc) {\n return doc[\"doctype\"];\n}\nexport const _documentElement = getEffProp(\"documentElement\");\n\nexport function getElementsByTagName(localName) {\n return function (doc) {\n return function () {\n return doc.getElementsByTagName(localName);\n };\n };\n}\n\nexport function _getElementsByTagNameNS(ns) {\n return function (localName) {\n return function (doc) {\n return function () {\n return doc.getElementsByTagNameNS(ns, localName);\n };\n };\n };\n}\n\nexport function getElementsByClassName(classNames) {\n return function (doc) {\n return function () {\n return doc.getElementsByClassName(classNames);\n };\n };\n}\n\nexport function createElement(localName) {\n return function (doc) {\n return function () {\n return doc.createElement(localName);\n };\n };\n}\n\nexport function _createElementNS(ns) {\n return function (qualifiedName) {\n return function (doc) {\n return function () {\n return doc.createElementNS(ns, qualifiedName);\n };\n };\n };\n}\n\nexport function createDocumentFragment(doc) {\n return function () {\n return doc.createDocumentFragment();\n };\n}\n\nexport function createTextNode(data) {\n return function (doc) {\n return function () {\n return doc.createTextNode(data);\n };\n };\n}\n\nexport function createComment(data) {\n return function (doc) {\n return function () {\n return doc.createComment(data);\n };\n };\n}\n\nexport function createProcessingInstruction(target) {\n return function (data) {\n return function (doc) {\n return function () {\n return doc.createProcessingInstruction(target, data);\n };\n };\n };\n}\n\nexport function importNode(node) {\n return function (deep) {\n return function (doc) {\n return function () {\n return doc.importNode(node, deep);\n };\n };\n };\n}\n\nexport function adoptNode(node) {\n return function (doc) {\n return function () {\n return doc.adoptNode(node);\n };\n };\n}\n", "-- | This module provides type definitions and implementations for the\n-- | `Document` interface, which is part of the W3C DOM API.\n-- |\n-- | The DOM API doesn't actually give you any way of getting hold of a\n-- | `Document` by itself. To do that, you will need to look at one of the\n-- | other APIs which build on the DOM API. For example, `window.document` is\n-- | part of the HTML5 API, and so the relevant binding can be found in\n-- | `Web.HTML.Window`, which is part of the `purescript-web-html` package.\nmodule Web.DOM.Document\n ( Document\n , fromNode\n , fromParentNode\n , fromNonElementParentNode\n , fromEventTarget\n , toNode\n , toParentNode\n , toNonElementParentNode\n , toEventTarget\n , url\n , documentURI\n , origin\n , compatMode\n , characterSet\n , contentType\n , doctype\n , documentElement\n , getElementsByTagName\n , getElementsByTagNameNS\n , getElementsByClassName\n , createElement\n , createElementNS\n , createDocumentFragment\n , createTextNode\n , createComment\n , createProcessingInstruction\n , importNode\n , adoptNode\n ) where\n\nimport Prelude\n\nimport Data.Maybe (Maybe)\nimport Data.Nullable (Nullable, toMaybe, toNullable)\nimport Effect (Effect)\nimport Unsafe.Coerce (unsafeCoerce)\nimport Web.DOM.Comment (Comment)\nimport Web.DOM.DocumentFragment (DocumentFragment)\nimport Web.DOM.DocumentType (DocumentType)\nimport Web.DOM.Element (Element)\nimport Web.DOM.HTMLCollection (HTMLCollection)\nimport Web.DOM.Internal.Types (Node)\nimport Web.DOM.NonElementParentNode (NonElementParentNode)\nimport Web.DOM.ParentNode (ParentNode)\nimport Web.DOM.ProcessingInstruction (ProcessingInstruction)\nimport Web.DOM.Text (Text)\nimport Web.Event.EventTarget (EventTarget)\nimport Web.Internal.FFI (unsafeReadProtoTagged)\n\nforeign import data Document :: Type\n\nfromNode :: Node -> Maybe Document\nfromNode = unsafeReadProtoTagged \"Document\"\n\nfromParentNode :: ParentNode -> Maybe Document\nfromParentNode = unsafeReadProtoTagged \"Document\"\n\nfromNonElementParentNode :: NonElementParentNode -> Maybe Document\nfromNonElementParentNode = unsafeReadProtoTagged \"Document\"\n\nfromEventTarget :: EventTarget -> Maybe Document\nfromEventTarget = unsafeReadProtoTagged \"Document\"\n\ntoNode :: Document -> Node\ntoNode = unsafeCoerce\n\ntoParentNode :: Document -> ParentNode\ntoParentNode = unsafeCoerce\n\ntoNonElementParentNode :: Document -> NonElementParentNode\ntoNonElementParentNode = unsafeCoerce\n\ntoEventTarget :: Document -> EventTarget\ntoEventTarget = unsafeCoerce\n\nforeign import url :: Document -> Effect String\nforeign import documentURI :: Document -> Effect String\nforeign import origin :: Document -> Effect String\nforeign import compatMode :: Document -> Effect String\nforeign import characterSet :: Document -> Effect String\nforeign import contentType :: Document -> Effect String\n\ndoctype :: Document -> Maybe DocumentType\ndoctype = toMaybe <<< _doctype\n\nforeign import _doctype :: Document -> Nullable DocumentType\n\ndocumentElement :: Document -> Effect (Maybe Element)\ndocumentElement = map toMaybe <<< _documentElement\n\nforeign import _documentElement :: Document -> Effect (Nullable Element)\n\nforeign import getElementsByTagName :: String -> Document -> Effect HTMLCollection\n\ngetElementsByTagNameNS :: Maybe String -> String -> Document -> Effect HTMLCollection\ngetElementsByTagNameNS = _getElementsByTagNameNS <<< toNullable\n\nforeign import _getElementsByTagNameNS :: Nullable String -> String -> Document -> Effect HTMLCollection\nforeign import getElementsByClassName :: String -> Document -> Effect HTMLCollection\n\nforeign import createElement :: String -> Document -> Effect Element\n\ncreateElementNS :: Maybe String -> String -> Document -> Effect Element\ncreateElementNS = _createElementNS <<< toNullable\n\nforeign import _createElementNS :: Nullable String -> String -> Document -> Effect Element\nforeign import createDocumentFragment :: Document -> Effect DocumentFragment\nforeign import createTextNode :: String -> Document -> Effect Text\nforeign import createComment :: String -> Document -> Effect Comment\nforeign import createProcessingInstruction :: String -> String -> Document -> Effect ProcessingInstruction\n\nforeign import importNode :: Node -> Boolean -> Document -> Effect Node\nforeign import adoptNode :: Node -> Document -> Effect Node\n", "export function key(e) {\n return e.key;\n}\n\nexport function code(e) {\n return e.code;\n}\n\nexport function locationIndex(e) {\n return e.location;\n}\n\nexport function ctrlKey(e) {\n return e.ctrlKey;\n}\n\nexport function shiftKey(e) {\n return e.shiftKey;\n}\n\nexport function altKey(e) {\n return e.altKey;\n}\n\nexport function metaKey(e) {\n return e.metaKey;\n}\n\nexport function repeat(e) {\n return e.repeat;\n}\n\nexport function isComposing(e) {\n return e.isComposing;\n}\n\nexport function getModifierState(s) {\n return function (e) {\n return function () {\n return e.getModifierState(s);\n };\n };\n}\n", "-- | Functions that expose the KeyboardEvent API.\n-- |\n-- | https://developer.mozilla.org/en-US/docs/Web/API/KeyboardEvent\n-- |\n-- | Note: The deprecated attributes `.keyCode`, `.charCode`, and\n-- | `.which` are deliberately omitted. It is currently recommended to use\n-- | `KeyboardEvent.key` instead.\n-- |\n-- | If browser support for `KeyboardEvent.key` is not yet widespread\n-- | enough for your use case, consider using a polyfill\n-- | (e.g. https://github.com/inexorabletash/polyfill#keyboard-events)\n-- | or use the purescript FFI to access the deprecated attributes you\n-- | want to work with.\n-- |\nmodule Web.UIEvent.KeyboardEvent\n ( KeyboardEvent\n , fromUIEvent\n , fromEvent\n , toUIEvent\n , toEvent\n , key\n , code\n , locationIndex\n , location\n , KeyLocation(..)\n , toEnumKeyLocation\n , fromEnumKeyLocation\n , ctrlKey\n , shiftKey\n , altKey\n , metaKey\n , repeat\n , isComposing\n , getModifierState\n ) where\n\nimport Prelude\n\nimport Data.Enum (class BoundedEnum, class Enum, Cardinality(..), defaultPred, defaultSucc, toEnum)\nimport Data.Maybe (Maybe(..), fromJust)\nimport Effect (Effect)\nimport Unsafe.Coerce (unsafeCoerce)\nimport Web.Event.Event (Event)\nimport Web.Internal.FFI (unsafeReadProtoTagged)\nimport Web.UIEvent.UIEvent (UIEvent)\n\nforeign import data KeyboardEvent :: Type\n\nfromUIEvent :: UIEvent -> Maybe KeyboardEvent\nfromUIEvent = unsafeReadProtoTagged \"KeyboardEvent\"\n\nfromEvent :: Event -> Maybe KeyboardEvent\nfromEvent = unsafeReadProtoTagged \"KeyboardEvent\"\n\ntoUIEvent :: KeyboardEvent -> UIEvent\ntoUIEvent = unsafeCoerce\n\ntoEvent :: KeyboardEvent -> Event\ntoEvent = unsafeCoerce\n\n-- | A non-empty Unicode character string containing the printable representation\n-- | of the key, if available.\nforeign import key :: KeyboardEvent -> String\n\n-- | Returns a string representing a physical key on the keyboard. Not\n-- | affected by keyboard layout or state of the modifier keys.\nforeign import code :: KeyboardEvent -> String\n\nforeign import locationIndex :: KeyboardEvent -> Int\n\nlocation :: Partial => KeyboardEvent -> KeyLocation\nlocation = fromJust <<< toEnum <<< locationIndex\n\ndata KeyLocation\n = Standard\n | Left\n | Right\n | Numpad\n\nderive instance eqKeyLocation :: Eq KeyLocation\nderive instance ordKeyLocation :: Ord KeyLocation\n\ninstance boundedKeyLocation :: Bounded KeyLocation where\n bottom = Standard\n top = Numpad\n\ninstance enumKeyLocation :: Enum KeyLocation where\n succ = defaultSucc toEnumKeyLocation fromEnumKeyLocation\n pred = defaultPred toEnumKeyLocation fromEnumKeyLocation\n\ninstance boundedEnumKeyLocation :: BoundedEnum KeyLocation where\n cardinality = Cardinality 4\n toEnum = toEnumKeyLocation\n fromEnum = fromEnumKeyLocation\n\ntoEnumKeyLocation :: Int -> Maybe KeyLocation\ntoEnumKeyLocation =\n case _ of\n 0 -> Just Standard\n 1 -> Just Left\n 2 -> Just Right\n 3 -> Just Numpad\n _ -> Nothing\n\nfromEnumKeyLocation :: KeyLocation -> Int\nfromEnumKeyLocation =\n case _ of\n Standard -> 0\n Left -> 1\n Right -> 2\n Numpad -> 3\n\nforeign import ctrlKey :: KeyboardEvent -> Boolean\n\nforeign import shiftKey :: KeyboardEvent -> Boolean\n\nforeign import altKey :: KeyboardEvent -> Boolean\n\nforeign import metaKey :: KeyboardEvent -> Boolean\n\nforeign import repeat :: KeyboardEvent -> Boolean\n\nforeign import isComposing :: KeyboardEvent -> Boolean\n\nforeign import getModifierState\n :: String\n -> KeyboardEvent\n -> Effect Boolean\n", "-- | This module contains a Halogen component for search field, that emits\n-- | `SearchFieldMessage`s for various events.\nmodule Docs.Search.App.SearchField where\n\nimport Prelude\n\nimport CSS (border, borderRadius, color, em, float, floatLeft, fontWeight, lineHeight, marginBottom, marginLeft, paddingBottom, paddingLeft, paddingRight, paddingTop, pct, px, rgb, solid, weight, width)\nimport Data.Maybe (Maybe(..), maybe)\nimport Data.Newtype (wrap)\nimport Docs.Search.URIHash as URIHash\nimport Effect (Effect)\nimport Effect.Aff (Aff)\nimport Halogen as H\nimport Halogen.HTML as HH\nimport Halogen.HTML.CSS as HS\nimport Halogen.HTML.Events as HE\nimport Halogen.HTML.Properties as HP\nimport Halogen.Query.Event as ES\nimport Web.DOM.Document as Document\nimport Web.DOM.ParentNode as ParentNode\nimport Web.HTML as HTML\nimport Web.HTML.HTMLDocument as HTMLDocument\nimport Web.HTML.HTMLElement as HTMLElement\nimport Web.HTML.HTMLInputElement as HTMLInputElement\nimport Web.HTML.Window as Window\nimport Web.UIEvent.KeyboardEvent (KeyboardEvent)\nimport Web.UIEvent.KeyboardEvent as KE\nimport Web.UIEvent.KeyboardEvent as KeyboardEvent\nimport Web.UIEvent.KeyboardEvent.EventTypes as KET\n\ntype State = { input :: String, focused :: Boolean }\n\ndata Action\n = InputAction String\n | EnterPressed\n | FocusChanged Boolean\n | InitKeyboardListener\n | HandleKey H.SubscriptionId KeyboardEvent\n | NoOp\n\ndata Query a = ReadURIHash a\n\ndata SearchFieldMessage\n = InputUpdated String\n | InputCleared\n | Focused\n | LostFocus\n\ncomponent :: forall i. H.Component Query i SearchFieldMessage Aff\ncomponent =\n H.mkComponent\n { initialState\n , render\n , eval: H.mkEval $ H.defaultEval\n { handleAction = handleAction\n , handleQuery = handleQuery\n , initialize = Just InitKeyboardListener\n }\n }\n\nhandleQuery\n :: forall a\n . Query a\n -> H.HalogenM State Action () SearchFieldMessage Aff (Maybe a)\nhandleQuery (ReadURIHash _next) = do\n oldInput <- H.get <#> _.input\n newInput <- H.liftEffect URIHash.getInput\n when (oldInput /= newInput) do\n H.modify_ (_ { input = newInput })\n H.raise (InputUpdated newInput)\n pure Nothing\n\ninitialState :: forall i. i -> State\ninitialState _ = { input: \"\", focused: false }\n\nhandleAction :: Action -> H.HalogenM State Action () SearchFieldMessage Aff Unit\nhandleAction = case _ of\n NoOp -> pure unit\n InitKeyboardListener -> do\n\n document <- H.liftEffect $ Window.document =<< HTML.window\n H.subscribe' \\sid ->\n ES.eventListener\n KET.keyup\n (HTMLDocument.toEventTarget document)\n (map (HandleKey sid) <<< KE.fromEvent)\n\n HandleKey _sid ev -> do\n\n when (KE.code ev == \"KeyS\") do\n state <- H.get\n when (not state.focused) do\n H.liftEffect do\n withSearchField HTMLInputElement.select\n withSearchField (HTMLInputElement.toHTMLElement >>> HTMLElement.focus)\n\n when (KE.code ev == \"Escape\") do\n state <- H.get\n if state.focused then do\n H.liftEffect do\n withSearchField (HTMLInputElement.toHTMLElement >>> HTMLElement.blur)\n else clearInput\n\n InputAction input -> do\n H.modify_ $ (_ { input = input })\n\n EnterPressed -> do\n state <- H.get\n H.liftEffect do\n withSearchField (HTMLInputElement.toHTMLElement >>> HTMLElement.blur)\n H.liftEffect (URIHash.setInput state.input)\n H.raise $ InputUpdated state.input\n\n FocusChanged isFocused -> do\n H.modify_ (_ { focused = isFocused })\n H.raise\n if isFocused then Focused\n else LostFocus\n when isFocused scrollToTop\n\nscrollToTop :: H.HalogenM State Action () SearchFieldMessage Aff Unit\nscrollToTop = do\n H.liftEffect do\n HTML.window >>= Window.scroll 0 0\n\nclearInput :: H.HalogenM State Action () SearchFieldMessage Aff Unit\nclearInput = do\n H.modify_ (_ { input = \"\" })\n H.liftEffect URIHash.removeHash\n H.raise InputCleared\n\nwithSearchField :: (HTML.HTMLInputElement -> Effect Unit) -> Effect Unit\nwithSearchField cont = do\n doc <- Document.toParentNode\n <$> HTMLDocument.toDocument\n <$>\n (Window.document =<< HTML.window)\n\n let selector = wrap \"#docs-search-query-field\"\n\n mbEl <- ParentNode.querySelector selector doc\n maybe mempty cont (mbEl >>= HTMLInputElement.fromElement)\n\nrender :: forall m. State -> H.ComponentHTML Action () m\nrender state =\n HH.div\n [ HS.style do\n float floatLeft\n lineHeight (px 90.0)\n marginBottom (px 0.0)\n marginLeft (em 2.0)\n width (pct 30.0)\n ]\n\n [ HH.input\n [ HP.value state.input\n , HP.placeholder \"Search for definitions... (S to focus)\"\n , HP.id \"docs-search-query-field\"\n , HP.type_ HP.InputText\n , HE.onKeyUp\n ( \\event ->\n case KeyboardEvent.code event of\n \"Enter\" -> EnterPressed\n _ -> NoOp\n )\n , HE.onValueInput InputAction\n , HE.onFocusIn $ const $ FocusChanged true\n , HE.onFocusOut $ const $ FocusChanged false\n , HS.style do\n\n let\n pursuitColor = rgb 0x1d 0x22 0x2d\n rds = px 3.0\n\n border solid (px 1.0) pursuitColor\n borderRadius rds rds rds rds\n color pursuitColor\n fontWeight $ weight 300.0\n lineHeight $ em 2.0\n paddingLeft $ em 0.8\n paddingRight $ em 0.21\n paddingTop $ em 0.512\n paddingBottom $ em 0.512\n width $ pct 100.0\n ]\n ]\n", "/* global exports */\n\nexport function loadIndex_ (partId) {\n return function (url) {\n return function () {\n return new Promise(function(resolve, reject) {\n if (typeof window.DocsSearchIndex[partId] === 'undefined') {\n\n var script = document.createElement('script');\n script.type = 'text/javascript';\n script.src = url;\n\n script.addEventListener('load', function () {\n if (typeof window.DocsSearchIndex[partId] == 'undefined') {\n reject();\n } else {\n resolve(window.DocsSearchIndex[partId]);\n }\n });\n\n script.addEventListener('error', reject);\n\n document.body.appendChild(script);\n } else {\n resolve(window.DocsSearchIndex[partId]);\n }\n });\n };\n };\n};\n", "export function promise(f) {\n return function () {\n return new Promise(function (success, error) {\n var succF = function (s) { return function() { return success(s); } };\n var failF = function (s) { return function() { return error(s); } };\n\n // This indicates the aff was wrong?\n try { f(succF)(failF)(); }\n catch (e) {\n error(e);\n }\n });\n };\n}\n\nexport function thenImpl(promise) {\n return function(errCB) {\n return function(succCB) {\n return function() {\n promise.then(succCB, errCB);\n };\n };\n };\n}\n", "module Control.Promise (fromAff, toAff, toAff', toAffE, Promise()) where\n\nimport Prelude\n\nimport Control.Alt ((<|>))\nimport Control.Monad.Except (runExcept)\nimport Data.Either (Either(..), either)\nimport Effect (Effect)\nimport Effect.Aff (Aff, makeAff, runAff_)\nimport Effect.Class (liftEffect)\nimport Effect.Exception (Error, error)\nimport Effect.Uncurried (EffectFn1, mkEffectFn1)\nimport Foreign (Foreign, readString, unsafeReadTagged)\n\n-- | Type of JavaScript Promises (with particular return type)\n-- | Effects are not traced in the Promise type, as they form part of the Effect that\n-- | results in the promise.\nforeign import data Promise :: Type -> Type\n\ntype role Promise representational\n\nforeign import promise :: forall a b.\n ((a -> Effect Unit) -> (b -> Effect Unit) -> Effect Unit) -> Effect (Promise a)\nforeign import thenImpl :: forall a b.\n Promise a -> (EffectFn1 Foreign b) -> (EffectFn1 a b) -> Effect Unit\n\n-- | Convert an Aff into a Promise.\nfromAff :: forall a. Aff a -> Effect (Promise a)\nfromAff aff = promise (\\succ err -> runAff_ (either err succ) aff)\n\ncoerce :: Foreign -> Error\ncoerce fn =\n either (\\_ -> error \"Promise failed, couldn't extract JS Error or String\")\n identity\n (runExcept ((unsafeReadTagged \"Error\" fn) <|> (error <$> readString fn)))\n\n-- | Convert a Promise into an Aff.\n-- | When the promise rejects, we attempt to\n-- | coerce the error value into an actual JavaScript Error object. We can do this\n-- | with Error objects or Strings. Anything else gets a \"dummy\" Error object.\ntoAff :: forall a. Promise a -> Aff a\ntoAff = toAff' coerce\n\n-- | Convert a Promise into an Aff with custom Error coercion.\n-- | When the promise rejects, we attempt to coerce the error value into an\n-- | actual JavaScript Error object using the provided function.\ntoAff' :: forall a. (Foreign -> Error) -> Promise a -> Aff a\ntoAff' customCoerce p = makeAff\n (\\cb -> mempty <$ thenImpl\n p\n (mkEffectFn1 $ cb <<< Left <<< customCoerce)\n (mkEffectFn1 $ cb <<< Right))\n\n-- | Utility to convert an Effect returning a Promise into an Aff (i.e. the inverse of fromAff)\ntoAffE :: forall a. Effect (Promise a) -> Aff a\ntoAffE f = liftEffect f >>= toAff\n", "const coerce = (x) => x;\n\nexport const _null = null;\n\nexport const fromBoolean = coerce;\n\nexport const fromInt = coerce;\n\nexport const fromString = coerce;\n\nexport const fromJArray = coerce;\n\nexport const fromJObject = coerce;\n\nexport const print = (j) => JSON.stringify(j);\n\nexport const printIndented = (j) => JSON.stringify(j, null, 2);\n", "const toString = Object.prototype.toString;\nconst hasOwnProperty = Object.prototype.hasOwnProperty;\n\nexport const _parse = (left, right, s) => {\n try {\n return right(JSON.parse(s));\n }\n catch (e) {\n return left(e.message);\n }\n};\n\nexport const _fromNumberWithDefault = (fallback, n) => isNaN(n) || !isFinite(n) ? fallback : n;\n\nexport const _case = (isNull, isBool, isNum, isStr, isArr, isObj, j) => {\n if (j == null) return isNull(null);\n const ty = typeof j;\n if (ty === \"boolean\") return isBool(j);\n if (ty === \"number\") return isNum(j);\n if (ty === \"string\") return isStr(j);\n if (toString.call(j) === \"[object Array]\") return isArr(j);\n return isObj(j);\n};\n\nexport const toArray = (js) => js;\nexport const fromArray = (js) => js;\n\nexport const _fromEntries = (fst, snd, entries) => {\n const result = {};\n for (var i = 0; i < entries.length; i++) {\n result[fst(entries[i])] = snd(entries[i]);\n }\n return result;\n};\n\nexport const _insert = (k, v, obj) =>\n Object.assign({ [k]: v }, obj);\n\nexport const _delete = (k, obj) => {\n if (!Object.hasOwn(obj, k)) return obj;\n const result = Object.assign({}, obj);\n delete result[k];\n return result;\n};\n\nexport const _entries = (tuple, obj) =>\n Object.entries(obj).map(([k, v]) => tuple(k)(v));\n\nexport const _lookup = (nothing, just, key, obj) =>\n hasOwnProperty.call(obj, key) ? just(obj[key]) : nothing;\n\nexport const empty = [];\n\nexport const length = (arr) => arr.length;\n\nexport const _index = (nothing, just, ix, arr) =>\n ix >= 0 && ix < arr.length ? just(arr[ix]) : nothing;\n\nexport const _append = (xs, ys) => xs.concat(ys);\n\nexport const isNull = (json) => json == null;\n", "module JSON\n ( parse\n , null\n , fromBoolean\n , fromNumber\n , fromNumberWithDefault\n , fromInt\n , fromString\n , fromArray\n , fromJArray\n , fromJObject\n , case_\n , toNull\n , toBoolean\n , toNumber\n , toInt\n , toString\n , toArray\n , toJArray\n , toJObject\n , print\n , printIndented\n , module Exports\n ) where\n\nimport Prelude\n\nimport Data.Either (Either(..))\nimport Data.Function.Uncurried (runFn2, runFn3, runFn7)\nimport Data.Int as Int\nimport Data.Maybe (Maybe(..))\nimport JSON.Internal (JArray, JObject, JSON)\nimport JSON.Internal (JArray, JObject, JSON, isNull) as Exports\nimport JSON.Internal as Internal\n\n-- | Attempts to parse a string as a JSON value. If parsing fails, an error message detailing the\n-- | cause may be returned in the `Left` of the result.\nparse :: String -> Either String JSON\nparse j = runFn3 Internal._parse Left Right j\n\n-- | The JSON `null` value.\nnull :: JSON\nnull = _null\n\n-- | The JSON `null` value.\nforeign import _null :: JSON\n\n-- | Converts a `Boolean` into `JSON`.\nforeign import fromBoolean :: Boolean -> JSON\n\n-- | Converts a `Number` into `JSON`.\n-- |\n-- | The PureScript `Number` type admits infinities and a `NaN` value which are not allowed in JSON,\n-- | so when encountered, this function will treat those values as 0.\nfromNumber :: Number -> JSON\nfromNumber n = runFn2 Internal._fromNumberWithDefault 0 n\n\n-- | Creates a `Number` into `JSON`, using a fallback `Int` value for cases where the\n-- | PureScript number value is not valid for JSON (`NaN`, `infinity`).\nfromNumberWithDefault :: Int -> Number -> JSON\nfromNumberWithDefault fallback n = runFn2 Internal._fromNumberWithDefault fallback n\n\n-- | Converts an `Int` into `JSON`.\n-- |\n-- | Note: JSON doesn't have a concept of integers. This is provided\n-- | as a convenience to avoid having to convert `Int` to `Number` before creating a `JSON` value.\nforeign import fromInt :: Int -> JSON\n\n-- | Converts a `String` into `JSON`.\n-- |\n-- | **Note**: this does not parse a string as a JSON value, it takes a PureScript string and\n-- | produces the corresponding `JSON` value for that string, similar to the other functions like\n-- | `fromBoolean` and `fromNumber`.\n-- |\n-- | To take a string that contains printed JSON and turn it into a `JSON` value, see\n-- | [`parse`](#v:parse).\nforeign import fromString :: String -> JSON\n\n-- | Converts a `JArray` into `JSON`.\nforeign import fromJArray :: JArray -> JSON\n\n-- | Converts an array of `JSON` values into `JSON`.\nfromArray :: Array JSON -> JSON\nfromArray js = fromJArray (Internal.fromArray js)\n\n-- | Converts a `JObject` into `JSON`.\nforeign import fromJObject :: JObject -> JSON\n\n-- | Performs case analysis on a JSON value.\n-- |\n-- | As the `JSON` type is not a PureScript sum type, pattern matching cannot be used to\n-- | discriminate between the potential varieties of value. This function provides an equivalent\n-- | mechanism by accepting functions that deal with each variety, similar to an exaustive `case`\n-- | statement.\n-- |\n-- | The `Unit` case is for `null` values.\ncase_\n :: forall a\n . (Unit -> a)\n -> (Boolean -> a)\n -> (Number -> a)\n -> (String -> a)\n -> (JArray -> a)\n -> (JObject -> a)\n -> JSON\n -> a\ncase_ a b c d e f json = runFn7 Internal._case a b c d e f json\n\nfail :: forall a b. a -> Maybe b\nfail _ = Nothing\n\n-- | Converts a `JSON` value to `Null` if the `JSON` is `null`.\ntoNull :: JSON -> Maybe Unit\ntoNull json = runFn7 Internal._case Just fail fail fail fail fail json\n\n-- | Converts a `JSON` value to `Boolean` if the `JSON` is a boolean.\ntoBoolean :: JSON -> Maybe Boolean\ntoBoolean json = runFn7 Internal._case fail Just fail fail fail fail json\n\n-- | Converts a `JSON` value to `Number` if the `JSON` is a number.\ntoNumber :: JSON -> Maybe Number\ntoNumber json = runFn7 Internal._case fail fail Just fail fail fail json\n\n-- | Converts a `JSON` `Number` into an `Int`.\n-- |\n-- | This is provided for convenience only.\ntoInt :: JSON -> Maybe Int\ntoInt = toNumber >=> Int.fromNumber\n\n-- | Converts a `JSON` value to `String` if the `JSON` is a string.\ntoString :: JSON -> Maybe String\ntoString json = runFn7 Internal._case fail fail fail Just fail fail json\n\n-- | Converts a `JSON` value to `JArray` if the `JSON` is an array.\ntoJArray :: JSON -> Maybe JArray\ntoJArray json = runFn7 Internal._case fail fail fail fail Just fail json\n\n-- | Converts a `JSON` value to `Array JSON` if the `JSON` is an array.\ntoArray :: JSON -> Maybe (Array JSON)\ntoArray json = Internal.toArray <$> toJArray json\n\n-- | Converts a `JSON` value to `Object` if the `JSON` is an object.\ntoJObject :: JSON -> Maybe JObject\ntoJObject json = runFn7 Internal._case fail fail fail fail fail Just json\n\n-- | Prints a JSON value as a compact (single line) string.\nforeign import print :: JSON -> String\n\n-- | Prints a JSON value as a \"pretty\" string with newlines and indentation.\nforeign import printIndented :: JSON -> String\n", "module JSON.Array\n ( fromFoldable\n , singleton\n , index\n , toUnfoldable\n , module Exports\n ) where\n\nimport Data.Array as Array\nimport Data.Foldable (class Foldable)\nimport Data.Function.Uncurried (runFn4)\nimport Data.Maybe (Maybe(..))\nimport Data.Unfoldable (class Unfoldable)\nimport JSON.Internal (JArray, JSON, _index, fromArray, toArray)\nimport JSON.Internal (JArray, empty, fromArray, length, toArray) as Exports\n\n-- | Creates a `JArray` from a `Foldable` source of `JSON`.\nfromFoldable :: forall f. Foldable f => f JSON -> JArray\nfromFoldable js = fromArray (Array.fromFoldable js)\n\n-- | Creates a `JArray` with a single entry.\nforeign import singleton :: JSON -> JArray\n\n-- | Attempts to read a value from the specified index of a `JArray`.\nindex :: Int -> JArray -> Maybe JSON\nindex ix arr = runFn4 _index Nothing Just ix arr\n\n-- | Unfolds a `JArray` into `JSON` items\ntoUnfoldable :: forall f. Unfoldable f => JArray -> f JSON\ntoUnfoldable js = Array.toUnfoldable (toArray js)\n", "module JSON.Object\n ( fromEntries\n , fromFoldable\n , fromFoldableWithIndex\n , empty\n , singleton\n , insert\n , delete\n , entries\n , keys\n , values\n , lookup\n , toUnfoldable\n , module Exports\n ) where\n\nimport Data.Array as Array\nimport Data.Foldable (class Foldable)\nimport Data.FoldableWithIndex (class FoldableWithIndex, foldrWithIndex)\nimport Data.Function.Uncurried (runFn2, runFn3, runFn4)\nimport Data.Maybe (Maybe(..))\nimport Data.Tuple (Tuple(..), fst, snd)\nimport Data.Unfoldable (class Unfoldable)\nimport JSON.Internal (JObject) as Exports\nimport JSON.Internal (JObject, JSON, _delete, _entries, _fromEntries, _insert, _lookup)\n\n-- | Creates an `JObject` from an array of key/value pairs.\nfromEntries :: Array (Tuple String JSON) -> JObject\nfromEntries kvs = runFn3 _fromEntries fst snd kvs\n\n-- | Creates an `JObject` from a foldable source of key/value pairs.\nfromFoldable :: forall f. Foldable f => f (Tuple String JSON) -> JObject\nfromFoldable kvs = fromEntries (Array.fromFoldable kvs)\n\n-- | Creates an `JObject` from an indexed foldable source.\nfromFoldableWithIndex :: forall f. FoldableWithIndex String f => f JSON -> JObject\nfromFoldableWithIndex kvs = fromEntries (foldrWithIndex (\\k v -> Array.cons (Tuple k v)) [] kvs)\n\n-- | An empty `JObject`.\nforeign import empty :: JObject\n\n-- | Creates an `JObject` with a single entry.\nsingleton :: String -> JSON -> JObject\nsingleton k v = runFn3 _insert k v empty\n\n-- | Inserts an entry into an `JObject`. If the key already exists the value will be overwritten.\ninsert :: String -> JSON -> JObject -> JObject\ninsert k v obj = runFn3 _insert k v obj\n\n-- | Deletes an entry from an `JObject`. This will have no effect if the key does not exist in the\n-- | object.\ndelete :: String -> JObject -> JObject\ndelete k obj = runFn2 _delete k obj\n\n-- | Extracts the key/value pairs of an `JObject`.\nentries :: JObject -> Array (Tuple String JSON)\nentries obj = runFn2 _entries Tuple obj\n\n-- | Extracts the keys of an `JObject`.\nkeys :: JObject -> Array String\nkeys obj = runFn2 _entries (\\k _ -> k) obj\n\n-- | Extracts the values of an `JObject`.\nvalues :: JObject -> Array JSON\nvalues obj = runFn2 _entries (\\_ v -> v) obj\n\n-- | Attempts to fetch the value for a key from an `JObject`. If the key is not present `Nothing` is\n-- | returned.\nlookup :: String -> JObject -> Maybe JSON\nlookup k obj = runFn4 _lookup Nothing Just k obj\n\n-- | Unfolds an object into key/value pairs.\ntoUnfoldable :: forall f. Unfoldable f => JObject -> f (Tuple String JSON)\ntoUnfoldable obj = Array.toUnfoldable (entries obj)\n", "module JSON.Path where\n\nimport Prelude\n\nimport Data.Generic.Rep (class Generic)\nimport Data.Maybe (Maybe(..))\nimport JSON (JSON)\nimport JSON as JSON\nimport JSON.Array as JArray\nimport JSON.Object as JObject\n\n-- | A path to a location in a JSON document.\ndata Path\n = Tip\n | AtKey String Path\n | AtIndex Int Path\n\nderive instance Eq Path\nderive instance Ord Path\nderive instance Generic Path _\n\ninstance Show Path where\n show = case _ of\n Tip -> \"Tip\"\n AtKey key rest -> \"(AtKey \" <> show key <> \" \" <> show rest <> \")\"\n AtIndex ix rest -> \"(AtIndex \" <> show ix <> \" \" <> show rest <> \")\"\n\n-- | Attempts to get the value at the path in a JSON document.\nget :: Path -> JSON -> Maybe JSON\nget path json =\n case path of\n Tip -> Just json\n AtKey key rest -> get rest =<< JObject.lookup key =<< JSON.toJObject json\n AtIndex ix rest -> get rest =<< JArray.index ix =<< JSON.toJArray json\n\n-- | Prints the path as a basic JSONPath expression.\nprint :: Path -> String\nprint path = \"$\" <> go path\n where\n go :: Path -> String\n go p = case p of\n Tip -> \"\"\n AtKey k rest -> \".\" <> k <> go rest -- TODO: [\"quoted\"] paths also\n AtIndex ix rest -> \"[\" <> show ix <> \"]\" <> go rest\n\n-- | Extends the tip of the first path with the second path.\n-- |\n-- | For example, `$.data[0]` extended with `$.info.title` would result in `$.data[0].info.title`.\nextend :: Path -> Path -> Path\nextend p1 p2 = case p1 of\n Tip -> p2\n AtKey key rest -> AtKey key (extend rest p2)\n AtIndex ix rest -> AtIndex ix (extend rest p2)\n\n-- | Finds the common prefix of two paths. If they have nothing in common the result will be the\n-- | root.\nfindCommonPrefix :: Path -> Path -> Path\nfindCommonPrefix = case _, _ of\n AtKey k1 rest1, AtKey k2 rest2 | k1 == k2 -> AtKey k1 (findCommonPrefix rest1 rest2)\n AtIndex i1 rest1, AtIndex i2 rest2 | i1 == i2 -> AtIndex i1 (findCommonPrefix rest1 rest2)\n _, _ -> Tip\n\n-- | Attempts to strip the first path from the start of the second path. `Nothing` is returned if\n-- | the second path does not start with the prefix.\n-- |\n-- | For example, stripping a prefix of `$.data[0]` from `$.data[0].info.title` would result in\n-- | `$.info.title`.\nstripPrefix :: Path -> Path -> Maybe Path\nstripPrefix = case _, _ of\n AtKey k1 rest1, AtKey k2 rest2 | k1 == k2 -> stripPrefix rest1 rest2\n AtIndex i1 rest1, AtIndex i2 rest2 | i1 == i2 -> stripPrefix rest1 rest2\n Tip, tail -> Just tail\n _, _ -> Nothing\n", "module Codec.JSON.DecodeError where\n\nimport Prelude\n\nimport Data.Array as Array\nimport Data.Generic.Rep (class Generic)\nimport Data.Maybe (fromMaybe)\nimport Data.Newtype (class Newtype, over)\nimport Data.String as String\nimport JSON.Path as JP\n\n-- | Type for failures while decoding, a path to the point in the JSON that failure occurred, a\n-- | message describing the problem, and a list of further causes for the failure.\nnewtype DecodeError = DecodeError DecodeErrorDetails\n\ntype DecodeErrorDetails =\n { path \u2237 JP.Path\n , message \u2237 String\n , causes \u2237 Array DecodeError\n }\n\nderive instance Eq DecodeError\nderive instance Ord DecodeError\nderive instance Generic DecodeError _\nderive instance Newtype DecodeError _\n\ninstance Show DecodeError where\n show (DecodeError err) = \"(DecodeError \" <> show err <> \")\"\n\ninstance Semigroup DecodeError where\n append (DecodeError err1) (DecodeError err2) =\n DecodeError\n { path: JP.findCommonPrefix err1.path err2.path\n , message: altMessage\n , causes:\n (if err1.message == altMessage then err1.causes else [ DecodeError err1 ])\n <> (if err2.message == altMessage then err2.causes else [ DecodeError err2 ])\n }\n where\n altMessage \u2237 String\n altMessage = \"Failed to decode alternatives\"\n\n-- | Prints an `DecodeError` as a somewhat readable error message.\nprint \u2237 DecodeError \u2192 String\nprint (DecodeError err) = pathPart <> err.message <> details\n where\n pathPart = if err.path == JP.Tip then \"\" else JP.print err.path <> \": \"\n causes =\n map\n ( \\e \u2192\n String.replaceAll\n (String.Pattern \"\\n\")\n (String.Replacement (if Array.length err.causes == 1 then \"\\n \" else \"\\n \"))\n (print (withPath (\\p \u2192 fromMaybe p (JP.stripPrefix err.path p)) e))\n )\n err.causes\n details =\n case Array.length err.causes of\n 0 \u2192 \"\"\n 1 \u2192 \":\\n \" <> String.joinWith \"\\n \" causes\n _ \u2192 \":\\n - \" <> String.joinWith \"\\n - \" causes\n\n-- | Updates the path for an error. The transformation is applied to the error itself along with\n-- | its causes, recursively. This is intended for extending the path to elaborate on the location\n-- | of errors from the top down.\nwithPath \u2237 (JP.Path \u2192 JP.Path) \u2192 DecodeError \u2192 DecodeError\nwithPath f = over DecodeError \\err \u2192 err { path = f err.path, causes = map (withPath f) err.causes }\n\n-- | Starts a new context for the error, pushing the current error into `causes` and providing a\n-- | new message. This is useful for cases where you want to introduce a higher level error, adding\n-- | information about domain types, for example.\nwithContext \u2237 String \u2192 DecodeError \u2192 DecodeError\nwithContext message =\n over DecodeError \\err \u2192\n { path: err.path\n , message\n , causes: [ DecodeError err ]\n }\n\n-- | Constructs an error from a path and message (no further causes).\nerror \u2237 JP.Path \u2192 String \u2192 DecodeError\nerror path message = DecodeError { path, message, causes: [] }\n\n-- | Constructs a basic error from just a message.\nbasic \u2237 String \u2192 DecodeError\nbasic = error JP.Tip\n\n-- | Constructs an error with the message \"No value found\" and the specified path.\nnoValueFound \u2237 JP.Path \u2192 DecodeError\nnoValueFound path = error path \"No value found\"\n", "module Data.Codec where\n\nimport Prelude hiding (compose, identity)\n\nimport Control.Alt (class Alt, (<|>))\nimport Control.Category as Category\nimport Data.Bifunctor (lmap)\nimport Data.Functor.Invariant (class Invariant, imapF)\nimport Data.Profunctor (class Profunctor, lcmap)\nimport Data.Tuple (Tuple(..), fst)\n\ndata Codec m a b c d = Codec (a \u2192 m d) (c \u2192 Tuple b d)\n\ninstance Functor m \u21D2 Functor (Codec m a b c) where\n map f (Codec g h) = Codec (map f <<< g) (map f <<< h)\n\ninstance Functor m \u21D2 Invariant (Codec m a b c) where\n imap = imapF\n\ninstance Alt m \u21D2 Alt (Codec m a b c) where\n alt (Codec f _) (Codec h i) = Codec (\\a \u2192 f a <|> h a) i\n\ninstance (Apply m, Semigroup b) \u21D2 Apply (Codec m a b c) where\n apply (Codec f g) (Codec h i) = Codec (\\a \u2192 f a <*> h a) (\\c \u2192 g c <*> i c)\n\ninstance (Applicative m, Monoid b) \u21D2 Applicative (Codec m a b c) where\n pure x = Codec (const (pure x)) (const (pure x))\n\ninstance Functor m \u21D2 Profunctor (Codec m a b) where\n dimap f g (Codec h i) = Codec (map g <<< h) (map g <<< i <<< f)\n\ncodec \u2237 \u2200 m a b c. (a \u2192 m c) \u2192 (c \u2192 b) \u2192 Codec m a b c c\ncodec f g = Codec f (\\b \u2192 Tuple (g b) b)\n\ntype Codec' m a b = Codec m a a b b\n\ncodec' \u2237 \u2200 m a b. (a \u2192 m b) \u2192 (b \u2192 a) \u2192 Codec' m a b\ncodec' f g = Codec f (\\b \u2192 Tuple (g b) b)\n\ndecode \u2237 \u2200 m a b c d. Codec m a b c d \u2192 a \u2192 m d\ndecode (Codec f _) = f\n\nencode \u2237 \u2200 m a b c d. Codec m a b c d \u2192 c \u2192 b\nencode (Codec _ f) = fst <<< f\n\nhoist \u2237 \u2200 m m' a b c d. (m ~> m') \u2192 Codec m a b c d \u2192 Codec m' a b c d\nhoist f (Codec g h) = Codec (f <<< g) h\n\nidentity \u2237 \u2200 m a. Applicative m \u21D2 Codec m a a a a\nidentity = codec pure Category.identity\n\nfix \u2237 \u2200 m a b. (Codec' m a b \u2192 Codec' m a b) \u2192 Codec' m a b\nfix f =\n codec\n (\\x \u2192 decode (f (fix f)) x)\n (\\x \u2192 encode (f (fix f)) x)\n\ncompose \u2237 \u2200 a d f b e c m. Bind m \u21D2 Codec m d c e f \u2192 Codec m a b c d \u2192 Codec m a b e f\ncompose (Codec f g) (Codec h i) = Codec (f <=< h) (lmap (fst <<< i) <<< g)\n\ninfixr 8 compose as <~<\n\ncomposeFlipped \u2237 \u2200 a d f b e c m. Bind m \u21D2 Codec m a b c d \u2192 Codec m d c e f \u2192 Codec m a b e f\ncomposeFlipped = flip compose\n\ninfixr 8 composeFlipped as >~>\n\n-- | `Codec` is defined as a `Profunctor` so that `lcmap` can be used to target\n-- | specific fields when defining a codec for a product type. This operator\n-- | is a convenience for that:\n-- |\n-- | ``` purescript\n-- | tupleCodec =\n-- | Tuple\n-- | <$> fst ~ fstCodec\n-- | <*> snd ~ sndCodec\n-- | ```\ninfixl 5 lcmap as ~\n", "module Data.Codec.JSON\n ( Codec\n , encode\n , decode\n , json\n , null\n , boolean\n , number\n , int\n , string\n , codePoint\n , char\n , jarray\n , jobject\n , void\n , array\n , IndexedCodec\n , indexedArray\n , index\n , PropCodec\n , object\n , prop\n , record\n , recordProp\n , recordPropOptional\n , nullable\n , named\n , coercible\n , prismaticCodec\n , module Exports\n ) where\n\nimport Prelude hiding ((<<<), (<=<), (>=>), (>>>))\n\nimport Codec.JSON.DecodeError (DecodeError(..))\nimport Codec.JSON.DecodeError (DecodeError(..)) as Exports\nimport Codec.JSON.DecodeError as Error\nimport Control.Monad.Except (Except, except, runExcept)\nimport Data.Codec (Codec(..), Codec', codec, codec', decode, encode) as Codec\nimport Data.Codec (fix, hoist, identity, (<~<), (>~>), (~)) as Exports\nimport Data.Either (Either(..))\nimport Data.Int as I\nimport Data.List ((:))\nimport Data.List as L\nimport Data.Maybe (Maybe(..))\nimport Data.String as S\nimport Data.String.CodeUnits as SCU\nimport Data.Symbol (class IsSymbol, reflectSymbol)\nimport Data.TraversableWithIndex (traverseWithIndex)\nimport Data.Tuple (Tuple(..))\nimport JSON (JArray, JObject, JSON)\nimport JSON as J\nimport JSON.Array as JA\nimport JSON.Object as JO\nimport JSON.Path as JP\nimport Prim.Coerce (class Coercible)\nimport Prim.Row as Row\nimport Record.Unsafe as Record\nimport Safe.Coerce (coerce)\nimport Type.Proxy (Proxy(..))\nimport Unsafe.Coerce (unsafeCoerce)\n\n-- | Codec type for `Json` values.\ntype Codec a = Codec.Codec' (Except DecodeError) JSON a\n\n-- | Encodes a value as JSON using the specified code.\nencode \u2237 \u2200 a b c d. Codec.Codec (Except DecodeError) a b c d \u2192 c \u2192 b\nencode = Codec.encode\n\n-- | Tries to decode JSON to a value using the specified code.\ndecode \u2237 \u2200 a b c d. Codec.Codec (Except DecodeError) a b c d \u2192 a \u2192 Either DecodeError d\ndecode codec j = runExcept (Codec.decode codec j)\n\n-- | The \"identity codec\" for `Json` values.\njson \u2237 Codec JSON\njson = Codec.codec' pure identity\n\njsonPrimCodec \u2237 \u2200 a. String \u2192 (JSON \u2192 Maybe a) \u2192 (a \u2192 JSON) \u2192 Codec a\njsonPrimCodec ty f =\n Codec.codec' \\j \u2192\n except case f j of\n Just a \u2192 Right a\n Nothing \u2192 Left\n ( DecodeError\n { path: JP.Tip\n , message: \"Expected value of type \" <> ty\n , causes: []\n }\n )\n\n-- | A codec for `null` values in `Json`.\nnull \u2237 Codec Unit\nnull = jsonPrimCodec \"Null\" J.toNull (const J.null)\n\n-- | A codec for `Boolean` values in `Json`.\nboolean \u2237 Codec Boolean\nboolean = jsonPrimCodec \"Boolean\" J.toBoolean J.fromBoolean\n\n-- | A codec for `Number` values in `Json`.\nnumber \u2237 Codec Number\nnumber = jsonPrimCodec \"Number\" J.toNumber J.fromNumber\n\n-- | A codec for `Int` values in `Json`.\nint \u2237 Codec Int\nint = jsonPrimCodec \"Int\" (\\j \u2192 I.fromNumber =<< J.toNumber j) (\\n \u2192 J.fromNumber (I.toNumber n))\n\n-- | A codec for `String` values in `Json`.\nstring \u2237 Codec String\nstring = jsonPrimCodec \"String\" J.toString J.fromString\n\n-- | A codec for `Codepoint` values in `Json`.\ncodePoint \u2237 Codec S.CodePoint\ncodePoint = jsonPrimCodec \"CodePoint\" (\\j \u2192 S.codePointAt 0 =<< J.toString j) (\\cp \u2192 J.fromString (S.singleton cp))\n\n-- | A codec for `Char` values in `Json`.\nchar \u2237 Codec Char\nchar = jsonPrimCodec \"Char\" (\\j \u2192 SCU.toChar =<< J.toString j) (\\c \u2192 J.fromString (SCU.singleton c))\n\n-- | A codec for `Void` values.\nvoid \u2237 Codec Void\nvoid = jsonPrimCodec \"Void\" (const Nothing) absurd\n\n-- | A codec for `JArray` values in `Json`. This does not decode the values of the array, for that\n-- | use `array` for a general array decoder, or `indexedArray` with `index` to decode fixed length\n-- | array encodings.\njarray \u2237 Codec JArray\njarray = jsonPrimCodec \"Array\" J.toJArray J.fromJArray\n\n-- | A codec for `JObject` values in `Json`.\njobject \u2237 Codec JObject\njobject = jsonPrimCodec \"Object\" J.toJObject J.fromJObject\n\n-- | A codec for arbitrary length `Array`s where every item in the array\n-- | shares the same type.\n-- |\n-- | ``` purescript\n-- | import Data.Codec.JSON as CJ\n-- |\n-- | codecIntArray \u2237 CJ.Codec (Array Int)\n-- | codecIntArray = CJ.array CJ.int\n-- | ```\narray \u2237 \u2200 a. Codec a \u2192 Codec (Array a)\narray codec =\n Codec.codec'\n ( \\j \u2192 do\n arr \u2190 Codec.decode jarray j\n traverseWithIndex\n ( \\ix a \u2192\n except case decode codec a of\n Left err \u2192 Left (Error.withPath (JP.AtIndex ix) err)\n value \u2192 value\n )\n (JA.toArray arr)\n )\n (\\a \u2192 J.fromArray (map (encode codec) a))\n\n-- | Codec type for specifically indexed `JArray` elements.\ntype IndexedCodec a =\n Codec.Codec\n (Except DecodeError)\n JArray\n (L.List JSON)\n a\n a\n\n-- | A codec for types that are encoded as an array with a specific layout.\n-- |\n-- | For example, if we'd like to encode a `Person` as a 2-element array, like\n-- | `[\"Rashida\", 37]`, we could write the following codec:\n-- |\n-- | ```purescript\n-- | import Data.Codec.JSON ((~))\n-- | import Data.Codec.JSON as CJ\n-- |\n-- | type Person = { name \u2237 String, age \u2237 Int }\n-- |\n-- | codecPerson \u2237 CJ.Codec Person\n-- | codecPerson = CJ.indexedArray $\n-- | { name: _, age: _ }\n-- | <$> _.name ~ CJ.index 0 CJ.string\n-- | <*> _.age ~ CJ.index 1 CJ.int\n-- | ```\nindexedArray \u2237 \u2200 a. IndexedCodec a \u2192 Codec a\nindexedArray codec =\n Codec.codec'\n (\\j \u2192 Codec.decode codec =<< Codec.decode jarray j)\n (\\a \u2192 encode jarray (JA.fromFoldable (encode codec a)))\n\n-- | A codec for an item in an `indexedArray`.\nindex \u2237 \u2200 a. Int \u2192 Codec a \u2192 IndexedCodec a\nindex ix codec =\n Codec.codec\n ( \\xs \u2192\n except case JA.index ix xs of\n Just j \u2192\n case decode codec j of\n Left err \u2192 Left (Error.withPath (JP.AtIndex ix) err)\n value \u2192 value\n Nothing \u2192\n Left (Error.noValueFound (JP.AtIndex ix JP.Tip))\n )\n (\\a \u2192 pure (encode codec a))\n\n-- | Codec type for `JObject` prop/value pairs.\ntype PropCodec a =\n Codec.Codec\n (Except DecodeError)\n JObject\n (L.List (Tuple String JSON))\n a\n a\n\n-- | A codec for objects that are encoded with specific properties. This codec\n-- | will ignore any unknown properties in the incoming record. Use\n-- | `Data.Codec.JSON.Strict.objectStrict` for a version that fails upon\n-- | encountering unknown properties.\n-- |\n-- | See also `Data.Codec.JSON.Record.object` for a more commonly useful version\n-- | of this function.\nobject \u2237 \u2200 a. PropCodec a \u2192 Codec a\nobject codec =\n Codec.codec'\n (\\j \u2192 Codec.decode codec =<< Codec.decode jobject j)\n (\\a \u2192 encode jobject (JO.fromFoldable (encode codec a)))\n\n-- | A codec for a property of an object.\nprop \u2237 \u2200 a. String \u2192 Codec a \u2192 PropCodec a\nprop key codec =\n Codec.codec\n ( \\obj \u2192\n except case JO.lookup key obj of\n Just j \u2192\n case decode codec j of\n Left err \u2192 Left (Error.withPath (JP.AtKey key) err)\n value \u2192 value\n Nothing \u2192\n Left (Error.noValueFound (JP.AtKey key JP.Tip))\n )\n (\\a \u2192 pure (Tuple key (encode codec a)))\n\n-- | The starting value for a object-record codec. Used with `recordProp` it\n-- | provides a convenient method for defining codecs for record types that\n-- | encode into JSON objects of the same shape.\n-- |\n-- | For example, to encode a record as the JSON object\n-- | `{ \"name\": \"Karl\", \"age\": 25 }` we would define a codec like this:\n-- | ```\n-- | import Data.Codec.JSON as CJ\n-- |\n-- | type Person = { name \u2237 String, age \u2237 Int }\n-- |\n-- | codecPerson \u2237 CJ.Codec Person\n-- | codecPerson =\n-- | CJ.object $ CJ.record\n-- | # CJ.recordProp @\"name\" CJ.string\n-- | # CJ.recordProp @\"age\" CJ.int\n-- | ```\n-- |\n-- | See also `Data.Codec.JSON.Record.object` for a more commonly useful\n-- | version of this function.\nrecord \u2237 PropCodec {}\nrecord = Codec.Codec (const (pure {})) pure\n\n-- | Used with `record` to define codecs for record types that encode into JSON\n-- | objects of the same shape. See the comment on `record` for an example.\nrecordProp\n \u2237 \u2200 @p a r r'\n . IsSymbol p\n \u21D2 Row.Cons p a r r'\n \u21D2 Codec a\n \u2192 PropCodec (Record r)\n \u2192 PropCodec (Record r')\nrecordProp codecA codecR =\n let key = reflectSymbol (Proxy @p) in Codec.codec (dec' key) (enc' key)\n where\n dec' \u2237 String \u2192 JObject \u2192 Except DecodeError (Record r')\n dec' key obj = do\n r \u2190 Codec.decode codecR obj\n a \u2190 except case JO.lookup key obj of\n Just val \u2192\n case decode codecA val of\n Left err \u2192 Left (Error.withPath (JP.AtKey key) err)\n value \u2192 value\n Nothing \u2192\n Left (Error.noValueFound (JP.AtKey key JP.Tip))\n pure $ Record.unsafeSet key a r\n\n enc' \u2237 String \u2192 Record r' \u2192 L.List (Tuple String JSON)\n enc' key val =\n Tuple key (Codec.encode codecA (Record.unsafeGet key val))\n : Codec.encode codecR ((unsafeCoerce \u2237 Record r' \u2192 Record r) val)\n\n-- | Used with `record` to define an optional field.\n-- |\n-- | This will only decode the property as `Nothing` if the field does not exist\n-- | in the object - having a values such as `null` assigned will need handling\n-- | separately.\n-- |\n-- | The property will be omitted when encoding and the value is `Nothing`.\nrecordPropOptional\n \u2237 \u2200 @p a r r'\n . IsSymbol p\n \u21D2 Row.Cons p (Maybe a) r r'\n \u21D2 Codec a\n \u2192 PropCodec (Record r)\n \u2192 PropCodec (Record r')\nrecordPropOptional codecA codecR = Codec.codec dec' enc'\n where\n key \u2237 String\n key = reflectSymbol (Proxy @p)\n\n dec' \u2237 JObject \u2192 Except DecodeError (Record r')\n dec' obj = do\n r \u2190 Codec.decode codecR obj\n a \u2190 except case JO.lookup key obj of\n Just val \u2192\n case decode codecA val of\n Left err \u2192 Left (Error.withPath (JP.AtKey key) err)\n value \u2192 Just <$> value\n _ \u2192\n Right Nothing\n pure $ Record.unsafeSet key a r\n\n enc' \u2237 Record r' \u2192 L.List (Tuple String JSON)\n enc' val = do\n let w = Codec.encode codecR ((unsafeCoerce \u2237 Record r' \u2192 Record r) val)\n case Record.unsafeGet key val of\n Just a \u2192 Tuple key (Codec.encode codecA a) : w\n Nothing \u2192 w\n\n-- | A codec for JSON values that can be `null` or some other value.\n-- |\n-- | This should not be used if an accurate representation of nested `Maybe` values is required, as\n-- | values like `Just Nothing` cannot be encoded. For nested `Maybe`s consider using\n-- | `Data.Codec.JSON.Common.maybe` instead.\nnullable \u2237 \u2200 a. Codec a \u2192 Codec (Maybe a)\nnullable codec =\n Codec.codec'\n ( \\j \u2192 except case decode codec j of\n Left err1 \u2192\n case decode null j of\n Left err2 \u2192 Left (err1 <> err2)\n Right _ \u2192 Right Nothing\n Right value \u2192\n Right (Just value)\n )\n case _ of\n Just a \u2192 encode codec a\n Nothing \u2192 J.null\n\n-- | A codec for introducing names into error messages - useful when definiting a codec for a type\n-- | synonym for a record, for instance.\nnamed \u2237 \u2200 a. String \u2192 Codec a \u2192 Codec a\nnamed name codec =\n Codec.codec'\n ( \\j \u2192\n except case decode codec j of\n Left err \u2192 Left (Error.withContext (\"Could not decode \" <> name) err)\n value \u2192 value\n )\n (encode codec)\n\n-- | A codec for types that can be safely coerced.\n-- |\n-- | Accepts the name of the target type as an argument to improve error messaging when the inner\n-- | codec fails.\ncoercible \u2237 \u2200 a b. Coercible a b \u21D2 String \u2192 Codec a \u2192 Codec b\ncoercible name codec =\n Codec.codec'\n ( \\j \u2192\n except case decode codec j of\n Left err \u2192 Left (Error.withContext (\"Could not decode \" <> name) err)\n value \u2192 coerce value\n )\n (coerce (encode codec))\n\n-- | Adapts an existing codec with a pair of functions to allow a value to be\n-- | further refined. If the inner decoder fails an `UnexpectedValue` error will\n-- | be raised for JSON input.\n-- |\n-- | This function is named as such as the pair of functions it accepts\n-- | correspond with the `preview` and `review` functions of a `Prism`-style lens.\n-- |\n-- | An example of this would be a codec for `Data.String.NonEmpty.NonEmptyString`:\n-- |\n-- | ```purescript\n-- | nonEmptyString \u2237 CJ.Codec NES.NonEmptyString\n-- | nonEmptyString = CJ.prismaticCodec \"NonEmptyString\" NES.fromString NES.toString CJ.string\n-- | ```\n-- |\n-- | Another example might be to handle a mapping from a small sum type to\n-- | strings:\n-- |\n-- | ```purescript\n-- | data Direction = North | South | West | East\n-- |\n-- | directionCodec :: Codec Direction\n-- | directionCodec = CJ.prismaticCodec \"Direction\" dec enc string\n-- | where\n-- | dec = case _ of\n-- | \"N\" -> Just North\n-- | \"S\" -> Just South\n-- | \"W\" -> Just West\n-- | \"E\" -> Just East\n-- | _ -> Nothing\n-- |\n-- | enc = case _ of\n-- | North -> \"N\"\n-- | South -> \"S\"\n-- | West -> \"W\"\n-- | East -> \"E\"\n-- | ```\n-- |\n-- | Although for this latter case there are some other options too, in the form\n-- | of `Data.Codec.JSON.Generic.nullarySum` and `Data.Codec.JSON.Sum.enumSum`.\nprismaticCodec \u2237 \u2200 a b. String \u2192 (a \u2192 Maybe b) \u2192 (b \u2192 a) \u2192 Codec a \u2192 Codec b\nprismaticCodec name f g codec =\n Codec.codec'\n ( \\j \u2192\n except $ case decode codec j of\n Left err \u2192\n Left (Error.withContext (\"Could not decode \" <> name) err)\n Right a \u2192\n case f a of\n Just b \u2192\n Right b\n Nothing \u2192\n Left (Error.basic (\"Could not decode \" <> name <> \", unexpected value found\"))\n )\n (\\b \u2192 encode codec (g b))\n", "-- | This module defines a type of sets as height-balanced (AVL) binary trees.\n-- | Efficient set operations are implemented in terms of\n-- | \n\nmodule Data.Set\n ( Set\n , fromFoldable\n , toUnfoldable\n , empty\n , isEmpty\n , singleton\n , map\n , checkValid\n , insert\n , member\n , delete\n , toggle\n , size\n , findMin\n , findMax\n , union\n , unions\n , difference\n , subset\n , properSubset\n , intersection\n , filter\n , mapMaybe\n , catMaybes\n , toMap\n , fromMap\n ) where\n\nimport Prelude hiding (map)\n\nimport Data.Eq (class Eq1)\nimport Data.Foldable (class Foldable, foldMap, foldl, foldr)\nimport Data.List (List)\nimport Data.List as List\nimport Data.Map.Internal as M\nimport Data.Maybe (Maybe(..), maybe)\nimport Data.Ord (class Ord1)\nimport Data.Unfoldable (class Unfoldable)\nimport Prelude as Prelude\nimport Safe.Coerce (coerce)\n\n-- | `Set a` represents a set of values of type `a`\nnewtype Set a = Set (M.Map a Unit)\n\n-- | Create a set from a foldable structure.\nfromFoldable :: forall f a. Foldable f => Ord a => f a -> Set a\nfromFoldable = foldl (\\m a -> insert a m) empty\n\n-- | Convert a set to an unfoldable structure.\ntoUnfoldable :: forall f a. Unfoldable f => Set a -> f a\ntoUnfoldable = List.toUnfoldable <<< toList\n\ntoList :: forall a. Set a -> List a\ntoList (Set m) = M.keys m\n\ninstance eqSet :: Eq a => Eq (Set a) where\n eq (Set m1) (Set m2) = m1 == m2\n\ninstance eq1Set :: Eq1 Set where\n eq1 = eq\n\ninstance showSet :: Show a => Show (Set a) where\n show s = \"(fromFoldable \" <> show (toUnfoldable s :: Array a) <> \")\"\n\ninstance ordSet :: Ord a => Ord (Set a) where\n compare s1 s2 = compare (toList s1) (toList s2)\n\ninstance ord1Set :: Ord1 Set where\n compare1 = compare\n\ninstance monoidSet :: Ord a => Monoid (Set a) where\n mempty = empty\n\ninstance semigroupSet :: Ord a => Semigroup (Set a) where\n append = union\n\ninstance foldableSet :: Foldable Set where\n foldMap f = foldMap f <<< toList\n foldl f x = foldl f x <<< toList\n foldr f x = foldr f x <<< toList\n\n-- | An empty set\nempty :: forall a. Set a\nempty = Set M.empty\n\n-- | Test if a set is empty\nisEmpty :: forall a. Set a -> Boolean\nisEmpty = coerce (M.isEmpty :: M.Map a Unit -> _)\n\n-- | Create a set with one element\nsingleton :: forall a. a -> Set a\nsingleton a = Set (M.singleton a unit)\n\n-- | Maps over the values in a set.\n-- |\n-- | This operation is not structure-preserving for sets, so is not a valid\n-- | `Functor`. An example case: mapping `const x` over a set with `n > 0`\n-- | elements will result in a set with one element.\nmap :: forall a b. Ord b => (a -> b) -> Set a -> Set b\nmap f = foldl (\\m a -> insert (f a) m) empty\n\n-- | Check whether the underlying tree satisfies the height, size, and ordering invariants.\n-- |\n-- | This function is provided for internal use.\ncheckValid :: forall a. Ord a => Set a -> Boolean\ncheckValid = coerce (M.checkValid :: M.Map a Unit -> _)\n\n-- | Test if a value is a member of a set\nmember :: forall a. Ord a => a -> Set a -> Boolean\nmember = coerce (M.member :: _ -> M.Map a Unit -> _)\n\n-- | Insert a value into a set\ninsert :: forall a. Ord a => a -> Set a -> Set a\ninsert a (Set m) = Set (M.insert a unit m)\n\n-- | Delete a value from a set\ndelete :: forall a. Ord a => a -> Set a -> Set a\ndelete = coerce (M.delete :: _ -> M.Map a Unit -> _)\n\n-- | Insert a value into a set if it is not already present, if it is present, delete it.\ntoggle :: forall a. Ord a => a -> Set a -> Set a\ntoggle a (Set m) = Set (M.alter (maybe (Just unit) (\\_ -> Nothing)) a m)\n\n-- | Find the size of a set\nsize :: forall a. Set a -> Int\nsize = coerce (M.size :: M.Map a Unit -> _)\n\nfindMin :: forall a. Set a -> Maybe a\nfindMin (Set m) = Prelude.map _.key (M.findMin m)\n\nfindMax :: forall a. Set a -> Maybe a\nfindMax (Set m) = Prelude.map _.key (M.findMax m)\n\n-- | Form the union of two sets\n-- |\n-- | Running time: `O(n + m)`\nunion :: forall a. Ord a => Set a -> Set a -> Set a\nunion = coerce (M.union :: M.Map a Unit -> _ -> _)\n\n-- | Form the union of a collection of sets\nunions :: forall f a. Foldable f => Ord a => f (Set a) -> Set a\nunions = foldl union empty\n\n-- | Form the set difference\ndifference :: forall a. Ord a => Set a -> Set a -> Set a\ndifference = coerce (M.difference :: M.Map a Unit -> M.Map a Unit -> _)\n\n-- | True if and only if every element in the first set\n-- | is an element of the second set\nsubset :: forall a. Ord a => Set a -> Set a -> Boolean\nsubset s1 s2 = isEmpty $ s1 `difference` s2\n\n-- | True if and only if the first set is a subset of the second set\n-- | and the sets are not equal\nproperSubset :: forall a. Ord a => Set a -> Set a -> Boolean\nproperSubset s1 s2 = size s1 /= size s2 && subset s1 s2\n\n-- | The set of elements which are in both the first and second set\nintersection :: forall a. Ord a => Set a -> Set a -> Set a\nintersection = coerce (M.intersection :: M.Map a Unit -> M.Map a Unit -> _)\n\n-- | Filter out those values of a set for which a predicate on the value fails\n-- | to hold.\nfilter :: forall a. Ord a => (a -> Boolean) -> Set a -> Set a\nfilter = coerce (M.filterKeys :: _ -> M.Map a Unit -> _)\n\n-- | Applies a function to each value in a set, discarding entries where the\n-- | function returns `Nothing`.\nmapMaybe :: forall a b. Ord b => (a -> Maybe b) -> Set a -> Set b\nmapMaybe f = foldr (\\a acc -> maybe acc (\\b -> insert b acc) (f a)) empty\n\n-- | Filter a set of optional values, discarding values that contain `Nothing`\ncatMaybes :: forall a. Ord a => Set (Maybe a) -> Set a\ncatMaybes = mapMaybe identity\n\n-- | A set is a map with no value attached to each key.\ntoMap :: forall a. Set a -> M.Map a Unit\ntoMap (Set s) = s\n\n-- | A map with no value attached to each key is a set.\n-- | See also `Data.Map.keys`.\nfromMap :: forall a. M.Map a Unit -> Set a\nfromMap = Set\n", "module Data.Codec.JSON.Common\n ( nonEmptyString\n , nonEmptyArray\n , maybe\n , tuple\n , either\n , list\n , nonEmptyList\n , map\n , strMap\n , set\n , nonEmptySet\n , foreignObject\n , module Exports\n ) where\n\nimport Prelude hiding (identity, map, void)\n\nimport Data.Array as Array\nimport Data.Array.NonEmpty as NEA\nimport Data.Codec as Codec\nimport Data.Codec.JSON (Codec, DecodeError(..), IndexedCodec, PropCodec, array, boolean, char, codePoint, coercible, decode, encode, fix, hoist, identity, index, indexedArray, int, jarray, jobject, json, named, null, nullable, number, object, prismaticCodec, prop, record, recordProp, recordPropOptional, string, void, (<~<), (>~>), (~)) as Exports\nimport Data.Codec.JSON ((~))\nimport Data.Codec.JSON as CJ\nimport Data.Codec.JSON.Sum (taggedSum)\nimport Data.Codec.JSON.Sum (taggedSum) as Exports\nimport Data.Either (Either(..))\nimport Data.Functor as F\nimport Data.List as List\nimport Data.List.NonEmpty as NEL\nimport Data.Map as Map\nimport Data.Maybe (Maybe(..))\nimport Data.Profunctor (dimap)\nimport Data.Set as Set\nimport Data.Set.NonEmpty as NESet\nimport Data.String.NonEmpty as NEString\nimport Data.Traversable (traverse)\nimport Data.Tuple (Tuple(..), fst, snd)\nimport Foreign.Object as Object\nimport JSON.Object as JO\n\n-- | A codec for `NonEmptyString` values.\n-- |\n-- | Encodes as the standard type in JSON, but will fail to decode if the string is empty.\nnonEmptyString \u2237 CJ.Codec NEString.NonEmptyString\nnonEmptyString = CJ.prismaticCodec \"NonEmptyString\" NEString.fromString NEString.toString CJ.string\n\n-- | A codec for `NonEmptyArray` values.\n-- |\n-- | Encodes as the standard type in JSON, but will fail to decode if the array is empty.\nnonEmptyArray \u2237 \u2200 a. CJ.Codec a \u2192 CJ.Codec (NEA.NonEmptyArray a)\nnonEmptyArray codec = CJ.prismaticCodec \"NonEmptyArray\" NEA.fromArray NEA.toArray (CJ.array codec)\n\n-- | A codec for `Maybe` values.\nmaybe \u2237 \u2200 a. CJ.Codec a \u2192 CJ.Codec (Maybe a)\nmaybe codec = taggedSum \"Maybe\" printTag parseTag dec enc\n where\n printTag = case _ of\n false \u2192 \"Nothing\"\n true \u2192 \"Just\"\n parseTag = case _ of\n \"Nothing\" \u2192 Just false\n \"Just\" \u2192 Just true\n _ \u2192 Nothing\n dec = case _ of\n false \u2192 Left Nothing\n true \u2192 Right (F.map Just <<< CJ.decode codec)\n enc = case _ of\n Nothing \u2192 Tuple false Nothing\n Just a \u2192 Tuple true (Just (CJ.encode codec a))\n\n-- | A codec for `Tuple` values.\n-- |\n-- | Encodes as a two-element array in JSON.\ntuple \u2237 \u2200 a b. CJ.Codec a \u2192 CJ.Codec b \u2192 CJ.Codec (Tuple a b)\ntuple codecA codecB = CJ.named \"Tuple\" $ CJ.indexedArray $\n Tuple\n <$> fst ~ CJ.index 0 codecA\n <*> snd ~ CJ.index 1 codecB\n\n-- | A codec for `Either` values.\neither \u2237 \u2200 a b. CJ.Codec a \u2192 CJ.Codec b \u2192 CJ.Codec (Either a b)\neither codecA codecB = taggedSum \"Either\" printTag parseTag dec enc\n where\n printTag = case _ of\n true \u2192 \"Left\"\n false \u2192 \"Right\"\n parseTag = case _ of\n \"Left\" \u2192 Just true\n \"Right\" \u2192 Just false\n _ \u2192 Nothing\n dec = case _ of\n true \u2192 Right (F.map Left <<< CJ.decode codecA)\n false \u2192 Right (F.map Right <<< CJ.decode codecB)\n enc = case _ of\n Left a \u2192 Tuple true (Just (CJ.encode codecA a))\n Right b \u2192 Tuple false (Just (CJ.encode codecB b))\n\n-- | A codec for `List` values.\n-- |\n-- | Encodes as an array in JSON.\nlist \u2237 \u2200 a. CJ.Codec a \u2192 CJ.Codec (List.List a)\nlist codec = dimap Array.fromFoldable List.fromFoldable (CJ.named \"List\" (CJ.array codec))\n\n-- | A codec for `NonEmptyList` values.\n-- |\n-- | Encodes as an array in JSON.\nnonEmptyList \u2237 \u2200 a. CJ.Codec a \u2192 CJ.Codec (NEL.NonEmptyList a)\nnonEmptyList codec = CJ.prismaticCodec \"NonEmptyList\" NEL.fromFoldable Array.fromFoldable (CJ.array codec)\n\n-- | A codec for `Map` values.\n-- |\n-- | Encodes as an array of two-element key/value arrays in JSON.\nmap \u2237 \u2200 a b. Ord a \u21D2 CJ.Codec a \u2192 CJ.Codec b \u2192 CJ.Codec (Map.Map a b)\nmap codecA codecB = dimap Map.toUnfoldable (Map.fromFoldable) (CJ.named \"Map\" (CJ.array (tuple codecA codecB)))\n\n-- | A codec for `Map` values which have string keys.\n-- |\n-- | Encodes as an object in JSON.\nstrMap \u2237 \u2200 a. CJ.Codec a \u2192 CJ.Codec (Map.Map String a)\nstrMap codec =\n Codec.codec'\n (F.map Map.fromFoldable <<< traverse (traverse (Codec.decode codec)) <<< JO.entries <=< Codec.decode CJ.jobject)\n (CJ.encode CJ.jobject <<< JO.fromFoldableWithIndex <<< F.map (CJ.encode codec))\n\n-- | A codec for `Set` values.\n-- |\n-- | Encodes as an array in JSON.\nset \u2237 \u2200 a. Ord a \u21D2 CJ.Codec a \u2192 CJ.Codec (Set.Set a)\nset codec = dimap Array.fromFoldable Set.fromFoldable (CJ.named \"Set\" (CJ.array codec))\n\n-- | A codec for `NonEmptySet` values.\n-- |\n-- | Encodes as an array in JSON.\nnonEmptySet \u2237 \u2200 a. Ord a \u21D2 CJ.Codec a \u2192 CJ.Codec (NESet.NonEmptySet a)\nnonEmptySet codec = CJ.prismaticCodec \"NonEmptySet\" NESet.fromFoldable NESet.toUnfoldable (CJ.array codec)\n\n-- | A codec for `Object` values.\n-- |\n-- | Encodes as an array of two-element key/value arrays in JSON.\nforeignObject \u2237 \u2200 a. CJ.Codec a \u2192 CJ.Codec (Object.Object a)\nforeignObject = dimap Object.toUnfoldable Object.fromFoldable <<< CJ.array <<< tuple CJ.string\n", "module Data.Search.Trie.Internal\n ( Trie(..)\n , Ctx(..)\n , Zipper(..)\n , alter\n , delete\n , deleteByPrefix\n , descend\n , entries\n , entriesUnordered\n , eq'\n , follow\n , fromFoldable\n , fromList\n , fromZipper\n , insert\n , isEmpty\n , lookup\n , mkZipper\n , prune\n , query\n , queryValues\n , size\n , subtrie\n , subtrieWithPrefixes\n , toUnfoldable\n , update\n , values\n )\nwhere\n\nimport Prelude\n\nimport Data.Array as A\nimport Data.Foldable (class Foldable, foldl)\nimport Data.List (List(..), (:))\nimport Data.List as L\nimport Data.Map (Map)\nimport Data.Map as M\nimport Data.Maybe (Maybe(..))\nimport Data.Maybe as MB\nimport Data.Tuple (Tuple(..), snd, uncurry)\nimport Data.Bifunctor (lmap, rmap)\nimport Data.Unfoldable (class Unfoldable)\n\ndata Trie k v =\n Branch (Maybe v) (Map k (Trie k v))\n -- `Arc` lengths are saved in the structure to speed up lookups.\n -- `List` was chosen because of better asymptotics of its `drop`\n -- operation, in comparison with `Data.Array.drop`.\n -- The list is always non-empty.\n | Arc Int (List k) (Trie k v)\n\ninstance eqTrie :: (Eq k, Eq v) => Eq (Trie k v) where\n eq a b = entries a == entries b\n\ninstance showTrie :: (Show k, Show v) => Show (Trie k v) where\n show trie = \"fromFoldable \" <> show (toUnfoldable trie :: Array (Tuple (Array k) v))\n\ninstance semigroupTrie :: Ord k => Semigroup (Trie k v) where\n append a b =\n foldl (flip $ uncurry insert) b $ entries a\n\ninstance monoidTrie :: Ord k => Monoid (Trie k v) where\n mempty = empty\n\ninstance functorTrie :: Ord k => Functor (Trie k) where\n map f trie = fromList $ entriesUnordered trie <#> rmap f\n\n-- | Check that two tries are not only equal, but also have the same internal structure.\neq'\n :: forall k v\n . Eq k\n => Eq v\n => Trie k v\n -> Trie k v\n -> Boolean\neq' (Branch mbValue1 children1) (Branch mbValue2 children2) =\n if mbValue1 == mbValue2\n then\n let childrenList1 = M.toUnfoldable children1\n childrenList2 = M.toUnfoldable children2\n in\n if A.length childrenList1 == A.length childrenList2\n then A.all identity $\n A.zipWith (\\(Tuple k1 v1) (Tuple k2 v2) ->\n if k1 == k2\n then\n eq' v1 v2\n else\n false\n )\n childrenList1\n childrenList2\n else false\n else false\neq' (Arc len1 path1 child1) (Arc len2 path2 child2) =\n len1 == len2 && path1 == path2 && eq' child1 child2\neq' _ _ = false\n\n-- | A smart constructor to ensure Arc non-emptiness.\nmkArc\n :: forall k v\n . List k\n -> Trie k v\n -> Trie k v\nmkArc Nil trie = trie\nmkArc arc trie = Arc (L.length arc) arc trie\n\nempty\n :: forall k v\n . Ord k\n => Trie k v\nempty = Branch Nothing M.empty\n\nisEmpty\n :: forall k v\n . Trie k v\n -> Boolean\nisEmpty = isEmpty' <<< L.singleton\n where\n isEmpty' Nil = true\n isEmpty' (Branch (Just _) _ : _) = false\n isEmpty' (Branch _ children : rest)\n = isEmpty' $\n (snd <$> M.toUnfoldableUnordered children) <> rest\n isEmpty' (Arc _ _ child : rest) =\n isEmpty' (child : rest)\n\n-- | Number of elements in a trie.\nsize\n :: forall k v\n . Trie k v\n -> Int\nsize = go 0 <<< L.singleton\n where\n go acc Nil = acc\n go acc (Branch mbValue children : rest) =\n go (MB.maybe acc (const (acc + 1)) mbValue)\n ((snd <$> M.toUnfoldableUnordered children) <> rest)\n go acc (Arc _ _ child : rest) =\n go acc (child : rest)\n\ndata Ctx k v = BranchCtx (Maybe v) k (Map k (Trie k v))\n | ArcCtx Int (List k)\n\ndata Zipper k v = Zipper (Trie k v) (List (Ctx k v))\n\nmkZipper\n :: forall k v\n . Trie k v\n -> Zipper k v\nmkZipper trie = Zipper trie Nil\n\nwithZipper\n :: forall k v\n . Ord k\n => (Zipper k v -> Zipper k v)\n -> Trie k v\n -> Trie k v\nwithZipper f trie = fromZipper (f (mkZipper trie))\n\nfromZipper\n :: forall k v\n . Ord k\n => Zipper k v\n -> Trie k v\nfromZipper (Zipper trie (Cons ctx ctxs)) =\n case ctx, trie of\n BranchCtx mbValue key other, _ ->\n fromZipper (Zipper (Branch mbValue $ M.insert key trie other) ctxs)\n\n ArcCtx len1 path1, Arc len2 path2 child ->\n fromZipper (Zipper (Arc (len1 + len2) (path1 <> path2) child) ctxs)\n\n ArcCtx len path, _ ->\n fromZipper (Zipper (Arc len path trie) ctxs)\nfromZipper (Zipper trie Nil) = trie\n\n-- | Delete everything until the first non-empty context.\nprune\n :: forall k v\n . Ord k\n => List (Ctx k v)\n -> Zipper k v\nprune ctxs =\n case ctxs of\n BranchCtx mbValue key children : rest ->\n let newChildren = M.delete key children in\n if MB.isJust mbValue || not (M.isEmpty newChildren)\n then Zipper (Branch mbValue newChildren) rest\n else prune rest\n ArcCtx len path : rest ->\n prune rest\n Nil -> mkZipper mempty\n\n-- | Follows a given path, constructing new branches as necessary.\n-- | Returns the contents of the last branch with context from which the trie\n-- | can be restored using `fromZipper`.\ndescend\n :: forall k v\n . Ord k\n => List k\n -> Zipper k v\n -> { mbValue :: Maybe v\n , children :: Map k (Trie k v)\n , ctxs :: List (Ctx k v)\n }\ndescend Nil (Zipper (Branch mbValue children) ctxs) =\n { mbValue, children, ctxs }\ndescend (head : tail) (Zipper (Branch mbOldValue children) ctxs) =\n case M.lookup head children of\n Just child ->\n descend tail $\n Zipper child (BranchCtx mbOldValue head children : ctxs)\n Nothing -> { mbValue: Nothing, children: M.empty, ctxs: ctxs' }\n where\n -- Create a new empty trie, place it at the end of a new arc.\n branchCtxs = BranchCtx mbOldValue head children : ctxs\n ctxs' = if L.null tail then branchCtxs\n else ArcCtx (L.length tail) tail : branchCtxs\ndescend path (Zipper (Arc len arc child) ctxs) =\n let prefixLength = longestCommonPrefixLength path arc in\n if prefixLength == len\n then\n let newPath = L.drop prefixLength path in\n descend newPath $\n Zipper child (ArcCtx len arc : ctxs)\n else\n if prefixLength == 0 then\n -- Replace `Arc` with a `Branch`.\n case L.uncons arc of\n Just { head, tail } ->\n -- We want to avoid `L.length` call on `tail`: at this point\n -- the length can be calculated.\n let len' = len - 1\n children = M.singleton head $\n if len' > 0\n then Arc len' tail child\n else child\n in\n descend path $\n Zipper (Branch Nothing children) ctxs\n Nothing ->\n -- Impossible: `arc` is always non-empty\n { mbValue: Nothing\n , children: M.empty\n , ctxs\n }\n else\n let\n outerArc = L.take prefixLength path\n newPath = L.drop prefixLength path\n -- `innerArc` is always non-empty, because\n -- `prefixLength == L.length arc` is false in this branch.\n -- `prefixLength <= L.length arc` is true because `prefixLength` is\n -- a length of some prefix of `arc`.\n -- Thus `prefixLength < L.length arc`.\n innerArc = L.drop prefixLength arc\n innerArcLength = len - prefixLength\n outerArcLength = L.length outerArc\n in\n descend newPath $\n Zipper (Arc innerArcLength innerArc child)\n if outerArcLength == 0\n then ctxs\n else ArcCtx outerArcLength outerArc : ctxs\n\n-- | Follows a given path, but unlike `descend`, fails instead of creating new\n-- | branches.\nfollow\n :: forall k v\n . Ord k\n => List k\n -> Zipper k v\n -> Maybe { mbValue :: Maybe v\n , children :: Map k (Trie k v)\n , ctxs :: List (Ctx k v)\n }\nfollow Nil (Zipper (Branch mbValue children) ctxs) =\n Just { mbValue, children, ctxs }\nfollow (head : tail) (Zipper (Branch mbOldValue children) ctxs) =\n case M.lookup head children of\n Just child ->\n follow tail $ Zipper child (BranchCtx mbOldValue head children : ctxs)\n Nothing ->\n Nothing\nfollow path (Zipper (Arc len arc child) ctxs) =\n let prefixLength = longestCommonPrefixLength path arc in\n if prefixLength == len\n then\n let newPath = L.drop prefixLength path in\n follow newPath $ Zipper child (ArcCtx len arc : ctxs)\n else\n Nothing\n\nlookup\n :: forall k v\n . Ord k\n => List k\n -> Trie k v\n -> Maybe v\nlookup path trie =\n follow path (mkZipper trie) >>= _.mbValue\n\n-- | Update the entry at a given path.\nupdate\n :: forall k v\n . Ord k\n => (v -> v)\n -> List k\n -> Trie k v\n -> Trie k v\nupdate f path trie =\n case follow path (mkZipper trie) of\n Just { mbValue, children, ctxs } ->\n fromZipper $ Zipper (Branch (f <$> mbValue) children) ctxs\n _ -> trie\n\n-- | Delete the entry at a given path.\ndelete\n :: forall k v\n . Ord k\n => List k\n -> Trie k v\n -> Trie k v\ndelete path trie =\n case follow path (mkZipper trie) of\n Just { mbValue, children, ctxs } ->\n fromZipper $\n if M.isEmpty children then\n prune ctxs\n else\n Zipper (Branch Nothing children) ctxs\n _ -> trie\n\n-- | Delete all entries by a given path prefix.\ndeleteByPrefix\n :: forall k v\n . Ord k\n => List k\n -> Trie k v\n -> Trie k v\ndeleteByPrefix path trie =\n fromZipper $ prune (descend path (mkZipper trie)).ctxs\n\n-- | Returns a subtrie containing all paths with given prefix. Path prefixes are not saved.\nsubtrie\n :: forall k v\n . Ord k\n => List k\n -> Trie k v\n -> Maybe (Trie k v)\nsubtrie Nil trie = Just trie\nsubtrie path (Arc len arc child) =\n let prefixLength = longestCommonPrefixLength path arc in\n if prefixLength == 0\n then Nothing\n else subtrie (L.drop prefixLength path)\n if prefixLength == len\n then child\n else mkArc (L.drop prefixLength arc) child\nsubtrie (head : tail) trie@(Branch _ children) =\n case M.lookup head children of\n Just trie' -> subtrie tail trie'\n Nothing -> Nothing\n\n-- | A version of `subtrie` that does not cut the prefixes.\nsubtrieWithPrefixes\n :: forall k v\n . Ord k\n => List k\n -> Trie k v\n -> Maybe (Trie k v)\nsubtrieWithPrefixes path trie =\n fromFoldable <<<\n map (lmap (path <> _)) <<<\n entriesUnordered <$>\n subtrie path trie\n\nquery\n :: forall k v\n . Ord k\n => List k\n -> Trie k v\n -> List (Tuple (List k) v)\nquery path =\n entries <<< MB.fromMaybe empty <<< subtrieWithPrefixes path\n\nqueryValues\n :: forall k v\n . Ord k\n => List k\n -> Trie k v\n -> List v\nqueryValues path =\n values <<< MB.fromMaybe mempty <<< subtrie path\n\n-- | Insert an entry into a trie.\ninsert\n :: forall k v\n . Ord k\n => List k\n -> v\n -> Trie k v\n -> Trie k v\ninsert path value trie =\n case descend path (mkZipper trie) of\n { mbValue, children, ctxs } ->\n fromZipper $ Zipper (Branch (Just value) children) ctxs\n\n-- | Delete, insert or update the entry by a given path.\n-- | It is recommended to use specialized functions for each case.\nalter\n :: forall k v\n . Ord k\n => List k\n -> (Maybe v -> Maybe v)\n -> Trie k v\n -> Trie k v\nalter path =\n withZipper <<< alter' path\n\nalter'\n :: forall k v\n . Ord k\n => List k\n -> (Maybe v -> Maybe v)\n -> Zipper k v\n -> Zipper k v\nalter' path f zipper =\n case descend path zipper of\n { mbValue, children, ctxs } ->\n let updatedValue = f mbValue\n wasDeleted = MB.isJust mbValue &&\n MB.isNothing updatedValue &&\n M.isEmpty children\n in if wasDeleted\n then\n -- Remove unused branches and arcs from the tree.\n prune ctxs\n else Zipper (Branch updatedValue children) ctxs\n\nfromList\n :: forall k v\n . Ord k\n => List (Tuple (List k) v)\n -> Trie k v\nfromList =\n foldl (flip (uncurry insert)) empty\n\nfromFoldable\n :: forall f p k v\n . Ord k\n => Foldable f\n => Foldable p\n => f (Tuple (p k) v)\n -> Trie k v\nfromFoldable =\n foldl (flip (lmap L.fromFoldable >>> uncurry insert)) empty\n\n-- | Resulting List will be sorted.\nentries\n :: forall k v\n . Trie k v\n -> List (Tuple (List k) v)\nentries =\n entriesWith M.toUnfoldable\n\n-- | A version of `entries` defined using [Data.Map.toUnfoldableUnordered](https://pursuit.purescript.org/packages/purescript-ordered-collections/docs/Data.Map#v:toUnfoldableUnordered).\nentriesUnordered\n :: forall k v\n . Trie k v\n -> List (Tuple (List k) v)\nentriesUnordered =\n entriesWith M.toUnfoldableUnordered\n\nentriesWith\n :: forall k v\n . (Map k (Trie k v) -> List (Tuple k (Trie k v)))\n -> Trie k v\n -> List (Tuple (List k) v)\nentriesWith mapToUnfoldable trie =\n L.reverse $\n lmap (L.concat <<< L.reverse) <$>\n go (L.singleton $ Tuple trie Nil) Nil\n where\n go :: List (Tuple (Trie k v) (List (List k)))\n -> List (Tuple (List (List k)) v)\n -> List (Tuple (List (List k)) v)\n go (Tuple (Branch mbValue children) chunks : queue) res =\n let childrenQueue =\n mapToUnfoldable children <#>\n \\(Tuple key child) ->\n Tuple child (L.singleton key : chunks) in\n go (childrenQueue <> queue)\n (case mbValue of\n Just value ->\n Tuple chunks value : res\n Nothing -> res)\n go (Tuple (Arc _ path child) chunks : queue) res =\n go (Tuple child (path : chunks) : queue) res\n go Nil res = res\n\ntoUnfoldable\n :: forall f p k v\n . Unfoldable f\n => Unfoldable p\n => Trie k v\n -> f (Tuple (p k) v)\ntoUnfoldable trie =\n L.toUnfoldable (entries trie <#> lmap L.toUnfoldable)\n\nvalues\n :: forall k v\n . Trie k v\n -> List v\nvalues = L.reverse <<< go Nil <<< L.singleton\n where\n go res Nil = res\n go res (Branch mbValue children : queue) =\n go (case mbValue of\n Just value -> value : res\n Nothing -> res) (M.values children <> queue)\n go res (Arc len path child : queue) =\n go res (child : queue)\n\nlongestCommonPrefixLength :: forall a. Eq a => List a -> List a -> Int\nlongestCommonPrefixLength = go 0\n where\n go n xs ys =\n case L.uncons xs, L.uncons ys of\n Just x, Just y ->\n if x.head == y.head\n then go (n + 1) x.tail y.tail\n else n\n _, _ -> n\n", "-- | A type and functions for single characters.\nmodule Data.Char\n ( toCharCode\n , fromCharCode\n ) where\n\nimport Data.Enum (fromEnum, toEnum)\nimport Data.Maybe (Maybe)\n\n-- | Returns the numeric Unicode value of the character.\ntoCharCode :: Char -> Int\ntoCharCode = fromEnum\n\n-- | Constructs a character from the given Unicode numeric value.\nfromCharCode :: Int -> Maybe Char\nfromCharCode = toEnum\n", "module Data.Variant\n ( Variant\n , inj\n , prj\n , on\n , onMatch\n , over\n , overOne\n , overSome\n , case_\n , match\n , default\n , traverse\n , traverseOne\n , traverseSome\n , expand\n , contract\n , Unvariant(..)\n , Unvariant'\n , unvariant\n , revariant\n , class VariantEqs, variantEqs\n , class VariantOrds, variantOrds\n , class VariantShows, variantShows\n , class VariantBounded, variantBounded\n , class VariantBoundedEnums, variantBoundedEnums\n , module Exports\n ) where\n\nimport Prelude\n\nimport Control.Alternative (empty, class Alternative)\nimport Data.Enum (class Enum, pred, succ, class BoundedEnum, Cardinality(..), fromEnum, toEnum, cardinality)\nimport Data.List as L\nimport Data.Maybe (Maybe)\nimport Data.Symbol (class IsSymbol, reflectSymbol)\nimport Data.Variant.Internal (class Contractable, class VariantMapCases, class VariantMatchCases, class VariantTraverseCases) as Exports\nimport Data.Variant.Internal (class Contractable, class VariantMapCases, class VariantMatchCases, class VariantTags, class VariantTraverseCases, BoundedDict, BoundedEnumDict, VariantCase, VariantRep(..), contractWith, lookup, lookupCardinality, lookupEq, lookupFirst, lookupFromEnum, lookupLast, lookupOrd, lookupPred, lookupSucc, lookupToEnum, unsafeGet, unsafeHas, variantTags)\nimport Partial.Unsafe (unsafeCrashWith)\nimport Prim.Row as R\nimport Prim.RowList as RL\nimport Type.Proxy (Proxy(..))\nimport Unsafe.Coerce (unsafeCoerce)\n\nforeign import data Variant \u2237 Row Type \u2192 Type\n\n-- | Inject into the variant at a given label.\n-- | ```purescript\n-- | intAtFoo :: forall r. Variant (foo :: Int | r)\n-- | intAtFoo = inj (Proxy :: Proxy \"foo\") 42\n-- | ```\ninj\n \u2237 \u2200 sym a r1 r2\n . R.Cons sym a r1 r2\n \u21D2 IsSymbol sym\n \u21D2 Proxy sym\n \u2192 a\n \u2192 Variant r2\ninj p value = coerceV $ VariantRep { type: reflectSymbol p, value }\n where\n coerceV \u2237 VariantRep a \u2192 Variant r2\n coerceV = unsafeCoerce\n\n-- | Attempt to read a variant at a given label.\n-- | ```purescript\n-- | case prj (Proxy :: Proxy \"foo\") intAtFoo of\n-- | Just i -> i + 1\n-- | Nothing -> 0\n-- | ```\nprj\n \u2237 \u2200 sym a r1 r2 f\n . R.Cons sym a r1 r2\n \u21D2 IsSymbol sym\n \u21D2 Alternative f\n \u21D2 Proxy sym\n \u2192 Variant r2\n \u2192 f a\nprj p = on p pure (const empty)\n\n-- | Attempt to read a variant at a given label by providing branches.\n-- | The failure branch receives the provided variant, but with the label\n-- | removed.\non\n \u2237 \u2200 sym a b r1 r2\n . R.Cons sym a r1 r2\n \u21D2 IsSymbol sym\n \u21D2 Proxy sym\n \u2192 (a \u2192 b)\n \u2192 (Variant r1 \u2192 b)\n \u2192 Variant r2\n \u2192 b\non p f g r =\n case coerceV r of\n VariantRep v | v.type == reflectSymbol p \u2192 f v.value\n _ \u2192 g (coerceR r)\n where\n coerceV \u2237 Variant r2 \u2192 VariantRep a\n coerceV = unsafeCoerce\n\n coerceR \u2237 Variant r2 \u2192 Variant r1\n coerceR = unsafeCoerce\n\n-- | Match a `Variant` with a `Record` containing functions for handling cases.\n-- | This is similar to `on`, except instead of providing a single label and\n-- | handler, you can provide a record where each field maps to a particular\n-- | `Variant` case.\n-- |\n-- | ```purescript\n-- | onMatch\n-- | { foo: \\foo -> \"Foo: \" <> foo\n-- | , bar: \\bar -> \"Bar: \" <> bar\n-- | }\n-- | ```\n-- |\n-- | Polymorphic functions in records (such as `show` or `id`) can lead\n-- | to inference issues if not all polymorphic variables are specified\n-- | in usage. When in doubt, label methods with specific types, such as\n-- | `show :: Int -> String`, or give the whole record an appropriate type.\nonMatch\n \u2237 \u2200 rl r r1 r2 r3 b\n . RL.RowToList r rl\n \u21D2 VariantMatchCases rl r1 b\n \u21D2 R.Union r1 r2 r3\n \u21D2 Record r\n \u2192 (Variant r2 \u2192 b)\n \u2192 Variant r3\n \u2192 b\nonMatch r k v =\n case coerceV v of\n VariantRep v' | unsafeHas v'.type r \u2192 unsafeGet v'.type r v'.value\n _ \u2192 k (coerceR v)\n\n where\n coerceV \u2237 \u2200 a. Variant r3 \u2192 VariantRep a\n coerceV = unsafeCoerce\n\n coerceR \u2237 Variant r3 \u2192 Variant r2\n coerceR = unsafeCoerce\n\n-- | Map over one case of a variant, putting the result back at the same label,\n-- | with a fallback function to handle the remaining cases.\noverOne\n \u2237 \u2200 sym a b r1 r2 r3 r4\n . IsSymbol sym\n \u21D2 R.Cons sym a r1 r2\n \u21D2 R.Cons sym b r4 r3\n \u21D2 Proxy sym\n \u2192 (a \u2192 b)\n \u2192 (Variant r1 \u2192 Variant r3)\n \u2192 Variant r2\n \u2192 Variant r3\noverOne p f = on p (inj p <<< f)\n\n-- | Map over several cases of a variant using a `Record` containing functions\n-- | for each case. Each case gets put back at the same label it was matched\n-- | at, i.e. its label in the record. Labels not found in the record are\n-- | handled using the fallback function.\noverSome\n \u2237 \u2200 r rl ri ro r1 r2 r3 r4\n . RL.RowToList r rl\n \u21D2 VariantMapCases rl ri ro\n \u21D2 R.Union ri r2 r1\n \u21D2 R.Union ro r4 r3\n \u21D2 Record r\n \u2192 (Variant r2 \u2192 Variant r3)\n \u2192 Variant r1\n \u2192 Variant r3\noverSome r k v =\n case coerceV v of\n VariantRep v' | unsafeHas v'.type r \u2192\n coerceV' (VariantRep { type: v'.type, value: unsafeGet v'.type r v'.value })\n _ \u2192 k (coerceR v)\n\n where\n coerceV \u2237 \u2200 a. Variant r1 \u2192 VariantRep a\n coerceV = unsafeCoerce\n\n coerceV' \u2237 \u2200 a. VariantRep a \u2192 Variant r3\n coerceV' = unsafeCoerce\n\n coerceR \u2237 Variant r1 \u2192 Variant r2\n coerceR = unsafeCoerce\n\n-- | Map over some labels and leave the rest unchanged. For example:\n-- |\n-- | ```purescript\n-- | over { label: show :: Int -> String }\n-- | :: forall r. Variant ( label :: Int | r ) -> Variant ( label :: String | r )\n-- | ```\n-- |\n-- | `over r` is like `expand # overSome r` but with a more easily\n-- | solved constraint (i.e. it can be solved once the type of `r` is known).\nover\n \u2237 \u2200 r rl ri ro r1 r2 r3\n . RL.RowToList r rl\n \u21D2 VariantMapCases rl ri ro\n \u21D2 R.Union ri r2 r1\n \u21D2 R.Union ro r2 r3 -- this is \"backwards\" for `expand`, but still safe\n \u21D2 Record r\n \u2192 Variant r1\n \u2192 Variant r3\nover r = overSome r unsafeExpand where\n unsafeExpand = unsafeCoerce \u2237 Variant r2 \u2192 Variant r3\n\n-- | Traverse over one case of a variant (in a functorial/monadic context `m`),\n-- | putting the result back at the same label, with a fallback function.\ntraverseOne\n \u2237 \u2200 sym a b r1 r2 r3 r4 m\n . IsSymbol sym\n \u21D2 R.Cons sym a r1 r2\n \u21D2 R.Cons sym b r4 r3\n \u21D2 Functor m\n \u21D2 Proxy sym\n \u2192 (a \u2192 m b)\n \u2192 (Variant r1 \u2192 m (Variant r3))\n \u2192 Variant r2\n \u2192 m (Variant r3)\ntraverseOne p f = on p (map (inj p) <<< f)\n\n-- | Traverse over several cases of a variant using a `Record` containing\n-- | traversals. Each case gets put back at the same label it was matched\n-- | at, i.e. its label in the record. Labels not found in the record are\n-- | handled using the fallback function.\ntraverseSome\n \u2237 \u2200 r rl ri ro r1 r2 r3 r4 m\n . RL.RowToList r rl\n \u21D2 VariantTraverseCases m rl ri ro\n \u21D2 R.Union ri r2 r1\n \u21D2 R.Union ro r4 r3\n \u21D2 Functor m\n \u21D2 Record r\n \u2192 (Variant r2 \u2192 m (Variant r3))\n \u2192 Variant r1\n \u2192 m (Variant r3)\ntraverseSome r k v =\n case coerceV v of\n VariantRep v' | unsafeHas v'.type r \u2192\n unsafeGet v'.type r v'.value <#> \\value ->\n coerceV' (VariantRep { type: v'.type, value })\n _ \u2192 k (coerceR v)\n\n where\n coerceV \u2237 \u2200 a. Variant r1 \u2192 VariantRep a\n coerceV = unsafeCoerce\n\n coerceV' \u2237 \u2200 a. VariantRep a \u2192 Variant r3\n coerceV' = unsafeCoerce\n\n coerceR \u2237 Variant r1 \u2192 Variant r2\n coerceR = unsafeCoerce\n\n-- | Traverse over some labels and leave the rest unchanged.\n-- | (Implemented by expanding after `traverseSome`.)\ntraverse\n \u2237 \u2200 r rl ri ro r1 r2 r3 m\n . RL.RowToList r rl\n \u21D2 VariantTraverseCases m rl ri ro\n \u21D2 R.Union ri r2 r1\n \u21D2 R.Union ro r2 r3 -- this is \"backwards\" for `expand`, but still safe\n \u21D2 Applicative m\n \u21D2 Record r\n \u2192 Variant r1\n \u2192 m (Variant r3)\ntraverse r = traverseSome r (pure <<< unsafeExpand) where\n unsafeExpand = unsafeCoerce \u2237 Variant r2 \u2192 Variant r3\n\n-- | Combinator for exhaustive pattern matching.\n-- | ```purescript\n-- | caseFn :: Variant (foo :: Int, bar :: String, baz :: Boolean) -> String\n-- | caseFn = case_\n-- | # on (Proxy :: Proxy \"foo\") (\\foo -> \"Foo: \" <> show foo)\n-- | # on (Proxy :: Proxy \"bar\") (\\bar -> \"Bar: \" <> bar)\n-- | # on (Proxy :: Proxy \"baz\") (\\baz -> \"Baz: \" <> show baz)\n-- | ```\ncase_ \u2237 \u2200 a. Variant () \u2192 a\ncase_ r = unsafeCrashWith case unsafeCoerce r of\n VariantRep v \u2192 \"Data.Variant: pattern match failure [\" <> v.type <> \"]\"\n\n-- | Combinator for exhaustive pattern matching using an `onMatch` case record.\n-- | ```purescript\n-- | matchFn :: Variant (foo :: Int, bar :: String, baz :: Boolean) -> String\n-- | matchFn = match\n-- | { foo: \\foo -> \"Foo: \" <> show foo\n-- | , bar: \\bar -> \"Bar: \" <> bar\n-- | , baz: \\baz -> \"Baz: \" <> show baz\n-- | }\n-- | ```\nmatch\n \u2237 \u2200 rl r r1 r2 b\n . RL.RowToList r rl\n \u21D2 VariantMatchCases rl r1 b\n \u21D2 R.Union r1 () r2\n \u21D2 Record r\n \u2192 Variant r2\n \u2192 b\nmatch r = case_ # onMatch r\n\n-- | Combinator for partial matching with a default value in case of failure.\n-- | ```purescript\n-- | caseFn :: forall r. Variant (foo :: Int, bar :: String | r) -> String\n-- | caseFn = default \"No match\"\n-- | # on (Proxy :: Proxy \"foo\") (\\foo -> \"Foo: \" <> show foo)\n-- | # on (Proxy :: Proxy \"bar\") (\\bar -> \"Bar: \" <> bar)\n-- | ```\ndefault \u2237 \u2200 a r. a \u2192 Variant r \u2192 a\ndefault a _ = a\n\n-- | Every `Variant lt` can be cast to some `Variant gt` as long as `lt` is a\n-- | subset of `gt`.\nexpand\n \u2237 \u2200 lt a gt\n . R.Union lt a gt\n \u21D2 Variant lt\n \u2192 Variant gt\nexpand = unsafeCoerce\n\n-- | A `Variant gt` can be cast to some `Variant lt`, where `lt` is is a subset\n-- | of `gt`, as long as there is proof that the `Variant`'s runtime tag is\n-- | within the subset of `lt`.\ncontract\n \u2237 \u2200 lt gt f\n . Alternative f\n \u21D2 Contractable gt lt\n \u21D2 Variant gt\n \u2192 f (Variant lt)\ncontract v =\n contractWith\n (Proxy \u2237 Proxy gt)\n (Proxy \u2237 Proxy lt)\n (case coerceV v of VariantRep v' \u2192 v'.type)\n (coerceR v)\n where\n coerceV \u2237 \u2200 a. Variant gt \u2192 VariantRep a\n coerceV = unsafeCoerce\n\n coerceR \u2237 Variant gt \u2192 Variant lt\n coerceR = unsafeCoerce\n\ntype Unvariant' r x =\n \u2200 s t o\n . IsSymbol s\n \u21D2 R.Cons s t o r\n \u21D2 Proxy s\n \u2192 t\n \u2192 x\n\nnewtype Unvariant r = Unvariant\n (\u2200 x. Unvariant' r x \u2192 x)\n\n-- | A low-level eliminator which reifies the `IsSymbol` and `Cons`\n-- | constraints required to reconstruct the Variant. This lets you\n-- | work generically with some Variant at runtime.\nunvariant\n \u2237 \u2200 r\n . Variant r\n \u2192 Unvariant r\nunvariant v = case (unsafeCoerce v \u2237 VariantRep Unit) of\n VariantRep o \u2192\n Unvariant \\f \u2192\n coerce f { reflectSymbol: const o.type } {} Proxy o.value\n where\n coerce\n \u2237 \u2200 x\n . Unvariant' r x\n \u2192 { reflectSymbol \u2237 Proxy \"\" \u2192 String }\n \u2192 {}\n \u2192 Proxy \"\"\n \u2192 Unit\n \u2192 x\n coerce = unsafeCoerce\n\n-- | Reconstructs a Variant given an Unvariant eliminator.\nrevariant \u2237 \u2200 r. Unvariant r -> Variant r\nrevariant (Unvariant f) = f inj\n\nclass VariantEqs :: RL.RowList Type -> Constraint\nclass VariantEqs rl where\n variantEqs \u2237 Proxy rl \u2192 L.List (VariantCase \u2192 VariantCase \u2192 Boolean)\n\ninstance eqVariantNil \u2237 VariantEqs RL.Nil where\n variantEqs _ = L.Nil\n\ninstance eqVariantCons \u2237 (VariantEqs rs, Eq a) \u21D2 VariantEqs (RL.Cons sym a rs) where\n variantEqs _ =\n L.Cons (coerceEq eq) (variantEqs (Proxy \u2237 Proxy rs))\n where\n coerceEq \u2237 (a \u2192 a \u2192 Boolean) \u2192 VariantCase \u2192 VariantCase \u2192 Boolean\n coerceEq = unsafeCoerce\n\ninstance eqVariant \u2237 (RL.RowToList r rl, VariantTags rl, VariantEqs rl) \u21D2 Eq (Variant r) where\n eq v1 v2 =\n let\n c1 = unsafeCoerce v1 \u2237 VariantRep VariantCase\n c2 = unsafeCoerce v2 \u2237 VariantRep VariantCase\n tags = variantTags (Proxy \u2237 Proxy rl)\n eqs = variantEqs (Proxy \u2237 Proxy rl)\n in\n lookupEq tags eqs c1 c2\n\nclass VariantBounded :: RL.RowList Type -> Constraint\nclass VariantBounded rl where\n variantBounded \u2237 Proxy rl \u2192 L.List (BoundedDict VariantCase)\n\ninstance boundedVariantNil \u2237 VariantBounded RL.Nil where\n variantBounded _ = L.Nil\n\ninstance boundedVariantCons \u2237 (VariantBounded rs, Bounded a) \u21D2 VariantBounded (RL.Cons sym a rs) where\n variantBounded _ = L.Cons dict (variantBounded (Proxy \u2237 Proxy rs))\n where\n dict \u2237 BoundedDict VariantCase\n dict =\n { top: coerce top\n , bottom: coerce bottom\n }\n\n coerce \u2237 a \u2192 VariantCase\n coerce = unsafeCoerce\n\ninstance boundedVariant \u2237 (RL.RowToList r rl, VariantTags rl, VariantEqs rl, VariantOrds rl, VariantBounded rl) \u21D2 Bounded (Variant r) where\n top =\n let\n tags = variantTags (Proxy \u2237 Proxy rl)\n dicts = variantBounded (Proxy \u2237 Proxy rl)\n coerce = unsafeCoerce \u2237 VariantRep VariantCase \u2192 Variant r\n in\n coerce $ VariantRep $ lookupLast \"top\" _.top tags dicts\n\n bottom =\n let\n tags = variantTags (Proxy \u2237 Proxy rl)\n dicts = variantBounded (Proxy \u2237 Proxy rl)\n coerce = unsafeCoerce \u2237 VariantRep VariantCase \u2192 Variant r\n in\n coerce $ VariantRep $ lookupFirst \"bottom\" _.bottom tags dicts\n\nclass VariantBoundedEnums :: RL.RowList Type -> Constraint\nclass VariantBounded rl \u21D0 VariantBoundedEnums rl where\n variantBoundedEnums \u2237 Proxy rl \u2192 L.List (BoundedEnumDict VariantCase)\n\ninstance enumVariantNil \u2237 VariantBoundedEnums RL.Nil where\n variantBoundedEnums _ = L.Nil\n\ninstance enumVariantCons \u2237 (VariantBoundedEnums rs, BoundedEnum a) \u21D2 VariantBoundedEnums (RL.Cons sym a rs) where\n variantBoundedEnums _ = L.Cons dict (variantBoundedEnums (Proxy \u2237 Proxy rs))\n where\n dict \u2237 BoundedEnumDict VariantCase\n dict =\n { pred: coerceAToMbA pred\n , succ: coerceAToMbA succ\n , fromEnum: coerceFromEnum fromEnum\n , toEnum: coerceToEnum toEnum\n , cardinality: coerceCardinality cardinality\n }\n\n coerceAToMbA \u2237 (a \u2192 Maybe a) \u2192 VariantCase \u2192 Maybe VariantCase\n coerceAToMbA = unsafeCoerce\n\n coerceFromEnum \u2237 (a \u2192 Int) \u2192 VariantCase \u2192 Int\n coerceFromEnum = unsafeCoerce\n\n coerceToEnum \u2237 (Int \u2192 Maybe a) \u2192 Int \u2192 Maybe VariantCase\n coerceToEnum = unsafeCoerce\n\n coerceCardinality \u2237 Cardinality a \u2192 Int\n coerceCardinality = unsafeCoerce\n\ninstance enumVariant \u2237 (RL.RowToList r rl, VariantTags rl, VariantEqs rl, VariantOrds rl, VariantBoundedEnums rl) \u21D2 Enum (Variant r) where\n pred a =\n let\n rep = unsafeCoerce a \u2237 VariantRep VariantCase\n tags = variantTags (Proxy \u2237 Proxy rl)\n bounds = variantBounded (Proxy \u2237 Proxy rl)\n dicts = variantBoundedEnums (Proxy \u2237 Proxy rl)\n coerce = unsafeCoerce \u2237 Maybe (VariantRep VariantCase) \u2192 Maybe (Variant r)\n in\n coerce $ lookupPred rep tags bounds dicts\n\n succ a =\n let\n rep = unsafeCoerce a \u2237 VariantRep VariantCase\n tags = variantTags (Proxy \u2237 Proxy rl)\n bounds = variantBounded (Proxy \u2237 Proxy rl)\n dicts = variantBoundedEnums (Proxy \u2237 Proxy rl)\n coerce = unsafeCoerce \u2237 Maybe (VariantRep VariantCase) \u2192 Maybe (Variant r)\n in\n coerce $ lookupSucc rep tags bounds dicts\n\ninstance boundedEnumVariant \u2237 (RL.RowToList r rl, VariantTags rl, VariantEqs rl, VariantOrds rl, VariantBoundedEnums rl) \u21D2 BoundedEnum (Variant r) where\n cardinality =\n Cardinality $ lookupCardinality $ variantBoundedEnums (Proxy \u2237 Proxy rl)\n\n fromEnum a =\n let\n rep = unsafeCoerce a \u2237 VariantRep VariantCase\n tags = variantTags (Proxy \u2237 Proxy rl)\n dicts = variantBoundedEnums (Proxy \u2237 Proxy rl)\n in\n lookupFromEnum rep tags dicts\n\n toEnum n =\n let\n tags = variantTags (Proxy \u2237 Proxy rl)\n dicts = variantBoundedEnums (Proxy \u2237 Proxy rl)\n coerceV = unsafeCoerce \u2237 Maybe (VariantRep VariantCase) \u2192 Maybe (Variant r)\n in\n coerceV $ lookupToEnum n tags dicts\n\nclass VariantOrds :: RL.RowList Type -> Constraint\nclass VariantOrds rl where\n variantOrds \u2237 Proxy rl \u2192 L.List (VariantCase \u2192 VariantCase \u2192 Ordering)\n\ninstance ordVariantNil \u2237 VariantOrds RL.Nil where\n variantOrds _ = L.Nil\n\ninstance ordVariantCons \u2237 (VariantOrds rs, Ord a) \u21D2 VariantOrds (RL.Cons sym a rs) where\n variantOrds _ =\n L.Cons (coerceOrd compare) (variantOrds (Proxy \u2237 Proxy rs))\n where\n coerceOrd \u2237 (a \u2192 a \u2192 Ordering) \u2192 VariantCase \u2192 VariantCase \u2192 Ordering\n coerceOrd = unsafeCoerce\n\ninstance ordVariant \u2237 (RL.RowToList r rl, VariantTags rl, VariantEqs rl, VariantOrds rl) \u21D2 Ord (Variant r) where\n compare v1 v2 =\n let\n c1 = unsafeCoerce v1 \u2237 VariantRep VariantCase\n c2 = unsafeCoerce v2 \u2237 VariantRep VariantCase\n tags = variantTags (Proxy \u2237 Proxy rl)\n ords = variantOrds (Proxy \u2237 Proxy rl)\n in\n lookupOrd tags ords c1 c2\n\nclass VariantShows :: RL.RowList Type -> Constraint\nclass VariantShows rl where\n variantShows \u2237 Proxy rl \u2192 L.List (VariantCase \u2192 String)\n\ninstance showVariantNil \u2237 VariantShows RL.Nil where\n variantShows _ = L.Nil\n\ninstance showVariantCons \u2237 (VariantShows rs, Show a) \u21D2 VariantShows (RL.Cons sym a rs) where\n variantShows _ =\n L.Cons (coerceShow show) (variantShows (Proxy \u2237 Proxy rs))\n where\n coerceShow \u2237 (a \u2192 String) \u2192 VariantCase \u2192 String\n coerceShow = unsafeCoerce\n\ninstance showVariant \u2237 (RL.RowToList r rl, VariantTags rl, VariantShows rl) \u21D2 Show (Variant r) where\n show v1 =\n let\n VariantRep v = unsafeCoerce v1 \u2237 VariantRep VariantCase\n tags = variantTags (Proxy \u2237 Proxy rl)\n shows = variantShows (Proxy \u2237 Proxy rl)\n body = lookup \"show\" v.type tags shows v.value\n in\n \"(inj @\" <> show v.type <> \" \" <> body <> \")\"\n", "module Record\n ( get\n , set\n , modify\n , insert\n , delete\n , rename\n , equal\n , merge\n , union\n , disjointUnion\n , nub\n , class EqualFields\n , equalFields\n ) where\n\nimport Prelude\n\nimport Data.Function.Uncurried (runFn2)\nimport Data.Symbol (class IsSymbol, reflectSymbol)\nimport Prim.Row (class Lacks, class Cons, class Nub, class Union)\nimport Prim.RowList (class RowToList, RowList, Cons, Nil)\nimport Record.Unsafe (unsafeGet, unsafeSet, unsafeDelete)\nimport Record.Unsafe.Union (unsafeUnionFn)\nimport Type.Proxy (Proxy(..))\nimport Unsafe.Coerce (unsafeCoerce)\n\n-- | Get a property for a label which is specified using a value-level proxy for\n-- | a type-level string.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | get (Proxy :: Proxy \"x\") :: forall r a. { x :: a | r } -> a\n-- | ```\nget\n :: forall r r' l a\n . IsSymbol l\n => Cons l a r' r\n => Proxy l\n -> Record r\n -> a\nget l r = unsafeGet (reflectSymbol l) r\n\n-- | Set a property for a label which is specified using a value-level proxy for\n-- | a type-level string.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | set (Proxy :: Proxy \"x\")\n-- | :: forall r a b. a -> { x :: b | r } -> { x :: a | r }\n-- | ```\nset\n :: forall r1 r2 r l a b\n . IsSymbol l\n => Cons l a r r1\n => Cons l b r r2\n => Proxy l\n -> b\n -> Record r1\n -> Record r2\nset l b r = unsafeSet (reflectSymbol l) b r\n\n-- | Modify a property for a label which is specified using a value-level proxy for\n-- | a type-level string.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | modify (Proxy :: Proxy \"x\")\n-- | :: forall r a b. (a -> b) -> { x :: a | r } -> { x :: b | r }\n-- | ```\nmodify\n :: forall r1 r2 r l a b\n . IsSymbol l\n => Cons l a r r1\n => Cons l b r r2\n => Proxy l\n -> (a -> b)\n -> Record r1\n -> Record r2\nmodify l f r = set l (f (get l r)) r\n\n-- | Insert a new property for a label which is specified using a value-level proxy for\n-- | a type-level string.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | insert (Proxy :: Proxy \"x\")\n-- | :: forall r a. Lacks \"x\" r => a -> { | r } -> { x :: a | r }\n-- | ```\ninsert\n :: forall r1 r2 l a\n . IsSymbol l\n => Lacks l r1\n => Cons l a r1 r2\n => Proxy l\n -> a\n -> Record r1\n -> Record r2\ninsert l a r = unsafeSet (reflectSymbol l) a r\n\n-- | Delete a property for a label which is specified using a value-level proxy for\n-- | a type-level string.\n-- |\n-- | Note that the type of the resulting row must _lack_ the specified property.\n-- | Since duplicate labels are allowed, this is checked with a type class constraint.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | delete (Proxy :: Proxy \"x\")\n-- | :: forall r a. Lacks \"x\" r => { x :: a | r } -> { | r }\n-- | ```\ndelete\n :: forall r1 r2 l a\n . IsSymbol l\n => Lacks l r1\n => Cons l a r1 r2\n => Proxy l\n -> Record r2\n -> Record r1\ndelete l r = unsafeDelete (reflectSymbol l) r\n\n-- | Rename a property for a label which is specified using a value-level proxy for\n-- | a type-level string.\n-- |\n-- | Note that the type of the resulting row must _lack_ the specified property.\n-- | Since duplicate labels are allowed, this is checked with a type class constraint.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | rename (Proxy :: Proxy \"x\") (Proxy :: Proxy \"y\")\n-- | :: forall a r. Lacks \"x\" r => Lacks \"y\" r => { x :: a | r} -> { y :: a | r}\n-- | ```\nrename :: forall prev next ty input inter output\n . IsSymbol prev\n => IsSymbol next\n => Cons prev ty inter input\n => Lacks prev inter\n => Cons next ty inter output\n => Lacks next inter\n => Proxy prev\n -> Proxy next\n -> Record input\n -> Record output\nrename prev next record =\n insert next (get prev record) (delete prev record :: Record inter)\n\n-- | Merges two records with the first record's labels taking precedence in the\n-- | case of overlaps.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | merge { x: 1, y: \"y\" } { y: 2, z: true }\n-- | :: { x :: Int, y :: String, z :: Boolean }\n-- | ```\nmerge\n :: forall r1 r2 r3 r4\n . Union r1 r2 r3\n => Nub r3 r4\n => Record r1\n -> Record r2\n -> Record r4\nmerge l r = runFn2 unsafeUnionFn l r\n\n-- | Merges two records with the first record's labels taking precedence in the\n-- | case of overlaps. Unlike `merge`, this does not remove duplicate labels\n-- | from the resulting record type. This can result in better inference for\n-- | some pipelines, deferring the need for a `Nub` constraint.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | union { x: 1, y: \"y\" } { y: 2, z: true }\n-- | :: { x :: Int, y :: String, y :: Int, z :: Boolean }\n-- | ```\nunion\n :: forall r1 r2 r3\n . Union r1 r2 r3\n => Record r1\n -> Record r2\n -> Record r3\nunion l r = runFn2 unsafeUnionFn l r\n\n-- | Merges two records where no labels overlap. This restriction exhibits\n-- | better inference than `merge` when the resulting record type is known,\n-- | but one argument is not.\n-- |\n-- | For example, hole `?help` is inferred to have type `{ b :: Int }` here:\n-- |\n-- | ```purescript\n-- | disjointUnion { a: 5 } ?help :: { a :: Int, b :: Int }\n-- | ```\ndisjointUnion\n :: forall r1 r2 r3\n . Union r1 r2 r3\n => Nub r3 r3\n => Record r1\n -> Record r2\n -> Record r3\ndisjointUnion l r = runFn2 unsafeUnionFn l r\n\n-- | A coercion which removes duplicate labels from a record's type.\nnub\n :: forall r1 r2\n . Nub r1 r2\n => Record r1\n -> Record r2\nnub = unsafeCoerce\n\n-- | Check two records of the same type for equality.\nequal\n :: forall r rs\n . RowToList r rs\n => EqualFields rs r\n => Record r\n -> Record r\n -> Boolean\nequal a b = equalFields (Proxy :: Proxy rs) a b\n\nclass EqualFields (rs :: RowList Type) (row :: Row Type) | rs -> row where\n equalFields :: Proxy rs -> Record row -> Record row -> Boolean\n\ninstance equalFieldsCons\n ::\n ( IsSymbol name\n , Eq ty\n , Cons name ty tailRow row\n , EqualFields tail row\n ) => EqualFields (Cons name ty tail) row where\n equalFields _ a b = get' a == get' b && equalRest a b\n where\n get' = get (Proxy :: Proxy name)\n equalRest = equalFields (Proxy :: Proxy tail)\n\ninstance equalFieldsNil :: EqualFields Nil row where\n equalFields _ _ _ = true\n", "module Data.Codec.JSON.Variant where\n\nimport Prelude\n\nimport Codec.JSON.DecodeError as Error\nimport Control.Monad.Except (Except, except)\nimport Data.Array as Array\nimport Data.Codec (Codec(..))\nimport Data.Codec as Codec\nimport Data.Codec.JSON as CJ\nimport Data.Either (Either(..), hush)\nimport Data.Maybe (Maybe(..))\nimport Data.Symbol (class IsSymbol, reflectSymbol)\nimport Data.Tuple (Tuple(..))\nimport Data.Variant (Variant, case_, inj, on)\nimport JSON (JSON)\nimport JSON.Object as JO\nimport Prim.Row as R\nimport Prim.RowList as RL\nimport Record as Record\nimport Type.Equality as TE\nimport Type.Proxy (Proxy(..))\nimport Unsafe.Coerce (unsafeCoerce)\n\n-- | Builds a codec for a variant from a record, similar to the way\n-- | `Variant.match` works to pattern match on a variant.\n-- |\n-- | Commonly used to write decoders for sum-types, by providing a mapping from\n-- | and to a Variant from that type and then using `dimap`.\n-- |\n-- | Each field in the record accepts an `Either`, where `Right` is used to\n-- | specify a codec used for the constructor, and `Left` is used to specify a\n-- | static value (generally as `Left unit` for nullary constructors).\n-- |\n-- | The variant will be encoded as a JSON object of the form\n-- | `{ \"tag\": , \"value\": }`, where `` is the name of the\n-- | variant case, and `` is the associated value (omitted in the case\n-- | of static `Left`-defined values).\n-- |\n-- |```purescript\n-- | codecMaybeMatch \u2237 \u2200 a. CJ.Codec a \u2192 CJ.Codec (Maybe a)\n-- | codecMaybeMatch codecA =\n-- | dimap toVariant fromVariant\n-- | (CJV.variantMatch\n-- | { just: Right codecA\n-- | , nothing: Left unit\n-- | })\n-- | where\n-- | toVariant = case _ of\n-- | Just a \u2192 V.inj @\"just\" a\n-- | Nothing \u2192 V.inj @\"nothing\" unit\n-- | fromVariant = V.match\n-- | { just: Just\n-- | , nothing: \\_ \u2192 Nothing\n-- | }\n-- |```\nvariantMatch\n \u2237 \u2200 rl ri ro\n . RL.RowToList ri rl\n \u21D2 VariantCodec rl ri ro\n \u21D2 Record ri\n \u2192 CJ.Codec (Variant ro)\nvariantMatch = variantCodec (Proxy @rl)\n\n-- | Builds codecs for variants in combination with `variantCase`.\n-- |\n-- | Provides an alternative means of building variant codecs to that of\n-- | `variantMatch`, often for cases where the codec is being constructed\n-- | with a fold or some other similar technique.\n-- |\n-- |```purescript\n-- | codecMaybe \u2237 \u2200 a. CJ.Codec a \u2192 CJ.Codec (Maybe a)\n-- | codecMaybe codecA =\n-- | dimap toVariant fromVariant\n-- | (CJV.variant\n-- | # CJV.variantCase _Just (Right codecA)\n-- | # CJV.variantCase _Nothing (Left unit))\n-- | where\n-- | toVariant = case _ of\n-- | Just a \u2192 V.inj _Just a\n-- | Nothing \u2192 V.inj _Nothing unit\n-- | fromVariant = V.case_\n-- | # V.on _Just Just\n-- | # V.on _Nothing (const Nothing)\n-- | _Just = Proxy @\"just\"\n-- | _Nothing = Proxy @\"nothing\"\n-- |```\nvariant \u2237 CJ.Codec (Variant ())\nvariant = Codec (\\_ \u2192 except (Left (Error.basic \"Unexpected value\"))) case_\n\nvariantCase\n \u2237 \u2200 l a r r'\n . IsSymbol l\n \u21D2 R.Cons l a r r'\n \u21D2 Proxy l\n \u2192 Either a (CJ.Codec a)\n \u2192 CJ.Codec (Variant r)\n \u2192 CJ.Codec (Variant r')\nvariantCase proxy eacodec (Codec dec enc) = Codec.Codec dec' enc'\n where\n\n dec' \u2237 JSON \u2192 Except CJ.DecodeError (Variant r')\n dec' j = do\n obj \u2190 Codec.decode CJ.jobject j\n tag \u2190 Codec.decode (CJ.prop \"tag\" CJ.string) obj\n if tag == reflectSymbol proxy then\n case eacodec of\n Left a \u2192 pure (inj proxy a)\n Right codec \u2192 do\n value \u2190 Codec.decode (CJ.prop \"value\" CJ.json) obj\n inj proxy <$> Codec.decode codec value\n else\n coerceR <$> dec j\n\n enc' \u2237 Variant r' \u2192 Tuple JSON (Variant r')\n enc' v =\n on proxy\n ( \\v' \u2192 flip Tuple v\n $ Codec.encode CJ.jobject\n $ JO.fromEntries\n $ Array.catMaybes\n [ Just $ Tuple \"tag\" (Codec.encode CJ.string (reflectSymbol proxy))\n , Tuple \"value\" <<< (flip Codec.encode v') <$> hush eacodec\n ]\n )\n (\\v' \u2192 enc v' $> v)\n v\n\n coerceR \u2237 Variant r \u2192 Variant r'\n coerceR = unsafeCoerce\n\n-- | The class used to enable the building of `Variant` codecs from a record of\n-- | codecs.\nclass VariantCodec (rl \u2237 RL.RowList Type) (ri \u2237 Row Type) (ro \u2237 Row Type) | rl \u2192 ri ro where\n variantCodec \u2237 \u2200 proxy. proxy rl \u2192 Record ri \u2192 CJ.Codec (Variant ro)\n\ninstance VariantCodec RL.Nil () () where\n variantCodec _ _ = variant\n\ninstance\n ( VariantCodec rs ri' ro'\n , R.Cons sym (Either a (CJ.Codec a)) ri' ri\n , R.Cons sym a ro' ro\n , IsSymbol sym\n , TE.TypeEquals co (Either a (CJ.Codec a))\n ) \u21D2\n VariantCodec (RL.Cons sym co rs) ri ro where\n variantCodec _ codecs =\n variantCase (Proxy @sym) codec tail\n where\n codec \u2237 Either a (CJ.Codec a)\n codec = TE.from (Record.get (Proxy @sym) codecs)\n\n tail \u2237 CJ.Codec (Variant ro')\n tail = variantCodec (Proxy @rs) ((unsafeCoerce \u2237 Record ri \u2192 Record ri') codecs)\n", "/* eslint-disable no-eq-null, eqeqeq */\nfunction id(x) {\n return x;\n}\n\nexport {id as fromBoolean};\nexport {id as fromNumber};\nexport {id as fromString};\nexport {id as fromArray};\nexport {id as fromObject};\nexport const jsonNull = null;\n\nexport function stringify(j) {\n return JSON.stringify(j);\n}\n\nexport function stringifyWithIndent(i) {\n return function (j) {\n return JSON.stringify(j, null, i);\n };\n}\n\nfunction isArray(a) {\n return Object.prototype.toString.call(a) === \"[object Array]\";\n}\n\nexport function _caseJson(isNull, isBool, isNum, isStr, isArr, isObj, j) {\n if (j == null) return isNull();\n else if (typeof j === \"boolean\") return isBool(j);\n else if (typeof j === \"number\") return isNum(j);\n else if (typeof j === \"string\") return isStr(j);\n else if (Object.prototype.toString.call(j) === \"[object Array]\")\n return isArr(j);\n else return isObj(j);\n}\n\nexport function _compare(EQ, GT, LT, a, b) {\n if (a == null) {\n if (b == null) return EQ;\n else return LT;\n } else if (typeof a === \"boolean\") {\n if (typeof b === \"boolean\") {\n // boolean / boolean\n if (a === b) return EQ;\n else if (a === false) return LT;\n else return GT;\n } else if (b == null) return GT;\n else return LT;\n } else if (typeof a === \"number\") {\n if (typeof b === \"number\") {\n if (a === b) return EQ;\n else if (a < b) return LT;\n else return GT;\n } else if (b == null) return GT;\n else if (typeof b === \"boolean\") return GT;\n else return LT;\n } else if (typeof a === \"string\") {\n if (typeof b === \"string\") {\n if (a === b) return EQ;\n else if (a < b) return LT;\n else return GT;\n } else if (b == null) return GT;\n else if (typeof b === \"boolean\") return GT;\n else if (typeof b === \"number\") return GT;\n else return LT;\n } else if (isArray(a)) {\n if (isArray(b)) {\n for (var i = 0; i < Math.min(a.length, b.length); i++) {\n var ca = _compare(EQ, GT, LT, a[i], b[i]);\n if (ca !== EQ) return ca;\n }\n if (a.length === b.length) return EQ;\n else if (a.length < b.length) return LT;\n else return GT;\n } else if (b == null) return GT;\n else if (typeof b === \"boolean\") return GT;\n else if (typeof b === \"number\") return GT;\n else if (typeof b === \"string\") return GT;\n else return LT;\n } else {\n if (b == null) return GT;\n else if (typeof b === \"boolean\") return GT;\n else if (typeof b === \"number\") return GT;\n else if (typeof b === \"string\") return GT;\n else if (isArray(b)) return GT;\n else {\n var akeys = Object.keys(a);\n var bkeys = Object.keys(b);\n if (akeys.length < bkeys.length) return LT;\n else if (akeys.length > bkeys.length) return GT;\n var keys = akeys.concat(bkeys).sort();\n for (var j = 0; j < keys.length; j++) {\n var k = keys[j];\n if (a[k] === undefined) return LT;\n else if (b[k] === undefined) return GT;\n var ck = _compare(EQ, GT, LT, a[k], b[k]);\n if (ck !== EQ) return ck;\n }\n return EQ;\n }\n }\n}\n", "-- | This module defines a data type and various functions for creating and\n-- | manipulating JSON values. The README contains additional documentation\n-- | for this module.\nmodule Data.Argonaut.Core\n ( Json\n , caseJson\n , caseJsonNull\n , caseJsonBoolean\n , caseJsonNumber\n , caseJsonString\n , caseJsonArray\n , caseJsonObject\n , isNull\n , isBoolean\n , isNumber\n , isString\n , isArray\n , isObject\n , fromBoolean\n , fromNumber\n , fromString\n , fromArray\n , fromObject\n , toNull\n , toBoolean\n , toNumber\n , toString\n , toArray\n , toObject\n , jsonNull\n , jsonTrue\n , jsonFalse\n , jsonZero\n , jsonEmptyString\n , jsonEmptyArray\n , jsonSingletonArray\n , jsonEmptyObject\n , jsonSingletonObject\n , stringify\n , stringifyWithIndent\n ) where\n\nimport Prelude\n\nimport Data.Function.Uncurried (Fn5, runFn5, Fn7, runFn7)\nimport Data.Maybe (Maybe(..))\nimport Foreign.Object (Object)\nimport Foreign.Object as Obj\n\n-- | The type of JSON data. The underlying representation is the same as what\n-- | would be returned from JavaScript's `JSON.parse` function; that is,\n-- | ordinary JavaScript booleans, strings, arrays, objects, etc.\nforeign import data Json :: Type\n\ninstance eqJson :: Eq Json where\n eq j1 j2 = compare j1 j2 == EQ\n\ninstance ordJson :: Ord Json where\n compare a b = runFn5 _compare EQ GT LT a b\n\n-- | The type of null values inside JSON data. There is exactly one value of\n-- | this type: in JavaScript, it is written `null`. This module exports this\n-- | value as `jsonNull`.\nforeign import data JNull :: Type\n\ninstance eqJNull :: Eq JNull where\n eq _ _ = true\n\ninstance ordJNull :: Ord JNull where\n compare _ _ = EQ\n\n-- | Case analysis for `Json` values. See the README for more information.\ncaseJson\n :: forall a\n . (Unit -> a)\n -> (Boolean -> a)\n -> (Number -> a)\n -> (String -> a)\n -> (Array Json -> a)\n -> (Object Json -> a)\n -> Json\n -> a\ncaseJson a b c d e f json = runFn7 _caseJson a b c d e f json\n\n-- | A simpler version of `caseJson` which accepts a callback for when the\n-- | `Json` argument was null, and a default value for all other cases.\ncaseJsonNull :: forall a. a -> (Unit -> a) -> Json -> a\ncaseJsonNull d f j = runFn7 _caseJson f (const d) (const d) (const d) (const d) (const d) j\n\n-- | A simpler version of `caseJson` which accepts a callback for when the\n-- | `Json` argument was a `Boolean`, and a default value for all other cases.\ncaseJsonBoolean :: forall a. a -> (Boolean -> a) -> Json -> a\ncaseJsonBoolean d f j = runFn7 _caseJson (const d) f (const d) (const d) (const d) (const d) j\n\n-- | A simpler version of `caseJson` which accepts a callback for when the\n-- | `Json` argument was a `Number`, and a default value for all other cases.\ncaseJsonNumber :: forall a. a -> (Number -> a) -> Json -> a\ncaseJsonNumber d f j = runFn7 _caseJson (const d) (const d) f (const d) (const d) (const d) j\n\n-- | A simpler version of `caseJson` which accepts a callback for when the\n-- | `Json` argument was a `String`, and a default value for all other cases.\ncaseJsonString :: forall a. a -> (String -> a) -> Json -> a\ncaseJsonString d f j = runFn7 _caseJson (const d) (const d) (const d) f (const d) (const d) j\n\n-- | A simpler version of `caseJson` which accepts a callback for when the\n-- | `Json` argument was a `Array Json`, and a default value for all other cases.\ncaseJsonArray :: forall a. a -> (Array Json -> a) -> Json -> a\ncaseJsonArray d f j = runFn7 _caseJson (const d) (const d) (const d) (const d) f (const d) j\n\n-- | A simpler version of `caseJson` which accepts a callback for when the\n-- | `Json` argument was an `Object`, and a default value for all other cases.\ncaseJsonObject :: forall a. a -> (Object Json -> a) -> Json -> a\ncaseJsonObject d f j = runFn7 _caseJson (const d) (const d) (const d) (const d) (const d) f j\n\nverbJsonType :: forall a b. b -> (a -> b) -> (b -> (a -> b) -> Json -> b) -> Json -> b\nverbJsonType def f g = g def f\n\n-- Tests\n\nisJsonType :: forall a. (Boolean -> (a -> Boolean) -> Json -> Boolean) -> Json -> Boolean\nisJsonType = verbJsonType false (const true)\n\n-- | Check if the provided `Json` is the `null` value\nisNull :: Json -> Boolean\nisNull = isJsonType caseJsonNull\n\n-- | Check if the provided `Json` is a `Boolean`\nisBoolean :: Json -> Boolean\nisBoolean = isJsonType caseJsonBoolean\n\n-- | Check if the provided `Json` is a `Number`\nisNumber :: Json -> Boolean\nisNumber = isJsonType caseJsonNumber\n\n-- | Check if the provided `Json` is a `String`\nisString :: Json -> Boolean\nisString = isJsonType caseJsonString\n\n-- | Check if the provided `Json` is an `Array`\nisArray :: Json -> Boolean\nisArray = isJsonType caseJsonArray\n\n-- | Check if the provided `Json` is an `Object`\nisObject :: Json -> Boolean\nisObject = isJsonType caseJsonObject\n\n-- Decoding\n\ntoJsonType\n :: forall a\n . (Maybe a -> (a -> Maybe a) -> Json -> Maybe a)\n -> Json\n -> Maybe a\ntoJsonType = verbJsonType Nothing Just\n\n-- | Convert `Json` to the `Unit` value if the `Json` is the null value\ntoNull :: Json -> Maybe Unit\ntoNull = toJsonType caseJsonNull\n\n-- | Convert `Json` to a `Boolean` value, if the `Json` is a boolean.\ntoBoolean :: Json -> Maybe Boolean\ntoBoolean = toJsonType caseJsonBoolean\n\n-- | Convert `Json` to a `Number` value, if the `Json` is a number.\ntoNumber :: Json -> Maybe Number\ntoNumber = toJsonType caseJsonNumber\n\n-- | Convert `Json` to a `String` value, if the `Json` is a string. To write a\n-- | `Json` value to a JSON string, see `stringify`.\ntoString :: Json -> Maybe String\ntoString = toJsonType caseJsonString\n\n-- | Convert `Json` to an `Array` of `Json` values, if the `Json` is an array.\ntoArray :: Json -> Maybe (Array Json)\ntoArray = toJsonType caseJsonArray\n\n-- | Convert `Json` to an `Object` of `Json` values, if the `Json` is an object.\ntoObject :: Json -> Maybe (Object Json)\ntoObject = toJsonType caseJsonObject\n\n-- Encoding\n\n-- | Construct `Json` from a `Boolean` value\nforeign import fromBoolean :: Boolean -> Json\n\n-- | Construct `Json` from a `Number` value\nforeign import fromNumber :: Number -> Json\n\n-- | Construct the `Json` representation of a `String` value.\n-- | Note that this function only produces `Json` containing a single piece of `String`\n-- | data (similar to `fromBoolean`, `fromNumber`, etc.).\n-- | This function does NOT convert the `String` encoding of a JSON value to `Json` - For that\n-- | purpose, you'll need to use `jsonParser`.\nforeign import fromString :: String -> Json\n\n-- | Construct `Json` from an array of `Json` values\nforeign import fromArray :: Array Json -> Json\n\n-- | Construct `Json` from an object with `Json` values\nforeign import fromObject :: Object Json -> Json\n\n-- Defaults\n\n-- | The JSON null value represented as `Json`\nforeign import jsonNull :: Json\n\n-- | The true boolean value represented as `Json`\njsonTrue :: Json\njsonTrue = fromBoolean true\n\n-- | The false boolean value represented as `Json`\njsonFalse :: Json\njsonFalse = fromBoolean false\n\n-- | The number zero represented as `Json`\njsonZero :: Json\njsonZero = fromNumber 0.0\n\n-- | An empty string represented as `Json`\njsonEmptyString :: Json\njsonEmptyString = fromString \"\"\n\n-- | An empty array represented as `Json`\njsonEmptyArray :: Json\njsonEmptyArray = fromArray []\n\n-- | An empty object represented as `Json`\njsonEmptyObject :: Json\njsonEmptyObject = fromObject Obj.empty\n\n-- | Constructs a `Json` array value containing only the provided value\njsonSingletonArray :: Json -> Json\njsonSingletonArray j = fromArray [ j ]\n\n-- | Constructs a `Json` object value containing only the provided key and value\njsonSingletonObject :: String -> Json -> Json\njsonSingletonObject key val = fromObject (Obj.singleton key val)\n\n-- | Converts a `Json` value to a JSON string. To retrieve a string from a `Json`\n-- | string value, see `fromString`.\nforeign import stringify :: Json -> String\n\n-- | Converts a `Json` value to a JSON string.\n-- | The first `Int` argument specifies the amount of white space characters to use as indentation.\n-- | This number is capped at 10 (if it is greater, the value is just 10). Values less than 1 indicate that no space should be used.\nforeign import stringifyWithIndent :: Int -> Json -> String\n\nforeign import _caseJson\n :: forall z\n . Fn7\n (Unit -> z)\n (Boolean -> z)\n (Number -> z)\n (String -> z)\n (Array Json -> z)\n (Object Json -> z)\n Json\n z\n\nforeign import _compare :: Fn5 Ordering Ordering Ordering Json Json Ordering\n", "-- | Unidirectional, value-based JSON codecs.\n-- | This module should be imported using a qualified `J` or `Json` alias:\n-- | ```\n-- | import Codec.Json.Unidirectional.Value as J\n-- | import Codec.Json.Unidirectional.Value as Json\n-- | ```\n-- | thereby causing `to*` and `from*` code to read like so:\n-- | - `J.fromInt`/`Json.fromInt`, which reads \"encode an `Int` to `Json`\"\n-- | - `J.toInt`/`Json.toInt`, which reads \"decode `JSON` to an `Int`\"\n--\n-- @inline export altAccumulate arity=2\n-- @inline export altAccumulateLazy arity=1\n-- @inline export fromPrimitiveArray(..).fromPrimitive arity=1\n-- @inline export fromPrimitiveObject(..).fromPrimitive arity=1\n-- @inline export fromPrimitiveRecord(..).fromPrimitive arity=2\n-- @inline export fromPrimitiveFailure(..).fromPrimitive always\n-- @inline export underIndex arity=1\n-- @inline export underKey arity=1\n-- @inline export toIdentity arity=1\n-- @inline export toMaybeTagged arity=1\n-- @inline export toEitherTagged arity=1\n-- @inline export toEitherSingle arity=1\n-- @inline export toTuple arity=1\n-- @inline export toThese arity=1\n-- @inline export toNonEmpty arity=1\n-- @inline export toList arity=1\n-- @inline export toNonEmptyList arity=1\n-- @inline export toMap arity=1\n-- @inline export toSet arity=1\n-- @inline export toNonEmptySet arity=1\n-- @inline export fromRecord arity=2\n-- @inline export toRecord arity=2\n-- @inline export fromRecordN arity=3\n-- @inline export toRecordN arity=3\n-- @inline export toStatic arity=1\n-- @inline export fromRequired arity=1\n-- @inline export fromRequired' arity=2\n-- @inline export toRequired arity=1\n-- @inline export fromRequiredRename arity=2\n-- @inline export fromRequiredRename' arity=3\n-- @inline export toRequiredRename arity=2\n-- @inline export fromOption arity=1\n-- @inline export fromOption' arity=2\n-- @inline export toOption arity=1\n-- @inline export fromOptionRename arity=2\n-- @inline export fromOptionRename' arity=3\n-- @inline export toOptionRename arity=2\n-- @inline export toOptionDefault arity=2\n-- @inline export toOptionDefaultRename arity=3\n-- @inline export fromOptionArray arity=1\n-- @inline export fromOptionArray' arity=2\n-- @inline export toOptionArray arity=1\n-- @inline export fromOptionAssocArray arity=2\n-- @inline export fromOptionAssocArray' arity=3\n-- @inline export toOptionAssocArray arity=2\n-- @inline export toRecordObjNil(..).toRecordObj arity=2\n-- @inline export toRecordObjCons(..).toRecordObj arity=2\n-- @inline export toRecordObjFailure(..).toRecordObj always\n-- @inline export fromRecordPropArrayNil(..).fromRecordPropArray arity=3\n-- @inline export fromRecordPropArrayCons(..).fromRecordPropArray arity=3\n-- @inline export fromRecordPropArrayFailure(..).fromRecordPropArray always\nmodule Codec.Json.Unidirectional.Value\n ( DecodeError(..)\n , accumulateErrors\n , altAccumulate\n , altAccumulateLazy\n , printDecodeError\n , unsafePrintDecodeError\n , coerce1\n , class FromPrimitive\n , fromPrimitive\n , class AllPrimitive\n , fromVoid\n , toVoid\n , fromJNull\n , fromNull\n , toJNull\n , fromUnit\n , toNullDefaultOrA\n , fromNullNothingOrJust\n , toNullNothingOrJust\n , fromNullable\n , toNullable\n , fromBoolean\n , toBoolean\n , fromNumber\n , toNumber\n , fromInt\n , toInt\n , fromString\n , toString\n , fromChar\n , toChar\n , fromCodePoint\n , toCodePoint\n , fromNonEmptyString\n , toNonEmptyString\n , fromJArray\n , toJArray\n , underIndex\n , fromArray\n , toArray\n , fromArray2\n , toArray2\n , fromArray3\n , toArray3\n , fromArray4\n , toArray4\n , fromArray5\n , toArray5\n , fromNonEmptyArray\n , toNonEmptyArray\n , fromJObject\n , toJObject\n , underKey\n , fromObject\n , toObject\n , fromObjSingleton\n , toObjSingleton\n , fromPropArray\n , fromIdentity\n , toIdentity\n , fromMaybeTagged\n , toMaybeTagged\n , fromEitherTagged\n , toEitherTagged\n , fromEitherSingle\n , toEitherSingle\n , fromTuple\n , toTuple\n , fromThese\n , toThese\n , fromNonEmpty\n , toNonEmpty\n , fromList\n , toList\n , fromNonEmptyList\n , toNonEmptyList\n , fromMap\n , toMap\n , fromSet\n , toSet\n , fromNonEmptySet\n , toNonEmptySet\n , fromRecord\n , toRecord\n , fromRecordN\n , toRecordN\n , FromProp(..)\n , ToProp(..)\n , toStatic\n , fromRequired\n , fromRequired'\n , toRequired\n , fromRequiredRename\n , fromRequiredRename'\n , toRequiredRename\n , fromOption\n , fromOption'\n , toOption\n , fromOptionRename\n , fromOptionRename'\n , toOptionRename\n , toOptionDefault\n , toOptionDefaultRename\n , fromOptionArray\n , fromOptionArray'\n , toOptionArray\n , fromOptionAssocArray\n , fromOptionAssocArray'\n , toOptionAssocArray\n , class ToRecordObj\n , toRecordObj\n , class FromRecordPropArray\n , fromRecordPropArray\n ) where\n\nimport Prelude\n\nimport Data.Argonaut.Core (Json, caseJson)\nimport Data.Argonaut.Core as Json\nimport Data.Array as Array\nimport Data.Array.NonEmpty as NEA\nimport Data.Array.NonEmpty.Internal (NonEmptyArray)\nimport Data.Bifunctor (lmap)\nimport Data.Either (Either(..), either, note)\nimport Data.Foldable (foldMap, foldl)\nimport Data.FoldableWithIndex (foldlWithIndex)\nimport Data.Function.Uncurried (Fn2, mkFn2, runFn2)\nimport Data.Generic.Rep (class Generic)\nimport Data.Identity (Identity(..))\nimport Data.Int as Int\nimport Data.List (List)\nimport Data.List as List\nimport Data.List.NonEmpty as NEL\nimport Data.List.Types (NonEmptyList, nelCons)\nimport Data.Map (Map)\nimport Data.Map as Map\nimport Data.Maybe (Maybe(..), fromMaybe, maybe)\nimport Data.Monoid (power)\nimport Data.Newtype (class Newtype, unwrap)\nimport Data.NonEmpty (NonEmpty(..))\nimport Data.Nullable (Nullable, notNull, null, toMaybe)\nimport Data.Set (Set)\nimport Data.Set as Set\nimport Data.Set.NonEmpty (NonEmptySet)\nimport Data.Set.NonEmpty as NonEmptySet\nimport Data.Show.Generic (genericShow)\nimport Data.String (CodePoint, codePointAt)\nimport Data.String as SCP\nimport Data.String.CodeUnits (charAt)\nimport Data.String.CodeUnits as SCU\nimport Data.String.NonEmpty.Internal (NonEmptyString(..))\nimport Data.String.NonEmpty.Internal as NonEmptyString\nimport Data.Symbol (class IsSymbol, reflectSymbol)\nimport Data.These (These(..), these)\nimport Data.Traversable (traverse)\nimport Data.TraversableWithIndex (traverseWithIndex)\nimport Data.Tuple (Tuple(..))\nimport Foreign.Object (Object)\nimport Foreign.Object as Object\nimport Partial.Unsafe (unsafeCrashWith)\nimport Prim.Coerce (class Coercible)\nimport Prim.Row as Row\nimport Prim.RowList (class RowToList, RowList)\nimport Prim.RowList as RL\nimport Prim.TypeError (class Fail, Above, Beside, Quote, Text)\nimport Record as Record\nimport Safe.Coerce (coerce)\nimport Type.Proxy (Proxy(..))\nimport Unsafe.Coerce (unsafeCoerce)\n\n-- | An error type that \n-- | - includes path-to-json information\n-- | - allows for custom decode messages\n-- | - can accumulate errors at the same path location\ndata DecodeError\n = AtKey String DecodeError\n | AtIndex Int DecodeError\n | DecodeError String\n -- | Stores a reversed list of errors that happened at the same path.\n -- | The error at `head` happened AFTER the errors in `tail`.\n | AccumulateError (NonEmptyList DecodeError)\n\nderive instance Eq DecodeError\nderive instance Generic DecodeError _\ninstance Show DecodeError where\n show x = genericShow x\n\n-- | Prefer to use `altAccumulate` or `altAccumulateLazy`.\n-- | The first error arg is assumed to have happened before the second error arg.\naccumulateErrors :: DecodeError -> DecodeError -> DecodeError\naccumulateErrors = case _, _ of\n AccumulateError first', next -> AccumulateError $ nelCons next first'\n first, next -> AccumulateError $ nelCons next $ NEL.singleton first\n\n-- | Pretty-prints the decode error over a multi-line string.\n-- | Assumes that all keys, hints, and decode error messages are single-line `String`s.\n-- | Indents using two spaces.\nprintDecodeError :: DecodeError -> String\nprintDecodeError = unsafePrintDecodeError true 1 \" \" \"ROOT\"\n\n-- | Unsafe because no checking is done on the `Int` arg to determine\n-- | if it's `>=1` nor whether `applyIndent` makes sense in the given context.\n-- |\n-- | Fully control whether we should apply the indent to the next line of content,\n-- | how much to indent each error in `AccumulateError`, and \n-- | what to use as a \"tab\"-like string sequence.\n-- | Assumes that all keys, hints, and decode error messages are single-line `String`s.\nunsafePrintDecodeError :: Boolean -> Int -> String -> String -> DecodeError -> String\nunsafePrintDecodeError applyIndent indent sep acc = case _ of\n DecodeError msg ->\n acc <> \" - \" <> msg\n AtKey k next ->\n unsafePrintDecodeError true indent sep (acc <> \".\" <> show k) next\n AtIndex i next ->\n unsafePrintDecodeError true indent sep (acc <> \"[\" <> show i <> \"]\") next\n AccumulateError ls\n | applyIndent -> do\n acc\n <> foldMap (unsafePrintDecodeError false (indent + 1) sep (\"\\n\" <> power sep indent)) ls\n | otherwise ->\n acc\n <> unsafePrintDecodeError false indent sep \"\" (NEL.head ls)\n <> foldMap (unsafePrintDecodeError false indent sep (\"\\n\" <> power sep (indent - 1))) (NEL.tail ls)\n\n-- | Tries the first codec. If it fails, tries the second codec. If it fails, \n-- | errors from both are accumulated. Succeeds if either of the two codecs succeed.\naltAccumulate :: forall a. (Json -> Either DecodeError a) -> (Json -> Either DecodeError a) -> Json -> Either DecodeError a\naltAccumulate f g j = case f j of\n x@(Right _) -> x\n (Left e1) -> case g j of\n x@(Right _) -> x\n Left e2 -> Left $ accumulateErrors e1 e2\n\n-- | Tries the first codec. If it fails, tries the second codec. If it fails, \n-- | errors from both are accumulated. Succeeds if either of the two codecs succeed.\naltAccumulateLazy :: forall a. Either DecodeError a -> (Unit -> Either DecodeError a) -> Either DecodeError a\naltAccumulateLazy f g = case f of\n x@(Right _) -> x\n (Left e1) -> case g unit of\n x@(Right _) -> x\n Left e2 -> Left $ accumulateErrors e1 e2\n\n-- | Indicates which values are primitive JSON values that can be encoded via `unsafeCoerce`.\nclass FromPrimitive :: Type -> Constraint\nclass FromPrimitive a where\n -- | Shortcut encoder for encoding primitive JSON values.\n fromPrimitive :: a -> Json\n\ninstance FromPrimitive Boolean where\n fromPrimitive = unsafeCoerce\nelse instance FromPrimitive Number where\n fromPrimitive = unsafeCoerce\nelse instance FromPrimitive String where\n fromPrimitive = unsafeCoerce\nelse instance fromPrimitiveArray :: FromPrimitive a => FromPrimitive (Array a) where\n fromPrimitive = unsafeCoerce\nelse instance fromPrimitiveObject :: FromPrimitive a => FromPrimitive (Object a) where\n fromPrimitive = unsafeCoerce\nelse instance fromPrimitiveRecord ::\n ( RowToList rows rl\n , AllPrimitive rl\n ) =>\n FromPrimitive { | rows } where\n fromPrimitive = unsafeCoerce\nelse instance fromPrimitiveFailure ::\n ( Fail (Beside (Text \"Expected a primitive JSON type but got type: \") (Quote a))\n ) =>\n FromPrimitive a where\n fromPrimitive _ = unsafeCrashWith \"Impossible\"\n\n-- | Utility class that distinguishes which records are primitive and which are not.\n-- | Used in `FromPrimitive`.\nclass AllPrimitive :: RL.RowList Type -> Constraint\nclass AllPrimitive rl\n\ninstance allPrimitiveNil :: AllPrimitive RL.Nil\ninstance allPrimitiveCons :: (AllPrimitive tail, FromPrimitive a) => AllPrimitive (RL.Cons sym a tail)\n\nfromVoid :: Void -> Json\nfromVoid = absurd\n\ntoVoid :: Json -> Either DecodeError Void\ntoVoid _ = Left $ DecodeError $ \"Decoding a value to Void is impossible\"\n\ncoerce1 :: forall n a. Coercible n a => (a -> n) -> Either DecodeError a -> Either DecodeError n\ncoerce1 _ = coerce\n\nfromJNull :: Json\nfromJNull = Json.jsonNull\n\nfromUnit :: Unit -> Json\nfromUnit = const fromJNull\n\nfromNull :: forall a. a -> Json\nfromNull = const fromJNull\n\ntoJNull :: Json -> Either DecodeError Unit\ntoJNull json =\n caseJson\n pure\n (\\_ -> Left $ DecodeError $ \"Expected a value of type Null but got Boolean\")\n (\\_ -> Left $ DecodeError $ \"Expected a value of type Null but got Number\")\n (\\_ -> Left $ DecodeError $ \"Expected a value of type Null but got String\")\n (\\_ -> Left $ DecodeError $ \"Expected a value of type Null but got Array\")\n (\\_ -> Left $ DecodeError $ \"Expected a value of type Null but got Object\")\n json\n\ntoNullDefaultOrA :: forall a. a -> (Json -> Either DecodeError a) -> Json -> Either DecodeError a\ntoNullDefaultOrA def f = altAccumulate (\\j -> def <$ toJNull j) f\n\nfromNullNothingOrJust :: forall a. (a -> Json) -> Maybe a -> Json\nfromNullNothingOrJust f = maybe Json.jsonNull f\n\ntoNullNothingOrJust :: forall a. (Json -> Either DecodeError a) -> Json -> Either DecodeError (Maybe a)\ntoNullNothingOrJust f = toNullDefaultOrA Nothing (map Just <$> f)\n\nfromNullable :: forall a. (a -> Json) -> Nullable a -> Json\nfromNullable fromA = toMaybe >>> fromNullNothingOrJust fromA\n\ntoNullable :: forall a. (Json -> Either DecodeError a) -> Json -> Either DecodeError (Nullable a)\ntoNullable toA = altAccumulate (\\j -> null <$ toJNull j) (\\j -> notNull <$> toA j)\n\nfromBoolean :: Boolean -> Json\nfromBoolean = Json.fromBoolean\n\ntoBoolean :: Json -> Either DecodeError Boolean\ntoBoolean json =\n caseJson\n (\\_ -> Left $ DecodeError $ \"Expected a value of type Boolean but got Null\")\n pure\n (\\_ -> Left $ DecodeError $ \"Expected a value of type Boolean but got Number\")\n (\\_ -> Left $ DecodeError $ \"Expected a value of type Boolean but got String\")\n (\\_ -> Left $ DecodeError $ \"Expected a value of type Boolean but got Array\")\n (\\_ -> Left $ DecodeError $ \"Expected a value of type Boolean but got Object\")\n json\n\nfromNumber :: Number -> Json\nfromNumber = Json.fromNumber\n\ntoNumber :: Json -> Either DecodeError Number\ntoNumber json =\n caseJson\n (\\_ -> Left $ DecodeError $ \"Expected a value of type Number but got Null\")\n (\\_ -> Left $ DecodeError $ \"Expected a value of type Number but got Boolean\")\n pure\n (\\_ -> Left $ DecodeError $ \"Expected a value of type Number but got String\")\n (\\_ -> Left $ DecodeError $ \"Expected a value of type Number but got Array\")\n (\\_ -> Left $ DecodeError $ \"Expected a value of type Number but got Object\")\n json\n\nfromInt :: Int -> Json\nfromInt = Int.toNumber >>> fromNumber\n\nfromString :: String -> Json\nfromString = Json.fromString\n\ntoInt :: Json -> Either DecodeError Int\ntoInt = toNumber >=> (\\n -> note (DecodeError \"Could not convert Number to Int\") $ Int.fromNumber n)\n\ntoString :: Json -> Either DecodeError String\ntoString json =\n caseJson\n (\\_ -> Left $ DecodeError $ \"Expected a value of type String but got Null\")\n (\\_ -> Left $ DecodeError $ \"Expected a value of type String but got Boolean\")\n (\\_ -> Left $ DecodeError $ \"Expected a value of type String but got Number\")\n pure\n (\\_ -> Left $ DecodeError $ \"Expected a value of type String but got Array\")\n (\\_ -> Left $ DecodeError $ \"Expected a value of type String but got Object\")\n json\n\nfromChar :: Char -> Json\nfromChar = SCU.singleton >>> fromString\n\ntoChar :: Json -> Either DecodeError Char\ntoChar = toString >=> (note (DecodeError \"Could not get char at index 0 in String\") <<< charAt 0)\n\nfromCodePoint :: CodePoint -> Json\nfromCodePoint = SCP.singleton >>> fromString\n\ntoCodePoint :: Json -> Either DecodeError CodePoint\ntoCodePoint = toString >=> (\\s -> note (DecodeError \"Could not get code point from String\") $ codePointAt 0 s)\n\nfromNonEmptyString :: NonEmptyString -> Json\nfromNonEmptyString (NonEmptyString s) = fromString s\n\ntoNonEmptyString :: Json -> Either DecodeError NonEmptyString\ntoNonEmptyString = toString >=> (note (DecodeError \"Received empty string\") <<< NonEmptyString.fromString)\n\nfromJArray :: Array Json -> Json\nfromJArray = Json.fromArray\n\ntoJArray :: Json -> Either DecodeError (Array Json)\ntoJArray json =\n caseJson\n (\\_ -> Left $ DecodeError $ \"Expected a value of type Array but got Null\")\n (\\_ -> Left $ DecodeError $ \"Expected a value of type Array but got Boolean\")\n (\\_ -> Left $ DecodeError $ \"Expected a value of type Array but got Number\")\n (\\_ -> Left $ DecodeError $ \"Expected a value of type Array but got String\")\n pure\n (\\_ -> Left $ DecodeError $ \"Expected a value of type Array but got Object\")\n json\n\nunderIndex :: forall a. Int -> (Json -> Either DecodeError a) -> Array Json -> Either DecodeError a\nunderIndex idx f arr = lmap (AtIndex idx) case Array.index arr idx of\n Nothing -> Left $ DecodeError \"Missing index\"\n Just j -> f j\n\nfromArray :: forall a. (a -> Json) -> Array a -> Json\nfromArray fromA = map fromA >>> fromJArray\n\ntoArray :: forall a. (Json -> Either DecodeError a) -> Json -> Either DecodeError (Array a)\ntoArray toElem = toJArray >=> traverseWithIndex (\\i j -> lmap (AtIndex i) $ toElem j)\n\nfromArray2 :: Json -> Json -> Json\nfromArray2 a b = fromJArray [ a, b ]\n\ntoArray2\n :: forall a b x\n . (Json -> Either DecodeError a)\n -> (Json -> Either DecodeError b)\n -> (a -> b -> x)\n -> Json\n -> Either DecodeError x\ntoArray2 a' b' x = toJArray >=> case _ of\n [ a, b ] ->\n x\n <$> (lmap (AtIndex 0) $ a' a)\n <*> (lmap (AtIndex 1) $ b' b)\n _ -> Left $ DecodeError \"Expected array of length 2\"\n\nfromArray3 :: Json -> Json -> Json -> Json\nfromArray3 a b c = fromJArray [ a, b, c ]\n\ntoArray3\n :: forall a b c x\n . (Json -> Either DecodeError a)\n -> (Json -> Either DecodeError b)\n -> (Json -> Either DecodeError c)\n -> (a -> b -> c -> x)\n -> Json\n -> Either DecodeError x\ntoArray3 a' b' c' x = toJArray >=> case _ of\n [ a, b, c ] ->\n x\n <$> (lmap (AtIndex 0) $ a' a)\n <*> (lmap (AtIndex 1) $ b' b)\n <*> (lmap (AtIndex 2) $ c' c)\n _ -> Left $ DecodeError \"Expected array of length 3\"\n\nfromArray4 :: Json -> Json -> Json -> Json -> Json\nfromArray4 a b c d = fromJArray [ a, b, c, d ]\n\ntoArray4\n :: forall a b c d x\n . (Json -> Either DecodeError a)\n -> (Json -> Either DecodeError b)\n -> (Json -> Either DecodeError c)\n -> (Json -> Either DecodeError d)\n -> (a -> b -> c -> d -> x)\n -> Json\n -> Either DecodeError x\ntoArray4 a' b' c' d' x = toJArray >=> case _ of\n [ a, b, c, d ] ->\n x\n <$> (lmap (AtIndex 0) $ a' a)\n <*> (lmap (AtIndex 1) $ b' b)\n <*> (lmap (AtIndex 2) $ c' c)\n <*> (lmap (AtIndex 3) $ d' d)\n _ -> Left $ DecodeError \"Expected array of length 4\"\n\nfromArray5 :: Json -> Json -> Json -> Json -> Json -> Json\nfromArray5 a b c d e = fromJArray [ a, b, c, d, e ]\n\ntoArray5\n :: forall a b c d e x\n . (Json -> Either DecodeError a)\n -> (Json -> Either DecodeError b)\n -> (Json -> Either DecodeError c)\n -> (Json -> Either DecodeError d)\n -> (Json -> Either DecodeError e)\n -> (a -> b -> c -> d -> e -> x)\n -> Json\n -> Either DecodeError x\ntoArray5 a' b' c' d' e' x = toJArray >=> case _ of\n [ a, b, c, d, e ] ->\n x\n <$> (lmap (AtIndex 0) $ a' a)\n <*> (lmap (AtIndex 1) $ b' b)\n <*> (lmap (AtIndex 2) $ c' c)\n <*> (lmap (AtIndex 3) $ d' d)\n <*> (lmap (AtIndex 4) $ e' e)\n _ -> Left $ DecodeError \"Expected array of length 5\"\n\nfromNonEmptyArray :: forall a. (a -> Json) -> NonEmptyArray a -> Json\nfromNonEmptyArray fromA = NEA.toArray >>> fromArray fromA\n\ntoNonEmptyArray :: forall a. (Json -> Either DecodeError a) -> Json -> Either DecodeError (NonEmptyArray a)\ntoNonEmptyArray toElem = toArray toElem >=> (note (DecodeError \"Received empty array\") <<< NEA.fromArray)\n\nfromJObject :: Object Json -> Json\nfromJObject = Json.fromObject\n\ntoJObject :: Json -> Either DecodeError (Object Json)\ntoJObject json =\n caseJson\n (\\_ -> Left $ DecodeError \"Expected a value of type Object but got Null\")\n (\\_ -> Left $ DecodeError \"Expected a value of type Object but got Boolean\")\n (\\_ -> Left $ DecodeError \"Expected a value of type Object but got Number\")\n (\\_ -> Left $ DecodeError \"Expected a value of type Object but got String\")\n (\\_ -> Left $ DecodeError \"Expected a value of type Object but got Array\")\n pure\n json\n\nunderKey :: forall a. String -> (Json -> Either DecodeError a) -> Object Json -> Either DecodeError a\nunderKey key f obj = lmap (AtKey key) case Object.lookup key obj of\n Nothing -> Left $ DecodeError \"Missing key\"\n Just j -> f j\n\nfromObject :: forall a. (a -> Json) -> Object a -> Json\nfromObject fromA = map fromA >>> fromJObject\n\ntoObject :: forall a. (Json -> Either DecodeError a) -> Json -> Either DecodeError (Object a)\ntoObject toElem = toJObject >=> traverseWithIndex (\\k j -> lmap (AtKey k) $ toElem j)\n\nfromObjSingleton :: String -> Json -> Json\nfromObjSingleton k v = fromJObject $ Object.singleton k v\n\ntoObjSingleton :: forall a. String -> (Json -> Either DecodeError a) -> Json -> Either DecodeError a\ntoObjSingleton k f = toJObject >=> (\\j -> underKey k f j)\n\nfromPropArray :: Array (Tuple String Json) -> Json\nfromPropArray = fromJObject <<< Array.foldl (\\acc (Tuple k v) -> Object.insert k v acc) Object.empty\n\nfromIdentity :: forall a. (a -> Json) -> Identity a -> Json\nfromIdentity fromA (Identity a) = fromA a\n\ntoIdentity :: forall a. (Json -> Either DecodeError a) -> Json -> Either DecodeError (Identity a)\ntoIdentity f = coerce f\n\nfromMaybeTagged :: forall a. (a -> Json) -> Maybe a -> Json\nfromMaybeTagged fromA =\n maybe (Object.singleton \"tag\" $ fromString \"Nothing\") (tagged \"Just\" <<< fromA)\n >>> fromJObject\n where\n tagged tag j = Object.fromFoldable [ Tuple \"tag\" $ fromString tag, Tuple \"value\" j ]\n\ntoMaybeTagged :: forall a. (Json -> Either DecodeError a) -> Json -> Either DecodeError (Maybe a)\ntoMaybeTagged toElem = toJObject >=> \\jo -> do\n tag <- jo # underKey \"tag\" toString\n case tag of\n \"Just\" -> (map Just <$> underKey \"value\" toElem) jo\n \"Nothing\" ->\n pure Nothing\n _ ->\n Left $ DecodeError \"Tag was not 'Just' or 'Nothing'.\"\n\nfromEitherTagged :: forall a b. (a -> Json) -> (b -> Json) -> Either a b -> Json\nfromEitherTagged fromA fromB =\n either (tagged \"Left\" <<< fromA) (tagged \"Right\" <<< fromB)\n >>> fromJObject\n where\n tagged tag j = Object.fromFoldable [ Tuple \"tag\" $ fromString tag, Tuple \"value\" j ]\n\ntoEitherTagged\n :: forall a b\n . (Json -> Either DecodeError a)\n -> (Json -> Either DecodeError b)\n -> Json\n -> Either DecodeError (Either a b)\ntoEitherTagged toLeft toRight = toJObject >=> \\jo -> do\n tag <- underKey \"tag\" toString jo\n case tag of\n \"Left\" -> Left <$> underKey \"value\" toLeft jo\n \"Right\" -> Right <$> underKey \"value\" toRight jo\n _ ->\n Left $ DecodeError \"Tag was not 'Left' or 'Right'\"\n\nfromEitherSingle :: forall a b. (a -> Json) -> (b -> Json) -> Either a b -> Json\nfromEitherSingle fromA fromB =\n either (fromObjSingleton \"Left\" <<< fromA) (fromObjSingleton \"Right\" <<< fromB)\n\ntoEitherSingle\n :: forall a b\n . (Json -> Either DecodeError a)\n -> (Json -> Either DecodeError b)\n -> Json\n -> Either DecodeError (Either a b)\ntoEitherSingle toLeft toRight =\n altAccumulate\n (toObjSingleton \"Left\" toLeft >>> map Left)\n (toObjSingleton \"Right\" toRight >>> map Right)\n\nfromTuple :: forall a b. (a -> Json) -> (b -> Json) -> Tuple a b -> Json\nfromTuple fromA fromB (Tuple a b) =\n fromJArray\n [ fromA a\n , fromB b\n ]\n\ntoTuple\n :: forall a b\n . (Json -> Either DecodeError a)\n -> (Json -> Either DecodeError b)\n -> Json\n -> Either DecodeError (Tuple a b)\ntoTuple toA toB =\n toArray2\n toA\n toB\n Tuple\n\nfromThese :: forall a b. (a -> Json) -> (b -> Json) -> These a b -> Json\nfromThese fromA fromB =\n these\n (tagged \"This\" <<< fromA)\n (tagged \"That\" <<< fromB)\n ( \\a b -> tagged \"Both\" $ fromJObject $ Object.fromFoldable\n [ Tuple \"this\" $ fromA a\n , Tuple \"that\" $ fromB b\n ]\n )\n >>> fromJObject\n where\n tagged tag j = Object.fromFoldable [ Tuple \"tag\" $ fromString tag, Tuple \"value\" j ]\n\ntoThese\n :: forall a b\n . (Json -> Either DecodeError a)\n -> (Json -> Either DecodeError b)\n -> Json\n -> Either DecodeError (These a b)\ntoThese toA toB = toJObject >=> \\jo -> do\n tag <- underKey \"tag\" toString jo\n case tag of\n \"This\" -> This <$> underKey \"value\" toA jo\n \"That\" -> That <$> underKey \"value\" toB jo\n \"Both\" ->\n Both\n <$> (underKey \"this\" toA jo)\n <*> (underKey \"that\" toB jo)\n _ ->\n Left $ DecodeError \"Tag was not 'This', 'That', or 'Both'\"\n\nfromNonEmpty :: forall f a. (a -> Json) -> (f a -> Json) -> NonEmpty f a -> Json\nfromNonEmpty fromHead fromTail (NonEmpty a fa) =\n fromJObject\n $ Object.fromFoldable\n [ Tuple \"head\" $ fromHead a\n , Tuple \"tail\" $ fromTail fa\n ]\n\ntoNonEmpty\n :: forall g a\n . (Json -> Either DecodeError a)\n -> (Json -> Either DecodeError (g a))\n -> (Json -> Either DecodeError (NonEmpty g a))\ntoNonEmpty toHead toTail = toJObject >=> \\jo ->\n NonEmpty\n <$> (underKey \"head\" toHead jo)\n <*> (underKey \"tail\" toTail jo)\n\nfromList :: forall a. (a -> Json) -> List a -> Json\nfromList fromA = List.foldl (\\arr -> Array.snoc arr <<< fromA) [] >>> fromJArray\n\ntoList\n :: forall a\n . (Json -> Either DecodeError a)\n -> Json\n -> Either DecodeError (List a)\ntoList toElem = toArray toElem >>> map List.fromFoldable\n\nfromNonEmptyList :: forall a. (a -> Json) -> (NonEmptyList a -> Json)\nfromNonEmptyList fromA = NEL.foldl (\\arr -> Array.snoc arr <<< fromA) [] >>> fromJArray\n\ntoNonEmptyList\n :: forall a\n . (Json -> Either DecodeError a)\n -> Json\n -> Either DecodeError (NonEmptyList a)\ntoNonEmptyList toA = toList toA >=> (note (DecodeError \"Received empty list\") <<< NEL.fromList)\n\nfromMap :: forall k v. (k -> Json) -> (v -> Json) -> Map k v -> Json\nfromMap fromKey fromValue =\n foldlWithIndex\n ( \\k acc v -> Array.snoc acc\n $ fromJObject\n $ Object.fromFoldable\n [ Tuple \"key\" $ fromKey k\n , Tuple \"value\" $ fromValue v\n ]\n )\n []\n >>> fromJArray\n\ntoMap\n :: forall k v\n . Ord k\n => (Json -> Either DecodeError k)\n -> (Json -> Either DecodeError v)\n -> Json\n -> Either DecodeError (Map k v)\ntoMap toKey toValue =\n toArray\n ( toJObject >=> \\jo ->\n ( Tuple\n <$> (underKey \"key\" toKey jo)\n <*> (underKey \"value\" toValue jo)\n )\n )\n >>> map Map.fromFoldable\n\nfromSet :: forall a. (a -> Json) -> Set a -> Json\nfromSet fromA = foldl (\\arr -> Array.snoc arr <<< fromA) [] >>> fromJArray\n\ntoSet\n :: forall a\n . Ord a\n => (Json -> Either DecodeError a)\n -> Json\n -> Either DecodeError (Set a)\ntoSet toA = toArray toA >>> map Set.fromFoldable\n\nfromNonEmptySet :: forall a. (a -> Json) -> NonEmptySet a -> Json\nfromNonEmptySet fromA = NonEmptySet.toSet >>> fromSet fromA\n\ntoNonEmptySet\n :: forall a\n . Ord a\n => (Json -> Either DecodeError a)\n -> Json\n -> Either DecodeError (NonEmptySet a)\ntoNonEmptySet toA = toArray toA >=> (note (DecodeError \"Received empty set\") <<< NonEmptySet.fromSet <<< Set.fromFoldable)\n\n-- | All labels must have a value of type `FromProp a`,\n-- | which can be obtained via functions like `fromRequired*` and `fromOption*`\n-- | or by defining a value yourself. Otherwise, you will get a compiler error:\n-- |\n-- | ```\n-- | fromRecord\n-- | { label: fromRequired $ fromInt \n-- | , psName: fromRequiredRename \"jsonName\" fromInt\n-- | , optionalDisappears: fromOption $ fromInt\n-- | , optionalStillThere: fromOption $ fromInt\n-- | }\n-- | { label: 1\n-- | , psName: Just 2\n-- | , optionalDisappears: Nothing\n-- | , optionalStillThere: Just 3\n-- | }\n-- | ```\n-- | produces the following JSON\n-- | ```\n-- | { \"label\": 1\n-- | , \"jsonName\": 2\n-- | , \"optionalStillThere\": 3\n-- | }\n-- | ```\nfromRecord\n :: forall codecs values codecsRL\n . RowToList codecs codecsRL\n => FromRecordPropArray codecsRL { | codecs } { | values }\n => { | codecs }\n -> { | values }\n -> Json\nfromRecord codecs values =\n fromRecordPropArray (Proxy :: Proxy codecsRL) codecs values\n # Array.sortBy (\\l r -> compare l.insertionOrder r.insertionOrder <> compare l.key r.key)\n # flip foldl Object.empty (\\acc r -> Object.insert r.key r.value acc)\n # fromJObject\n\n-- | All labels must have a value of type `ToProp a`,\n-- | which can be obtained via functions like `toRequired*` and `toOption*`\n-- | or by defining a value yourself. Otherwise, you will get a compiler error:\n-- |\n-- | The following JSON and codec...\n-- | ```\n-- | toRecord\n-- | { label: toRequired toInt \n-- | , psName: toRequiredRename \"jsonName\" toInt\n-- | , optionalAppears: toOption toInt\n-- | , optionalAlwaysThere: toOption toInt\n-- | }\n-- | $ either (\\_ -> unsafeCrashWith \"error\") identity\n-- | $ jsonParser\n-- | \"\"\"{ \"label\": 1\n-- | , \"jsonName\": 2\n-- | , \"optionalAlwaysThere\": 3\n-- | }\"\"\"\n-- | ```\n-- | ...produces the following value\n-- | ```\n-- | { label: 1\n-- | , psName: Just 2\n-- | , optionalAppears: Nothing\n-- | , optionalAlwaysThere: Just 3\n-- | }\n-- | ```\ntoRecord\n :: forall codecs values codecsRL\n . RowToList codecs codecsRL\n => ToRecordObj codecsRL { | codecs } { | values }\n => { | codecs }\n -> Json\n -> Either DecodeError { | values }\ntoRecord codecs = toJObject >=>\n toRecordObj (Proxy :: Proxy codecsRL) codecs\n\n-- | Same as `fromRecord` but handles the Newtype for you\n-- | so you don't need to add a type annotation to help\n-- | type inference.\nfromRecordN\n :: forall n codecs values codecsRL\n . RowToList codecs codecsRL\n => FromRecordPropArray codecsRL { | codecs } { | values }\n => Newtype n { | values }\n => ({ | values } -> n)\n -> { | codecs }\n -> n\n -> Json\nfromRecordN _ codecs = unwrap >>> fromRecord codecs\n\n-- | Same as `toRecord` but handles the Newtype for you.\ntoRecordN\n :: forall n codecs values codecsRL\n . RowToList codecs codecsRL\n => ToRecordObj codecsRL { | codecs } { | values }\n => Newtype n { | values }\n => ({ | values } -> n)\n -> { | codecs }\n -> Json\n -> Either DecodeError n\ntoRecordN f codecs = coerce1 f <<< toRecord codecs\n\n-- | Converts a value in a JSON object into a value\n-- | associated with the record label.\n-- |\n-- | Explanation of arguments\n-- | - `String -> Maybe Json`: Looks up the provided key in the object. Implemented via `\\str -> Object.lookup str obj`\n-- | - `String` -> the label of the record\nnewtype ToProp a = ToProp (Fn2 (String -> Maybe Json) String (Either DecodeError a))\n\n-- | Converts a value associated with the record label\n-- | into a JSON value associated with the given label in the JSON object.\n-- |\n-- | On `Nothing`, the key-value pair is not added to the JSON object.\n-- | On `Just`, both the JSON-encoded value and the key to use in the JSON object is provided.\n-- | - `key`: on `Nothing`, the label associated with the record is used; on `Just`, the provided key is used\n-- | - `insertionOrder`: controls the order of the keys' appearance in the JSON object with\n-- | lower values (e.g. 1) appearing before larger values (e.g. 100). When order is the same,\n-- | reverts to alphabetical ordering. Key order is computed via `fromMaybe top insertionOrder`.\n-- | - `value`: the JSON value to use for the key\nnewtype FromProp a = FromProp (a -> Maybe { key :: Maybe String, insertionOrder :: Maybe Int, value :: Json })\n\ntoStatic :: forall a. a -> ToProp a\ntoStatic a = ToProp $ mkFn2 \\_ _ -> pure a\n\nfromRequired :: forall a. (a -> Json) -> FromProp a\nfromRequired f = FromProp $ (Just <<< { key: Nothing, insertionOrder: Nothing, value: _ }) <$> f\n\nfromRequired' :: forall a. Int -> (a -> Json) -> FromProp a\nfromRequired' order f = FromProp $ (Just <<< { key: Nothing, insertionOrder: Just order, value: _ }) <$> f\n\ntoRequired :: forall a. (Json -> Either DecodeError a) -> ToProp a\ntoRequired f = ToProp $ mkFn2 \\lookupFn recLabel ->\n lmap (AtKey recLabel) case lookupFn recLabel of\n Nothing -> Left $ DecodeError $ \"Missing field\"\n Just j' -> f j'\n\nfromRequiredRename :: forall a. String -> (a -> Json) -> FromProp a\nfromRequiredRename str f = FromProp $ (Just <<< { key: Just str, insertionOrder: Nothing, value: _ }) <$> f\n\nfromRequiredRename' :: forall a. Int -> String -> (a -> Json) -> FromProp a\nfromRequiredRename' order str f = FromProp $ (Just <<< { key: Just str, insertionOrder: Just order, value: _ }) <$> f\n\ntoRequiredRename :: forall a. String -> (Json -> Either DecodeError a) -> ToProp a\ntoRequiredRename jsonLbl f = ToProp $ mkFn2 \\lookupFn _ ->\n lmap (AtKey jsonLbl) case lookupFn jsonLbl of\n Nothing -> Left $ DecodeError \"Missing field\"\n Just j' -> f j'\n\n-- | If Nothing, does not add the coressponding key\n-- | If Just, adds the key and the encoded value to the JObject\nfromOption :: forall a. (a -> Json) -> FromProp (Maybe a)\nfromOption f = FromProp $ map ({ key: Nothing, insertionOrder: Nothing, value: _ } <<< f)\n\nfromOption' :: forall a. Int -> (a -> Json) -> FromProp (Maybe a)\nfromOption' order f = FromProp $ map ({ key: Nothing, insertionOrder: Just order, value: _ } <<< f)\n\n-- | Succeeds with Nothing if key wasn't found or with Just if key was found and value was succesfully tod.\ntoOption :: forall a. (Json -> Either DecodeError a) -> ToProp (Maybe a)\ntoOption f = toOptionDefault Nothing (map Just <$> f)\n\nfromOptionRename :: forall a. String -> (a -> Json) -> FromProp (Maybe a)\nfromOptionRename str f = FromProp $ map ({ key: Just str, insertionOrder: Nothing, value: _ } <<< f)\n\nfromOptionRename' :: forall a. Int -> String -> (a -> Json) -> FromProp (Maybe a)\nfromOptionRename' order str f = FromProp $ map ({ key: Just str, insertionOrder: Just order, value: _ } <<< f)\n\ntoOptionRename :: forall a. String -> (Json -> Either DecodeError a) -> ToProp (Maybe a)\ntoOptionRename rename f = toOptionDefaultRename rename Nothing (map Just <$> f)\n\ntoOptionDefault :: forall a. a -> (Json -> Either DecodeError a) -> ToProp a\ntoOptionDefault a f = ToProp $ mkFn2 \\lookupFn recLabel ->\n case lookupFn recLabel of\n Nothing -> pure a\n Just j' -> lmap (AtKey recLabel) $ f j'\n\ntoOptionDefaultRename :: forall a. String -> a -> (Json -> Either DecodeError a) -> ToProp a\ntoOptionDefaultRename jsonLbl a f = ToProp $ mkFn2 \\lookupFn _ ->\n case lookupFn jsonLbl of\n Nothing -> pure a\n Just j' -> lmap (AtKey jsonLbl) $ f j'\n\nfromOptionArray :: forall a. (a -> Json) -> FromProp (Array a)\nfromOptionArray f = FromProp $ \\arr ->\n if Array.length arr == 0 then Nothing\n else Just $ { key: Nothing, insertionOrder: Nothing, value: _ } $ fromArray f arr\n\nfromOptionArray' :: forall a. Int -> (a -> Json) -> FromProp (Array a)\nfromOptionArray' order f = FromProp $ \\arr ->\n if Array.length arr == 0 then Nothing\n else Just $ { key: Nothing, insertionOrder: Just order, value: _ } $ fromArray f arr\n\ntoOptionArray :: forall a. (Json -> Either DecodeError a) -> ToProp (Array a)\ntoOptionArray f = ToProp $ mkFn2 \\lookupFn recLabel ->\n case lookupFn recLabel of\n Nothing -> pure []\n Just j' -> lmap (AtKey recLabel) $ toArray f j'\n\nfromOptionAssocArray :: forall a b. (a -> String) -> (b -> Json) -> FromProp (Array (Tuple a b))\nfromOptionAssocArray k' v' = FromProp $ \\arr ->\n if Array.length arr == 0 then Nothing\n else Just $ { key: Nothing, insertionOrder: Nothing, value: _ } $ Json.fromObject $ Array.foldl (\\acc (Tuple k v) -> Object.insert (k' k) (v' v) acc) Object.empty arr\n\nfromOptionAssocArray' :: forall a b. Int -> (a -> String) -> (b -> Json) -> FromProp (Array (Tuple a b))\nfromOptionAssocArray' order k' v' = FromProp $ \\arr ->\n if Array.length arr == 0 then Nothing\n else Just $ { key: Nothing, insertionOrder: Just order, value: _ } $ Json.fromObject $ Array.foldl (\\acc (Tuple k v) -> Object.insert (k' k) (v' v) acc) Object.empty arr\n\ntoOptionAssocArray :: forall a b. (String -> Either DecodeError a) -> (Json -> Either DecodeError b) -> ToProp (Array (Tuple a b))\ntoOptionAssocArray k' v' = ToProp $ mkFn2 \\lookupFn recLabel ->\n case lookupFn recLabel of\n Nothing -> pure []\n Just j' -> lmap (AtKey recLabel) $\n ( (Object.toUnfoldable <$> toJObject j') >>= traverse \\(Tuple k v) ->\n lmap (AtKey k) do\n Tuple\n <$>\n ( k' k # lmap case _ of\n DecodeError err -> DecodeError $ \"while decoding the key \" <> show k <> \" - \" <> err\n x -> x\n )\n <*> v' v\n )\n\nclass ToRecordObj :: RowList Type -> Type -> Type -> Constraint\nclass ToRecordObj codecsRL codecs values | codecsRL -> codecs values where\n toRecordObj :: Proxy codecsRL -> codecs -> Object Json -> Either DecodeError values\n\ninstance toRecordObjNil :: ToRecordObj RL.Nil {} {} where\n toRecordObj _ _ _ = pure {}\n\ninstance toRecordObjCons ::\n ( ToRecordObj codecTail { | cRest } { | vRest }\n , IsSymbol sym\n , Row.Cons sym (ToProp a) cRest codecs\n , Row.Cons sym a vRest values\n , Row.Lacks sym vRest\n ) =>\n ToRecordObj (RL.Cons sym (ToProp a) codecTail) { | codecs } { | values } where\n toRecordObj _ codecs j = do\n rec <- onLeft (toRecordObj (Proxy :: Proxy codecTail) codecsRest j) \\e1 ->\n case runFn2 decoder (\\k -> Object.lookup k j) lbl of\n Left e2 -> Left $ accumulateErrors e1 e2\n _ -> Left e1\n a <- runFn2 decoder (\\k -> Object.lookup k j) lbl\n pure $ Record.insert _lbl a rec\n where\n onLeft :: forall e x. Either e x -> (e -> Either e x) -> Either e x\n onLeft l f = case l of\n Left l' -> f l'\n x@(Right _) -> x\n lbl = reflectSymbol _lbl\n _lbl = (Proxy :: Proxy sym)\n (ToProp decoder) = Record.get _lbl codecs\n\n codecsRest :: { | cRest }\n codecsRest = unsafeCoerce codecs\nelse instance toRecordObjFailure ::\n ( Fail\n ( Above\n (Beside (Beside (Text \"Expected 'ToProp a' for label '\") (Text sym)) (Beside (Text \"' but got type: \") (Quote a)))\n ( Above (Text \"\")\n (Text \"User likely forgot to supply an additional argument or is not using `toRequired*`/`toOption*` variants.\")\n )\n )\n ) =>\n ToRecordObj (RL.Cons sym a codecTail) { | codecs } { | values } where\n toRecordObj _ _ _ = unsafeCrashWith \"Impossible\"\n\nclass FromRecordPropArray :: RowList Type -> Type -> Type -> Constraint\nclass FromRecordPropArray codecsRL codecs values | codecsRL -> codecs values where\n fromRecordPropArray :: Proxy codecsRL -> codecs -> values -> Array { key :: String, insertionOrder :: Int, value :: Json }\n\ninstance fromRecordPropArrayNil :: FromRecordPropArray RL.Nil {} {} where\n fromRecordPropArray _ _ _ = []\n\ninstance fromRecordPropArrayCons ::\n ( FromRecordPropArray codecTail { | cRest } { | vRest }\n , IsSymbol sym\n , Row.Cons sym (FromProp a) cRest codecs\n , Row.Cons sym a vRest values\n ) =>\n FromRecordPropArray (RL.Cons sym (FromProp a) codecTail) { | codecs } { | values } where\n fromRecordPropArray _ codecs values = do\n let arr = fromRecordPropArray (Proxy :: Proxy codecTail) cRest vRest\n case encoder a' of\n Nothing -> arr\n Just r -> Array.cons { key: fromMaybe lbl r.key, insertionOrder: fromMaybe top r.insertionOrder, value: r.value } arr\n where\n lbl = reflectSymbol _lbl\n _lbl = (Proxy :: Proxy sym)\n (FromProp encoder) = Record.get _lbl codecs\n a' = Record.get _lbl values\n cRest = unsafeCoerce codecs\n vRest = unsafeCoerce values\nelse instance fromRecordPropArrayFailure ::\n ( Fail\n ( Above\n (Beside (Beside (Text \"Expected 'FromProp a' for label '\") (Text sym)) (Beside (Text \"' but got type: \") (Quote a)))\n ( Above (Text \"\")\n (Text \"User likely forgot to supply an additional argument or is not using `fromRequired*`/`fromOption*` variants.\")\n )\n )\n ) =>\n FromRecordPropArray (RL.Cons sym a codecTail) { | codecs } { | values } where\n fromRecordPropArray _ _ _ = unsafeCrashWith \"Impossible\"\n", "-- | Utilities to interop between different codec libraries\nmodule Docs.Search.JsonCodec\n ( fromUni\n , inject\n ) where\n\nimport Prelude\n\nimport Codec.JSON.DecodeError as CJ\nimport Codec.JSON.DecodeError as CJ.DecodeError\nimport Codec.Json.Unidirectional.Value (DecodeError, printDecodeError)\nimport Control.Monad.Except (Except, except)\nimport Data.Argonaut.Core (Json)\nimport Data.Bifunctor (lmap)\nimport Data.Either (Either)\nimport Data.Symbol (class IsSymbol)\nimport Data.Variant (Variant, inj)\nimport JSON (JSON)\nimport Prim.Row (class Cons)\nimport Type.Proxy (Proxy(..))\nimport Unsafe.Coerce (unsafeCoerce)\n\n-- | Equivalent to `Data.Variant.inj`, just uses a Visible Type Application instead of Proxy\n-- | Useful for deriving codecs for sum types\ninject :: forall @sym a r1 r2. Cons sym a r1 r2 => IsSymbol sym => a -> Variant r2\ninject = inj (Proxy @sym)\n\nfromUni\n :: forall a\n . (Json -> Either DecodeError a)\n -> (JSON -> Except CJ.DecodeError a)\nfromUni fn = except <<< lmap convertError <<< (fn <<< toArgonaut)\n where\n convertError :: DecodeError -> CJ.DecodeError\n convertError = printDecodeError >>> CJ.DecodeError.basic\n\n toArgonaut :: JSON -> Json\n toArgonaut = unsafeCoerce\n", "module Language.PureScript.AST.SourcePos where\n\nimport Prelude\n\nimport Codec.Json.Unidirectional.Value (fromArray, fromArray2, fromRecordN, fromRequired, toArray, toArray2, toInt, toRecordN, toRequired, toString)\nimport Codec.Json.Unidirectional.Value as Json\nimport Data.Argonaut.Core (Json)\nimport Data.Either (Either)\nimport Data.Generic.Rep (class Generic)\nimport Data.Newtype (class Newtype)\nimport Data.Show.Generic (genericShow)\nimport Language.PureScript.Comments (Comment, fromComment, toComment)\n\n-- | Source annotation - position information and comments.\nnewtype SourceAnn = SourceAnn\n { span :: SourceSpan\n , comments :: Array Comment\n }\n\nderive instance Eq SourceAnn\nderive instance Newtype SourceAnn _\nderive instance Generic SourceAnn _\ninstance Show SourceAnn where\n show x = genericShow x\n\nfromSourceAnn :: SourceAnn -> Json\nfromSourceAnn (SourceAnn { span, comments }) =\n fromArray2 (fromSourceSpan span) (fromArray fromComment comments)\n\ntoSourceAnn :: Json -> Either Json.DecodeError SourceAnn\ntoSourceAnn =\n toArray2 toSourceSpan (toArray toComment) \\span comments ->\n SourceAnn { span, comments }\n\n-- | Source position information\nnewtype SourcePos = SourcePos\n { line :: Int\n , column :: Int\n }\n\nderive instance Eq SourcePos\nderive instance Ord SourcePos\nderive instance Newtype SourcePos _\nderive instance Generic SourcePos _\ninstance Show SourcePos where\n show x = genericShow x\n\nfromSourcePos :: SourcePos -> Json\nfromSourcePos (SourcePos { line, column }) =\n fromArray2 (Json.fromInt line) (Json.fromInt column)\n\ntoSourcePos :: Json -> Either Json.DecodeError SourcePos\ntoSourcePos = toArray2 toInt toInt \\line column ->\n SourcePos { line, column }\n\nnewtype SourceSpan = SourceSpan\n { name :: String\n , start :: SourcePos\n , end :: SourcePos\n }\n\nderive instance Eq SourceSpan\nderive instance Ord SourceSpan\nderive instance Newtype SourceSpan _\nderive instance Generic SourceSpan _\ninstance Show SourceSpan where\n show x = genericShow x\n\nfromSourceSpan :: SourceSpan -> Json\nfromSourceSpan = fromRecordN SourceSpan\n { name: fromRequired Json.fromString\n , start: fromRequired fromSourcePos\n , end: fromRequired fromSourcePos\n }\n\ntoSourceSpan :: Json -> Either Json.DecodeError SourceSpan\ntoSourceSpan = toRecordN SourceSpan\n { name: toRequired toString\n , start: toRequired toSourcePos\n , end: toRequired toSourcePos\n }\n\nnullSourcePos :: SourcePos\nnullSourcePos = SourcePos { line: 0, column: 0 }\n\nnullSourceSpan :: SourceSpan\nnullSourceSpan = SourceSpan { name: \"\", start: nullSourcePos, end: nullSourcePos }\n\nnullSourceAnn :: SourceAnn\nnullSourceAnn = SourceAnn { span: nullSourceSpan, comments: [] }\n", "module Language.PureScript.Names where\n\nimport Prelude\n\nimport Codec.Json.Unidirectional.Value as Json\nimport Data.Argonaut.Core (Json)\nimport Data.Array as Array\nimport Data.Either (Either)\nimport Data.Generic.Rep (class Generic)\nimport Data.Maybe (Maybe)\nimport Data.Newtype (class Newtype, unwrap, wrap)\nimport Data.Show.Generic (genericShow)\nimport Data.String (Pattern(..))\nimport Data.String as String\nimport Data.Traversable (class Foldable, class Traversable)\nimport Language.PureScript.AST.SourcePos (SourcePos(..), toSourcePos, fromSourcePos)\nimport Safe.Coerce (coerce)\n\ndata Name\n = IdentName Ident\n | ValOpName (OpName ValueOpName)\n | TyName (ProperName TypeName)\n | TyOpName (OpName TypeOpName)\n | DctorName (ProperName ConstructorName)\n | TyClassName (ProperName ClassName)\n | ModName ModuleName\n\nderive instance Eq Name\nderive instance Ord Name\nderive instance Generic Name _\ninstance Show Name where\n show x = genericShow x\n\n-- | This type is meant to be extended with any new uses for idents that come\n-- | along. Adding constructors to this type is cheaper than adding them to\n-- | `Ident` because functions that match on `Ident` can ignore all\n-- | `InternalIdent`s with a single pattern, and thus don't have to change if\n-- | a new `InternalIdentData` constructor is created.\ndata InternalIdentData\n -- Used by CoreFn.Laziness\n = RuntimeLazyFactory\n | Lazy String\n\nderive instance Eq InternalIdentData\nderive instance Ord InternalIdentData\nderive instance Generic InternalIdentData _\ninstance Show InternalIdentData where\n show x = genericShow x\n\nfromInternalIdentData :: InternalIdentData -> Json\nfromInternalIdentData = case _ of\n RuntimeLazyFactory -> Json.fromObjSingleton \"RuntimeLazyFactory\" Json.fromJNull\n Lazy str -> Json.fromObjSingleton \"Lazy\" (Json.fromString str)\n\ntoInternalIdentData :: Json -> Either Json.DecodeError InternalIdentData\ntoInternalIdentData = Json.altAccumulate runtimeLazy lazyStr\n where\n runtimeLazy = Json.toObjSingleton \"RuntimeLazyFactory\" (const $ pure RuntimeLazyFactory)\n lazyStr = Json.toObjSingleton \"Lazy\" (Json.toString >>> map Lazy)\n\n-- | Names for value identifiers\ndata Ident\n -- | An alphanumeric identifier\n = Ident String\n -- | A generated name for an identifier\n | GenIdent (Maybe String) Int\n -- | A generated name used only for type-checking\n | UnusedIdent\n -- | A generated name used only for internal transformations\n | InternalIdent InternalIdentData\n\nderive instance Eq Ident\nderive instance Ord Ident\nderive instance Generic Ident _\ninstance Show Ident where\n show x = genericShow x\n\nfromIdent :: Ident -> Json\nfromIdent = case _ of\n Ident str -> Json.fromObjSingleton \"Ident\" $ Json.fromString str\n GenIdent mbStr i -> Json.fromObjSingleton \"GenIdent\"\n $ Json.fromArray2 (Json.fromNullNothingOrJust Json.fromString mbStr) (Json.fromInt i)\n UnusedIdent -> Json.fromObjSingleton \"UnusedIdent\" Json.fromJNull\n InternalIdent iid -> Json.fromObjSingleton \"InternalIdent\" $ fromInternalIdentData iid\n\ntoIdent :: Json -> Either Json.DecodeError Ident\ntoIdent = ((jIdent `Json.altAccumulate` jGenIdent) `Json.altAccumulate` jUnusedIdent) `Json.altAccumulate` jInternalIdent\n where\n jIdent = Json.toObjSingleton \"Ident\" (Json.toString >>> map Ident)\n jGenIdent = Json.toObjSingleton \"GenIdent\" (Json.toArray2 (Json.toNullNothingOrJust Json.toString) Json.toInt GenIdent)\n jUnusedIdent = Json.toObjSingleton \"UnusedIdent\" (const $ pure UnusedIdent)\n jInternalIdent = Json.toObjSingleton \"InternalIdent\" (toInternalIdentData >>> map InternalIdent)\n\n-- | Operator alias names.\nnewtype OpName :: OpNameType -> Type\nnewtype OpName a = OpName String\n\nderive instance Eq (OpName a)\nderive instance Ord (OpName a)\nderive instance Newtype (OpName a) _\nderive instance Generic (OpName a) _\ninstance Show (OpName a) where\n show x = genericShow x\n\nfromOpName :: forall a. OpName a -> Json\nfromOpName = unwrap >>> Json.fromString\n\ntoOpName :: forall a. Json -> Either Json.DecodeError (OpName a)\ntoOpName = Json.toString >>> coerce\n\ndata OpNameType\n\nforeign import data ValueOpName :: OpNameType\nforeign import data TypeOpName :: OpNameType\nforeign import data AnyOpName :: OpNameType\n\n-- | Proper names, i.e. capitalized names for e.g. module names, type/data constructors.\nnewtype ProperName :: ProperNameType -> Type\nnewtype ProperName a = ProperName String\n\nderive instance Eq (ProperName a)\nderive instance Ord (ProperName a)\nderive instance Newtype (ProperName a) _\nderive instance Generic (ProperName a) _\n\ninstance Show (ProperName a) where\n show x = genericShow x\n\nfromProperName :: forall a. ProperName a -> Json\nfromProperName = unwrap >>> Json.fromString\n\ntoProperName :: forall a. Json -> Either Json.DecodeError (ProperName a)\ntoProperName = Json.toString >>> coerce\n\ndata ProperNameType\n\nforeign import data TypeName :: ProperNameType\nforeign import data ConstructorName :: ProperNameType\nforeign import data ClassName :: ProperNameType\nforeign import data Namespace :: ProperNameType\n\nnewtype ModuleName = ModuleName String\n\nderive instance Eq ModuleName\nderive instance Ord ModuleName\nderive instance Newtype ModuleName _\nderive instance Generic ModuleName _\ninstance Show ModuleName where\n show x = genericShow x\n\nfromModuleName :: ModuleName -> Json\nfromModuleName = unwrap >>> String.split (Pattern \".\") >>> Json.fromArray Json.fromString\n\ntoModuleName :: Json -> Either Json.DecodeError ModuleName\ntoModuleName = Json.toArray Json.toString >>> map (Array.intercalate \".\" >>> wrap)\n\ndata QualifiedBy\n = BySourcePos SourcePos\n | ByModuleName ModuleName\n\nderive instance Eq QualifiedBy\nderive instance Ord QualifiedBy\nderive instance Generic QualifiedBy _\ninstance Show QualifiedBy where\n show x = genericShow x\n\nbyNullSourcePos :: QualifiedBy\nbyNullSourcePos = BySourcePos (SourcePos { line: 0, column: 0 })\n\n-- | Note: this instance isn't defined in the PureScript compiler.\n-- | as it appears within the instance of `Qualified a`.\nfromQualifiedBy :: QualifiedBy -> Json\nfromQualifiedBy = case _ of\n ByModuleName mn -> fromModuleName mn\n BySourcePos ss -> fromSourcePos ss\n\n-- | Note: this instance isn't defined in the PureScript compiler.\n-- | as it appears within the instance of `Qualified a`.\ntoQualifiedBy :: Json -> Either Json.DecodeError QualifiedBy\ntoQualifiedBy = (byModule `Json.altAccumulate` bySourcePos) `Json.altAccumulate` byMaybeModuleName\n where\n byModule j = ByModuleName <$> toModuleName j\n bySourcePos j = BySourcePos <$> toSourcePos j\n byMaybeModuleName = Json.toNullDefaultOrA byNullSourcePos byModule\n\n-- |\n-- A qualified name, i.e. a name with an optional module name\n--\ndata Qualified a = Qualified QualifiedBy a\n\nderive instance Eq a => Eq (Qualified a)\nderive instance Ord a => Ord (Qualified a)\nderive instance Generic (Qualified a) _\ninstance Show a => Show (Qualified a) where\n show x = genericShow x\n\nderive instance Functor Qualified\nderive instance Foldable Qualified\nderive instance Traversable Qualified\n\nfromQualified :: forall a. (a -> Json) -> Qualified a -> Json\nfromQualified f (Qualified by a) = Json.fromArray2 (fromQualifiedBy by) (f a)\n\ntoQualified :: forall a. (Json -> Either Json.DecodeError a) -> Json -> Either Json.DecodeError (Qualified a)\ntoQualified f = Json.toArray2 toQualifiedBy f Qualified\n", "module Web.Bower.PackageMeta where\n\nimport Prelude\n\nimport Codec.Json.Unidirectional.Value (DecodeError(..), FromProp(..), fromOption, fromOptionArray, fromOptionAssocArray, fromRecordN, fromRequired, toBoolean, toOption, toOptionArray, toOptionAssocArray, toOptionDefault, toRecordN, toRequired, toString)\nimport Codec.Json.Unidirectional.Value as Json\nimport Control.Alt ((<|>))\nimport Data.Argonaut.Core (Json)\nimport Data.Array as Array\nimport Data.Bounded.Generic (genericBottom, genericTop)\nimport Data.CodePoint.Unicode (isAscii, isDecDigit, isLower)\nimport Data.Either (Either, note)\nimport Data.Enum (class BoundedEnum, class Enum, enumFromTo)\nimport Data.Enum.Generic (genericCardinality, genericFromEnum, genericPred, genericSucc, genericToEnum)\nimport Data.Foldable (foldr, traverse_)\nimport Data.Generic.Rep (class Generic)\nimport Data.List (List(..))\nimport Data.List as List\nimport Data.Map (Map)\nimport Data.Map as Map\nimport Data.Maybe (Maybe(..), maybe)\nimport Data.Newtype (class Newtype, unwrap)\nimport Data.Show.Generic (genericShow)\nimport Data.String (CodePoint, Pattern(..), fromCodePointArray, toCodePointArray)\nimport Data.String as String\nimport Data.Tuple (Tuple(..))\nimport Safe.Coerce (coerce)\n\n---------------------\n-- Data types\n\n-- | A data type representing the data stored in a bower.json package manifest\n-- file.\n--\n-- Note that the 'fromencode' / 'fromFrom' instances don't exactly match; for\n-- example, it is not always the case that decoding from Json and then encoding\n-- to Json will give you the exact same Json that you started with. However, if\n-- you start with a PackageMeta value, encode to Json, and then decode, you\n-- should always get the same value back.\nnewtype PackageMeta = PackageMeta\n { name :: PackageName\n , description :: Maybe String\n , main :: Array String\n , moduleType :: Array ModuleType\n , licence :: Array String\n , ignore :: Array String\n , keywords :: Array String\n , authors :: Array Author\n , homepage :: Maybe String\n , repository :: Maybe Repository\n , dependencies :: Array (Tuple PackageName VersionRange)\n , devDependencies :: Array (Tuple PackageName VersionRange)\n , resolutions :: Array (Tuple PackageName Version)\n , private :: Boolean\n }\n\nderive instance Eq PackageMeta\nderive instance Ord PackageMeta\nderive instance Newtype PackageMeta _\nderive instance Generic PackageMeta _\ninstance Show PackageMeta where\n show x = genericShow x\n\nfromPackageMeta :: PackageMeta -> Json\nfromPackageMeta = fromRecordN PackageMeta\n { name: fromRequired fromPackageName\n , description: fromOption Json.fromString\n , main: fromOptionArray Json.fromString\n , moduleType: fromOptionArray fromModuleType\n , licence: fromOptionArray Json.fromString\n , ignore: fromOptionArray Json.fromString\n , keywords: fromOptionArray Json.fromString\n , authors: fromOptionArray fromAuthor\n , homepage: fromOption Json.fromString\n , repository: fromOption fromRepository\n , dependencies: fromOptionAssocArray unwrap fromVersionRange\n , devDependencies: fromOptionAssocArray unwrap fromVersionRange\n , resolutions: fromOptionAssocArray unwrap fromVersion\n , private: FromProp \\b ->\n if b then Just { key: Nothing, insertionOrder: Nothing, value: Json.fromBoolean b } else Nothing\n }\n\ntoPackageMeta :: Json -> Either Json.DecodeError PackageMeta\ntoPackageMeta =\n toRecordN PackageMeta\n { name: toRequired toPackageName\n , description: toOption toString\n , main: toOptionArray toString\n , moduleType: toOptionArray toModuleType\n , licence: toOptionArray toString\n , ignore: toOptionArray toString\n , keywords: toOptionArray toString\n , authors: toOptionArray toAuthor\n , homepage: toOption toString\n , repository: toOption toRepository\n , dependencies: toOptionAssocArray toPkgName toVersionRange\n , devDependencies: toOptionAssocArray toPkgName toVersionRange\n , resolutions: toOptionAssocArray toPkgName toVersion\n , private: toOptionDefault false toBoolean\n }\n where\n toPkgName = note (DecodeError \"Invalid package name\") <<< parsePackageName\n\n-- | A valid package name for a Bower package.\nnewtype PackageName = PackageName String\n\nderive instance Eq PackageName\nderive instance Ord PackageName\nderive instance Newtype PackageName _\nderive instance Generic PackageName _\ninstance Show PackageName where\n show x = genericShow x\n\nfromPackageName :: PackageName -> Json\nfromPackageName = unwrap >>> Json.fromString\n\ntoPackageName :: Json -> Either Json.DecodeError PackageName\ntoPackageName = toString >=> parsePackageName >>> note (DecodeError \"Invalid package name\")\n\nparsePackageName :: String -> Maybe PackageName\nparsePackageName = mkPackageName\n where\n mkPackageName :: String -> Maybe PackageName\n mkPackageName = validateAll validators <<< toCodePointArray\n where\n dashOrDot = toCodePointArray \"-.\"\n\n validateAll :: Array (Array CodePoint -> Boolean) -> Array CodePoint -> Maybe PackageName\n validateAll vs x = traverse_ (validateWith x) vs *> pure (PackageName $ String.fromCodePointArray x)\n\n validateWith :: Array CodePoint -> (Array CodePoint -> Boolean) -> Maybe (Array CodePoint)\n validateWith x p\n | p x = Just x\n | otherwise = Nothing\n validChar c = isAscii c && (isLower c || isDecDigit c || c `Array.elem` dashOrDot)\n\n validators :: Array (Array CodePoint -> Boolean)\n validators =\n [ not <<< Array.null\n , Array.all validChar\n , Array.head >>> maybe false (\\x -> not $ x `Array.elem` dashOrDot)\n , Array.last >>> maybe false (\\x -> not $ x `Array.elem` dashOrDot)\n , not <<< String.contains (Pattern \"--\") <<< fromCodePointArray\n , not <<< String.contains (Pattern \"..\") <<< fromCodePointArray\n , Array.length >>> (_ <= 50)\n ]\n\nnewtype Author = Author\n { name :: String\n , email :: Maybe String\n , homepage :: Maybe String\n }\n\nderive instance Eq Author\nderive instance Ord Author\nderive instance Newtype Author _\nderive instance Generic Author _\ninstance Show Author where\n show x = genericShow x\n\nfromAuthor :: Author -> Json\n\nfromAuthor = fromRecordN Author\n { name: fromRequired Json.fromString\n , email: fromOption Json.fromString\n , homepage: fromOption Json.fromString\n }\n\ntoAuthor :: Json -> Either Json.DecodeError Author\ntoAuthor j = decodeAuthorString j <|> decodeAuthorObj j\n where\n decodeAuthorString = toString >=> \\str -> do\n let\n Tuple email s1 =\n str\n # String.split (Pattern \" \")\n # List.fromFoldable\n # takeDelim \"<\" \">\"\n Tuple homepage s2 = takeDelim \"(\" \")\" s1\n pure $ Author\n { name: List.intercalate \" \" s2\n , email\n , homepage\n }\n where\n takeDelim l r = foldr go (Tuple Nothing Nil)\n where\n go str (Tuple (Just x) strs) =\n Tuple (Just x) (str List.: strs)\n go str (Tuple Nothing strs) =\n case stripWrapper l r str of\n Just str' -> Tuple (Just str') strs\n Nothing -> Tuple Nothing $ str List.: strs\n\n stripWrapper l r = String.stripPrefix (Pattern l) >=> String.stripSuffix (Pattern r)\n\n decodeAuthorObj :: Json -> Either Json.DecodeError Author\n decodeAuthorObj = toRecordN Author\n { name: toRequired toString\n , email: toOption toString\n , homepage: toOption toString\n }\n\n-- | See: \ndata ModuleType\n = Globals\n | AMD\n | Node\n | ES6\n | YUI\n\nderive instance Eq ModuleType\nderive instance Ord ModuleType\nderive instance Generic ModuleType _\ninstance Show ModuleType where\n show x = genericShow x\n\ninstance Enum ModuleType where\n succ x = genericSucc x\n pred x = genericPred x\n\ninstance Bounded ModuleType where\n bottom = genericBottom\n top = genericTop\n\ninstance BoundedEnum ModuleType where\n cardinality = genericCardinality\n toEnum x = genericToEnum x\n fromEnum x = genericFromEnum x\n\nmoduleTypes :: Map String ModuleType\nmoduleTypes =\n Map.fromFoldable\n $ map (\\t -> Tuple (String.toLower $ show t) t)\n $ (enumFromTo bottom top :: Array ModuleType)\n\nfromModuleType :: ModuleType -> Json\nfromModuleType = show >>> String.toLower >>> Json.fromString\n\ntoModuleType :: Json -> Either Json.DecodeError ModuleType\ntoModuleType = toString >=> flip Map.lookup moduleTypes >>> note (DecodeError \"Key not found in 'moduleTypes' map\")\n\nnewtype Repository = Repository\n { url :: String\n , \"type\" :: String\n }\n\nderive instance Eq Repository\nderive instance Ord Repository\nderive instance Newtype Repository _\nderive instance Generic Repository _\ninstance Show Repository where\n show x = genericShow x\n\nfromRepository :: Repository -> Json\nfromRepository = fromRecordN Repository\n { url: fromRequired Json.fromString\n , type: fromRequired Json.fromString\n }\n\ntoRepository :: Json -> Either Json.DecodeError Repository\ntoRepository = toRecordN Repository\n { url: toRequired toString\n , type: toRequired toString\n }\n\nnewtype Version = Version String\n\nderive instance Eq Version\nderive instance Ord Version\nderive instance Newtype Version _\nderive instance Generic Version _\ninstance Show Version where\n show x = genericShow x\n\nfromVersion :: Version -> Json\nfromVersion = unwrap >>> Json.fromString\n\ntoVersion :: Json -> Either Json.DecodeError Version\ntoVersion = coerce <<< toString\n\nnewtype VersionRange = VersionRange String\n\nderive instance Eq VersionRange\nderive instance Ord VersionRange\nderive instance Newtype VersionRange _\nderive instance Generic VersionRange _\ninstance Show VersionRange where\n show x = genericShow x\n\nfromVersionRange :: VersionRange -> Json\nfromVersionRange = unwrap >>> Json.fromString\n\ntoVersionRange :: Json -> Either Json.DecodeError VersionRange\ntoVersionRange = coerce <<< toString\n\ndata BowerError\n = InvalidPackageName PackageNameError\n | InvalidModuleType String\n\nderive instance Eq BowerError\nderive instance Ord BowerError\nderive instance Generic BowerError _\ninstance Show BowerError where\n show x = genericShow x\n\ndata PackageNameError\n = NotEmpty\n | TooLong Int\n | InvalidChars String\n | RepeatedSeparators\n | MustNotBeginSeparator\n | MustNotEndSeparator\n\nderive instance Eq PackageNameError\nderive instance Ord PackageNameError\nderive instance Generic PackageNameError _\ninstance Show PackageNameError where\n show x = genericShow x\n", "module Docs.Search.Types\n ( module ReExport\n , packageNameCodec\n , moduleNameCodec\n , Identifier(..)\n , PackageInfo(..)\n , packageInfoCodec\n , PackageScore(..)\n , packageScoreCodec\n , GlobalIdentifier(..)\n , PartId(..)\n , URL(..)\n , FilePath(..)\n ) where\n\nimport Prelude\n\nimport Data.Codec.JSON.Variant as CJ.Variant\nimport Data.Codec.JSON.Common as CJ\nimport Data.Either (Either(..))\nimport Data.Generic.Rep (class Generic)\nimport Data.Newtype (class Newtype)\nimport Data.Profunctor (wrapIso, dimap)\nimport Data.Show.Generic (genericShow)\nimport Data.Variant as Variant\nimport Docs.Search.JsonCodec (inject)\nimport Language.PureScript.Names (ModuleName(..))\nimport Language.PureScript.Names (ModuleName(..)) as ReExport\nimport Web.Bower.PackageMeta (PackageName(..))\nimport Web.Bower.PackageMeta (PackageName(..)) as ReExport\n\nnewtype Identifier = Identifier String\n\nderive instance newtypeIdentifier :: Newtype Identifier _\nderive instance genericIdentifier :: Generic Identifier _\nderive newtype instance eqIdentifier :: Eq Identifier\nderive newtype instance ordIdentifier :: Ord Identifier\nderive newtype instance showIdentifier :: Show Identifier\n\nmoduleNameCodec :: CJ.Codec ModuleName\nmoduleNameCodec = wrapIso ModuleName CJ.string\n\ndata PackageInfo = LocalPackage | Builtin | Package PackageName | UnknownPackage\n\nderive instance eqPackageInfo :: Eq PackageInfo\nderive instance ordPackageInfo :: Ord PackageInfo\nderive instance genericPackageInfo :: Generic PackageInfo _\ninstance showPackageInfo :: Show PackageInfo where\n show = genericShow\n\npackageNameCodec :: CJ.Codec PackageName\npackageNameCodec = wrapIso PackageName CJ.string\n\npackageInfoCodec :: CJ.Codec PackageInfo\npackageInfoCodec =\n dimap toVariant fromVariant $ CJ.Variant.variantMatch\n { local: Left unit\n , builtin: Left unit\n , unknown: Left unit\n , package: Right packageNameCodec\n }\n where\n toVariant = case _ of\n LocalPackage -> inject @\"local\" unit\n Builtin -> inject @\"builtin\" unit\n Package name -> inject @\"package\" name\n UnknownPackage -> inject @\"unknown\" unit\n\n fromVariant = Variant.match\n { local: \\_ -> LocalPackage\n , builtin: \\_ -> Builtin\n , unknown: \\_ -> UnknownPackage\n , package: \\name -> Package name\n }\n\nnewtype PackageScore = PackageScore Int\n\nderive instance newtypePackageScore :: Newtype PackageScore _\nderive instance genericPackageScore :: Generic PackageScore _\nderive newtype instance eqPackageScore :: Eq PackageScore\nderive newtype instance ordPackageScore :: Ord PackageScore\nderive newtype instance semiringPackageScore :: Semiring PackageScore\nderive newtype instance ringPackageScore :: Ring PackageScore\nderive newtype instance showPackageScore :: Show PackageScore\n\npackageScoreCodec :: CJ.Codec PackageScore\npackageScoreCodec = wrapIso PackageScore CJ.int\n\nnewtype URL = URL String\n\nderive instance newtypeURL :: Newtype URL _\nderive newtype instance showURL :: Show URL\n\nnewtype FilePath = FilePath String\n\nderive instance newtypeFilePath :: Newtype FilePath _\nderive newtype instance showFilePath :: Show FilePath\n\nnewtype GlobalIdentifier = GlobalIdentifier String\n\nderive instance newtypeGlobalIdentifier :: Newtype GlobalIdentifier _\nderive newtype instance showGlobalIdentifier :: Show GlobalIdentifier\n\nnewtype PartId = PartId Int\n\nderive instance newtypePartId :: Newtype PartId _\nderive newtype instance eqPartId :: Eq PartId\nderive newtype instance ordPartId :: Ord PartId\nderive newtype instance showPartId :: Show PartId\n", "module Docs.Search.Config where\n\nimport Prelude\n\nimport Data.Char as Char\nimport Data.List (List, (:))\nimport Data.Newtype (wrap)\nimport Docs.Search.Types (GlobalIdentifier, PackageName, PartId(..), URL, FilePath)\n\nversion :: String\nversion = \"0.0.12\"\n\nmkShapeScriptPath :: String -> String\nmkShapeScriptPath shape = \"./index/types/\" <> shape <> \".js\"\n\n-- | In how many parts the index should be splitted?\nnumberOfIndexParts :: Int\nnumberOfIndexParts = 50\n\nmkIndexPartPath :: PartId -> String\nmkIndexPartPath partId = \"html/index/declarations/\" <> show partId <> \".js\"\n\nmkIndexPartLoadPath :: PartId -> URL\nmkIndexPartLoadPath partId = wrap $ \"./index/declarations/\" <> show partId <> \".js\"\n\nmoduleIndexPath :: FilePath\nmoduleIndexPath = wrap \"generated-docs/html/index/modules.js\"\n\n-- | Used to load mode index to the browser scope.\nmoduleIndexLoadPath :: String\nmoduleIndexLoadPath = \"./index/modules.js\"\n\ntypeIndexDirectory :: FilePath\ntypeIndexDirectory = wrap \"generated-docs/html/index/types\"\n\nmetaPath :: FilePath\nmetaPath = wrap \"generated-docs/html/index/meta.js\"\n\nmetaLoadPath :: URL\nmetaLoadPath = wrap \"./index/meta.js\"\n\nmetaItem :: GlobalIdentifier\nmetaItem = wrap \"DocsSearchMeta\"\n\n-- | localStorage key to save sidebar checkbox value to.\ngroupModulesItem :: String\ngroupModulesItem = \"PureScriptDocsSearchGroupModules\"\n\npackageInfoPath :: FilePath\npackageInfoPath = wrap \"generated-docs/html/index/packages.js\"\n\npackageInfoItem :: GlobalIdentifier\npackageInfoItem = wrap \"DocsSearchPackageIndex\"\n\npackageInfoLoadPath :: URL\npackageInfoLoadPath = wrap \"./index/packages.js\"\n\n-- | How many results to show by default?\nresultsCount :: Int\nresultsCount = 25\n\n-- | Penalties used to determine how \"far\" a type query is from a given type.\n-- See Docs.Search.TypeQuery\npenalties\n :: { excessiveConstraint :: Int\n , generalize :: Int\n , instantiate :: Int\n , match :: Int\n , matchConstraint :: Int\n , missingConstraint :: Int\n , rowsMismatch :: Int\n , typeVars :: Int\n }\npenalties =\n { typeVars: 2\n , match: 2\n , matchConstraint: 1\n , instantiate: 2\n , generalize: 2\n , rowsMismatch: 3\n , missingConstraint: 1\n , excessiveConstraint: 1\n }\n\n-- | Find in which part of the index this path can be found.\ngetPartId :: List Char -> PartId\ngetPartId (a : b : _) =\n PartId $ (Char.toCharCode a + Char.toCharCode b) `mod` numberOfIndexParts\ngetPartId (a : _) =\n PartId $ Char.toCharCode a `mod` numberOfIndexParts\ngetPartId _ = PartId 0\n\ndefaultPackageName :: PackageName\ndefaultPackageName = wrap \"\"\n\ndefaultDocsFiles :: Array String\ndefaultDocsFiles = [ \"output/**/docs.json\" ]\n\ndefaultBowerFiles :: Array String\ndefaultBowerFiles = [ \".spago/*/*/bower.json\", \"bower_components/purescript-*/bower.json\" ]\n\ndefaultSourceFiles :: Array String\ndefaultSourceFiles = [ \"src/**/*.purs\" ]\n", "/* global exports */\n\nexport function load (url) {\n return function () {\n return new Promise(function (resolve, reject) {\n if (typeof window.DocsSearchModuleIndex === 'undefined') {\n var script = document.createElement('script');\n script.type = 'text/javascript';\n script.src = url;\n script.addEventListener('load', function () {\n if (typeof window.DocsSearchModuleIndex === 'undefined') {\n reject(new Error(\"Couldn't load module index\"));\n } else {\n resolve(window.DocsSearchModuleIndex);\n }\n });\n script.addEventListener('error', reject);\n document.body.appendChild(script);\n } else {\n resolve(window.DocsSearchModuleIndex);\n }\n });\n };\n};\n", "-- | This module defines the `State` monad.\n\nmodule Control.Monad.State\n ( State\n , runState\n , evalState\n , execState\n , mapState\n , withState\n , module Control.Monad.State.Class\n , module Control.Monad.State.Trans\n ) where\n\nimport Prelude\n\nimport Control.Monad.State.Class (class MonadState, get, gets, modify, modify_, put, state)\nimport Control.Monad.State.Trans (class MonadTrans, StateT(..), evalStateT, execStateT, lift, mapStateT, runStateT, withStateT)\n\nimport Data.Identity (Identity(..))\nimport Data.Newtype (unwrap)\nimport Data.Tuple (Tuple(Tuple))\n\n-- | The `State` monad is a synonym for the `StateT` monad transformer, applied\n-- | to the `Identity` monad.\ntype State s = StateT s Identity\n\n-- | Run a computation in the `State` monad\nrunState :: forall s a. State s a -> s -> Tuple a s\nrunState (StateT s) = unwrap <<< s\n\n-- | Run a computation in the `State` monad, discarding the final state\nevalState :: forall s a. State s a -> s -> a\nevalState (StateT m) s = case m s of Identity (Tuple a _) -> a\n\n-- | Run a computation in the `State` monad, discarding the result\nexecState :: forall s a. State s a -> s -> s\nexecState (StateT m) s = case m s of Identity (Tuple _ s') -> s'\n\n-- | Change the type of the result in a `State` action\nmapState :: forall s a b. (Tuple a s -> Tuple b s) -> State s a -> State s b\nmapState f = mapStateT (Identity <<< f <<< unwrap)\n\n-- | Modify the state in a `State` action\nwithState :: forall s a. (s -> s) -> State s a -> State s a\nwithState = withStateT\n", "-- | This module defines functions for working with lenses.\nmodule Data.Lens.Lens\n ( lens\n , lens'\n , withLens\n , cloneLens\n , ilens\n , ilens'\n , withIndexedLens\n , cloneIndexedLens\n , lensStore\n , module Data.Lens.Types\n ) where\n\nimport Prelude\n\nimport Control.Apply (lift2)\nimport Data.Lens.Internal.Indexed (Indexed(..))\nimport Data.Lens.Internal.Shop (Shop(..))\nimport Data.Lens.Types\n ( ALens\n , ALens'\n , AnIndexedLens\n , AnIndexedLens'\n , IndexedLens\n , IndexedLens'\n , Lens\n , Lens'\n )\nimport Data.Newtype (un)\nimport Data.Profunctor (dimap)\nimport Data.Profunctor.Strong (first)\nimport Data.Tuple (Tuple(..))\n\n-- | Create a `Lens` from a getter/setter pair.\n-- |\n-- | ```purescript\n-- | > species = lens _.species $ _ {species = _}\n-- | > view species {species : \"bovine\"}\n-- | \"bovine\"\n-- |\n-- | > _2 = lens Tuple.snd $ \\(Tuple keep _) new -> Tuple keep new\n-- | ```\n-- |\n-- | Note: `_2` is predefined in `Data.Lens.Tuple`.\n\nlens :: forall s t a b. (s -> a) -> (s -> b -> t) -> Lens s t a b\nlens get set = lens' \\s -> Tuple (get s) \\b -> set s b\n\nlens' :: forall s t a b. (s -> Tuple a (b -> t)) -> Lens s t a b\nlens' to pab = dimap to (\\(Tuple b f) -> f b) (first pab)\n\nwithLens :: forall s t a b r. ALens s t a b -> ((s -> a) -> (s -> b -> t) -> r) -> r\nwithLens l f = case l (Shop identity \\_ b -> b) of Shop x y -> f x y\n\ncloneLens :: forall s t a b. ALens s t a b -> Lens s t a b\ncloneLens l = withLens l \\x y p -> lens x y p\n\nilens'\n :: forall i s t a b\n . (s -> Tuple (Tuple i a) (b -> t))\n -> IndexedLens i s t a b\nilens' to pab = dimap to (\\(Tuple b f) -> f b) (first ((un Indexed) pab))\n\n-- create an `IndexedLens` from a getter/setter pair.\nilens\n :: forall i s t a b\n . (s -> Tuple i a)\n -> (s -> b -> t)\n -> IndexedLens i s t a b\nilens get set = ilens' \\s -> Tuple (get s) \\b -> set s b\n\nwithIndexedLens\n :: forall i s t a b r\n . (AnIndexedLens i s t a b)\n -> ((s -> (Tuple i a)) -> (s -> b -> t) -> r)\n -> r\nwithIndexedLens l f = case l (Indexed (Shop identity \\_ b -> b)) of Shop x y -> f x y\n\ncloneIndexedLens :: forall i s t a b. AnIndexedLens i s t a b -> IndexedLens i s t a b\ncloneIndexedLens l = withIndexedLens l \\x y p -> ilens x y p\n\n-- | Converts a lens into the form that `lens'` accepts.\n-- |\n-- | Can be useful when defining a lens where the focus appears under multiple\n-- | constructors of an algebraic data type. This function would be called for\n-- | each case of the data type.\n-- |\n-- | For example:\n-- |\n-- | ```\n-- | data LensStoreExample = LensStoreA Int | LensStoreB (Tuple Boolean Int)\n-- |\n-- | lensStoreExampleInt :: Lens' LensStoreExample Int\n-- | lensStoreExampleInt = lens' case _ of\n-- | LensStoreA i -> map LensStoreA <$> lensStore identity i\n-- | LensStoreB i -> map LensStoreB <$> lensStore _2 i\n-- | ```\nlensStore :: forall s t a b. ALens s t a b -> s -> Tuple a (b -> t)\nlensStore l = withLens l (lift2 Tuple)\n\n", "module Data.Lens.Record (prop) where\n\nimport Prelude\n\nimport Data.Lens (Lens, lens)\nimport Data.Symbol (class IsSymbol)\nimport Prim.Row as Row\nimport Record (get, set)\nimport Type.Proxy (Proxy)\n\n-- | Construct a (type-changing) lens for a record property, by providing a\n-- | proxy for the `Symbol` which corresponds to the property label.\n-- |\n-- | The lens is polymorphic in the rest of the row of property labels.\n-- |\n-- | For example:\n-- |\n-- | ```purescript\n-- | prop (Proxy :: Proxy \"foo\")\n-- | :: forall a b r. Lens { foo :: a | r } { foo :: b | r } a b\n-- | ```\nprop\n :: forall l r1 r2 r a b\n . IsSymbol l\n => Row.Cons l a r r1\n => Row.Cons l b r r2\n => Proxy l\n -> Lens (Record r1) (Record r2) a b\nprop l = lens (get l) (flip (set l))\n", "-- | This module defines functions for working with setters.\nmodule Data.Lens.Setter\n ( (%~)\n , over\n , iover\n , (.~)\n , set\n , (+~)\n , addOver\n , (-~)\n , subOver\n , (*~)\n , mulOver\n , (//~)\n , divOver\n , (||~)\n , disjOver\n , (&&~)\n , conjOver\n , (<>~)\n , appendOver\n , (?~)\n , setJust\n , (.=)\n , assign\n , (%=)\n , modifying\n , (+=)\n , addModifying\n , (*=)\n , mulModifying\n , (-=)\n , subModifying\n , (//=)\n , divModifying\n , (||=)\n , disjModifying\n , (&&=)\n , conjModifying\n , (<>=)\n , appendModifying\n , (?=)\n , assignJust\n , module Data.Lens.Types\n ) where\n\nimport Prelude\n\nimport Control.Monad.State.Class (class MonadState, modify)\nimport Data.Lens.Types (Indexed(..), IndexedSetter, Setter, Setter')\nimport Data.Maybe (Maybe(..))\nimport Data.Tuple (uncurry)\n\ninfixr 4 over as %~\ninfixr 4 set as .~\ninfixr 4 addOver as +~\ninfixr 4 subOver as -~\ninfixr 4 mulOver as *~\ninfixr 4 divOver as //~\ninfixr 4 disjOver as ||~\ninfixr 4 conjOver as &&~\ninfixr 4 appendOver as <>~\ninfixr 4 setJust as ?~\n\ninfix 4 assign as .=\ninfix 4 modifying as %=\ninfix 4 addModifying as +=\ninfix 4 mulModifying as *=\ninfix 4 subModifying as -=\ninfix 4 divModifying as //=\ninfix 4 disjModifying as ||=\ninfix 4 conjModifying as &&=\ninfix 4 appendModifying as <>=\ninfix 4 assignJust as ?=\n\n-- | Apply a function to the foci of a `Setter`.\nover :: forall s t a b. Setter s t a b -> (a -> b) -> s -> t\nover l = l\n\n-- | Apply a function to the foci of a `Setter` that may vary with the index.\niover :: forall i s t a b. IndexedSetter i s t a b -> (i -> a -> b) -> s -> t\niover l f = l (Indexed $ uncurry f)\n\n-- | Set the foci of a `Setter` to a constant value.\nset :: forall s t a b. Setter s t a b -> b -> s -> t\nset l b = over l (const b)\n\naddOver :: forall s t a. Semiring a => Setter s t a a -> a -> s -> t\naddOver p = over p <<< add\n\nmulOver :: forall s t a. Semiring a => Setter s t a a -> a -> s -> t\nmulOver p = over p <<< flip mul\n\nsubOver :: forall s t a. Ring a => Setter s t a a -> a -> s -> t\nsubOver p = over p <<< flip sub\n\ndivOver :: forall s t a. EuclideanRing a => Setter s t a a -> a -> s -> t\ndivOver p = over p <<< flip div\n\ndisjOver :: forall s t a. HeytingAlgebra a => Setter s t a a -> a -> s -> t\ndisjOver p = over p <<< flip disj\n\nconjOver :: forall s t a. HeytingAlgebra a => Setter s t a a -> a -> s -> t\nconjOver p = over p <<< flip conj\n\nappendOver :: forall s t a. Semigroup a => Setter s t a a -> a -> s -> t\nappendOver p = over p <<< flip append\n\nsetJust :: forall s t a b. Setter s t a (Maybe b) -> b -> s -> t\nsetJust p = set p <<< Just\n\n-- Stateful\n\n-- | Set the foci of a `Setter` in a monadic state to a constant value.\nassign :: forall s a b m. MonadState s m => Setter s s a b -> b -> m Unit\nassign p b = void (modify (set p b))\n\n-- | Modify the foci of a `Setter` in a monadic state.\nmodifying :: forall s a b m. MonadState s m => Setter s s a b -> (a -> b) -> m Unit\nmodifying p f = void (modify (over p f))\n\naddModifying :: forall s a m. MonadState s m => Semiring a => Setter' s a -> a -> m Unit\naddModifying p = modifying p <<< add\n\nmulModifying :: forall s a m. MonadState s m => Semiring a => Setter' s a -> a -> m Unit\nmulModifying p = modifying p <<< flip mul\n\nsubModifying :: forall s a m. MonadState s m => Ring a => Setter' s a -> a -> m Unit\nsubModifying p = modifying p <<< flip sub\n\ndivModifying :: forall s a m. MonadState s m => EuclideanRing a => Setter' s a -> a -> m Unit\ndivModifying p = modifying p <<< flip div\n\ndisjModifying :: forall s a m. MonadState s m => HeytingAlgebra a => Setter' s a -> a -> m Unit\ndisjModifying p = modifying p <<< flip disj\n\nconjModifying :: forall s a m. MonadState s m => HeytingAlgebra a => Setter' s a -> a -> m Unit\nconjModifying p = modifying p <<< flip conj\n\nappendModifying :: forall s a m. MonadState s m => Semigroup a => Setter' s a -> a -> m Unit\nappendModifying p = modifying p <<< flip append\n\nassignJust :: forall s a b m. MonadState s m => Setter s s a (Maybe b) -> b -> m Unit\nassignJust p = assign p <<< Just\n", "module Docs.Search.Extra where\n\nimport Prelude\n\nimport Data.Array as Array\nimport Data.Foldable (class Foldable, foldMap, foldl)\nimport Data.List (List, (:))\nimport Data.List as List\nimport Data.List.NonEmpty (NonEmptyList, cons', uncons)\nimport Data.String.CodeUnits as String\nimport Data.Newtype (wrap)\nimport Data.Maybe (Maybe(..), fromMaybe)\n\nwhenJust :: forall a m. Monad m => Maybe a -> (a -> m Unit) -> m Unit\nwhenJust (Just a) f = f a\nwhenJust _ _ = pure unit\n\nfoldMapFlipped :: forall a m f. Foldable f => Monoid m => f a -> (a -> m) -> m\nfoldMapFlipped = flip foldMap\n\ninfixr 7 foldMapFlipped as >#>\n\nfoldl1 :: forall a. (a -> a -> a) -> NonEmptyList a -> a\nfoldl1 f as =\n case uncons as of\n { head, tail } -> foldl f head tail\n\nfoldr1 :: forall a. (a -> a -> a) -> NonEmptyList a -> a\nfoldr1 f = go List.Nil\n where\n go acc x = case uncons x of\n { head, tail } -> case List.uncons tail of\n Nothing -> List.foldl (flip f) head acc\n Just { head: head1, tail: tail1 } ->\n go (head : acc) (cons' head1 tail1)\n\n-- | Try to guess repository main page on github from git URL.\nhomePageFromRepository :: String -> String\nhomePageFromRepository repo =\n fromMaybe repo $ String.stripSuffix (wrap \".git\")\n $ fromMaybe repo\n $ String.stripPrefix (wrap \"git:\") repo <#> (\"https:\" <> _)\n\nstringToList :: String -> List Char\nstringToList = List.fromFoldable <<< String.toCharArray\n\nlistToString :: List Char -> String\nlistToString = String.fromCharArray <<< Array.fromFoldable\n", "module Docs.Search.Score where\n\nimport Prelude\n\nimport Data.Array as Array\nimport Data.Map (Map)\nimport Data.Map as Map\nimport Data.Maybe (fromMaybe)\nimport Data.Tuple (Tuple(..))\nimport Docs.Search.Types (PackageInfo(..), PackageName, PackageScore(..))\nimport Safe.Coerce (coerce)\nimport Web.Bower.PackageMeta as Bower\n\ntype Dependencies = Array (Tuple Bower.PackageName Bower.VersionRange)\ntype Scores = Map PackageName PackageScore\n\n-- | Construct a mapping from package names to their scores, based on number\n-- of reverse dependencies.\nmkScores :: Array Bower.PackageMeta -> Scores\nmkScores =\n Array.foldr\n ( \\(Bower.PackageMeta pm) ->\n updateScoresFor pm.dependencies >>>\n updateScoresFor pm.devDependencies\n )\n Map.empty\n\n where\n updateScoresFor :: Dependencies -> Scores -> Scores\n updateScoresFor deps scores =\n Array.foldr\n (\\(Tuple dep _) -> Map.insertWith add (coerce dep) one)\n scores\n deps\n\n-- unsafeCrashWith \"Docs.Search.Score\"\ngetPackageScore :: Scores -> PackageInfo -> PackageScore\ngetPackageScore scores = case _ of\n Package p -> getPackageScoreForPackageName scores p\n Builtin -> PackageScore 100000\n LocalPackage -> PackageScore 200000\n UnknownPackage -> zero\n\ngetPackageScoreForPackageName :: Scores -> PackageName -> PackageScore\ngetPackageScoreForPackageName scores p = fromMaybe zero $ Map.lookup p scores\n", "module Docs.Search.ModuleIndex where\n\nimport Prelude\n\nimport Control.Monad.State (execState, modify_)\nimport Control.Promise (Promise, toAffE)\nimport Data.Array as Array\nimport Data.Codec.JSON as CJ\nimport Data.Codec.JSON.Common as CJ.Common\nimport Data.Either (hush)\nimport Data.Foldable (foldl)\nimport Data.Lens ((%~))\nimport Data.Lens.Record (prop)\nimport Data.List (List, (:))\nimport Data.Map (Map)\nimport Data.Map as Map\nimport Data.Maybe (Maybe(..), fromMaybe)\nimport Data.Newtype (unwrap)\nimport Data.Search.Trie (Trie)\nimport Data.Search.Trie as Trie\nimport Data.Set (Set)\nimport Data.Set as Set\nimport Data.String.CodeUnits (toCharArray) as String\nimport Data.String.Common (split, toLower) as String\nimport Data.String.Pattern (Pattern(..))\nimport Data.Traversable (foldr, for_)\nimport Data.Tuple.Nested ((/\\))\nimport Docs.Search.Config as Config\nimport Docs.Search.Declarations (Declarations(..))\nimport Docs.Search.Extra (stringToList)\nimport Docs.Search.Score (Scores, getPackageScore)\nimport Docs.Search.SearchResult (SearchResult(..))\nimport Docs.Search.Types (ModuleName, PackageInfo(..), PackageScore)\nimport Docs.Search.Types as Package\nimport Effect (Effect)\nimport Effect.Aff (Aff)\nimport JSON (JSON)\nimport Type.Proxy (Proxy(..))\n\n-- | Module index that is actually stored in a JS file.\ntype PackedModuleIndex = Map PackageInfo (Set ModuleName)\n\npackedModuleIndexCodec :: CJ.Codec PackedModuleIndex\npackedModuleIndexCodec = CJ.Common.map Package.packageInfoCodec (CJ.Common.set Package.moduleNameCodec)\n\n-- | \"Expanded\" module index that can be queried quickly.\ntype ModuleIndex =\n { packageModules :: Map PackageInfo (Set ModuleName)\n , modulePackages :: Map ModuleName PackageInfo\n , index :: Trie Char ModuleName\n }\n\ntype ModuleResult =\n { name :: ModuleName\n , package :: PackageInfo\n , score :: PackageScore\n }\n\nunpackModuleIndex :: PackedModuleIndex -> ModuleIndex\nunpackModuleIndex packageModules =\n flip execState { packageModules, modulePackages: Map.empty, index: mempty } do\n for_ (Map.toUnfoldableUnordered packageModules :: Array _)\n \\(package /\\ moduleNames) -> do\n for_ moduleNames \\moduleName -> do\n modify_ $ _modulePackages %~ Map.insert moduleName package\n for_ (extractModuleNameParts moduleName) \\part -> do\n let partPath = Array.toUnfoldable $ String.toCharArray part\n modify_ $ _index %~ Trie.insert partPath moduleName\n\n-- | E.g. `\"Data.Array.ST\" -> [\"data.array.st\", \"array.st\", \"st\"]`.\nextractModuleNameParts :: ModuleName -> List String\nextractModuleNameParts =\n unwrap >>> String.toLower\n >>> String.split (Pattern \".\")\n >>>\n foldl (\\acc el -> el : map (_ <> \".\" <> el) acc) mempty\n\nqueryModuleIndex\n :: Scores\n -> ModuleIndex\n -> String\n -> Array ModuleResult\nqueryModuleIndex scores { index, modulePackages } query =\n let\n path = stringToList $ String.toLower query\n in\n Trie.queryValues path index\n # Array.fromFoldable\n # Array.nub\n <#>\n ( \\name -> do\n package <- Map.lookup name modulePackages\n pure\n { name\n , package\n , score: getPackageScore scores package\n }\n )\n #\n Array.catMaybes\n\n-- | Constructs a mapping from packages to modules\nmkPackedModuleIndex :: Declarations -> Array ModuleName -> PackedModuleIndex\nmkPackedModuleIndex (Declarations trie) moduleNames =\n addLocalPackageModuleNames\n $ foldr (Map.unionWith Set.union) Map.empty\n $ extract <$> Trie.values trie\n where\n -- Add modules from src/ that may not contain any definitions, only\n -- re-exports\n addLocalPackageModuleNames = flip Map.alter LocalPackage $\n Just <<< append (Set.fromFoldable moduleNames) <<< fromMaybe Set.empty\n\n extract\n :: List SearchResult\n -> Map PackageInfo (Set ModuleName)\n extract = foldr (Map.unionWith Set.union) Map.empty <<< map mkEntry\n where\n mkEntry (SearchResult { packageInfo, moduleName }) =\n Map.singleton packageInfo (Set.singleton moduleName)\n\nloadModuleIndex :: Aff PackedModuleIndex\nloadModuleIndex = do\n json <- toAffE $ load Config.moduleIndexLoadPath\n pure $ fromMaybe Map.empty $ hush $ CJ.decode packedModuleIndexCodec json\n\nforeign import load\n :: String\n -> Effect (Promise JSON)\n\n_modulePackages :: forall a b rest. (a -> b) -> { modulePackages :: a | rest } -> { modulePackages :: b | rest }\n_modulePackages = prop (Proxy :: Proxy \"modulePackages\")\n\n_index :: forall a b rest. (a -> b) -> { index :: a | rest } -> { index :: b | rest }\n_index = prop (Proxy :: Proxy \"index\")\n", "module Data.Codec.JSON.Record where\n\nimport Data.Codec.JSON as CJ\nimport Data.Codec.JSON.Strict as CJS\nimport Data.Maybe (Maybe)\nimport Data.Symbol (class IsSymbol)\nimport Prim.Row as R\nimport Prim.RowList as RL\nimport Record as Rec\nimport Safe.Coerce (coerce)\nimport Type.Proxy (Proxy(..))\nimport Unsafe.Coerce (unsafeCoerce)\n\n-- | Constructs a `Codec` for a `Record` from a record of codecs.\n-- |\n-- | ```purescript\n-- | type Person = { name \u2237 String, age \u2237 Int }\n-- |\n-- | personCodec \u2237 CJ.Codec Person\n-- | personCodec = CAR.object { name: CJ.string, age: CJ.int }\n-- | ```\nobject\n \u2237 \u2200 ri ro rl\n . RL.RowToList ri rl\n \u21D2 RowListCodec rl ri ro\n \u21D2 Record ri\n \u2192 CJ.Codec (Record ro)\nobject rec = CJ.object (record rec)\n\n-- | A version of the `object` function that fails upon encountering unknown\n-- | properties while decoding a record.\n-- |\n-- | ```purescript\n-- | type Person = { name \u2237 String, age \u2237 Int }\n-- |\n-- | personCodec \u2237 CJ.Codec Person\n-- | personCodec = CAR.objectStrict { name: CJ.string, age: CJ.int }\n-- | ```\nobjectStrict\n \u2237 \u2200 ri ro rl\n . RL.RowToList ri rl\n \u21D2 RowListCodecStrict rl ri ro\n \u21D2 Record ri\n \u2192 CJ.Codec (Record ro)\nobjectStrict rec = CJS.objectStrict (recordStrict rec)\n\n-- | Constructs a `JPropCodec` for a `Record` from a record of codecs. Commonly\n-- | the `object` function in this module will be the preferred choice, as that\n-- | produces a `Codec` instead.\nrecord\n \u2237 \u2200 ri ro rl\n . RL.RowToList ri rl\n \u21D2 RowListCodec rl ri ro\n \u21D2 Record ri\n \u2192 CJ.PropCodec (Record ro)\nrecord = rowListCodec @rl\n\n-- | Constructs a `JPropCodec` for a `Record` from a record of codecs. Commonly\n-- | the `object` function in this module will be the preferred choice, as that\n-- | produces a `Codec` instead.\nrecordStrict\n \u2237 \u2200 ri ro rl\n . RL.RowToList ri rl\n \u21D2 RowListCodecStrict rl ri ro\n \u21D2 Record ri\n \u2192 CJS.PropCodec (Record ro)\nrecordStrict = rowListCodecStrict @rl\n\n-- | Used to wrap codec values provided in `record` to indicate the field is optional.\n-- |\n-- | This will only decode the property as `Nothing` if the field does not exist\n-- | in the object - having a values such as `null` assigned will need handling\n-- | separately.\n-- |\n-- | The property will be omitted when encoding and the value is `Nothing`.\nnewtype Optional a = Optional (CJ.Codec a)\n\n-- | A lowercase alias for `Optional`, provided for stylistic reasons only.\noptional \u2237 \u2200 a. CJ.Codec a \u2192 Optional a\noptional = Optional\n\n-- | The class used to enable the building of `Record` codecs by providing a\n-- | record of codecs.\nclass RowListCodec (rl \u2237 RL.RowList Type) (ri \u2237 Row Type) (ro \u2237 Row Type) | rl \u2192 ri ro where\n rowListCodec \u2237 Record ri \u2192 CJ.PropCodec (Record ro)\n\ninstance RowListCodec RL.Nil () () where\n rowListCodec _ = CJ.record\n\ninstance\n ( RowListCodec rs ri' ro'\n , R.Cons sym (Optional a) ri' ri\n , R.Cons sym (Maybe a) ro' ro\n , IsSymbol sym\n ) \u21D2\n RowListCodec (RL.Cons sym (Optional a) rs) ri ro where\n rowListCodec codecs =\n CJ.recordPropOptional @sym codec tail\n where\n codec \u2237 CJ.Codec a\n codec = coerce (Rec.get (Proxy @sym) codecs \u2237 Optional a)\n\n tail \u2237 CJ.PropCodec (Record ro')\n tail = rowListCodec @rs ((unsafeCoerce \u2237 Record ri \u2192 Record ri') codecs)\n\nelse instance\n ( RowListCodec rs ri' ro'\n , R.Cons sym (CJ.Codec a) ri' ri\n , R.Cons sym a ro' ro\n , IsSymbol sym\n ) \u21D2\n RowListCodec (RL.Cons sym (CJ.Codec a) rs) ri ro where\n rowListCodec codecs =\n CJ.recordProp @sym codec tail\n where\n codec \u2237 CJ.Codec a\n codec = Rec.get (Proxy @sym) codecs\n\n tail \u2237 CJ.PropCodec (Record ro')\n tail = rowListCodec @rs ((unsafeCoerce \u2237 Record ri \u2192 Record ri') codecs)\n\n-- | The class used to enable the building of `Record` codecs by providing a\n-- | record of codecs.\nclass RowListCodecStrict (rl \u2237 RL.RowList Type) (ri \u2237 Row Type) (ro \u2237 Row Type) | rl \u2192 ri ro where\n rowListCodecStrict \u2237 Record ri \u2192 CJS.PropCodec (Record ro)\n\ninstance RowListCodecStrict RL.Nil () () where\n rowListCodecStrict _ = CJS.record\n\ninstance\n ( RowListCodecStrict rs ri' ro'\n , R.Cons sym (Optional a) ri' ri\n , R.Cons sym (Maybe a) ro' ro\n , IsSymbol sym\n ) \u21D2\n RowListCodecStrict (RL.Cons sym (Optional a) rs) ri ro where\n rowListCodecStrict codecs =\n CJS.recordPropOptional @sym codec tail\n where\n codec \u2237 CJ.Codec a\n codec = coerce (Rec.get (Proxy @sym) codecs \u2237 Optional a)\n\n tail \u2237 CJS.PropCodec (Record ro')\n tail = rowListCodecStrict @rs ((unsafeCoerce \u2237 Record ri \u2192 Record ri') codecs)\n\nelse instance\n ( RowListCodecStrict rs ri' ro'\n , R.Cons sym (CJ.Codec a) ri' ri\n , R.Cons sym a ro' ro\n , IsSymbol sym\n ) \u21D2\n RowListCodecStrict (RL.Cons sym (CJ.Codec a) rs) ri ro where\n rowListCodecStrict codecs =\n CJS.recordProp @sym codec tail\n where\n codec \u2237 CJ.Codec a\n codec = Rec.get (Proxy @sym) codecs\n\n tail \u2237 CJS.PropCodec (Record ro')\n tail = rowListCodecStrict @rs ((unsafeCoerce \u2237 Record ri \u2192 Record ri') codecs)\n", "/* global exports */\n\nexport function loadFromScript (globalIdentifier) {\n return function (url) {\n return function () {\n return new Promise(function (resolve, reject) {\n if (typeof window[globalIdentifier] === 'undefined') {\n var script = document.createElement('script');\n script.type = 'text/javascript';\n script.src = url;\n script.addEventListener('load', function () {\n if (typeof window[globalIdentifier] === 'undefined') {\n reject(new Error(\"Couldn't load package index.\"));\n } else {\n resolve(window[globalIdentifier]);\n }\n });\n script.addEventListener('error', reject);\n document.body.appendChild(script);\n } else {\n resolve(window[globalIdentifier]);\n }\n });\n };\n };\n};\n", "module Docs.Search.Loader where\n\nimport Prelude\n\nimport Codec.JSON.DecodeError as CJ.DecodeError\nimport Control.Monad.Error.Class (throwError)\nimport Control.Promise (Promise, toAffE)\nimport Data.Codec.JSON.Common as CJ\nimport Data.Either (either)\nimport Data.Newtype (unwrap)\nimport Docs.Search.Types (GlobalIdentifier, URL)\nimport Effect (Effect)\nimport Effect.Aff (Aff)\nimport Effect.Exception (error)\nimport JSON (JSON)\n\nload\n :: forall a\n . CJ.Codec a\n -> GlobalIdentifier\n -> URL\n -> Aff a\nload codec globalIdentifier url = do\n json <- toAffE (loadFromScript globalIdentifier url)\n either throw pure $ CJ.decode codec json\n where\n throw err = throwError $ error $\n \"Couldn't load content from window.\"\n <> unwrap globalIdentifier\n <> \": \"\n <> CJ.DecodeError.print err\n\nforeign import loadFromScript\n :: GlobalIdentifier\n -> URL\n -> Effect (Promise JSON)\n", "module Docs.Search.PackageIndex where\n\nimport Prelude\n\nimport Data.Argonaut.Core (Json)\nimport Data.Array as Array\nimport Data.Codec as Codec\nimport Data.Codec.JSON as CJ\nimport Data.Codec.JSON.Record as CJ.Record\nimport Data.Map (Map)\nimport Data.Map as Map\nimport Data.Maybe (Maybe)\nimport Data.Newtype (unwrap)\nimport Data.Search.Trie (Trie)\nimport Data.Search.Trie as Trie\nimport Data.Tuple as Tuple\nimport Docs.Search.Config as Config\nimport Docs.Search.Extra (stringToList)\nimport Docs.Search.JsonCodec as JsonCodec\nimport Docs.Search.Loader as Loader\nimport Docs.Search.Score (Scores, getPackageScoreForPackageName)\nimport Docs.Search.Types (PackageScore)\nimport Docs.Search.Types as Package\nimport Effect.Aff (Aff)\nimport JSON (JSON)\nimport Unsafe.Coerce (unsafeCoerce)\nimport Web.Bower.PackageMeta (PackageMeta(..), PackageName)\nimport Web.Bower.PackageMeta as Bower\n\ntype PackageResult =\n { name :: PackageName\n , description :: Maybe String\n , score :: PackageScore\n , dependencies :: Array PackageName\n , repository :: Maybe String\n }\n\npackageResultCodec :: CJ.Codec PackageResult\npackageResultCodec = CJ.named \"PackageResult\" $\n CJ.Record.object\n { name: Package.packageNameCodec\n , description: CJ.Record.optional CJ.string\n , score: Package.packageScoreCodec\n , dependencies: CJ.array Package.packageNameCodec\n , repository: CJ.Record.optional CJ.string\n }\n\ntype PackageIndex = Trie Char PackageResult\n\ntype PackageInfo = Array PackageResult\n\nmkPackageInfo :: Scores -> Array PackageMeta -> PackageInfo\nmkPackageInfo packageScores pms =\n Array.fromFoldable\n $ Map.values\n $ Array.foldr insert Map.empty pms\n\n where\n insert\n :: PackageMeta\n -> Map PackageName PackageResult\n -> Map PackageName PackageResult\n insert\n ( PackageMeta\n { name\n , description\n , dependencies\n , repository\n }\n ) =\n Map.insert\n name\n { name\n , description\n , score: getPackageScoreForPackageName packageScores name\n , dependencies: dependencies <#> Tuple.fst\n , repository: repository <#> unwrap >>> (_.url)\n }\n\nmkScoresFromPackageIndex :: PackageIndex -> Scores\nmkScoresFromPackageIndex =\n Trie.values >>> Array.fromFoldable >>>\n Array.foldr (\\{ name, score } -> Map.insert name score) Map.empty\n\nloadPackageIndex :: Aff PackageIndex\nloadPackageIndex =\n mkPackageIndex <$> Loader.load packageInfoCodec Config.packageInfoItem Config.packageInfoLoadPath\n where\n packageInfoCodec :: CJ.Codec PackageInfo\n packageInfoCodec = CJ.array packageResultCodec\n\nmkPackageIndex :: PackageInfo -> PackageIndex\nmkPackageIndex =\n Array.foldr\n (\\package -> Trie.insert (stringToList $ unwrap package.name) package)\n mempty\n\nqueryPackageIndex\n :: forall m\n . Monad m\n => PackageIndex\n -> String\n -> m\n { index :: PackageIndex\n , results :: Array PackageResult\n }\nqueryPackageIndex index query =\n pure\n { index\n , results: Array.fromFoldable $ Trie.queryValues (stringToList query) index\n }\n\npackageMetaCodec :: CJ.Codec PackageMeta\npackageMetaCodec = Codec.codec' decode encode\n where\n decode = JsonCodec.fromUni Bower.toPackageMeta\n encode = Bower.fromPackageMeta >>> (unsafeCoerce :: Json -> JSON)\n", "-- | A module containing everything that is necessary to decode `docs.json` files.\nmodule Docs.Search.DocsJson\n ( sourceSpanCodec\n ) where\n\nimport Prelude\n\nimport Data.Codec.JSON as CJ\nimport Data.Codec.JSON.Record as CJ.Record\nimport Data.Profunctor (wrapIso)\n\nimport Language.PureScript.AST.SourcePos (SourceSpan(..), SourcePos(..))\n\nsourceSpanCodec :: CJ.Codec SourceSpan\nsourceSpanCodec =\n wrapIso SourceSpan $ CJ.named \"SourceSpan\" $\n CJ.Record.object\n { start: sourcePosCodec\n , end: sourcePosCodec\n , name: CJ.string\n }\n\nsourcePosCodec :: CJ.Codec SourcePos\nsourcePosCodec =\n wrapIso SourcePos $ CJ.named \"SourcePos\" $\n CJ.Record.object\n { line: CJ.int\n , column: CJ.int\n }\n", "------------------------------------\n-- This module is code generated. --\n-- DO NOT EDIT! --\n------------------------------------\nmodule Language.PureScript.Constants.Prim where\n\nimport Language.PureScript.Names (TypeName, Ident(..), ModuleName(..), ProperName(..), Qualified(..), QualifiedBy(..))\n\nm_Prim :: ModuleName\nm_Prim = ModuleName \"Prim\"\n\nclsPartial :: Qualified (ProperName TypeName)\nclsPartial = Qualified (ByModuleName m_Prim) (ProperName \"Partial\")\n\ntyArray :: Qualified (ProperName TypeName)\ntyArray = Qualified (ByModuleName m_Prim) (ProperName \"Array\")\n\ntyBoolean :: Qualified (ProperName TypeName)\ntyBoolean = Qualified (ByModuleName m_Prim) (ProperName \"Boolean\")\n\ntyChar :: Qualified (ProperName TypeName)\ntyChar = Qualified (ByModuleName m_Prim) (ProperName \"Char\")\n\ntyConstraint :: Qualified (ProperName TypeName)\ntyConstraint = Qualified (ByModuleName m_Prim) (ProperName \"Constraint\")\n\ntyFunction :: Qualified (ProperName TypeName)\ntyFunction = Qualified (ByModuleName m_Prim) (ProperName \"Function\")\n\ntyInt :: Qualified (ProperName TypeName)\ntyInt = Qualified (ByModuleName m_Prim) (ProperName \"Int\")\n\ntyNumber :: Qualified (ProperName TypeName)\ntyNumber = Qualified (ByModuleName m_Prim) (ProperName \"Number\")\n\ntyRecord :: Qualified (ProperName TypeName)\ntyRecord = Qualified (ByModuleName m_Prim) (ProperName \"Record\")\n\ntyRow :: Qualified (ProperName TypeName)\ntyRow = Qualified (ByModuleName m_Prim) (ProperName \"Row\")\n\ntyString :: Qualified (ProperName TypeName)\ntyString = Qualified (ByModuleName m_Prim) (ProperName \"String\")\n\ntySymbol :: Qualified (ProperName TypeName)\ntySymbol = Qualified (ByModuleName m_Prim) (ProperName \"Symbol\")\n\ntyType :: Qualified (ProperName TypeName)\ntyType = Qualified (ByModuleName m_Prim) (ProperName \"Type\")\n\ns_undefined :: String\ns_undefined = \"undefined\"\n\ni_undefined :: Qualified Ident\ni_undefined = Qualified (ByModuleName m_Prim) (Ident \"undefined\")\n\nm_Prim_Boolean :: ModuleName\nm_Prim_Boolean = ModuleName \"Prim.Boolean\"\n\ntyFalse :: Qualified (ProperName TypeName)\ntyFalse = Qualified (ByModuleName m_Prim_Boolean) (ProperName \"False\")\n\ntyTrue :: Qualified (ProperName TypeName)\ntyTrue = Qualified (ByModuleName m_Prim_Boolean) (ProperName \"True\")\n\nm_Prim_Coerce :: ModuleName\nm_Prim_Coerce = ModuleName \"Prim.Coerce\"\n\nclsCoercible :: Qualified (ProperName TypeName)\nclsCoercible = Qualified (ByModuleName m_Prim_Coerce) (ProperName \"Coercible\")\n\nm_Prim_Int :: ModuleName\nm_Prim_Int = ModuleName \"Prim.Int\"\n\nclsIntAdd :: Qualified (ProperName TypeName)\nclsIntAdd = Qualified (ByModuleName m_Prim_Int) (ProperName \"Add\")\n\nclsIntCompare :: Qualified (ProperName TypeName)\nclsIntCompare = Qualified (ByModuleName m_Prim_Int) (ProperName \"Compare\")\n\nclsIntMul :: Qualified (ProperName TypeName)\nclsIntMul = Qualified (ByModuleName m_Prim_Int) (ProperName \"Mul\")\n\nclsIntToString :: Qualified (ProperName TypeName)\nclsIntToString = Qualified (ByModuleName m_Prim_Int) (ProperName \"ToString\")\n\nm_Prim_Ordering :: ModuleName\nm_Prim_Ordering = ModuleName \"Prim.Ordering\"\n\ntyTypeOrdering :: Qualified (ProperName TypeName)\ntyTypeOrdering = Qualified (ByModuleName m_Prim_Ordering) (ProperName \"Ordering\")\n\ntyEQ :: Qualified (ProperName TypeName)\ntyEQ = Qualified (ByModuleName m_Prim_Ordering) (ProperName \"EQ\")\n\ntyGT :: Qualified (ProperName TypeName)\ntyGT = Qualified (ByModuleName m_Prim_Ordering) (ProperName \"GT\")\n\ntyLT :: Qualified (ProperName TypeName)\ntyLT = Qualified (ByModuleName m_Prim_Ordering) (ProperName \"LT\")\n\nm_Prim_Row :: ModuleName\nm_Prim_Row = ModuleName \"Prim.Row\"\n\nclsRowCons :: Qualified (ProperName TypeName)\nclsRowCons = Qualified (ByModuleName m_Prim_Row) (ProperName \"Cons\")\n\nclsRowLacks :: Qualified (ProperName TypeName)\nclsRowLacks = Qualified (ByModuleName m_Prim_Row) (ProperName \"Lacks\")\n\nclsRowNub :: Qualified (ProperName TypeName)\nclsRowNub = Qualified (ByModuleName m_Prim_Row) (ProperName \"Nub\")\n\nclsRowUnion :: Qualified (ProperName TypeName)\nclsRowUnion = Qualified (ByModuleName m_Prim_Row) (ProperName \"Union\")\n\nm_Prim_RowList :: ModuleName\nm_Prim_RowList = ModuleName \"Prim.RowList\"\n\ntyRowList :: Qualified (ProperName TypeName)\ntyRowList = Qualified (ByModuleName m_Prim_RowList) (ProperName \"RowList\")\n\nclsRowToList :: Qualified (ProperName TypeName)\nclsRowToList = Qualified (ByModuleName m_Prim_RowList) (ProperName \"RowToList\")\n\ntyRowListCons :: Qualified (ProperName TypeName)\ntyRowListCons = Qualified (ByModuleName m_Prim_RowList) (ProperName \"Cons\")\n\ntyRowListNil :: Qualified (ProperName TypeName)\ntyRowListNil = Qualified (ByModuleName m_Prim_RowList) (ProperName \"Nil\")\n\nm_Prim_Symbol :: ModuleName\nm_Prim_Symbol = ModuleName \"Prim.Symbol\"\n\nclsSymbolAppend :: Qualified (ProperName TypeName)\nclsSymbolAppend = Qualified (ByModuleName m_Prim_Symbol) (ProperName \"Append\")\n\nclsSymbolCompare :: Qualified (ProperName TypeName)\nclsSymbolCompare = Qualified (ByModuleName m_Prim_Symbol) (ProperName \"Compare\")\n\nclsSymbolCons :: Qualified (ProperName TypeName)\nclsSymbolCons = Qualified (ByModuleName m_Prim_Symbol) (ProperName \"Cons\")\n\nm_Prim_TypeError :: ModuleName\nm_Prim_TypeError = ModuleName \"Prim.TypeError\"\n\nclsFail :: Qualified (ProperName TypeName)\nclsFail = Qualified (ByModuleName m_Prim_TypeError) (ProperName \"Fail\")\n\nclsWarn :: Qualified (ProperName TypeName)\nclsWarn = Qualified (ByModuleName m_Prim_TypeError) (ProperName \"Warn\")\n\ntyAbove :: Qualified (ProperName TypeName)\ntyAbove = Qualified (ByModuleName m_Prim_TypeError) (ProperName \"Above\")\n\ntyBeside :: Qualified (ProperName TypeName)\ntyBeside = Qualified (ByModuleName m_Prim_TypeError) (ProperName \"Beside\")\n\ntyDoc :: Qualified (ProperName TypeName)\ntyDoc = Qualified (ByModuleName m_Prim_TypeError) (ProperName \"Doc\")\n\ntyQuote :: Qualified (ProperName TypeName)\ntyQuote = Qualified (ByModuleName m_Prim_TypeError) (ProperName \"Quote\")\n\ntyQuoteLabel :: Qualified (ProperName TypeName)\ntyQuoteLabel = Qualified (ByModuleName m_Prim_TypeError) (ProperName \"QuoteLabel\")\n\ntyText :: Qualified (ProperName TypeName)\ntyText = Qualified (ByModuleName m_Prim_TypeError) (ProperName \"Text\")\n", "export const decodeUtf16BEImpl = (arrayOfUt16CodeUnits) => {\n const arrayBuf = new ArrayBuffer(2 * arrayOfUt16CodeUnits.length);\n const dataBuf = new DataView(arrayBuf);\n for (let i = 0; i < arrayOfUt16CodeUnits.length; i++) {\n dataBuf.setUint16(2 * i, arrayOfUt16CodeUnits[i], false);\n }\n const decoder = new TextDecoder(\"utf-16be\", { fatal: true, ignoreBOM: false });\n try {\n return decoder.decode(dataBuf);\n } catch {\n return null;\n }\n}\n", "module Data.CodeUnit where\n\nimport Prelude\n\nimport Codec.Json.Unidirectional.Value as Json\nimport Control.Monad.ST.Internal (while)\nimport Control.Monad.ST.Internal as ST\nimport Control.Monad.ST.Internal as STRef\nimport Data.Argonaut.Core (Json)\nimport Data.Array as Array\nimport Data.Array.ST as STA\nimport Data.Char (toCharCode)\nimport Data.Either (Either(..), note)\nimport Data.Enum (class BoundedEnum, class Enum, Cardinality(..), defaultPred, defaultSucc, fromEnum, toEnum)\nimport Data.Int (hexadecimal)\nimport Data.Int as Int\nimport Data.Int.Bits (shr, (.&.))\nimport Data.Maybe (Maybe(..), fromJust)\nimport Data.Monoid (power)\nimport Data.String (CodePoint)\nimport Data.String as SCP\nimport Data.String as String\nimport Data.String.CodeUnits as SCU\nimport Data.Tuple (Tuple(..))\nimport Partial.Unsafe (unsafePartial)\n\nnewtype CodeUnit = CodeUnit Int\n\nderive instance Eq CodeUnit\nderive instance Ord CodeUnit\nderive newtype instance Show CodeUnit\ninstance Enum CodeUnit where\n succ = defaultSucc toEnum fromEnum\n pred = defaultPred toEnum fromEnum\n\ninstance Bounded CodeUnit where\n bottom = CodeUnit 0\n top = CodeUnit 65535\n\ninstance BoundedEnum CodeUnit where\n cardinality = Cardinality 65535\n toEnum c\n | between 0 65535 c = Just $ CodeUnit c\n | otherwise = Nothing\n fromEnum (CodeUnit c) = c\n\nfromCodeUnit :: CodeUnit -> Json\nfromCodeUnit = fromEnum >>> Json.fromInt\n\ntoCodeUnit :: Json -> Either Json.DecodeError CodeUnit\ntoCodeUnit = Json.toInt >=> toEnum >>> note (Json.DecodeError \"Value out of bounds for CodeUnit (0 <= x <= 65535)\")\n\nunpairBE :: CodeUnit -> Array Int\nunpairBE c = [ highByte c, lowByte c ]\n\nunpairLE :: CodeUnit -> Array Int\nunpairLE c = [ lowByte c, highByte c ]\n\n-- https://stackoverflow.com/a/53567998\nlowByte :: CodeUnit -> Int\nlowByte (CodeUnit c) = c .&. 0xFF\n\n-- https://stackoverflow.com/a/53567998\nhighByte :: CodeUnit -> Int\nhighByte (CodeUnit c) = (shr c 8) .&. 0xFF\n\nisLead :: Int -> Boolean\nisLead h = h >= 0xD800 && h <= 0xDBFF\n\nisTrail :: Int -> Boolean\nisTrail l = l >= 0xDC00 && l <= 0xDFFF\n\nisSurrogate :: Int -> Boolean\nisSurrogate c = isLead c || isTrail c\n\ndecodeUtf16BE :: Array CodeUnit -> Array (Either CodeUnit CodePoint)\ndecodeUtf16BE cus = ST.run do\n let len = Array.length cus\n let lastIdx = len - 1\n arr <- STA.new\n currentIdx <- STRef.new 0\n\n while ((notEq len) <$> STRef.read currentIdx) do\n idx <- STRef.read currentIdx\n let h'@(CodeUnit h) = unsafePartial $ Array.unsafeIndex cus idx\n if idx + 1 <= lastIdx then do\n let (CodeUnit l) = unsafePartial $ Array.unsafeIndex cus (idx + 1)\n if isLead h && isTrail l then do\n _ <- STA.push (Right $ unsafePartial $ fromJust $ toEnum $ (h - 0xD800) * 0x400 + (l - 0xDC00) + 0x10000) arr\n STRef.write (idx + 2) currentIdx\n else do\n _ <- STA.push (if isSurrogate h then Left h' else Right $ unsafePartial $ fromJust $ toEnum h) arr\n STRef.write (idx + 1) currentIdx\n else do\n _ <- STA.push (if isSurrogate h then Left h' else Right $ unsafePartial $ fromJust $ toEnum h) arr\n STRef.write (idx + 1) currentIdx\n\n STA.unsafeFreeze arr\n\ndecodeUtf16BEStr :: (CodeUnit -> String) -> Array CodeUnit -> String\ndecodeUtf16BEStr codeUnitToStr cus = ST.run do\n let len = Array.length cus\n let lastIdx = len - 1\n str <- STRef.new \"\"\n currentIdx <- STRef.new 0\n\n while ((notEq len) <$> STRef.read currentIdx) do\n idx <- STRef.read currentIdx\n let CodeUnit h = unsafePartial $ Array.unsafeIndex cus idx\n if idx + 1 <= lastIdx then do\n let (CodeUnit l) = unsafePartial $ Array.unsafeIndex cus (idx + 1)\n if isLead h && isTrail l then do\n _ <- str # STRef.modify \\s -> append s\n $ SCP.singleton\n $ unsafePartial\n $ fromJust\n $ toEnum\n $ (h - 0xD800) * 0x400 + (l - 0xDC00) + 0x10000\n STRef.write (idx + 2) currentIdx\n else do\n _ <- str # STRef.modify \\s -> append s\n if isSurrogate h then codeUnitToStr $ unsafePartial $ fromJust $ toEnum h\n else SCP.singleton $ unsafePartial $ fromJust $ toEnum h\n STRef.write (idx + 1) currentIdx\n else do\n _ <- str # STRef.modify \\s -> append s\n if isSurrogate h then codeUnitToStr $ unsafePartial $ fromJust $ toEnum h\n else SCP.singleton $ unsafePartial $ fromJust $ toEnum h\n STRef.write (idx + 1) currentIdx\n\n STRef.read str\n\nencodeUtf16BE \u2237 CodePoint \u2192 Array CodeUnit\nencodeUtf16BE cp = do\n let cpAsInt = fromEnum cp\n if cpAsInt >= 0xFFFF then do\n let Tuple high low = surrogatesBE cpAsInt\n [ high, low ]\n else do\n [ CodeUnit cpAsInt ]\n where\n surrogatesBE :: Int -> Tuple CodeUnit CodeUnit\n surrogatesBE cpAsInt = Tuple (CodeUnit $ h + 0xD800) (CodeUnit $ l + 0xDC00)\n where\n Tuple h l = divMod (cpAsInt - 0x10000) 0x400\n\ndivMod :: Int -> Int -> Tuple Int Int\ndivMod l r = Tuple (l / r) (l `mod` r)\n\nprettyPrintCodeUnitPS :: CodeUnit -> String\nprettyPrintCodeUnitPS = showHex' \"\\\\x\" 6 <<< fromEnum\n\nprettyPrintCodeUnitJS :: CodeUnit -> String\nprettyPrintCodeUnitJS (CodeUnit c)\n | c > 0xFF = showHex' \"\\\\u\" 4 c\n | c > 0x7E || c < 0x20 = showHex' \"\\\\x\" 2 c\n | c == 0x0008 {- '\\b' -} = \"\\\\b\"\n | c == toCharCode '\\t' = \"\\\\t\"\n | c == toCharCode '\\n' = \"\\\\n\"\n | c == 0x000b {- '\\v' -} = \"\\\\v\"\n | c == 0x000c {- '\\f' -} = \"\\\\f\"\n | c == toCharCode '\\r' = \"\\\\r\"\n | c == toCharCode '\"' = \"\\\\\\\"\"\n | c == toCharCode '\\\\' = \"\\\\\\\\\"\n | otherwise = SCU.singleton $ unsafePartial fromJust $ toEnum c\n\nshowHex' :: String -> Int -> Int -> String\nshowHex' prefix width c = do\n let hs = Int.toStringAs hexadecimal c\n prefix <> power \"0\" (width - String.length hs) <> hs\n", "module Language.PureScript.PSString\n ( PSString\n , toUTF16CodeUnits\n , mkPSString\n , fromPsString\n , toPSString\n , decodeString\n , decodeStringEither\n , decodeStringWithReplacement\n , prettyPrintStringPS\n , prettyPrintStringJS\n ) where\n\nimport Prelude\n\nimport Codec.Json.Unidirectional.Value as Json\nimport Control.Alt ((<|>))\nimport Data.Argonaut.Core (Json)\nimport Data.Array as Array\nimport Data.Char (toCharCode)\nimport Data.CodePoint.Unicode (generalCategory)\nimport Data.CodePoint.Unicode as GeneralCategory\nimport Data.CodeUnit (CodeUnit, fromCodeUnit, decodeUtf16BE, decodeUtf16BEStr, encodeUtf16BE, toCodeUnit, prettyPrintCodeUnitJS, prettyPrintCodeUnitPS, showHex', unpairBE)\nimport Data.Either (Either, either)\nimport Data.Enum (fromEnum, toEnum)\nimport Data.Maybe (Maybe(..), fromJust, fromMaybe)\nimport Data.Nullable (Nullable, toMaybe)\nimport Data.String (CodePoint, toCodePointArray)\nimport Data.String as SCP\nimport Data.String.CodeUnits as SCU\nimport Partial.Unsafe (unsafePartial)\n\n-- | An array of UTF-16BE code units\nnewtype PSString = PSString (Array CodeUnit)\n\ntoUTF16CodeUnits :: PSString -> Array CodeUnit\ntoUTF16CodeUnits (PSString x) = x\n\nderive newtype instance Eq PSString\nderive newtype instance Ord PSString\nderive newtype instance Semigroup PSString\nderive newtype instance Monoid PSString\n\ninstance Show PSString where\n show = show <<< codePoints\n\nfromPsString :: PSString -> Json\nfromPsString psStr = case decodeString psStr of\n Just str -> Json.fromString str\n Nothing -> Json.fromArray fromCodeUnit $ toUTF16CodeUnits psStr\n\ntoPSString :: Json -> Either Json.DecodeError PSString\n\ntoPSString j = asString <|> asCodeUnitArray\n where\n asString = mkPSString <$> Json.toString j\n asCodeUnitArray = PSString <$> Json.toArray toCodeUnit j\n\nmkPSString :: String -> PSString\nmkPSString = PSString <<< Array.concatMap encodeUtf16BE <<< toCodePointArray\n\ndecodeString :: PSString -> Maybe String\ndecodeString = toMaybe <<< decodeUtf16BEImpl <<< Array.concatMap unpairBE <<< toUTF16CodeUnits\n\ncodePoints :: PSString -> String\ncodePoints = toUTF16CodeUnits >>>\n decodeUtf16BEStr (SCU.singleton <<< unsafePartial fromJust <<< toEnum <<< fromEnum)\n\ndecodeStringEither :: PSString -> Array (Either CodeUnit CodePoint)\ndecodeStringEither = decodeUtf16BE <<< toUTF16CodeUnits\n\ndecodeStringWithReplacement :: PSString -> String\ndecodeStringWithReplacement = toUTF16CodeUnits >>>\n decodeUtf16BEStr (const \"\\xFFFD\")\n\nforeign import decodeUtf16BEImpl :: Array Int -> Nullable String\n\nprettyPrintStringPS :: PSString -> String\nprettyPrintStringPS s = \"\\\"\" <> Array.foldMap (either prettyPrintCodeUnitPS encodeCodePoint) (decodeStringEither s) <> \"\\\"\"\n where\n encodeCodePoint cp = encode $ fromEnum cp\n where\n encode c\n | c == toCharCode '\\t' = \"\\\\t\"\n | c == toCharCode '\\r' = \"\\\\r\"\n | c == toCharCode '\\n' = \"\\\\n\"\n | c == toCharCode '\"' = \"\\\\\\\"\"\n | c == toCharCode '\\'' = \"\\\\\\'\"\n | c == toCharCode '\\\\' = \"\\\\\\\\\"\n | shouldPrint cp = SCP.singleton cp\n | otherwise = showHex' \"\\\\x\" 6 c\n\n shouldPrint :: CodePoint -> Boolean\n shouldPrint cp\n | i <- fromEnum cp, i == toCharCode ' ' = true\n | otherwise = fromMaybe false do\n cat <- generalCategory cp\n pure $ Array.elem cat\n [ GeneralCategory.UppercaseLetter\n , GeneralCategory.LowercaseLetter\n , GeneralCategory.TitlecaseLetter\n , GeneralCategory.OtherLetter\n , GeneralCategory.DecimalNumber\n , GeneralCategory.LetterNumber\n , GeneralCategory.OtherNumber\n , GeneralCategory.ConnectorPunctuation\n , GeneralCategory.DashPunctuation\n , GeneralCategory.OpenPunctuation\n , GeneralCategory.ClosePunctuation\n , GeneralCategory.InitialQuote\n , GeneralCategory.FinalQuote\n , GeneralCategory.OtherPunctuation\n , GeneralCategory.MathSymbol\n , GeneralCategory.CurrencySymbol\n , GeneralCategory.ModifierSymbol\n , GeneralCategory.OtherSymbol\n ]\n\nprettyPrintStringJS :: PSString -> String\nprettyPrintStringJS s = \"\\\"\" <> Array.foldMap prettyPrintCodeUnitJS (toUTF16CodeUnits s) <> \"\\\"\"\n", "module Language.PureScript.Label where\n\nimport Prelude\n\nimport Codec.Json.Unidirectional.Value as Json\nimport Data.Argonaut.Core (Json)\nimport Data.Either (Either)\nimport Data.Generic.Rep (class Generic)\nimport Data.Newtype (class Newtype, unwrap)\nimport Language.PureScript.PSString (PSString, toPSString, fromPsString)\nimport Safe.Coerce (coerce)\n\n-- |\n-- Labels are used as record keys and row entry names. Labels newtype PSString\n-- because records are indexable by PureScript strings at runtime.\n--\nnewtype Label = Label PSString\n\nderive instance Eq Label\nderive instance Ord Label\nderive instance Newtype Label _\nderive instance Generic Label _\nderive newtype instance Show Label\nderive newtype instance Semigroup Label\nderive newtype instance Monoid Label\n\nfromLabel :: Label -> Json\nfromLabel = unwrap >>> fromPsString\n\ntoLabel :: Json -> Either Json.DecodeError Label\ntoLabel = coerce <<< toPSString\n\n", "module Language.PureScript.Types where\n\nimport Prelude\nimport Prim hiding (Type, Constraint)\n\nimport Codec.Json.Unidirectional.Value (ToProp(..))\nimport Codec.Json.Unidirectional.Value as Json\nimport Control.Alt ((<|>))\nimport Data.Argonaut.Core (Json)\nimport Data.Array (zipWith)\nimport Data.Either (Either(..))\nimport Data.Foldable (class Foldable, and, fold)\nimport Data.Function.Uncurried (mkFn2)\nimport Data.Generic.Rep (class Generic)\nimport Data.Maybe (Maybe(..), maybe)\nimport Data.Newtype (class Newtype, unwrap)\nimport Data.Show.Generic (genericShow)\nimport Data.Traversable (class Traversable)\nimport Data.Tuple (Tuple(..))\nimport Language.PureScript.AST.SourcePos (SourceAnn, nullSourceAnn)\nimport Language.PureScript.Constants.Prim as C\nimport Language.PureScript.Label (Label, toLabel, fromLabel)\nimport Language.PureScript.Names (ClassName, OpName, ProperName, Qualified, TypeName, TypeOpName, toOpName, toProperName, toQualified, fromOpName, fromProperName, fromQualified)\nimport Language.PureScript.PSString (PSString, fromPsString, toPSString)\nimport Safe.Coerce (coerce)\n\n-- | An identifier for the scope of a skolem variable\nnewtype SkolemScope = SkolemScope Int\n\nderive instance Eq SkolemScope\nderive instance Ord SkolemScope\nderive instance Newtype SkolemScope _\nderive instance Generic SkolemScope _\ninstance Show SkolemScope where\n show x = genericShow x\n\nfromSkolemScope :: SkolemScope -> Json\nfromSkolemScope = unwrap >>> Json.fromInt\n\ntoSkolemScope :: Json -> Either Json.DecodeError SkolemScope\ntoSkolemScope = coerce Json.toInt\n\ndata WildcardData\n = HoleWildcard String\n | UnnamedWildcard\n | IgnoredWildcard\n\nderive instance Eq WildcardData\nderive instance Ord WildcardData\nderive instance Generic WildcardData _\ninstance Show WildcardData where\n show x = genericShow x\n\nfromWildcardData :: WildcardData -> Json\nfromWildcardData = case _ of\n HoleWildcard name -> Json.fromString name\n UnnamedWildcard -> Json.fromJNull\n IgnoredWildcard -> Json.fromObjSingleton \"ignored\" (Json.fromBoolean true)\n\ntoWildcardData :: Json -> Either Json.DecodeError WildcardData\ntoWildcardData j = holeWildcard <|> unnamedWildcard <|> ignoredWildcard\n where\n holeWildcard = HoleWildcard <$> Json.toString j\n unnamedWildcard = UnnamedWildcard <$ Json.toJNull j\n ignoredWildcard = IgnoredWildcard <$ Json.toJObject j\n\ndata TypeVarVisibility\n = TypeVarVisible\n | TypeVarInvisible\n\nderive instance Eq TypeVarVisibility\nderive instance Ord TypeVarVisibility\nderive instance Generic TypeVarVisibility _\ninstance Show TypeVarVisibility where\n show x = genericShow x\n\nfromTypeVarVisibility :: TypeVarVisibility -> Json\nfromTypeVarVisibility = Json.fromString <<< case _ of\n TypeVarVisible -> \"TypeVarVisible\"\n TypeVarInvisible -> \"TypeVarInvisible\"\n\ntoTypeVarVisibility :: Json -> Either Json.DecodeError TypeVarVisibility\ntoTypeVarVisibility = Json.toString >=> case _ of\n \"TypeVarVisible\" -> pure TypeVarVisible\n \"TypeVarInvisible\" -> pure TypeVarInvisible\n str -> Left $ Json.DecodeError $ \"Expected 'TypeVarVisible' or 'TypeVarInvisible' but got '\" <> str <> \"'.\"\n\ntype SourceType = Type SourceAnn\n\ndata Type a\n = TUnknown a Int\n | TypeVar a String\n | TypeLevelString a PSString\n | TypeLevelInt a Int\n | TypeWildcard a WildcardData\n | TypeConstructor a (Qualified (ProperName TypeName))\n | TypeOp a (Qualified (OpName TypeOpName))\n | TypeApp a (Type a) (Type a)\n | KindApp a (Type a) (Type a)\n | ForAll a TypeVarVisibility String (Maybe (Type a)) (Type a) (Maybe SkolemScope)\n | ConstrainedType a (Constraint a) (Type a)\n | Skolem a String (Maybe (Type a)) Int SkolemScope\n | REmpty a\n | RCons a Label (Type a) (Type a)\n | KindedType a (Type a) (Type a)\n | BinaryNoParensType a (Type a) (Type a) (Type a)\n | ParensInType a (Type a)\n\nderive instance Functor Type\nderive instance Foldable Type\nderive instance Traversable Type\nderive instance Generic (Type a) _\ninstance Show a => Show (Type a) where\n show x = genericShow x\n\nsrcTypeConstructor :: Qualified (ProperName TypeName) -> SourceType\nsrcTypeConstructor = TypeConstructor nullSourceAnn\n\nfromType :: forall a. (a -> Json) -> Type a -> Json\nfromType fromAnn ty =\n case ty of\n TUnknown a b ->\n variant \"TUnknown\" a $ Json.fromInt b\n TypeVar a b ->\n variant \"TypeVar\" a $ Json.fromString b\n TypeLevelString a b ->\n variant \"TypeLevelString\" a $ fromPsString b\n TypeLevelInt a b ->\n variant \"TypeLevelInt\" a $ Json.fromInt b\n TypeWildcard a b ->\n variant \"TypeWildcard\" a $ fromWildcardData b\n TypeConstructor a b ->\n variant \"TypeConstructor\" a $ fromQualified fromProperName b\n TypeOp a b ->\n variant \"TypeOp\" a $ fromQualified fromOpName b\n TypeApp a b c ->\n variant \"TypeApp\" a $ Json.fromArray2 (go b) (go c)\n KindApp a b c ->\n variant \"KindApp\" a $ Json.fromArray2 (go b) (go c)\n ForAll a b c d e f ->\n variant \"ForAll\" a $ Json.fromPropArray\n [ Tuple \"visibility\" $ fromTypeVarVisibility b\n , Tuple \"identifier\" $ Json.fromString c\n , Tuple \"kind\" $ Json.fromNullNothingOrJust go d\n , Tuple \"type\" $ go e\n , Tuple \"skolem\" $ Json.fromNullNothingOrJust fromSkolemScope f\n ]\n ConstrainedType a b c ->\n variant \"ConstrainedType\" a $ Json.fromArray2 (fromConstraint fromAnn b) (go c)\n Skolem a b c d e ->\n variant \"Skolem\" a $ Json.fromArray4 (Json.fromString b) (Json.fromNullNothingOrJust go c) (Json.fromInt d) (fromSkolemScope e)\n REmpty a ->\n nullary \"REmpty\" a\n RCons a b c d ->\n variant \"RCons\" a $ Json.fromArray3 (fromLabel b) (go c) (go d)\n KindedType a b c ->\n variant \"KindedType\" a $ Json.fromArray2 (go b) (go c)\n BinaryNoParensType a b c d ->\n variant \"BinaryNoParensType\" a $ Json.fromArray3 (go b) (go c) (go d)\n ParensInType a b ->\n variant \"ParensInType\" a (go b)\n where\n go :: Type a -> Json\n go = fromType fromAnn\n\n variant :: String -> a -> Json -> Json\n variant tag ann contents = Json.fromPropArray\n [ Tuple \"tag\" $ Json.fromString tag\n , Tuple \"annotation\" $ fromAnn ann\n , Tuple \"contents\" $ contents\n ]\n\n nullary :: String -> a -> Json\n nullary tag ann = Json.fromPropArray\n [ Tuple \"tag\" $ Json.fromString tag\n , Tuple \"annotation\" $ fromAnn ann\n ]\n\ntoSourceType :: (Json -> Either Json.DecodeError SourceAnn) -> Json -> Either Json.DecodeError (Type SourceAnn)\ntoSourceType toAnn = toType' (pure nullSourceAnn) toAnn\n\ntoTypeUnit :: Json -> Either Json.DecodeError (Type Unit)\ntoTypeUnit = toType' (pure unit) Json.toJNull\n\ntoType' :: forall a. Either Json.DecodeError a -> (Json -> Either Json.DecodeError a) -> Json -> Either Json.DecodeError (Type a)\ntoType' defaultAnn toAnn j = do\n o <- Json.toJObject j\n tag <- Json.underKey \"tag\" Json.toString o\n a <- (Json.underKey \"annotation\" toAnn o) <|> defaultAnn\n let\n contents :: forall x. (Json -> Either Json.DecodeError x) -> Either Json.DecodeError x\n contents f = Json.underKey \"contents\" f o\n case tag of\n \"TUnknown\" ->\n TUnknown a <$> (contents Json.toInt)\n \"TypeVar\" ->\n TypeVar a <$> (contents Json.toString)\n \"TypeLevelString\" ->\n TypeLevelString a <$> (contents toPSString)\n \"TypeLevelInt\" ->\n TypeLevelInt a <$> (contents Json.toInt)\n \"TypeWildcard\" -> do\n TypeWildcard a <$> ((contents toWildcardData) <|> pure UnnamedWildcard)\n \"TypeConstructor\" ->\n TypeConstructor a <$> (contents $ toQualified toProperName)\n \"TypeOp\" ->\n TypeOp a <$> (contents $ toQualified toOpName)\n \"TypeApp\" -> do\n contents $ Json.toArray2 go go (TypeApp a)\n \"KindApp\" -> do\n contents $ Json.toArray2 go go (KindApp a)\n \"ForAll\" -> do\n let\n asObject fromContents = do\n { v, i, k, t, s } <- Json.toRecord\n { v: Json.toRequiredRename \"visibility\" toTypeVarVisibility\n , i: Json.toRequiredRename \"identifier\" Json.toString\n , k: Json.toOptionDefaultRename \"kind\" Nothing $ Json.toNullNothingOrJust go\n , t: Json.toRequiredRename \"type\" go\n , s: Json.toRequiredRename \"skolem\" $ Json.toNullNothingOrJust toSkolemScope\n }\n fromContents\n pure $ ForAll a v i k t s\n\n withoutMbKind fromContents = do\n fromContents # Json.toArray3 Json.toString go (Json.toNullNothingOrJust toSkolemScope) \\i t s ->\n ForAll a TypeVarInvisible i Nothing t s\n\n withMbKind fromContents = do\n fromContents # Json.toArray4 Json.toString (Json.toNullNothingOrJust go) go (Json.toNullNothingOrJust toSkolemScope) \\i k t s ->\n ForAll a TypeVarInvisible i k t s\n contents ((asObject `Json.altAccumulate` withMbKind) `Json.altAccumulate` withoutMbKind)\n \"ConstrainedType\" ->\n contents $ Json.toArray2 (toConstraint' defaultAnn toAnn) go (ConstrainedType a)\n \"Skolem\" -> do\n contents $ Json.toArray4 Json.toString (Json.toNullNothingOrJust go) Json.toInt toSkolemScope (Skolem a)\n \"REmpty\" ->\n pure $ REmpty a\n \"RCons\" -> do\n contents $ Json.toArray3 toLabel go go (RCons a)\n \"KindedType\" -> do\n contents $ Json.toArray2 go go (KindedType a)\n \"BinaryNoParensType\" -> do\n contents $ Json.toArray3 go go go (BinaryNoParensType a)\n \"ParensInType\" -> do\n ParensInType a <$> (contents go)\n -- Backwards compatibility for kinds\n -- See https://github.com/purescript/purescript/pull/3779/files#diff-870a1f93bcc1630036804836b97cff8471bfaeb781b70545aea51343786085a5\n \"KUnknown\" ->\n TUnknown a <$> (contents Json.toInt)\n \"Row\" ->\n TypeApp a (TypeConstructor a C.tyRow) <$> (contents go)\n \"FunKind\" -> do\n contents $ Json.toArray2 go go \\b c ->\n TypeApp a (TypeApp a (TypeConstructor a C.tyFunction) b) c\n \"NamedKind\" ->\n TypeConstructor a <$> (contents $ toQualified toProperName)\n str ->\n Left $ Json.DecodeError $ \"Unexpected value for `declType`: \" <> str\n where\n go :: Json -> Either Json.DecodeError (Type a)\n go = toType' defaultAnn toAnn\n\n-- | Additional data relevant to type class constraints\ndata ConstraintData = PartialConstraintData (Array (Array String)) Boolean\n\nderive instance Eq ConstraintData\nderive instance Ord ConstraintData\nderive instance Generic ConstraintData _\ninstance Show ConstraintData where\n show x = genericShow x\n\nfromConstraintData :: ConstraintData -> Json\nfromConstraintData = case _ of\n PartialConstraintData bs trunc ->\n Json.fromObjSingleton \"contents\" $ Json.fromArray2\n (Json.fromArray (Json.fromArray Json.fromString) bs)\n (Json.fromBoolean trunc)\n\ntoConstraintData :: Json -> Either Json.DecodeError ConstraintData\ntoConstraintData = map _.contents <<< Json.toRecord\n { contents: Json.toRequired $ Json.toArray2 (Json.toArray (Json.toArray Json.toString)) Json.toBoolean PartialConstraintData\n }\n\ntype SourceConstraint = Constraint SourceAnn\n\n-- | A typeclass constraint\nnewtype Constraint a = Constraint\n { ann :: a\n , class :: Qualified (ProperName ClassName)\n , kindArgs :: Array (Type a)\n , args :: Array (Type a)\n , \"data\" :: Maybe ConstraintData\n }\n\nderive instance Newtype (Constraint a) _\nderive instance Generic (Constraint a) _\nderive instance Functor Constraint\nderive instance Foldable Constraint\nderive instance Traversable Constraint\ninstance Show a => Show (Constraint a) where\n show x = genericShow x\n\nfromConstraint :: forall a. (a -> Json) -> Constraint a -> Json\nfromConstraint fromAnn = Json.fromRecordN Constraint\n { ann: Json.fromRequiredRename \"constraintAnn\" fromAnn\n , class: Json.fromRequiredRename \"constraintClass\" $ fromQualified fromProperName\n , kindArgs: Json.fromRequiredRename \"constraintKindArgs\" $ Json.fromArray $ fromType fromAnn\n , args: Json.fromRequiredRename \"constraintArgs\" $ Json.fromArray $ fromType fromAnn\n , data: Json.fromRequiredRename \"constraintData\" $ Json.fromNullNothingOrJust fromConstraintData\n }\n\ntoSourceConstraint :: (Json -> Either Json.DecodeError SourceAnn) -> Json -> Either Json.DecodeError (Constraint SourceAnn)\ntoSourceConstraint toAnn = toConstraint' (pure nullSourceAnn) toAnn\n\ntoConstraintUnit :: (Json -> Either Json.DecodeError Unit) -> Json -> Either Json.DecodeError (Constraint Unit)\ntoConstraintUnit toAnn = toConstraint' (pure unit) toAnn\n\ntoConstraint' :: forall a. Either Json.DecodeError a -> (Json -> Either Json.DecodeError a) -> Json -> Either Json.DecodeError (Constraint a)\ntoConstraint' defaultAnn toAnn = Json.toRecordN Constraint\n { ann: ToProp $ mkFn2 \\lookup _ -> (maybe defaultAnn toAnn $ lookup \"constraintAnn\") <|> defaultAnn\n , class: Json.toRequiredRename \"constraintClass\" $ toQualified toProperName\n , kindArgs: Json.toOptionDefaultRename \"constraintKindArgs\" [] $ Json.toArray $ toType' defaultAnn toAnn\n , args: Json.toRequiredRename \"constraintArgs\" $ Json.toArray $ toType' defaultAnn toAnn\n , data: Json.toRequiredRename \"constraintData\" $ Json.toNullNothingOrJust toConstraintData\n }\n\nnewtype RowListItem a = RowListItem\n { ann :: a\n , label :: Label\n , type :: Type a\n }\n\nderive instance Eq a => Eq (RowListItem a)\nderive instance Ord a => Ord (RowListItem a)\nderive instance Newtype (RowListItem a) _\nderive instance Generic (RowListItem a) _\ninstance Show a => Show (RowListItem a) where\n show x = genericShow x\n\nderive instance Functor RowListItem\nderive instance Foldable RowListItem\nderive instance Traversable RowListItem\n\ninstance Eq (Type a) where\n eq a b = eqType a b\n\ninstance Ord (Type a) where\n compare a b = compareType a b\n\neqType :: forall a b. Type a -> Type b -> Boolean\neqType = case _, _ of\n TUnknown _ a, TUnknown _ a' ->\n a == a'\n TypeVar _ a, TypeVar _ a' ->\n a == a'\n TypeLevelString _ a, TypeLevelString _ a' ->\n a == a'\n TypeLevelInt _ a, TypeLevelInt _ a' ->\n a == a'\n TypeWildcard _ a, TypeWildcard _ a' ->\n a == a'\n TypeConstructor _ a, TypeConstructor _ a' ->\n a == a'\n TypeOp _ a, TypeOp _ a' ->\n a == a'\n TypeApp _ a b, TypeApp _ a' b' ->\n eqType a a' && eqType b b'\n KindApp _ a b, KindApp _ a' b' ->\n eqType a a' && eqType b b'\n ForAll _ _ a b c d, ForAll _ _ a' b' c' d' ->\n a == a' && eqMaybeType b b' && eqType c c' && d == d'\n ConstrainedType _ a b, ConstrainedType _ a' b' ->\n eqConstraint a a' && eqType b b'\n Skolem _ a b c d, Skolem _ a' b' c' d' ->\n a == a' && eqMaybeType b b' && c == c' && d == d'\n REmpty _, REmpty _ ->\n true\n RCons _ a b c, RCons _ a' b' c' ->\n a == a' && eqType b b' && eqType c c'\n KindedType _ a b, KindedType _ a' b' ->\n eqType a a' && eqType b b'\n BinaryNoParensType _ a b c, BinaryNoParensType _ a' b' c' ->\n eqType a a' && eqType b b' && eqType c c'\n ParensInType _ a, ParensInType _ a' ->\n eqType a a'\n _, _ ->\n false\n\neqMaybeType :: forall a b. Maybe (Type a) -> Maybe (Type b) -> Boolean\neqMaybeType = case _, _ of\n Just a, Just b -> eqType a b\n Nothing, Nothing -> true\n _, _ -> false\n\ncompareType :: forall a b. Type a -> Type b -> Ordering\ncompareType = case _, _ of\n TUnknown _ a, TUnknown _ a' ->\n compare a a'\n TypeVar _ a, TypeVar _ a' ->\n compare a a'\n TypeLevelString _ a, TypeLevelString _ a' ->\n compare a a'\n TypeLevelInt _ a, TypeLevelInt _ a' ->\n compare a a'\n TypeWildcard _ a, TypeWildcard _ a' ->\n compare a a'\n TypeConstructor _ a, TypeConstructor _ a' ->\n compare a a'\n TypeOp _ a, TypeOp _ a' ->\n compare a a'\n TypeApp _ a b, TypeApp _ a' b' ->\n compareType a a' <> compareType b b'\n KindApp _ a b, KindApp _ a' b' ->\n compareType a a' <> compareType b b'\n ForAll _ _ a b c d, ForAll _ _ a' b' c' d' ->\n compare a a' <> compareMaybeType b b' <> compareType c c' <> compare d d'\n ConstrainedType _ a b, ConstrainedType _ a' b' ->\n compareConstraint a a' <> compareType b b'\n Skolem _ a b c d, Skolem _ a' b' c' d' ->\n compare a a' <> compareMaybeType b b' <> compare c c' <> compare d d'\n REmpty _, REmpty _ ->\n EQ\n RCons _ a b c, RCons _ a' b' c' ->\n compare a a' <> compareType b b' <> compareType c c'\n KindedType _ a b, KindedType _ a' b' ->\n compareType a a' <> compareType b b'\n BinaryNoParensType _ a b c, BinaryNoParensType _ a' b' c' ->\n compareType a a' <> compareType b b' <> compareType c c'\n ParensInType _ a, ParensInType _ a' ->\n compareType a a'\n typ, typ' ->\n compare (orderOf typ) (orderOf typ')\n where\n orderOf :: forall x. Type x -> Int\n orderOf = case _ of\n TUnknown _ _ -> 0\n TypeVar _ _ -> 1\n TypeLevelString _ _ -> 2\n TypeLevelInt _ _ -> 3\n TypeWildcard _ _ -> 4\n TypeConstructor _ _ -> 5\n TypeOp _ _ -> 6\n TypeApp _ _ _ -> 7\n KindApp _ _ _ -> 8\n ForAll _ _ _ _ _ _ -> 9\n ConstrainedType _ _ _ -> 10\n Skolem _ _ _ _ _ -> 11\n REmpty _ -> 12\n RCons _ _ _ _ -> 13\n KindedType _ _ _ -> 14\n BinaryNoParensType _ _ _ _ -> 15\n ParensInType _ _ -> 16\n\ncompareMaybeType :: forall a b. Maybe (Type a) -> Maybe (Type b) -> Ordering\ncompareMaybeType = case _, _ of\n Just a, Just b -> compareType a b\n Nothing, Nothing -> EQ\n Nothing, _ -> LT\n _, _ -> GT\n\ninstance Eq (Constraint a) where\n eq a b = eqConstraint a b\n\ninstance Ord (Constraint a) where\n compare a b = compareConstraint a b\n\neqConstraint :: forall a b. Constraint a -> Constraint b -> Boolean\neqConstraint = case _, _ of\n Constraint l, Constraint r ->\n l.class == r.class\n && and (zipWith eqType l.kindArgs r.kindArgs)\n && and (zipWith eqType l.args r.args)\n && l.data == r.data\n\ncompareConstraint :: forall a b. Constraint a -> Constraint b -> Ordering\ncompareConstraint = case _, _ of\n Constraint l, Constraint r ->\n compare l.class r.class\n <> fold (zipWith compareType l.kindArgs r.kindArgs)\n <> fold (zipWith compareType l.args r.args)\n <> compare l.data r.data\n", "module Language.PureScript.Environment where\n\nimport Prelude\n\nimport Codec.Json.Unidirectional.Value as Json\nimport Data.Argonaut.Core (Json)\nimport Data.Either (Either(..))\nimport Data.Generic.Rep (class Generic)\nimport Language.PureScript.Constants.Prim as CPrim\nimport Language.PureScript.Types (SourceType, srcTypeConstructor)\n\ndata DataDeclType\n = Data\n | Newtype\n\nderive instance Eq DataDeclType\nderive instance Ord DataDeclType\nderive instance Generic DataDeclType _\ninstance Show DataDeclType where\n show x = showDataDeclType x\n\nshowDataDeclType :: DataDeclType -> String\nshowDataDeclType Data = \"data\"\nshowDataDeclType Newtype = \"newtype\"\n\nfromDataDeclType :: DataDeclType -> Json\n\nfromDataDeclType = Json.fromString <<< showDataDeclType\n\ntoDataDeclType :: Json -> Either Json.DecodeError DataDeclType\ntoDataDeclType = Json.toString >=> case _ of\n \"data\" -> pure Data\n \"newtype\" -> pure Newtype\n str -> Left $ Json.DecodeError $ \"Expected 'data' or 'newtype' but got '\" <> str <> \"'.\"\n\nkindType :: SourceType\nkindType = srcTypeConstructor CPrim.tyType\n", "module Docs.Search.TypeDecoder\n ( module ReExport\n , dataDeclTypeCodec\n , typeCodec\n , TypeArgument\n , typeArgumentCodec\n , FunDeps\n , funDepsCodec\n , FunDep\n , QualifiedName\n , qualifiedNameCodec\n , constraintCodec\n ) where\n\nimport Prelude\nimport Prim hiding (Constraint)\n\nimport Codec.Json.Unidirectional.Value as Json\nimport Data.Argonaut.Core (Json)\nimport Data.Codec as Codec\nimport Data.Codec.JSON as CJ\nimport Data.Codec.JSON.Common as CJ.Common\nimport Data.Codec.JSON.Record as CJ.Record\nimport Data.Maybe (Maybe)\nimport Data.Tuple (Tuple)\nimport Docs.Search.DocTypes (AnyOpName, ChildDeclaration(..), ChildDeclarationInfo(..), ClassName, Constraint(..), Constraint', ConstraintData(..), ConstructorName, DataDeclType(..), Declaration(..), DeclarationInfo(..), DocLink(..), DocModule(..), GithubRepo(..), GithubUser(..), Ident(..), InPackage(..), InternalIdentData(..), KindInfo(..), Label(..), LinkLocation(..), LinksContext(..), ManifestError(..), ModuleName(..), Name(..), Namespace, NotYetKnown(..), OpName(..), OpNameType, Package(..), PackageError(..), ProperName(..), ProperNameType, Qualified(..), QualifiedBy(..), RowListItem(..), SkolemScope(..), SourceAnn(..), SourceConstraint, SourcePos(..), SourceSpan(..), SourceType, Type(..), Type', TypeName, TypeOpName, TypeVarVisibility(..), UploadedPackage, ValueOpName, VerifiedPackage, WildcardData(..), _ss, _sss, byNullSourcePos, compareConstraint, compareMaybeType, compareType, eqConstraint, eqMaybeType, eqType, fromChildDeclaration, fromChildDeclarationInfo, fromConstraint, fromConstraintData, fromDataDeclType, fromDeclaration, fromDeclarationInfo, fromDocModule, fromGithubRepo, fromGithubUser, fromISO8601, fromIdent, fromInPackage, fromInternalIdentData, fromKindInfo, fromLabel, fromModuleName, fromNotYetKnown, fromOpName, fromPackage, fromProperName, fromQualified, fromQualifiedBy, fromSkolemScope, fromSourceAnn, fromSourcePos, fromSourceSpan, fromType, fromTypeVarVisibility, fromVersion, fromWildcardData, hh_mm, kindType, nullSourceAnn, nullSourcePos, nullSourceSpan, showDataDeclType, srcTypeConstructor, toAsConstrantUnit, toChildDeclaration, toChildDeclarationInfo, toConstraint', toConstraintData, toConstraintUnit, toDataDeclType, toDeclaration, toDeclarationInfo, toDocModule, toFunDeps, toGithubRepo, toGithubUser, toISO8601, toIdent, toInPackage, toInternalIdentData, toKindInfo, toLabel, toModuleName, toNotYetKnown, toOpName, toPackage, toProperName, toQualified, toQualifiedBy, toSkolemScope, toSourceAnn, toSourceConstraint, toSourcePos, toSourceSpan, toSourceType, toType', toTypeArguments, toTypeUnit, toTypeVarVisibility, toUploadedPackage, toVersion, toWildcardData, yyyy_mm_dd) as ReExport\nimport Docs.Search.DocTypes (Constraint, DataDeclType, ProperName, Qualified, Type')\nimport Docs.Search.DocTypes as DocTypes\nimport Docs.Search.JsonCodec as JsonCodec\nimport JSON (JSON)\nimport JSON as JSON\nimport Unsafe.Coerce (unsafeCoerce)\n\ntype QualifiedName tag = Qualified (ProperName tag)\n\nqualifiedNameCodec :: forall tag. CJ.Codec (QualifiedName tag)\nqualifiedNameCodec = Codec.codec'\n (JsonCodec.fromUni $ DocTypes.toQualified DocTypes.toProperName)\n (fromArgonaut <<< DocTypes.fromQualified DocTypes.fromProperName)\n\ntype FunDeps = Array FunDep\ntype FunDep = Tuple (Array String) (Array String)\n\nfunDepsCodec :: CJ.Codec FunDeps\nfunDepsCodec = CJ.array $ CJ.Common.tuple typeVarsCodec typeVarsCodec\n where\n typeVarsCodec = CJ.array CJ.string\n\ntype TypeArgument =\n { name :: String\n , kind :: Maybe Type'\n }\n\ntypeArgumentCodec :: CJ.Codec TypeArgument\ntypeArgumentCodec = CJ.named \"TypeArgument\" $\n CJ.Record.object\n { name: CJ.string\n , kind: CJ.Record.optional typeCodec\n }\n\ndataDeclTypeCodec :: CJ.Codec DataDeclType\ndataDeclTypeCodec =\n Codec.codec'\n (JsonCodec.fromUni DocTypes.toDataDeclType)\n (fromArgonaut <<< DocTypes.fromDataDeclType)\n\ntypeCodec :: CJ.Codec Type'\ntypeCodec =\n Codec.codec'\n (JsonCodec.fromUni DocTypes.toTypeUnit)\n (fromArgonaut <<< DocTypes.fromType \\_ -> toArgonaut JSON.null)\n\ntype Constraint' = Constraint Unit\n\nconstraintCodec :: CJ.Codec Constraint'\nconstraintCodec =\n Codec.codec'\n (JsonCodec.fromUni $ DocTypes.toConstraintUnit Json.toJNull)\n (fromArgonaut <<< DocTypes.fromConstraint \\_ -> toArgonaut JSON.null)\n\nfromArgonaut :: Json -> JSON\nfromArgonaut = unsafeCoerce\n\ntoArgonaut :: JSON -> Json\ntoArgonaut = unsafeCoerce\n", "module Docs.Search.SearchResult where\n\nimport Prelude\n\nimport Data.Codec.JSON.Variant as CJ.Variant\nimport Data.Codec.JSON.Common as CJ\nimport Data.Codec.JSON.Record as CJ.Record\nimport Data.Either (Either(..))\nimport Data.Maybe (Maybe(..))\nimport Data.Newtype (class Newtype, un)\nimport Data.Profunctor (wrapIso, dimap)\nimport Data.Variant as Variant\nimport Docs.Search.DocTypes (DataDeclType, SourceSpan)\nimport Docs.Search.DocsJson as Docs\nimport Docs.Search.JsonCodec (inject)\nimport Docs.Search.TypeDecoder (ClassName, Constraint', FunDeps, ProperName, Qualified, Type', TypeArgument)\nimport Docs.Search.TypeDecoder as TypeDecoder\nimport Docs.Search.Types (Identifier(..), ModuleName, PackageInfo, PackageScore)\nimport Docs.Search.Types as Package\n\n-- | Metadata that makes sense only for certain types of search results.\ndata ResultInfo\n = DataResult\n { typeArguments :: Array TypeArgument\n , dataDeclType :: DataDeclType\n }\n | ExternDataResult { kind :: Type' }\n | TypeSynonymResult\n { arguments :: Array TypeArgument\n , type :: Type'\n }\n | DataConstructorResult\n { dataDeclType :: DataDeclType\n , type :: Type'\n }\n | TypeClassMemberResult\n { type :: Type'\n , typeClass :: Qualified (ProperName ClassName)\n , typeClassArguments :: Array TypeArgument\n }\n | TypeClassResult\n { fundeps :: FunDeps\n , arguments :: Array TypeArgument\n , superclasses :: Array Constraint'\n }\n | ValueResult { type :: Type' }\n | ValueAliasResult\n | TypeAliasResult\n | ExternKindResult\n\nresultInfoCodec :: CJ.Codec ResultInfo\nresultInfoCodec =\n dimap toVariant fromVariant $ CJ.Variant.variantMatch\n { data: Right $ CJ.named \"DataResult\" $\n CJ.Record.object\n { typeArguments: CJ.array TypeDecoder.typeArgumentCodec\n , dataDeclType: TypeDecoder.dataDeclTypeCodec\n }\n , externData: Right TypeDecoder.typeCodec\n , typeSynonym: Right $ CJ.named \"TypeSynonymResult\" $\n CJ.Record.object\n { arguments: CJ.array TypeDecoder.typeArgumentCodec\n , type: TypeDecoder.typeCodec\n }\n , dataConstructor: Right $ CJ.named \"DataConstructorResult\" $\n CJ.Record.object\n { dataDeclType: TypeDecoder.dataDeclTypeCodec\n , type: TypeDecoder.typeCodec\n }\n , typeClassMember: Right $ CJ.named \"TypeClassMemberResult\" $\n CJ.Record.object\n { type: TypeDecoder.typeCodec\n , typeClass: TypeDecoder.qualifiedNameCodec\n , typeClassArguments: CJ.array TypeDecoder.typeArgumentCodec\n }\n , typeClass: Right $ CJ.named \"TypeClassResult\" $\n CJ.Record.object\n { fundeps: TypeDecoder.funDepsCodec\n , arguments: CJ.array TypeDecoder.typeArgumentCodec\n , superclasses: CJ.array TypeDecoder.constraintCodec\n }\n , value: Right TypeDecoder.typeCodec\n , valueAlias: Left unit\n , typeAlias: Left unit\n , externKind: Left unit\n }\n where\n toVariant = case _ of\n DataResult args -> inject @\"data\" args\n ExternDataResult args -> inject @\"externData\" args.kind\n TypeSynonymResult args -> inject @\"typeSynonym\" args\n DataConstructorResult args -> inject @\"dataConstructor\" args\n TypeClassMemberResult args -> inject @\"typeClassMember\" args\n TypeClassResult args -> inject @\"typeClass\" args\n ValueResult args -> inject @\"value\" args.type\n ValueAliasResult -> inject @\"valueAlias\" unit\n TypeAliasResult -> inject @\"typeAlias\" unit\n ExternKindResult -> inject @\"externKind\" unit\n\n fromVariant = Variant.match\n { data: DataResult\n , externData: \\arg -> ExternDataResult { kind: arg }\n , typeSynonym: TypeSynonymResult\n , dataConstructor: DataConstructorResult\n , typeClassMember: TypeClassMemberResult\n , typeClass: TypeClassResult\n , value: \\arg -> ValueResult { type: arg }\n , valueAlias: fromUnit ValueAliasResult\n , typeAlias: fromUnit TypeAliasResult\n , externKind: fromUnit ExternKindResult\n }\n\n fromUnit :: forall a. a -> Unit -> a\n fromUnit = const\n\n-- | Extract the type field.\ntypeOf :: ResultInfo -> Maybe Type'\ntypeOf (TypeSynonymResult { type: res }) =\n Just res\ntypeOf (TypeClassMemberResult { type: res }) =\n Just res\ntypeOf (ValueResult { type: res }) =\n Just res\ntypeOf _ = Nothing\n\n-- | Common metadata for all types of search results.\nnewtype SearchResult = SearchResult\n { name :: Identifier\n , comments :: Maybe String\n , hashAnchor :: String\n , moduleName :: ModuleName\n , packageInfo :: PackageInfo\n , score :: PackageScore\n , sourceSpan :: Maybe SourceSpan\n , info :: ResultInfo\n }\n\nderive instance Newtype SearchResult _\n\nsearchResultCodec :: CJ.Codec SearchResult\nsearchResultCodec = wrapIso SearchResult $ CJ.named \"SearchResult\" $\n CJ.Record.object\n { name: wrapIso Identifier $ CJ.string\n , comments: CJ.Record.optional CJ.string\n , hashAnchor: CJ.string\n , moduleName: Package.moduleNameCodec\n , packageInfo: Package.packageInfoCodec\n , score: Package.packageScoreCodec\n , sourceSpan: CJ.Record.optional Docs.sourceSpanCodec\n , info: resultInfoCodec\n }\n\ntypeOfResult :: SearchResult -> Maybe Type'\ntypeOfResult = un SearchResult >>> (_.info) >>> typeOf\n", "/* global exports */\n\nexport function lookup_ (shape) {\n return function (url) {\n return function () {\n return new Promise(function (resolve, reject) {\n if (typeof window.DocsSearchTypeIndex[shape] === 'undefined') {\n var script = document.createElement('script');\n script.type = 'text/javascript';\n script.src = url;\n script.addEventListener('load', function () {\n if (typeof window.DocsSearchTypeIndex[shape] === 'undefined') {\n reject(new Error(\"Couldn't load index for type shape \" + shape));\n } else {\n resolve(window.DocsSearchTypeIndex[shape]);\n }\n });\n script.addEventListener('error', reject);\n document.body.appendChild(script);\n } else {\n resolve(window.DocsSearchTypeIndex[shape]);\n }\n });\n };\n };\n};\n", "-- | This module defines the `Parser` type of string parsers, and its instances.\n\nmodule StringParser.Parser where\n\nimport Prelude\n\nimport Control.Apply (lift2)\nimport Control.MonadPlus (class MonadPlus, class Alternative)\nimport Control.Monad.Rec.Class (class MonadRec, tailRecM, Step(..))\nimport Control.Plus (class Plus, class Alt)\nimport Control.Lazy (class Lazy)\nimport Data.Either (Either(..))\n\n-- | A position in an input string.\ntype Pos = Int\n\n-- | Strings are represented as a substring with an index from the\n-- | start of the string.\n-- |\n-- | `{ substring: s, position: n }` is interpreted as the substring `s`\n-- | starting at index n of the original string.\n-- |\n-- | The position is only kept for error messaging.\ntype PosString = { substring :: String, position :: Pos }\n\n-- | The type of parsing errors.\ntype ParseError = { error :: String, pos :: Pos }\n\n-- | A parser is represented as a function that, when successful, returns\n-- | a result and the position where the parse finished or, when it fails,\n-- | a ParserError with more information on where and why it failed.\n-- | See also `printParserError`.\nnewtype Parser a = Parser (PosString -> Either ParseError { result :: a, suffix :: PosString })\n\n-- | Run a parser, allowing the caller to define where to start within the\n-- | input `String` and what to do with the unchanged output of the Parser.\n-- | See `runparser` for more typical usages.\nunParser :: forall a. Parser a -> PosString -> Either ParseError { result :: a, suffix :: PosString }\nunParser (Parser p) = p\n\n-- | Run a parser for an input string. See also `printParserError`\n-- | and `unParser` for more flexible usages.\nrunParser :: forall a. Parser a -> String -> Either ParseError a\nrunParser (Parser p) s = map _.result (p { substring: s, position: 0 })\n\n-- | Prints a ParseError's the error message and the position of the error.\nprintParserError :: ParseError -> String\nprintParserError rec = rec.error <> \"; pos = \" <> show rec.pos\n\ninstance functorParser :: Functor Parser where\n map f (Parser p) = Parser (map (\\{ result, suffix } -> { result: f result, suffix }) <<< p)\n\ninstance applyParser :: Apply Parser where\n apply (Parser p1) (Parser p2) = Parser \\s -> do\n { result: f, suffix: s1 } <- p1 s\n { result: x, suffix: s2 } <- p2 s1\n pure { result: f x, suffix: s2 }\n\ninstance applicativeParser :: Applicative Parser where\n pure a = Parser \\s -> Right { result: a, suffix: s }\n\ninstance altParser :: Alt Parser where\n alt (Parser p1) (Parser p2) = Parser \\s ->\n case p1 s of\n Left { error, pos }\n | s.position == pos -> p2 s\n | otherwise -> Left { error, pos }\n right -> right\n\ninstance plusParser :: Plus Parser where\n empty = fail \"No alternative\"\n\ninstance alternativeParser :: Alternative Parser\n\ninstance bindParser :: Bind Parser where\n bind (Parser p) f = Parser \\s -> do\n { result, suffix } <- p s\n unParser (f result) suffix\n\ninstance monadParser :: Monad Parser\n\ninstance monadPlusParser :: MonadPlus Parser\n\ninstance monadRecParser :: MonadRec Parser where\n tailRecM f a = Parser \\str -> tailRecM (\\st -> map split (unParser (f st.state) st.str)) { state: a, str }\n where\n split { result: Loop state, suffix: str } = Loop { state, str }\n split { result: Done b, suffix } = Done { result: b, suffix }\n\ninstance lazyParser :: Lazy (Parser a) where\n defer f = Parser \\str -> unParser (f unit) str\n\n-- | Fail with the specified message.\nfail :: forall a. String -> Parser a\nfail error = Parser \\{ position } -> Left { pos: position, error }\n\ninstance semigroupParser :: Semigroup a => Semigroup (Parser a) where\n append = lift2 append\n\ninstance monoidParser :: Monoid a => Monoid (Parser a) where\n mempty = pure mempty\n", "-- | This module defines combinators for building string parsers.\nmodule StringParser.Combinators\n ( try\n , lookAhead\n , tryAhead\n , many\n , many1\n , manyTill\n , many1Till\n , assertConsume\n , withError\n , ()\n , between\n , option\n , optional\n , optionMaybe\n , sepBy\n , sepBy1\n , sepEndBy\n , sepEndBy1\n , endBy1\n , endBy\n , chainr\n , chainl\n , chainl1\n , chainr1\n , choice\n , module Control.Lazy\n ) where\n\nimport Prelude\n\nimport Control.Alt ((<|>))\nimport Control.Lazy (fix)\nimport Control.Monad.Rec.Class (Step(..), tailRecM)\nimport Data.Either (Either(..))\nimport Data.Foldable (class Foldable, foldl)\nimport Data.List (List(..), manyRec)\nimport Data.List.NonEmpty (NonEmptyList(..))\nimport Data.List.NonEmpty as NEL\nimport Data.Maybe (Maybe(..))\nimport Data.NonEmpty ((:|))\nimport StringParser.Parser (Parser(..), fail)\n\n-- | `try p` means: run `p` but do not consume input in case of failure.\ntry :: forall a. Parser a -> Parser a\ntry (Parser p) = Parser \\s ->\n case p s of\n Left { error } -> Left { pos: s.position, error }\n right -> right\n\n-- | `lookAhead p` means: run `p` but do not consume input in case of success.\n-- | In most cases you will probably want to use `tryAhead` instead.\nlookAhead :: forall a. Parser a -> Parser a\nlookAhead (Parser p) = Parser \\s ->\n case p s of\n Right { result } -> Right { result, suffix: s }\n left -> left\n\n-- | Read ahead without consuming input.\n-- | `tryAhead p` means: succeed if what comes next is of the form `p`; fail otherwise.\ntryAhead :: forall a. Parser a -> Parser a\ntryAhead = try <<< lookAhead\n\n-- | Match a parser zero or more times.\n-- | Stops matching when the parser fails or does not consume anymore.\nmany :: forall a. Parser a -> Parser (List a)\nmany = manyRec <<< assertConsume\n\n-- | Match a parser one or more times.\n-- | Stops matching when the parser fails or does not consume anymore.\nmany1 :: forall a. Parser a -> Parser (NonEmptyList a)\nmany1 p = cons' <$> p <*> many p\n\n-- | Match a parser until a terminator parser matches.\n-- | Fails when the parser does not consume anymore.\nmanyTill :: forall a end. Parser a -> Parser end -> Parser (List a)\nmanyTill p end = (end *> pure Nil) <|> map NEL.toList (many1Till p end)\n\n-- | Match a parser until a terminator parser matches, requiring at least one match.\n-- | Fails when the parser does not consume anymore.\nmany1Till :: forall a end. Parser a -> Parser end -> Parser (NonEmptyList a)\nmany1Till p end = do\n x <- p\n tailRecM inner (pure x)\n where\n ending acc = do\n _ <- end\n pure $ Done (NEL.reverse acc)\n continue acc = do\n c <- assertConsume p\n pure $ Loop (NEL.cons c acc)\n inner acc = ending acc <|> continue acc\n\n-- | Run given parser and fail if the parser did not consume any input.\nassertConsume :: forall a. Parser a -> Parser a\nassertConsume (Parser p) = Parser \\s ->\n case p s of\n Right result ->\n if s.position < result.suffix.position then Right result\n else Left { pos: s.position, error: \"Consumed no input.\" }\n x -> x\n\n-- | Provide an error message in case of failure.\nwithError :: forall a. Parser a -> String -> Parser a\nwithError p msg = p <|> fail msg\n\ninfixl 4 withError as \n\n-- | Parse a string between opening and closing markers.\nbetween :: forall a open close. Parser open -> Parser close -> Parser a -> Parser a\nbetween open close p = open *> p <* close\n\n-- | Parse a value with a default value in case of failure.\noption :: forall a. a -> Parser a -> Parser a\noption a p = p <|> pure a\n\n-- | Attempt to parse a value.\noptional :: forall a. Parser a -> Parser Unit\noptional p = (p >>= \\_ -> pure unit) <|> pure unit\n\n-- | Attempt to parse a value, pureing `Nothing` in case of failure.\noptionMaybe :: forall a. Parser a -> Parser (Maybe a)\noptionMaybe p = option Nothing (Just <$> p)\n\n-- | Parse zero or more separated values.\nsepBy :: forall a sep. Parser a -> Parser sep -> Parser (List a)\nsepBy p sep = map NEL.toList (sepBy1 p sep) <|> pure Nil\n\n-- | Parse one or more separated values.\nsepBy1 :: forall a sep. Parser a -> Parser sep -> Parser (NonEmptyList a)\nsepBy1 p sep = do\n a <- p\n as <- many $ sep *> p\n pure (cons' a as)\n\n-- | Parse zero or more separated values, optionally ending with a separator.\nsepEndBy :: forall a sep. Parser a -> Parser sep -> Parser (List a)\nsepEndBy p sep = (sepEndBy1 p sep <#> NEL.toList) <|> (sep $> Nil) <|> pure Nil\n\n-- | Parse one or more separated values, optionally ending with a separator.\nsepEndBy1 :: forall a sep. Parser a -> Parser sep -> Parser (NonEmptyList a)\nsepEndBy1 p sep = do\n a <- p\n ( do\n _ <- sep\n as <- sepEndBy p sep\n pure (cons' a as)\n ) <|> pure (NEL.singleton a)\n\n-- | Parse zero or more separated values, ending with a separator.\nendBy :: forall a sep. Parser a -> Parser sep -> Parser (List a)\nendBy p sep = (endBy1 p sep <#> NEL.toList) <|> (sep $> Nil)\n\n-- | Parse one or more separated values, ending with a separator.\nendBy1 :: forall a sep. Parser a -> Parser sep -> Parser (NonEmptyList a)\nendBy1 p sep = many1 $ p <* sep\n\n-- | Parse zero or more values separated by a right-associative operator.\nchainr :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a\nchainr p f a = chainr1 p f <|> pure a\n\n-- | Parse zero or more values separated by a left-associative operator.\nchainl :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a\nchainl p f a = chainl1 p f <|> pure a\n\n-- | Parse one or more values separated by a left-associative operator.\nchainl1 :: forall a. Parser a -> Parser (a -> a -> a) -> Parser a\nchainl1 p f = do\n a <- p\n chainl1' p f a\n\nchainl1' :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a\nchainl1' p f a =\n ( do\n f' <- f\n a' <- p\n chainl1' p f (f' a a')\n ) <|> pure a\n\n-- | Parse one or more values separated by a right-associative operator.\nchainr1 :: forall a. Parser a -> Parser (a -> a -> a) -> Parser a\nchainr1 p f = do\n a <- p\n chainr1' p f a\n\nchainr1' :: forall a. Parser a -> Parser (a -> a -> a) -> a -> Parser a\nchainr1' p f a =\n ( do\n f' <- f\n a' <- chainr1 p f\n pure $ f' a a'\n ) <|> pure a\n\n-- | Parse using any of a collection of parsers.\nchoice :: forall f a. Foldable f => f (Parser a) -> Parser a\nchoice = foldl (<|>) (fail \"Nothing to parse\")\n\ncons' :: forall a. a -> List a -> NonEmptyList a\ncons' h t = NonEmptyList (h :| t)\n", "-- | Primitive parsers for strings, parsing based on code units.\n-- |\n-- | These functions will be much faster than the `CodePoints` alternatives, but\n-- | will behave incorrectly when dealing with Unicode characters that consist\n-- | of multiple code units.\nmodule StringParser.CodeUnits\n ( eof\n , anyChar\n , anyDigit\n , string\n , satisfy\n , char\n , whiteSpace\n , skipSpaces\n , oneOf\n , noneOf\n , lowerCaseChar\n , upperCaseChar\n , anyLetter\n , alphaNum\n , regex\n ) where\n\nimport Prelude\n\nimport Control.Alt ((<|>))\nimport Data.Array ((..))\nimport Data.Array.NonEmpty as NEA\nimport Data.Char (toCharCode)\nimport Data.Either (Either(..))\nimport Data.Foldable (class Foldable, foldMap, elem, notElem)\nimport Data.Maybe (Maybe(..))\nimport Data.String.CodeUnits (charAt, singleton)\nimport Data.String.CodeUnits as SCU\nimport Data.String.Regex as Regex\nimport Data.String.Regex.Flags (noFlags)\nimport StringParser.Parser (Parser(..), fail)\nimport StringParser.Combinators (try, many, ())\n\n-- | Match the end of the file.\neof :: Parser Unit\neof = Parser \\s ->\n case s of\n { substring, position } | 0 < SCU.length substring -> Left { pos: position, error: \"Expected EOF\" }\n _ -> Right { result: unit, suffix: s }\n\n-- | Match any character.\nanyChar :: Parser Char\nanyChar = Parser \\{ substring, position } ->\n case charAt 0 substring of\n Just chr -> Right { result: chr, suffix: { substring: SCU.drop 1 substring, position: position + 1 } }\n Nothing -> Left { pos: position, error: \"Unexpected EOF\" }\n\n-- | Match any digit.\nanyDigit :: Parser Char\nanyDigit = try do\n c <- anyChar\n if c >= '0' && c <= '9' then pure c\n else fail $ \"Character \" <> show c <> \" is not a digit\"\n\n-- | Match the specified string.\nstring :: String -> Parser String\nstring pattern = Parser \\{ substring, position } ->\n let\n length = SCU.length pattern\n { before, after } = SCU.splitAt length substring\n in\n if before == pattern then Right { result: pattern, suffix: { substring: after, position: position + length } }\n else Left { pos: position, error: \"Expected '\" <> pattern <> \"'.\" }\n\n-- | Match a character satisfying the given predicate.\nsatisfy :: (Char -> Boolean) -> Parser Char\nsatisfy f = try do\n c <- anyChar\n if f c then pure c\n else fail $ \"Character \" <> show c <> \" did not satisfy predicate\"\n\n-- | Match the specified character.\nchar :: Char -> Parser Char\nchar c = satisfy (_ == c) \"Could not match character \" <> show c\n\n-- | Match many whitespace characters.\nwhiteSpace :: Parser String\nwhiteSpace = do\n cs <- many (satisfy \\c -> c == '\\n' || c == '\\r' || c == ' ' || c == '\\t')\n pure (foldMap singleton cs)\n\n-- | Skip many whitespace characters.\nskipSpaces :: Parser Unit\nskipSpaces = void whiteSpace\n\n-- | Match one of the characters in the foldable structure.\noneOf :: forall f. Foldable f => f Char -> Parser Char\noneOf = satisfy <<< flip elem\n\n-- | Match any character not in the foldable structure.\nnoneOf :: forall f. Foldable f => f Char -> Parser Char\nnoneOf = satisfy <<< flip notElem\n\n-- | Match any lower case character.\nlowerCaseChar :: Parser Char\nlowerCaseChar = try do\n c <- anyChar\n if toCharCode c `elem` (97 .. 122) then pure c\n else fail $ \"Expected a lower case character but found \" <> show c\n\n-- | Match any upper case character.\nupperCaseChar :: Parser Char\nupperCaseChar = try do\n c <- anyChar\n if toCharCode c `elem` (65 .. 90) then pure c\n else fail $ \"Expected an upper case character but found \" <> show c\n\n-- | Match any letter.\nanyLetter :: Parser Char\nanyLetter = lowerCaseChar <|> upperCaseChar \"Expected a letter\"\n\n-- | Match a letter or a number.\nalphaNum :: Parser Char\nalphaNum = anyLetter <|> anyDigit \"Expected a letter or a number\"\n\n-- | match the regular expression\nregex :: String -> Parser String\nregex pat =\n case Regex.regex pattern noFlags of\n Left _ ->\n fail $ \"StringParser.String.regex': illegal regex \" <> pat\n Right r ->\n matchRegex r\n where\n -- ensure the pattern only matches the current position in the parse\n pattern = \"^(\" <> pat <> \")\"\n\n matchRegex :: Regex.Regex -> Parser String\n matchRegex r = Parser \\{ substring, position } -> do\n case NEA.head <$> Regex.match r substring of\n Just (Just matched) ->\n Right { result: matched, suffix: { substring: SCU.drop (SCU.length matched) substring, position: position + SCU.length matched } }\n _ ->\n Left { pos: position, error: \"no match\" }\n", "-- | Primitive parsers for strings, parsing based on code points.\n-- |\n-- | These functions will be much slower than the `CodeUnits` alternatives, but\n-- | will behave correctly in the presence of Unicode characters made up of\n-- | multiple code units.\nmodule StringParser.CodePoints\n ( eof\n , anyChar\n , anyCodePoint\n , anyDigit\n , string\n , satisfy\n , satisfyCodePoint\n , char\n , codePoint\n , whiteSpace\n , skipSpaces\n , oneOf\n , noneOf\n , lowerCaseChar\n , upperCaseChar\n , anyLetter\n , alphaNum\n , regex\n ) where\n\nimport Prelude\n\nimport Control.Alt ((<|>))\nimport Data.Array ((..))\nimport Data.Array.NonEmpty as NEA\nimport Data.Char (fromCharCode, toCharCode)\nimport Data.Either (Either(..))\nimport Data.Enum (fromEnum)\nimport Data.Foldable (class Foldable, foldMap, elem, notElem)\nimport Data.Maybe (Maybe(..))\nimport Data.String (CodePoint)\nimport Data.String.CodePoints as SCP\nimport Data.String.CodeUnits as SCU\nimport Data.String.Regex as Regex\nimport Data.String.Regex.Flags (noFlags)\nimport StringParser.Parser (Parser(..), fail)\nimport StringParser.CodeUnits as CodeUnitsParser\nimport StringParser.Combinators (try, many, ())\n\n-- | Match the end of the file.\neof :: Parser Unit\neof = Parser \\s ->\n case s of\n { substring, position } | 0 < SCP.length substring -> Left { pos: position, error: \"Expected EOF\" }\n _ -> Right { result: unit, suffix: s }\n\n-- | Match any character from the Basic Multilingual Plane.\nanyChar :: Parser Char\nanyChar = do\n cc <- anyCodePoint <#> fromEnum\n case fromCharCode cc of\n Just chr ->\n -- the `fromCharCode` function doesn't check if this is beyond the\n -- BMP, so we check that ourselves.\n -- https://github.com/purescript/purescript-strings/issues/153\n if cc > 65535 -- BMP\n then notAChar cc\n else pure chr\n Nothing -> notAChar cc\n where\n notAChar cc = fail $ \"Code point \" <> show cc <> \" is not a character\"\n\n-- | Match any code point.\nanyCodePoint :: Parser CodePoint\nanyCodePoint = Parser \\{ substring, position } ->\n case SCP.uncons substring of\n Nothing -> Left { pos: position, error: \"Unexpected EOF\" }\n Just { head, tail } -> Right { result: head, suffix: { substring: tail, position: position + 1 } }\n\n-- | Match any digit.\nanyDigit :: Parser Char\nanyDigit = try do\n c <- CodeUnitsParser.anyChar\n if c >= '0' && c <= '9' then pure c\n else fail $ \"Character \" <> show c <> \" is not a digit\"\n\n-- | Match the specified string.\nstring :: String -> Parser String\nstring pattern = Parser \\{ substring, position } ->\n let\n length = SCP.length pattern\n { before, after } = SCP.splitAt length substring\n in\n if before == pattern then Right { result: pattern, suffix: { substring: after, position: position + length } }\n else Left { pos: position, error: \"Expected '\" <> pattern <> \"'.\" }\n\n-- | Match a character satisfying the given predicate.\nsatisfy :: (Char -> Boolean) -> Parser Char\nsatisfy f = try do\n c <- anyChar\n if f c then pure c\n else fail $ \"Character \" <> show c <> \" did not satisfy predicate\"\n\n-- | Match a code point satisfying the given predicate.\nsatisfyCodePoint :: (CodePoint -> Boolean) -> Parser CodePoint\nsatisfyCodePoint f = try do\n cp <- anyCodePoint\n if f cp then pure cp\n else fail $ \"Code point \" <> show cp <> \" did not satisfy predicate\"\n\n-- | Match the specified character.\nchar :: Char -> Parser Char\nchar c = satisfy (_ == c) \"Could not match character \" <> show c\n\n-- | Match the specified code point.\ncodePoint :: CodePoint -> Parser CodePoint\ncodePoint c = satisfyCodePoint (_ == c) \"Could not match code point \" <> show c\n\n-- | Match many whitespace characters.\nwhiteSpace :: Parser String\nwhiteSpace = do\n cs <- many (satisfy \\c -> c == '\\n' || c == '\\r' || c == ' ' || c == '\\t')\n pure (foldMap SCU.singleton cs)\n\n-- | Skip many whitespace characters.\nskipSpaces :: Parser Unit\nskipSpaces = void whiteSpace\n\n-- | Match one of the characters in the foldable structure.\noneOf :: forall f. Foldable f => f Char -> Parser Char\noneOf = satisfy <<< flip elem\n\n-- | Match any character not in the foldable structure.\nnoneOf :: forall f. Foldable f => f Char -> Parser Char\nnoneOf = satisfy <<< flip notElem\n\n-- | Match any lower case character.\nlowerCaseChar :: Parser Char\nlowerCaseChar = try do\n c <- CodeUnitsParser.anyChar\n if toCharCode c `elem` (97 .. 122) then pure c\n else fail $ \"Expected a lower case character but found \" <> show c\n\n-- | Match any upper case character.\nupperCaseChar :: Parser Char\nupperCaseChar = try do\n c <- CodeUnitsParser.anyChar\n if toCharCode c `elem` (65 .. 90) then pure c\n else fail $ \"Expected an upper case character but found \" <> show c\n\n-- | Match any letter.\nanyLetter :: Parser Char\nanyLetter = lowerCaseChar <|> upperCaseChar \"Expected a letter\"\n\n-- | Match a letter or a number.\nalphaNum :: Parser Char\nalphaNum = anyLetter <|> anyDigit \"Expected a letter or a number\"\n\n-- | match the regular expression\nregex :: String -> Parser String\nregex pat =\n case Regex.regex pattern noFlags of\n Left _ ->\n fail $ \"StringParser.String.regex': illegal regex \" <> pat\n Right r ->\n matchRegex r\n where\n -- ensure the pattern only matches the current position in the parse\n pattern = \"^(\" <> pat <> \")\"\n\n matchRegex :: Regex.Regex -> Parser String\n matchRegex r = Parser \\{ substring, position } -> do\n case NEA.head <$> Regex.match r substring of\n Just (Just matched) ->\n Right { result: matched, suffix: { substring: SCP.drop (SCP.length matched) substring, position: position + SCP.length matched } }\n _ ->\n Left { pos: position, error: \"no match\" }\n", "-- | `TypeQuery` is a representation of a user-provided type.\nmodule Docs.Search.TypeQuery\n ( TypeQuery(..)\n , Substitution(..)\n , parseTypeQuery\n , typeQueryParser\n , getFreeVariables\n , typeVarPenalty\n , penalty\n , joinConstraints\n , joinForAlls\n , joinRows\n ) where\n\nimport Prelude\nimport Prim hiding (Row)\n\nimport Control.Alt ((<|>))\nimport Data.Array as Array\nimport Data.Either (Either)\nimport Data.Generic.Rep (class Generic)\nimport Data.List (List(..), many, some, (:))\nimport Data.List as List\nimport Data.List.NonEmpty (NonEmptyList)\nimport Data.List.NonEmpty as NonEmptyList\nimport Data.Map (Map)\nimport Data.Map as Map\nimport Data.Maybe (Maybe(..))\nimport Data.Newtype (wrap)\nimport Data.Ord (abs)\nimport Data.Set (Set)\nimport Data.Set as Set\nimport Data.Show.Generic (genericShow)\nimport Data.String.CodeUnits (fromCharArray)\nimport Data.String.Common (trim) as String\nimport Data.Tuple (Tuple(..), fst, snd)\nimport Docs.Search.Config as Config\nimport Docs.Search.Extra (foldl1, foldr1)\nimport Docs.Search.TypeDecoder (Type(..), Type', Qualified(..), QualifiedBy(..), ModuleName(..), ProperName(..), Label(..), Constraint(..), TypeArgument)\nimport Docs.Search.Types (Identifier(..))\nimport Language.PureScript.PSString as PSString\nimport Safe.Coerce (coerce)\nimport StringParser (ParseError, Parser, runParser, try)\nimport StringParser.CodePoints (alphaNum, anyLetter, char, eof, lowerCaseChar, skipSpaces, string, upperCaseChar)\nimport StringParser.Combinators (fix, sepBy, sepBy1, sepEndBy, sepEndBy1)\n\n-- | We need type queries because we don't have a full-featured type parser\n-- | available.\ndata TypeQuery\n = QVar Identifier\n | QConst Identifier\n | QFun TypeQuery TypeQuery\n | QApp TypeQuery TypeQuery\n | QForAll (NonEmptyList Identifier) TypeQuery\n | QConstraint Identifier (List TypeQuery) TypeQuery\n | QRow (List (Tuple Identifier TypeQuery))\n\nderive instance eqTypeQuery :: Eq TypeQuery\nderive instance genericTypeQuery :: Generic TypeQuery _\n\ninstance showTypeQuery :: Show TypeQuery where\n show x = genericShow x\n\nparseTypeQuery :: String -> Either ParseError TypeQuery\nparseTypeQuery = String.trim >>> runParser (typeQueryParser <* eof)\n\ntypeQueryParser :: Parser TypeQuery\ntypeQueryParser = fix \\typeQuery ->\n let\n rowFields =\n QRow <$> sepBy\n ( Tuple <$> (skipSpaces *> ident <* skipSpaces <* string \"::\") <*>\n (skipSpaces *> typeQuery <* skipSpaces)\n )\n (string \",\" *> skipSpaces)\n\n row = string \"(\" *> rowFields <* string \")\"\n\n record = QApp (QConst $ Identifier \"Record\") <$>\n (string \"{\" *> rowFields <* string \"}\")\n\n binders =\n string \"forall\" *> some space *> sepEndBy1 ident skipSpaces <* string \".\" <* skipSpaces\n\n for_all = QForAll <$> binders <*> typeQuery\n\n parens =\n string \"(\" *> skipSpaces *> typeQuery <* skipSpaces <* string \")\"\n\n atom = skipSpaces *>\n ( for_all\n <|> try parens\n <|> row\n <|> record\n <|> concrete\n <|>\n any\n )\n\n apps =\n foldl1 QApp <$> sepEndBy1 atom (some space)\n\n funs =\n foldr1 QFun <$> sepBy1 apps (string \"->\" *> skipSpaces)\n\n constrained =\n QConstraint <$> (upperCaseIdent <* skipSpaces)\n <*>\n ( sepEndBy ((QVar <$> ident) <|> parens)\n (many space) <* string \"=>\" <* skipSpaces\n )\n <*>\n typeQuery\n in\n try constrained <|> funs\n\nany :: Parser TypeQuery\nany = do\n QVar <$> lowerCaseIdent\n\nconcrete :: Parser TypeQuery\nconcrete =\n QConst <$> upperCaseIdent\n\nident :: Parser Identifier\nident = do\n head <- anyLetter\n rest <- Array.many (alphaNum <|> char '\\'')\n pure $ Identifier <$> fromCharArray $ pure head <> rest\n\nupperCaseIdent :: Parser Identifier\nupperCaseIdent = do\n head <- upperCaseChar\n rest <- Array.many (alphaNum <|> char '\\'')\n pure $ Identifier $ fromCharArray $ pure head <> rest\n\nlowerCaseIdent :: Parser Identifier\nlowerCaseIdent = do\n head <- lowerCaseChar\n rest <- Array.many (alphaNum <|> char '\\'')\n pure $ Identifier $ fromCharArray $ pure head <> rest\n\nspace :: Parser Char\nspace = char ' '\n\n-- | Used only in `getFreeVariables`.\ndata FreeVarCounterQueueEntry = Unbind (Set.Set Identifier) | Next TypeQuery\n\ngetFreeVariables :: TypeQuery -> Set.Set Identifier\ngetFreeVariables query = go Set.empty Set.empty (List.singleton $ Next query)\n where\n insertIfUnbound bound var free =\n if Set.member var bound then free\n else Set.insert var free\n\n go _bound free Nil = free\n go bound free (Unbind vars : rest) =\n go (Set.difference bound vars) free rest\n\n go bound free (Next (QVar var) : rest) =\n go bound (insertIfUnbound bound var free) rest\n\n go bound free (Next (QConst _str) : rest) =\n go bound free rest\n go bound free (Next (QFun q1 q2) : rest) =\n go bound free (Next q1 : Next q2 : rest)\n go bound free (Next (QApp q1 q2) : rest) =\n go bound free (Next q1 : Next q2 : rest)\n\n go bound free (Next (QForAll nl q) : rest) =\n go (Set.union bound newBound) free queue\n where\n newBound = NonEmptyList.foldr Set.insert mempty nl\n queue = (Next q : Unbind (Set.difference newBound bound) : rest)\n\n go bound free (Next (QConstraint _ vars q) : rest) =\n go bound free ((Next <$> vars) <> (Next q : rest))\n\n go bound free (Next (QRow lst) : rest) =\n go bound free ((lst <#> snd >>> Next) <> rest)\n\ndata Substitution\n = Instantiate Identifier Type'\n | Match Identifier Identifier\n | Generalize TypeQuery Identifier\n | Substitute Identifier Identifier\n | MatchConstraints (Set Identifier) (Set Identifier)\n | MissingConstraint\n | ExcessiveConstraint\n | RowsMismatch Int Int\n -- Type and type query significantly differ.\n | Mismatch TypeQuery Type'\n -- A query of size 1 corresponds to some type.\n | TypeMismatch Type'\n -- A type of size 1 corresponds to some query.\n | QueryMismatch TypeQuery\n\nderive instance genericSubstitution :: Generic Substitution _\n\ninstance showSubstitution :: Show Substitution where\n show x = genericShow x\n\n-- | A mock-up of unification algorithm, that does not unify anything, actually.\n-- | We use it to estimate how far a type is from a type query, by looking into\n-- | the resulting list.\nunify :: TypeQuery -> Type' -> List Substitution\nunify query type_ = go Nil (List.singleton { q: query, t: type_ })\n where\n go :: List Substitution -> List { q :: TypeQuery, t :: Type' } -> List Substitution\n go acc Nil = acc\n go acc ({ q, t: ParensInType _ t } : rest) =\n go acc ({ q, t } : rest)\n\n -- * ForAll\n go acc ({ q, t: ForAll _ _ _ _ t _ } : rest) =\n go acc ({ q, t } : rest)\n go acc ({ q: (QForAll _ q), t } : rest) =\n go acc ({ q, t } : rest)\n\n -- * Constraints\n go\n acc\n ( { q: q@(QConstraint _ _ _)\n , t: t@(ConstrainedType _ _ _)\n } : rest\n ) =\n let\n qcs = Set.fromFoldable (joinQueryConstraints q).constraints\n tcs = Set.fromFoldable (joinConstraints t).constraints\n in\n -- TODO: use edit distance instead\n go (MatchConstraints qcs tcs : acc) rest\n go acc ({ q: QConstraint _ _ q, t } : rest) =\n go (ExcessiveConstraint : acc) ({ q, t } : rest)\n go acc ({ q, t: ConstrainedType _ _ t } : rest) =\n go (MissingConstraint : acc) ({ q, t } : rest)\n\n -- * Type variables\n go acc ({ q: QVar q, t: TypeVar _ v } : rest) =\n go (Substitute q (Identifier v) : acc) rest\n go acc ({ q, t: TypeVar _ v } : rest) =\n go (Generalize q (Identifier v) : acc) rest\n go acc ({ q: QVar v, t } : rest) =\n go (Instantiate v t : acc) rest\n\n -- * Names\n go acc ({ q: QConst qname, t: TypeConstructor _ (Qualified _ name) } : rest) =\n go (Match qname (coerce name) : acc) rest\n go acc ({ q: QConst _, t } : rest) =\n go (TypeMismatch t : acc) rest\n go acc ({ q, t: TypeConstructor _ _ } : rest) =\n go (QueryMismatch q : acc) rest\n\n -- type operators can't appear in type queries: this is always a mismatch\n go acc ({ q, t: TypeOp _ _ } : rest) =\n go (QueryMismatch q : acc) rest\n go acc ({ q, t: t@(BinaryNoParensType _ _ _ _) } : rest) =\n go (Mismatch q t : acc) rest\n\n -- * Functions\n go\n acc\n ( { q: QFun q1 q2\n , t: TypeApp _\n ( TypeApp _\n ( TypeConstructor _\n ( Qualified\n (ByModuleName (ModuleName \"Prim\"))\n (ProperName \"Function\")\n )\n )\n t1\n )\n t2\n } : rest\n ) =\n go acc ({ q: q1, t: t1 } : { q: q2, t: t2 } : rest)\n go acc ({ q: q@(QFun _ _), t } : rest) =\n go (Mismatch q t : acc) rest\n\n -- * Rows\n go\n acc\n ( { q: QApp (QConst (Identifier \"Record\")) (QRow qRows)\n , t: TypeApp _\n ( TypeConstructor _\n ( Qualified\n (ByModuleName (ModuleName \"Prim\"))\n (ProperName \"Record\")\n )\n )\n row\n } : rest\n ) =\n let\n { rows } = joinRows row\n qRowsLength = List.length qRows\n rowsLength = List.length rows\n in\n if rowsLength == qRowsLength then\n let\n sortedQRows = List.sortBy (\\x y -> compare (fst x) (fst y)) qRows\n sortedRows = List.sortBy (\\x y -> compare x.row y.row) rows\n in\n go\n -- match row names\n ( List.zipWith\n ( \\(Tuple qRowName _) { row: rowName } ->\n Match qRowName rowName\n )\n sortedQRows\n sortedRows\n <> acc\n )\n -- match row types\n ( List.zipWith\n ( \\(Tuple _ q) { ty: t } ->\n { q, t }\n )\n sortedQRows\n sortedRows\n <> rest\n )\n else\n go (RowsMismatch qRowsLength rowsLength : acc) rest\n\n go acc ({ q: q@(QRow _), t } : rest) =\n go (Mismatch q t : acc) rest\n\n -- * Type application\n go acc ({ q: QApp q1 q2, t: TypeApp _ t1 t2 } : rest) =\n go acc ({ q: q1, t: t1 } : { q: q2, t: t2 } : rest)\n\n go acc ({ q, t: TypeLevelString _ _ } : rest) =\n go (QueryMismatch q : acc) rest\n\n go acc ({ q, t: TypeLevelInt _ _ } : rest) =\n go (QueryMismatch q : acc) rest\n\n go acc ({ q, t: TypeWildcard _ _ } : rest) =\n go (QueryMismatch q : acc) rest\n\n go acc ({ q, t: t@(RCons _ _ _ _) } : rest) =\n go (Mismatch q t : acc) rest\n\n go acc ({ q, t: REmpty _ } : rest) =\n go (QueryMismatch q : acc) rest\n\n go acc ({ q, t: KindedType _ _ _ } : rest) =\n go (QueryMismatch q : acc) rest\n\n go acc ({ t: t@(KindApp _ _ _) } : rest) =\n go (TypeMismatch t : acc) rest\n\n -- FIXME(new-ast)\n go acc ({ t: t@(TUnknown _ _) } : rest) =\n go (TypeMismatch t : acc) rest\n\n -- FIXME(new-ast)\n go acc ({ t: t@(Skolem _ _ _ _ _) } : rest) =\n go (TypeMismatch t : acc) rest\n\n-- | Sum various penalties.\npenalty :: TypeQuery -> Type' -> Int\npenalty typeQuery ty =\n let\n substs = unify typeQuery ty\n in\n typeVarPenalty substs * Config.penalties.typeVars\n + namesPenalty substs\n +\n mismatchPenalty substs\n\n-- | Penalty for type variables mismatch.\n-- | Congruent types should receive zero penalty points.\ntypeVarPenalty :: List Substitution -> Int\ntypeVarPenalty substs =\n penaltyFor (varSubstMapWith (flip insertion)) +\n penaltyFor (varSubstMapWith insertion)\n where\n penaltyFor varSubstMap =\n abs $\n List.length (List.foldMap List.fromFoldable varSubstMap) - Map.size varSubstMap\n\n insertion v1 v2 = Map.insertWith append v1 (Set.singleton v2)\n\n varSubstMapWith\n :: ( Identifier\n -> Identifier\n -> Map Identifier (Set Identifier)\n -> Map Identifier (Set Identifier)\n )\n -> Map Identifier (Set Identifier)\n varSubstMapWith f =\n List.foldr\n ( case _ of\n Substitute v1 v2 ->\n f v1 v2\n _ -> identity\n )\n Map.empty\n substs\n\n-- | Penalty for name mismatches.\nnamesPenalty :: List Substitution -> Int\nnamesPenalty = go 0\n where\n go p Nil = p\n go p (Match a b : rest)\n | a == b = go p rest\n | otherwise = go (p + Config.penalties.match) rest\n go p (MatchConstraints qcs tcs : rest) =\n let\n p' = Set.size (Set.union qcs tcs) -\n Set.size (Set.intersection qcs tcs)\n in\n go (p + Config.penalties.matchConstraint * p') rest\n go _p (RowsMismatch n m : rest) = go (Config.penalties.rowsMismatch * abs (n - m)) rest\n go p (_ : rest) = go p rest\n\n-- | Penalty for generalization and instantiation.\nmismatchPenalty :: List Substitution -> Int\nmismatchPenalty = go 0\n where\n go n Nil = n\n go n (Instantiate _q t : rest) = go\n ( n + typeSize t *\n Config.penalties.instantiate\n )\n rest\n go n (Generalize q _t : rest) = go\n ( n + typeQuerySize q *\n Config.penalties.generalize\n )\n rest\n go n (ExcessiveConstraint : rest) = go (n + Config.penalties.excessiveConstraint) rest\n go n (MissingConstraint : rest) = go (n + Config.penalties.missingConstraint) rest\n go n (Mismatch q t : rest) = go (n + typeQuerySize q + typeSize t) rest\n go n (TypeMismatch t : rest) = go (n + typeSize t) rest\n go n (QueryMismatch q : rest) = go (n + typeQuerySize q) rest\n go n (_ : rest) = go n rest\n\n-- | Only returns a list of type class names (lists of arguments are omitted).\njoinQueryConstraints\n :: TypeQuery\n -> { constraints :: List Identifier\n , ty :: TypeQuery\n }\njoinQueryConstraints = go Nil\n where\n go acc (QConstraint name _ query) =\n go (name : acc) query\n go acc ty = { constraints: List.sort acc, ty }\n\ntypeQuerySize :: TypeQuery -> Int\ntypeQuerySize = go 0 <<< List.singleton\n where\n go n Nil = n\n go n (QVar _ : rest) =\n go (n + 1) rest\n go n (QConst _ : rest) =\n go (n + 1) rest\n go n (QFun q1 q2 : rest) =\n go (n + 1) (q1 : q2 : rest)\n go n (QApp q1 q2 : rest) =\n go (n + 1) (q1 : q2 : rest)\n go n (QForAll _ q : rest) =\n go (n + 1) (q : rest)\n go n (QConstraint _ _ q : rest) =\n go (n + 1) (q : rest)\n go n (QRow qs : rest) =\n go n ((qs <#> snd) <> rest)\n\ntypeSize :: Type' -> Int\ntypeSize = go 0 <<< List.singleton\n where\n go n Nil = n\n go n (TypeVar _ _ : rest) =\n go (n + 1) rest\n go n (TypeLevelString _ _ : rest) =\n go (n + 1) rest\n go n (TypeLevelInt _ _ : rest) =\n go (n + 1) rest\n go n (TypeWildcard _ _ : rest) =\n go (n + 1) rest\n go n (TypeConstructor _ _ : rest) =\n go (n + 1) rest\n go n (TypeOp _ _ : rest) =\n go (n + 1) rest\n go n (KindApp _ t1 t2 : res) = go n (t1 : t2 : res)\n go\n n\n ( TypeApp _\n ( TypeApp _\n ( TypeConstructor _\n ( Qualified\n (ByModuleName (ModuleName \"Prim\"))\n _name\n )\n )\n t1\n )\n t2 : rest\n ) =\n go (n + 1) (t1 : t2 : rest)\n go n (TypeApp _ q1 q2 : rest) =\n go (n + 1) (q1 : q2 : rest)\n go n (ForAll _ _ _ _ t _ : rest) =\n go (n + 1) (t : rest)\n go n (ConstrainedType _ _ t : rest) =\n go (n + 1) (t : rest)\n go n (RCons _ _ t1 t2 : rest) =\n go (n + 1) (t1 : t2 : rest)\n go n (REmpty _ : rest) =\n go (n + 1) rest\n go n (KindedType _ t1 t2 : rest) =\n go n (t1 : t2 : rest)\n go n (BinaryNoParensType _ _op t1 t2 : rest) =\n go (n + 1) (t1 : t2 : rest)\n go n (ParensInType _ t : rest) =\n go n (t : rest)\n go n (Skolem _ _ _ _ _ : rest) =\n go n rest -- FIXME(ast)\n go n (TUnknown _ _ : rest) =\n go n rest -- FIXME(ast)\n\njoinForAlls\n :: Type'\n -> { binders :: List TypeArgument\n , ty :: Type'\n }\njoinForAlls ty = go Nil ty\n where\n go acc (ForAll _ _ name kind ty' _) =\n go ({ name, kind } : acc) ty'\n go acc ty' = { binders: acc, ty: ty' }\n\ntype Row = { row :: Identifier, ty :: Type' }\ntype Rows = { rows :: List Row, ty :: Maybe Type' }\n\njoinRows\n :: Type'\n -> Rows\njoinRows = go Nil\n where\n go :: List Row -> Type' -> Rows\n go acc (RCons _ row ty rest) =\n go ({ row: labelToIdentifier row, ty } : acc) rest\n go acc ty =\n { rows: List.reverse acc\n , ty:\n case ty of\n REmpty _ -> Nothing\n ty' -> Just ty'\n }\n\n-- | Only returns a list of type class names (lists of arguments are omitted).\njoinConstraints\n :: Type'\n -> { constraints :: List Identifier\n , ty :: Type'\n }\njoinConstraints = go Nil\n where\n go acc (ConstrainedType _ (Constraint { \"class\": Qualified _ (ProperName name) }) ty) =\n --: Qualified _ { name } }) ty) =\n go (wrap name : acc) ty\n go acc ty = { constraints: List.sort acc, ty }\n\nlabelToIdentifier :: Label -> Identifier\nlabelToIdentifier = coerce PSString.decodeStringWithReplacement\n", "module Docs.Search.Declarations\n ( Declarations(..)\n , DeclLevel(..)\n , declLevelToHashAnchor\n , extractPackageName\n , mkDeclarations\n , resultsForDeclaration\n ) where\n\nimport Docs.Search.Score (Scores, getPackageScore, getPackageScoreForPackageName)\nimport Docs.Search.SearchResult (ResultInfo(..), SearchResult(..))\nimport Docs.Search.TypeDecoder (Constraint(..), Qualified(..), Type(..), TypeArgument, TypeVarVisibility(..))\nimport Docs.Search.TypeQuery as TypeQuery\nimport Docs.Search.Types (PackageName(..), PackageInfo(..), Identifier(..))\n\nimport Prelude\nimport Control.Alt ((<|>))\nimport Data.Array ((!!))\nimport Data.Array as Array\nimport Data.Foldable (foldl, foldr)\nimport Data.List (List, (:))\nimport Data.List as List\nimport Data.Maybe (Maybe(..), fromMaybe)\nimport Data.Newtype (class Newtype)\nimport Data.Search.Trie (Trie, alter)\nimport Data.String.CodeUnits (stripPrefix, stripSuffix, toCharArray)\nimport Data.String.Common (split) as String\nimport Data.String.Common (toLower)\nimport Data.String.Pattern (Pattern(..))\nimport Data.Tuple (Tuple(..))\nimport Docs.Search.DocTypes (SourceSpan(..), Type', ChildDeclaration(..), ChildDeclarationInfo(..), QualifiedBy(..), ProperName(..), ModuleName(..), Declaration(..), DocModule(..), DeclarationInfo(..))\nimport Safe.Coerce (coerce)\n\nnewtype Declarations = Declarations (Trie Char (List SearchResult))\n\nderive instance newtypeDeclarations :: Newtype Declarations _\nderive newtype instance semigroupDeclarations :: Semigroup Declarations\nderive newtype instance monoidDeclarations :: Monoid Declarations\n\nmkDeclarations :: Scores -> Array DocModule -> Declarations\nmkDeclarations scores = Declarations <<< foldr (insertDocModule scores) mempty\n where\n insertDocModule\n :: Scores\n -> DocModule\n -> Trie Char (List SearchResult)\n -> Trie Char (List SearchResult)\n\n insertDocModule _scores (DocModule { name, declarations }) trie =\n foldr (insertDeclaration scores name) trie declarations\n\ninsertDeclaration\n :: Scores\n -> ModuleName\n -> Declaration\n -> Trie Char (List SearchResult)\n -> Trie Char (List SearchResult)\ninsertDeclaration scores moduleName entry@(Declaration { title: _ }) trie = foldr insertSearchResult trie (resultsForDeclaration scores moduleName entry)\n\ninsertSearchResult\n :: { path :: String\n , result :: SearchResult\n }\n -> Trie Char (List SearchResult)\n -> Trie Char (List SearchResult)\ninsertSearchResult { path, result } trie =\n let\n path' = List.fromFoldable $ toCharArray $ toLower path\n in\n alter path' (Just <<< updateResults) trie\n where\n updateResults mbOldResults\n | Just oldResults <- mbOldResults =\n result : oldResults\n | otherwise =\n List.singleton result\n\n-- | For each declaration, extract its own `SearchResult` and `SearchResult`s\n-- | corresponding to its children (e.g. a class declaration contains class members).\nresultsForDeclaration\n :: Scores\n -> ModuleName\n -> Declaration\n -> List\n { path :: String\n , result :: SearchResult\n }\nresultsForDeclaration scores moduleName indexEntry@(Declaration entry) =\n case mkInfo declLevel indexEntry of\n Nothing -> mempty\n Just info' ->\n let\n result = SearchResult\n { name: Identifier title\n , comments\n , hashAnchor: declLevelToHashAnchor declLevel\n , moduleName\n , sourceSpan\n , packageInfo\n , score:\n fromMaybe zero $ getPackageScoreForPackageName scores <$> mbPackageName\n , info: info'\n }\n in\n ( List.singleton $\n { path: name\n , result\n }\n ) <>\n ( List.fromFoldable children >>=\n resultsForChildDeclaration scores packageInfo moduleName result\n )\n where\n { title, sourceSpan, comments, children } = entry\n { name, declLevel } = getLevelAndName indexEntry\n packageInfo = extractPackageName moduleName sourceSpan\n mbPackageName =\n case packageInfo of\n Package packageName -> Just packageName\n _ -> Nothing\n\nmkInfo :: DeclLevel -> Declaration -> Maybe ResultInfo\nmkInfo declLevel (Declaration { info, title: _ }) =\n case info of\n ValueDeclaration ty ->\n Just $ ValueResult { type: ty }\n\n DataDeclaration dataDeclType typeArguments _ ->\n Just $ DataResult\n { dataDeclType\n , typeArguments: typeArguments <#> toTypeArgument\n }\n\n ExternDataDeclaration kind _ ->\n Just $ ExternDataResult { kind }\n\n TypeSynonymDeclaration arguments ty ->\n Just $ TypeSynonymResult\n { type: ty\n , arguments: arguments <#> toTypeArgument\n }\n\n TypeClassDeclaration arguments superclasses fundeps ->\n Just $ TypeClassResult\n { fundeps\n , arguments: arguments <#> toTypeArgument\n , superclasses\n }\n\n AliasDeclaration _ _ ->\n case declLevel of\n TypeLevel -> Just TypeAliasResult\n ValueLevel -> Just ValueAliasResult\n\n where\n toTypeArgument :: Tuple _ _ -> TypeArgument\n toTypeArgument (Tuple name kind) = { name, kind }\n\n-- | Level of a declaration, used to determine which URI hash anchor to use in\n-- | links (\"v\" or \"t\" ).\ndata DeclLevel = ValueLevel | TypeLevel\n\ndeclLevelToHashAnchor :: DeclLevel -> String\ndeclLevelToHashAnchor = case _ of\n ValueLevel -> \"v\"\n TypeLevel -> \"t\"\n\ngetLevelAndName\n :: Declaration\n -> { declLevel :: DeclLevel\n , name :: String\n }\ngetLevelAndName (Declaration { info, title }) =\n case info of\n ValueDeclaration _ -> { name: title, declLevel: ValueLevel }\n DataDeclaration _ _ _ -> { name: title, declLevel: TypeLevel }\n TypeSynonymDeclaration _ _ -> { name: title, declLevel: TypeLevel }\n TypeClassDeclaration _ _ _ -> { name: title, declLevel: TypeLevel }\n AliasDeclaration _ _ ->\n -- \"declType\": \"alias\" does not specify the level of the declaration.\n -- But for type aliases, name of the declaration is always wrapped into\n -- \"type (\" and \")\".\n let\n withAnchor declLevel name = { declLevel, name }\n in\n fromMaybe (withAnchor ValueLevel title) $\n ( withAnchor ValueLevel <$>\n ( stripPrefix (Pattern \"(\") >=>\n stripSuffix (Pattern \")\")\n ) title\n ) <|>\n ( withAnchor TypeLevel <$>\n ( stripPrefix (Pattern \"type (\") >=>\n stripSuffix (Pattern \")\")\n ) title\n )\n\n ExternDataDeclaration _ _kind ->\n { name: title, declLevel: TypeLevel }\n\n-- | Extract package name from `sourceSpan.name`, which contains path to\n-- | the source file. If `ModuleName` string starts with `Prim.`, it's a\n-- | built-in (guaranteed by the compiler).\nextractPackageName :: ModuleName -> Maybe SourceSpan -> PackageInfo\nextractPackageName (ModuleName moduleName) _\n | String.split (Pattern \".\") moduleName !! 0 == Just \"Prim\" = Builtin\nextractPackageName _ Nothing = UnknownPackage\nextractPackageName _ (Just (SourceSpan { name })) =\n fromMaybe LocalPackage do\n topLevelDir <- dirs !! 0\n if topLevelDir == \".spago\" then Package <<< PackageName <$> dirs !! 2\n else do\n bowerDirIx <- Array.findIndex (_ == \"bower_components\") dirs\n Package <<< PackageName <$> dirs !! (bowerDirIx + 1)\n where\n dirs = String.split (Pattern \"/\") name\n\n-- | Extract `SearchResults` from a `ChildDeclaration`.\nresultsForChildDeclaration\n :: Scores\n -> PackageInfo\n -> ModuleName\n -> SearchResult\n -> ChildDeclaration\n -> List { path :: String, result :: SearchResult }\nresultsForChildDeclaration\n scores\n packageInfo\n moduleName\n parentResult\n child@(ChildDeclaration { title, info: _, comments, sourceSpan })\n | Just resultInfo <- mkChildInfo parentResult child =\n { path: title\n , result: SearchResult\n { name: Identifier title\n , comments\n -- `ChildDeclaration`s are always either data\n -- constructors, type class members or instances.\n -- The former two are both value-level, and\n -- the latter are not included in the index.\n , hashAnchor: \"v\"\n , moduleName\n , sourceSpan\n , packageInfo\n , score: getPackageScore scores packageInfo\n , info: resultInfo\n }\n } # List.singleton\n | otherwise = mempty\n\nmkChildInfo\n :: SearchResult\n -> ChildDeclaration\n -> Maybe ResultInfo\nmkChildInfo\n (SearchResult { info: parentInfo, moduleName, name: resultName })\n (ChildDeclaration { info })\n\n | ChildDataConstructor childTypeArguments <- info\n , DataResult { dataDeclType, typeArguments } <- parentInfo =\n let\n parentTypeCtor :: Type'\n parentTypeCtor =\n TypeConstructor unit $\n Qualified\n (ByModuleName moduleName)\n (coerce $ resultName)\n\n parentTypeArgs :: Array Type'\n parentTypeArgs = typeArguments <#> \\{ name } -> TypeVar unit name\n\n parentType :: Type'\n parentType = foldl (TypeApp unit) parentTypeCtor parentTypeArgs\n\n typeArrow :: Type' -> Type'\n typeArrow =\n TypeApp\n unit\n ( TypeConstructor\n unit\n ( Qualified\n (ByModuleName (ModuleName \"Prim\"))\n (ProperName \"Function\")\n )\n )\n\n makeType :: Array Type' -> Type'\n makeType = foldr (\\a b -> TypeApp unit (typeArrow a) b) parentType\n in\n Just $ DataConstructorResult\n { dataDeclType\n , \"type\": makeType childTypeArguments\n }\n | ChildTypeClassMember unconstrainedType <- info\n , TypeClassResult { arguments } <- parentInfo =\n -- We need to reconstruct a \"real\" type of a type class member.\n -- For example, if `unconstrainedType` is the type of `pure`, i.e.\n -- `forall a. a -> m a`, then `restoredType` should be:\n -- `forall m a. Control.Applicative.Applicative m => a -> m a`.\n\n let\n -- First, we get a list of nested `forall` quantifiers for\n -- `unconstrainedType` and a version of `unconstrainedType` without\n -- them (`ty`).\n ({ ty, binders }) = TypeQuery.joinForAlls unconstrainedType\n\n -- Then we construct a qualified name of the type class.\n constraintClass =\n Qualified\n (ByModuleName moduleName)\n (coerce resultName)\n\n -- We concatenate two lists:\n -- * a list of type parameters of the type class, and\n -- * a list of quantified variables of the unconstrained type\n allArguments :: Array TypeArgument\n allArguments =\n arguments <> List.toUnfoldable binders\n\n restoreType :: Type' -> Type'\n restoreType =\n foldr\n ( \\({ name, kind }) -> compose\n \\ty -> ForAll unit TypeVarInvisible name kind ty Nothing\n )\n identity\n allArguments\n\n -- Finally, we have a restored type. It allows us to search for\n -- type members the same way we search for functions. And types\n -- of class member results appear with the correct\n -- class constraints.\n restoredType =\n restoreType $\n ConstrainedType\n unit\n ( Constraint\n { ann: unit\n , args: toTypeVars arguments\n , class: constraintClass\n , data: Nothing\n , kindArgs: []\n }\n )\n ty\n\n in\n Just $ TypeClassMemberResult\n { type: restoredType\n , typeClass: constraintClass\n , typeClassArguments: arguments\n }\n | otherwise = Nothing\n\ntoTypeVars :: Array TypeArgument -> Array Type'\ntoTypeVars = map \\{ name } -> TypeVar unit name\n", "/* global exports */\n\nexport function hash (string) {\n var hash = Math.floor(Number.MAX_SAFE_INTEGER / 2);\n if (string.length == 0) {\n return hash;\n }\n for (var i = 0; i < string.length; i++) {\n var char = string.charCodeAt(i);\n hash = ((hash<<5)-hash)+char;\n hash = hash & hash; // Convert to 32bit integer\n }\n return hash;\n};\n", "-- | We need `TypeShape`s as a way to \"semantically hash\" types.\n-- | This allows us to split type index in parts and load\n-- | it on demand.\nmodule Docs.Search.TypeShape\n ( shapeOfType\n , shapeOfTypeQuery\n , stringifyShape\n , ShapeChunk(..)\n ) where\n\nimport Prelude\n\nimport Data.Generic.Rep (class Generic)\nimport Data.Show.Generic (genericShow)\nimport Data.List (List(..), (:))\nimport Data.List as List\nimport Data.List.NonEmpty as NonEmptyList\nimport Data.Set as Set\nimport Data.Tuple (Tuple(..), snd)\nimport Data.Ord (abs)\nimport Docs.Search.TypeDecoder (ModuleName(..), ProperName(..), Qualified(..), QualifiedBy(..), Type(..), Type')\nimport Docs.Search.TypeQuery (TypeQuery(..))\nimport Docs.Search.TypeQuery as TypeQuery\n\ntype TypeShape = List ShapeChunk\n\ndata ShapeChunk\n = PVar\n | PFun\n | PApp\n | PForAll Int\n | PRow Int\n\nderive instance eqShapeChunk :: Eq ShapeChunk\nderive instance ordShapeChunk :: Ord ShapeChunk\nderive instance genericShapeChunk :: Generic ShapeChunk _\n\ninstance showShapeChunk :: Show ShapeChunk where\n show x = genericShow x\n\nstringifyShape :: TypeShape -> String\nstringifyShape shape =\n show $ abs $ hash\n if res == \"\" then \"0\" else res\n where\n res = List.foldMap stringifyChunk shape\n stringifyChunk =\n case _ of\n PVar -> \"v\"\n PFun -> \"f\"\n PApp -> \"a\"\n PForAll n -> \"b\" <> show n\n PRow n -> \"r\" <> show n\n\nshapeOfTypeQuery :: TypeQuery -> TypeShape\nshapeOfTypeQuery query =\n prependForAll $ List.reverse $ go (pure query) Nil\n where\n\n prependForAll (PForAll n : rest) =\n PForAll (count + n) : rest\n prependForAll shape =\n if count == 0 then shape\n else PForAll count : shape\n\n count = Set.size $ TypeQuery.getFreeVariables query\n\n go Nil acc = acc\n go (this : rest) acc =\n case this of\n QVar _ ->\n go rest (PVar : acc)\n QConst _v ->\n go rest (PVar : acc)\n QFun q1 q2 ->\n go (q1 : q2 : rest) (PFun : acc)\n QApp q1 q2 ->\n go (q1 : q2 : rest) (PApp : acc)\n QForAll lst q ->\n go (q : rest) (PForAll (NonEmptyList.length lst) : acc)\n QConstraint _str _lst q ->\n go (q : rest) acc\n QRow lst ->\n let\n lst' = List.sortBy (\\(Tuple x _) (Tuple y _) -> compare x y) lst\n in\n go (map snd lst' <> rest) (PRow (List.length lst) : acc)\n\nshapeOfType :: Type' -> TypeShape\nshapeOfType ty = List.reverse $ go (pure ty) Nil\n where\n go Nil acc = acc\n go (this : rest) acc =\n case this of\n\n TypeVar _ _ ->\n go rest (PVar : acc)\n\n TypeLevelString _ _ ->\n go rest (PVar : acc)\n\n TypeWildcard _ _ ->\n go rest (PVar : acc)\n\n TypeApp _\n ( TypeApp _\n ( TypeConstructor _\n ( Qualified\n (ByModuleName (ModuleName \"Prim\"))\n (ProperName \"Function\")\n )\n )\n t1\n )\n t2 ->\n go (t1 : t2 : rest) (PFun : acc)\n\n TypeConstructor _ _ ->\n go rest (PVar : acc)\n\n TypeOp _ _ ->\n go rest (PVar : acc)\n\n TypeApp _ child1 child2 ->\n go (child1 : child2 : rest) (PApp : acc)\n\n KindApp _ child1 child2 ->\n go (child1 : child2 : rest) (PApp : acc)\n\n forallType@(ForAll _ _ _ _ _ _) ->\n go (foralls.ty : rest) (PForAll (List.length foralls.binders) : acc)\n where\n foralls = TypeQuery.joinForAlls forallType\n\n ParensInType _ child ->\n go (child : rest) acc\n\n ConstrainedType _ _ child ->\n go (child : rest) acc\n\n REmpty _ ->\n -- TODO: reconsider\n go rest (PVar : acc)\n\n row@(RCons _ _ _ _) ->\n go (typesInRow <> rest) (PRow (List.length joined.rows) : acc)\n where\n joined = TypeQuery.joinRows row\n sorted = List.sortBy (\\x y -> compare x.row y.row) joined.rows\n typesInRow = sorted <#> (_.ty)\n\n KindedType _ t1 _ -> go (t1 : rest) acc\n\n BinaryNoParensType _ op l r ->\n go (TypeApp unit (TypeApp unit op l) r : rest) acc\n\n Skolem _ _ _ _ _ ->\n go rest acc\n\n TypeLevelInt _ _ ->\n go rest acc\n\n TUnknown _ _ ->\n go rest acc\n\nforeign import hash :: String -> Int\n", "-- | Partial type index, can be loaded on demand in the browser.\nmodule Docs.Search.TypeIndex where\n\nimport Prelude\n\nimport Control.Promise (Promise, toAffE)\nimport Data.Array as Array\nimport Data.Codec.JSON as CJ\nimport Data.Either (hush)\nimport Data.Foldable (fold, foldr)\nimport Data.Map (Map)\nimport Data.Map as Map\nimport Data.Maybe (Maybe(..), fromMaybe', isJust)\nimport Data.Newtype (class Newtype, over)\nimport Docs.Search.Config as Config\nimport Docs.Search.Declarations (resultsForDeclaration)\nimport Docs.Search.DocTypes (Type')\nimport Docs.Search.Score (Scores)\nimport Docs.Search.SearchResult (ResultInfo(..), SearchResult(..))\nimport Docs.Search.SearchResult as SearchResult\nimport Docs.Search.TypeQuery (TypeQuery)\nimport Docs.Search.TypeShape (shapeOfType, shapeOfTypeQuery, stringifyShape)\nimport Effect (Effect)\nimport Effect.Aff (Aff, try)\nimport JSON (JSON)\nimport Language.PureScript.Docs.Types (DocModule(..))\n\nnewtype TypeIndex = TypeIndex (Map String (Maybe (Array SearchResult)))\n\nderive instance newtypeTypeIndex :: Newtype TypeIndex _\n\nmkTypeIndex :: Scores -> Array DocModule -> TypeIndex\nmkTypeIndex scores docsJsons =\n TypeIndex $ map Just $ foldr insert Map.empty docsJsons\n where\n insert :: DocModule -> Map String (Array SearchResult) -> Map String (Array SearchResult)\n insert docsJson mp =\n Array.foldr\n ( \\result ->\n case getType result of\n Just ty ->\n Map.insertWith append (stringifyShape $ shapeOfType ty) (pure result)\n Nothing -> identity\n )\n mp\n (allResults scores docsJson)\n\nallResults :: Scores -> DocModule -> Array SearchResult\nallResults scores (DocModule { name, declarations }) =\n declarations >>=\n ( resultsForDeclaration scores name\n >>> map (_.result)\n >>> Array.fromFoldable\n )\n\nresultsWithTypes :: Scores -> DocModule -> Array SearchResult\nresultsWithTypes scores = Array.filter (getType >>> isJust) <<< allResults scores\n\ngetType :: SearchResult -> Maybe Type'\ngetType (SearchResult { info }) =\n case info of\n ValueResult dict ->\n Just dict.type\n\n TypeClassMemberResult dict ->\n Just dict.type\n\n TypeSynonymResult dict ->\n Just dict.type\n\n _ -> Nothing\n\nlookup\n :: String\n -> TypeIndex\n -> Aff { index :: TypeIndex, results :: Array SearchResult }\nlookup key index@(TypeIndex map) =\n case Map.lookup key map of\n Just results -> pure { index, results: fold results }\n Nothing -> do\n eiJson <- try (toAffE (lookup_ key $ Config.mkShapeScriptPath key))\n pure $ fromMaybe'\n (\\_ -> { index: insert key Nothing index, results: [] })\n do\n json <- hush eiJson\n results <- hush (CJ.decode (CJ.array SearchResult.searchResultCodec) json)\n pure { index: insert key (Just results) index, results }\n\n where\n insert\n :: String\n -> Maybe (Array SearchResult)\n -> TypeIndex\n -> TypeIndex\n insert k v = over TypeIndex (Map.insert k v)\n\nquery\n :: TypeIndex\n -> TypeQuery\n -> Aff { index :: TypeIndex, results :: Array SearchResult }\nquery typeIndex typeQuery = do\n res <- lookup (stringifyShape $ shapeOfTypeQuery typeQuery) typeIndex\n pure $ res { results = res.results }\n\nforeign import lookup_\n :: String\n -> String\n -> Effect (Promise JSON)\n", "-- | A search engine that is used in the browser.\nmodule Docs.Search.BrowserEngine where\n\nimport Prelude\n\nimport Control.Promise (Promise, toAffE)\nimport Data.Array as Array\nimport Data.Codec.JSON as CJ\nimport Data.Codec.JSON.Common as CJ.Common\nimport Data.Either (hush)\nimport Data.List (List)\nimport Data.List as List\nimport Data.Map (Map)\nimport Data.Map as Map\nimport Data.Maybe (Maybe(..))\nimport Data.Newtype (class Newtype)\nimport Data.Search.Trie (Trie)\nimport Data.Search.Trie as Trie\nimport Data.String.CodeUnits as String\nimport Data.Tuple (Tuple(..))\nimport Docs.Search.Config as Config\nimport Docs.Search.Engine (Engine, EngineState, Index)\nimport Docs.Search.ModuleIndex as ModuleIndex\nimport Docs.Search.PackageIndex as PackageIndex\nimport Docs.Search.SearchResult (SearchResult)\nimport Docs.Search.SearchResult as SearchResult\nimport Docs.Search.TypeIndex (TypeIndex)\nimport Docs.Search.TypeIndex as TypeIndex\nimport Docs.Search.Types (PartId, URL)\nimport Effect (Effect)\nimport Effect.Aff (Aff, try)\nimport JSON (JSON)\n\nnewtype PartialIndex = PartialIndex (Map PartId Index)\n\nderive instance newtypePartialIndex :: Newtype PartialIndex _\n\ntype BrowserEngineState = EngineState PartialIndex TypeIndex\n\n-- | This function dynamically injects a script with the required index part and returns\n-- | a new `PartialIndex` that contains newly loaded definitions.\n-- |\n-- | We split the index because of its size, and also to speed up queries.\nquery\n :: PartialIndex\n -> String\n -> Aff { index :: PartialIndex, results :: Array SearchResult }\nquery index@(PartialIndex indexMap) input = do\n let\n path =\n List.fromFoldable\n $ String.toCharArray\n $\n input\n\n partId = Config.getPartId path\n\n case Map.lookup partId indexMap of\n Just trie ->\n pure { index, results: flatten $ Trie.queryValues path trie }\n Nothing -> do\n\n eiPartJson <-\n try $ toAffE $ loadIndex_ partId $ Config.mkIndexPartLoadPath partId\n\n let\n resultsCodec :: CJ.Codec (Array (Tuple String (Array SearchResult)))\n resultsCodec = CJ.array $ CJ.Common.tuple CJ.string $ CJ.array SearchResult.searchResultCodec\n\n mbNewTrie :: Maybe (Trie Char (List SearchResult))\n mbNewTrie = do\n json <- hush eiPartJson\n results <- hush $ CJ.decode resultsCodec json\n pure $ Array.foldr insertResults mempty results\n\n case mbNewTrie of\n Just newTrie -> do\n pure\n { index: PartialIndex $ Map.insert partId newTrie indexMap\n , results: flatten $ Trie.queryValues path newTrie\n }\n Nothing -> do\n pure { index, results: mempty }\n\n where\n flatten = Array.concat <<< Array.fromFoldable <<< map Array.fromFoldable\n\ninsertResults\n :: Tuple String (Array SearchResult)\n -> Trie Char (List SearchResult)\n -> Trie Char (List SearchResult)\ninsertResults (Tuple path newResults) =\n Trie.alter pathList insert\n where\n pathList = List.fromFoldable $ String.toCharArray path\n\n insert\n :: Maybe (List SearchResult)\n -> Maybe (List SearchResult)\n insert mbOldResults =\n case mbOldResults of\n Nothing -> Just $ List.fromFoldable newResults\n Just old -> Just $ List.fromFoldable newResults <> old\n\nbrowserSearchEngine\n :: Engine Aff PartialIndex TypeIndex\nbrowserSearchEngine =\n { queryIndex: query\n , queryTypeIndex: TypeIndex.query\n , queryPackageIndex: PackageIndex.queryPackageIndex\n , queryModuleIndex: ModuleIndex.queryModuleIndex\n }\n\n-- | Load a part of the index by injecting a