diff --git a/spago.lock b/spago.lock new file mode 100644 index 0000000..809974a --- /dev/null +++ b/spago.lock @@ -0,0 +1,1295 @@ +{ + "workspace": { + "packages": { + "codec-argonaut": { + "path": "./", + "core": { + "dependencies": [ + "argonaut-core", + "codec", + "console", + "effect", + "foreign-object", + "ordered-collections", + "prelude", + "type-equality", + "variant" + ], + "build_plan": [ + "argonaut-core", + "arrays", + "bifunctors", + "codec", + "console", + "const", + "contravariant", + "control", + "distributive", + "effect", + "either", + "enums", + "exists", + "foldable-traversable", + "foreign-object", + "functions", + "functors", + "gen", + "identity", + "integers", + "invariant", + "lazy", + "lists", + "maybe", + "newtype", + "nonempty", + "numbers", + "ordered-collections", + "orders", + "partial", + "prelude", + "profunctor", + "record", + "refs", + "safe-coerce", + "st", + "strings", + "tailrec", + "tuples", + "type-equality", + "typelevel-prelude", + "unfoldable", + "unsafe-coerce", + "variant" + ] + }, + "test": { + "dependencies": [ + "argonaut-codecs", + "debug", + "quickcheck" + ], + "build_plan": [ + "argonaut-codecs", + "argonaut-core", + "arrays", + "bifunctors", + "console", + "const", + "contravariant", + "control", + "debug", + "distributive", + "effect", + "either", + "enums", + "exceptions", + "exists", + "foldable-traversable", + "foreign-object", + "functions", + "functors", + "gen", + "identity", + "integers", + "invariant", + "lazy", + "lcg", + "lists", + "maybe", + "newtype", + "nonempty", + "numbers", + "ordered-collections", + "orders", + "partial", + "prelude", + "profunctor", + "quickcheck", + "random", + "record", + "refs", + "safe-coerce", + "st", + "strings", + "tailrec", + "transformers", + "tuples", + "type-equality", + "typelevel-prelude", + "unfoldable", + "unsafe-coerce" + ] + } + } + }, + "package_set": { + "address": { + "registry": "62.2.0" + }, + "compiler": ">=0.15.15 <0.16.0", + "content": { + "abc-parser": "2.0.1", + "ace": "9.1.0", + "address-rfc2821": "0.1.1", + "aff": "8.0.0", + "aff-bus": "6.0.0", + "aff-coroutines": "9.0.0", + "aff-promise": "4.0.0", + "aff-retry": "2.0.0", + "affjax": "13.0.0", + "affjax-node": "1.0.0", + "affjax-web": "1.0.0", + "ansi": "7.0.0", + "apexcharts": "0.5.0", + "applicative-phases": "1.0.0", + "argonaut": "9.0.0", + "argonaut-aeson-generic": "0.4.1", + "argonaut-codecs": "9.1.0", + "argonaut-core": "7.0.0", + "argonaut-generic": "8.0.0", + "argonaut-traversals": "10.0.0", + "argparse-basic": "2.0.0", + "array-builder": "0.1.2", + "array-search": "0.6.0", + "arraybuffer": "13.2.0", + "arraybuffer-builder": "3.1.0", + "arraybuffer-types": "3.0.2", + "arrays": "7.3.0", + "arrays-extra": "0.6.1", + "arrays-zipper": "2.0.1", + "ask": "1.0.0", + "assert": "6.0.0", + "assert-multiple": "0.4.0", + "avar": "5.0.0", + "b64": "0.0.8", + "barbies": "1.0.1", + "barlow-lens": "0.9.0", + "bifunctors": "6.0.0", + "bigints": "7.0.1", + "bolson": "0.3.9", + "bookhound": "0.1.7", + "bower-json": "3.0.0", + "call-by-name": "4.0.1", + "canvas": "6.0.0", + "canvas-action": "9.0.0", + "cartesian": "1.0.6", + "catenable-lists": "7.0.0", + "cbor-stream": "1.3.0", + "chameleon": "1.0.0", + "chameleon-halogen": "1.0.3", + "chameleon-react-basic": "1.1.0", + "chameleon-styled": "2.5.0", + "chameleon-transformers": "1.0.0", + "channel": "1.0.0", + "checked-exceptions": "3.1.1", + "choku": "1.0.2", + "classless": "0.1.1", + "classless-arbitrary": "0.1.1", + "classless-decode-json": "0.1.1", + "classless-encode-json": "0.1.3", + "classnames": "2.0.0", + "codec": "6.1.0", + "codec-argonaut": "10.0.0", + "codec-json": "2.0.0", + "colors": "7.0.1", + "concur-core": "0.5.0", + "concur-react": "0.5.0", + "concurrent-queues": "3.0.0", + "console": "6.1.0", + "const": "6.0.0", + "contravariant": "6.0.0", + "control": "6.0.0", + "convertable-options": "1.0.0", + "coroutines": "7.0.0", + "css": "6.0.0", + "css-class-name-extractor": "0.0.3", + "css-frameworks": "1.0.1", + "csv-stream": "2.3.0", + "data-mvc": "0.0.2", + "datetime": "6.1.0", + "datetime-parsing": "0.2.0", + "debounce": "0.1.0", + "debug": "6.0.2", + "decimals": "7.1.0", + "default-values": "1.0.1", + "deku": "0.9.23", + "deno": "0.0.5", + "dissect": "1.0.0", + "distributive": "6.0.0", + "dom-filereader": "7.0.0", + "dom-indexed": "12.0.0", + "dom-simple": "0.4.0", + "dotenv": "4.0.3", + "droplet": "0.6.0", + "dts": "1.0.0", + "dual-numbers": "1.0.3", + "dynamic-buffer": "3.0.1", + "echarts-simple": "0.0.1", + "effect": "4.0.0", + "either": "6.1.0", + "elmish": "0.13.0", + "elmish-enzyme": "0.1.1", + "elmish-hooks": "0.10.3", + "elmish-html": "0.9.0", + "elmish-testing-library": "0.3.2", + "email-validate": "7.0.0", + "encoding": "0.0.9", + "enums": "6.0.1", + "env-names": "0.4.0", + "error": "2.0.0", + "eta-conversion": "0.3.2", + "exceptions": "6.1.0", + "exists": "6.0.0", + "exitcodes": "4.0.0", + "expect-inferred": "3.0.0", + "ezfetch": "1.1.0", + "fahrtwind": "2.0.0", + "fallback": "0.1.0", + "fast-vect": "1.2.0", + "fetch": "4.1.0", + "fetch-argonaut": "1.0.1", + "fetch-core": "5.1.0", + "fetch-yoga-json": "1.1.0", + "ffi-simple": "0.5.1", + "fft-js": "0.1.0", + "filterable": "5.0.0", + "fix-functor": "0.1.0", + "fixed-points": "7.0.0", + "fixed-precision": "5.0.0", + "flame": "1.3.0", + "float32": "2.0.0", + "fmt": "0.2.1", + "foldable-traversable": "6.0.0", + "foldable-traversable-extra": "0.0.6", + "foreign": "7.0.0", + "foreign-object": "4.1.0", + "foreign-readwrite": "3.4.0", + "forgetmenot": "0.1.0", + "fork": "6.0.0", + "form-urlencoded": "7.0.0", + "formatters": "7.0.0", + "framer-motion": "1.0.1", + "free": "7.1.0", + "freeap": "7.0.0", + "freer-free": "0.0.1", + "freet": "7.0.0", + "functions": "6.0.0", + "functor1": "3.0.0", + "functors": "5.0.0", + "fuzzy": "0.4.0", + "gen": "4.0.0", + "generate-values": "1.0.1", + "generic-router": "0.0.1", + "geojson": "0.0.5", + "geometria": "2.2.0", + "gojs": "0.1.1", + "grain": "3.0.0", + "grain-router": "3.0.0", + "grain-virtualized": "3.0.0", + "graphs": "8.1.0", + "group": "4.1.1", + "halogen": "7.0.0", + "halogen-bootstrap5": "5.3.2", + "halogen-canvas": "1.0.0", + "halogen-css": "10.0.0", + "halogen-echarts-simple": "0.0.4", + "halogen-formless": "4.0.3", + "halogen-helix": "1.0.1", + "halogen-hooks": "0.6.3", + "halogen-hooks-extra": "0.9.0", + "halogen-infinite-scroll": "1.1.0", + "halogen-store": "0.5.4", + "halogen-storybook": "2.0.0", + "halogen-subscriptions": "2.0.0", + "halogen-svg-elems": "8.0.0", + "halogen-typewriter": "1.0.4", + "halogen-vdom": "8.0.0", + "halogen-vdom-string-renderer": "0.5.0", + "halogen-xterm": "2.0.0", + "heckin": "2.0.1", + "heterogeneous": "0.6.0", + "homogeneous": "0.4.0", + "http-methods": "6.0.0", + "httpurple": "4.0.0", + "huffman": "0.4.0", + "humdrum": "0.0.1", + "hyrule": "2.3.8", + "identity": "6.0.0", + "identy": "4.0.1", + "indexed-db": "1.0.0", + "indexed-monad": "3.0.0", + "int64": "3.0.0", + "integers": "6.0.0", + "interpolate": "5.0.2", + "intersection-observer": "1.0.1", + "invariant": "6.0.0", + "jarilo": "1.0.1", + "jelly": "0.10.0", + "jelly-router": "0.3.0", + "jelly-signal": "0.4.0", + "jest": "1.0.0", + "js-abort-controller": "1.0.0", + "js-bigints": "2.2.1", + "js-date": "8.0.0", + "js-fetch": "0.2.1", + "js-fileio": "3.0.0", + "js-intl": "1.1.4", + "js-iterators": "0.1.1", + "js-maps": "0.1.2", + "js-promise": "1.0.0", + "js-promise-aff": "1.0.0", + "js-timers": "6.1.0", + "js-uri": "3.1.0", + "jsdom": "1.0.0", + "json": "1.1.0", + "json-codecs": "5.0.0", + "justifill": "0.5.0", + "jwt": "0.0.9", + "labeled-data": "0.2.0", + "language-cst-parser": "0.14.0", + "lazy": "6.0.0", + "lazy-joe": "1.0.0", + "lcg": "4.0.0", + "leibniz": "5.0.0", + "leveldb": "1.0.1", + "liminal": "1.0.1", + "linalg": "6.0.0", + "lists": "7.0.0", + "literals": "1.0.2", + "logging": "3.0.0", + "logging-journald": "0.4.0", + "lumi-components": "18.0.0", + "machines": "7.0.0", + "maps-eager": "0.5.0", + "marionette": "1.0.0", + "marionette-react-basic-hooks": "0.1.1", + "marked": "0.1.0", + "matrices": "5.0.1", + "matryoshka": "1.0.0", + "maybe": "6.0.0", + "media-types": "6.0.0", + "meowclient": "1.0.0", + "midi": "4.0.0", + "milkis": "9.0.0", + "minibench": "4.0.1", + "mmorph": "7.0.0", + "monad-control": "5.0.0", + "monad-logger": "1.3.1", + "monad-loops": "0.5.0", + "monad-unlift": "1.0.1", + "monoid-extras": "0.0.1", + "monoidal": "0.16.0", + "morello": "0.4.0", + "mote": "3.0.0", + "motsunabe": "2.0.0", + "mvc": "0.0.1", + "mysql": "6.0.1", + "n3": "0.1.0", + "nano-id": "1.1.0", + "nanoid": "0.1.0", + "naturals": "3.0.0", + "nested-functor": "0.2.1", + "newtype": "5.0.0", + "nextjs": "0.1.1", + "nextui": "0.2.0", + "node-buffer": "9.0.0", + "node-child-process": "11.1.0", + "node-event-emitter": "3.0.0", + "node-execa": "5.0.0", + "node-fs": "9.2.0", + "node-glob-basic": "1.3.0", + "node-http": "9.1.0", + "node-http2": "1.1.1", + "node-human-signals": "1.0.0", + "node-net": "5.1.0", + "node-os": "5.1.0", + "node-path": "5.0.0", + "node-process": "11.2.0", + "node-readline": "8.1.1", + "node-sqlite3": "8.0.0", + "node-stream-pipes": "2.1.6", + "node-streams": "9.0.0", + "node-tls": "0.3.1", + "node-url": "7.0.1", + "node-zlib": "0.4.0", + "nonempty": "7.0.0", + "now": "6.0.0", + "npm-package-json": "2.0.0", + "nullable": "6.0.0", + "numberfield": "0.2.2", + "numbers": "9.0.1", + "oak": "3.1.1", + "oak-debug": "1.2.2", + "object-maps": "0.3.0", + "ocarina": "1.5.4", + "oooooooooorrrrrrrmm-lib": "0.0.1", + "open-colors-scales-and-schemes": "1.0.0", + "open-folds": "6.4.0", + "open-foreign-generic": "11.0.3", + "open-memoize": "6.2.0", + "open-mkdirp-aff": "1.2.0", + "open-pairing": "6.2.0", + "open-smolder": "12.0.2", + "options": "7.0.0", + "optparse": "5.0.1", + "ordered-collections": "3.2.0", + "ordered-set": "0.4.0", + "orders": "6.0.0", + "owoify": "1.2.0", + "pairs": "9.0.1", + "parallel": "7.0.0", + "parsing": "10.2.0", + "parsing-dataview": "3.2.4", + "partial": "4.0.0", + "pathy": "9.0.0", + "pha": "0.13.0", + "phaser": "0.7.0", + "phylio": "1.1.2", + "pipes": "8.0.0", + "pirates-charm": "0.0.1", + "pmock": "0.9.0", + "point-free": "1.0.0", + "pointed-list": "0.5.1", + "polymorphic-vectors": "4.0.0", + "posix-types": "6.0.0", + "postgresql": "2.0.20", + "precise": "6.0.0", + "precise-datetime": "7.0.0", + "prelude": "6.0.1", + "prettier-printer": "3.0.0", + "printf": "0.1.0", + "priority-queue": "0.1.2", + "profunctor": "6.0.1", + "profunctor-lenses": "8.0.0", + "protobuf": "4.4.0", + "psa-utils": "8.0.0", + "psci-support": "6.0.0", + "punycode": "1.0.0", + "qualified-do": "2.2.0", + "quantities": "12.2.0", + "quickcheck": "8.0.1", + "quickcheck-combinators": "0.1.3", + "quickcheck-laws": "7.0.0", + "quickcheck-utf8": "0.0.0", + "random": "6.0.0", + "rationals": "6.0.0", + "rdf": "0.1.0", + "react": "11.0.0", + "react-aria": "0.2.0", + "react-basic": "17.0.0", + "react-basic-classic": "3.0.0", + "react-basic-dnd": "10.1.0", + "react-basic-dom": "7.0.0", + "react-basic-dom-beta": "0.1.1", + "react-basic-emotion": "7.1.0", + "react-basic-hooks": "8.2.0", + "react-basic-storybook": "2.0.0", + "react-dom": "8.0.0", + "react-halo": "3.0.0", + "react-icons": "1.1.5", + "react-markdown": "0.1.0", + "react-testing-library": "4.0.1", + "react-virtuoso": "1.0.0", + "reactix": "0.6.1", + "read": "1.0.1", + "recharts": "1.1.0", + "record": "4.0.0", + "record-extra": "5.0.1", + "record-ptional-fields": "0.1.2", + "record-studio": "1.0.4", + "refs": "6.0.0", + "remotedata": "5.0.1", + "repr": "0.5.0", + "resize-observer": "1.0.0", + "resource": "2.0.1", + "resourcet": "1.0.0", + "result": "1.0.3", + "return": "0.2.0", + "ring-modules": "5.0.1", + "rito": "0.3.4", + "roman": "0.4.0", + "rough-notation": "1.0.2", + "routing": "11.0.0", + "routing-duplex": "0.7.0", + "run": "5.0.0", + "safe-coerce": "2.0.0", + "safely": "4.0.1", + "school-of-music": "1.3.0", + "selection-foldable": "0.2.0", + "selective-functors": "1.0.1", + "semirings": "7.0.0", + "signal": "13.0.0", + "simple-emitter": "3.0.1", + "simple-i18n": "2.0.1", + "simple-json": "9.0.0", + "simple-json-generics": "0.2.1", + "simple-ulid": "3.0.0", + "sized-matrices": "1.0.0", + "sized-vectors": "5.0.2", + "slug": "3.1.0", + "small-ffi": "4.0.1", + "soundfonts": "4.1.0", + "sparse-matrices": "2.0.1", + "sparse-polynomials": "3.0.1", + "spec": "8.1.1", + "spec-discovery": "8.4.0", + "spec-mocha": "5.1.1", + "spec-node": "0.0.3", + "spec-quickcheck": "5.0.2", + "spec-reporter-xunit": "0.7.1", + "splitmix": "2.1.0", + "ssrs": "1.0.0", + "st": "6.2.0", + "statistics": "0.3.2", + "strictlypositiveint": "1.0.1", + "string-parsers": "8.0.0", + "strings": "6.0.1", + "strings-extra": "4.0.0", + "stringutils": "0.0.12", + "substitute": "0.2.3", + "supply": "0.2.0", + "svg-parser": "3.0.0", + "systemd-journald": "0.3.0", + "tagged": "4.0.2", + "tailrec": "6.1.0", + "tanstack-query": "2.0.0", + "tecton": "0.2.1", + "tecton-halogen": "0.2.0", + "test-unit": "17.0.0", + "thermite": "6.3.1", + "thermite-dom": "0.3.1", + "these": "6.0.0", + "threading": "0.0.3", + "tldr": "0.0.0", + "toestand": "0.9.0", + "transformation-matrix": "1.0.1", + "transformers": "6.1.0", + "tree-rose": "4.0.2", + "ts-bridge": "4.0.0", + "tuples": "7.0.0", + "two-or-more": "1.0.0", + "type-equality": "4.0.1", + "typedenv": "2.0.1", + "typelevel": "6.0.0", + "typelevel-lists": "2.1.0", + "typelevel-peano": "1.0.1", + "typelevel-prelude": "7.0.0", + "typelevel-regex": "0.0.3", + "typelevel-rows": "0.1.0", + "typisch": "0.4.0", + "uint": "7.0.0", + "ulid": "3.0.1", + "uncurried-transformers": "1.1.0", + "undefined": "2.0.0", + "undefined-is-not-a-problem": "1.1.0", + "unfoldable": "6.0.0", + "unicode": "6.0.0", + "unique": "0.6.1", + "unlift": "1.0.1", + "unordered-collections": "3.1.0", + "unsafe-coerce": "6.0.0", + "unsafe-reference": "5.0.0", + "untagged-to-tagged": "0.1.4", + "untagged-union": "1.0.0", + "uri": "9.0.0", + "url-immutable": "1.0.0", + "uuid": "9.0.0", + "uuidv4": "1.0.0", + "validation": "6.0.0", + "variant": "8.0.0", + "variant-encodings": "2.0.0", + "vectorfield": "1.0.1", + "vectors": "2.1.0", + "versions": "7.0.0", + "visx": "0.0.2", + "vitest": "1.0.0", + "web-clipboard": "6.0.0", + "web-cssom": "2.0.0", + "web-cssom-view": "0.1.0", + "web-dom": "6.0.0", + "web-dom-parser": "8.0.0", + "web-dom-xpath": "3.0.0", + "web-encoding": "3.0.0", + "web-events": "4.0.0", + "web-fetch": "4.0.1", + "web-file": "4.0.0", + "web-geometry": "0.1.0", + "web-html": "4.1.0", + "web-pointerevents": "2.0.0", + "web-proletarian": "1.0.0", + "web-promise": "3.2.0", + "web-resize-observer": "2.1.0", + "web-router": "1.0.0", + "web-socket": "4.0.0", + "web-storage": "5.0.0", + "web-streams": "4.0.0", + "web-touchevents": "4.0.0", + "web-uievents": "5.0.0", + "web-url": "2.0.0", + "web-workers": "1.1.0", + "web-xhr": "5.0.1", + "webextension-polyfill": "0.1.0", + "webgpu": "0.0.1", + "which": "2.0.0", + "whine-core": "0.0.1", + "xterm": "1.0.0", + "yoga-fetch": "1.0.1", + "yoga-json": "5.1.0", + "yoga-om": "0.1.0", + "yoga-postgres": "6.0.0", + "yoga-react-dom": "1.0.1", + "yoga-subtlecrypto": "0.1.0", + "yoga-tree": "1.0.0", + "z3": "0.0.2", + "zipperarray": "2.0.0" + } + }, + "extra_packages": {} + }, + "packages": { + "argonaut-codecs": { + "type": "registry", + "version": "9.1.0", + "integrity": "sha256-N6efXByUeg848ompEqJfVvZuZPfdRYDGlTDFn0G0Oh8=", + "dependencies": [ + "argonaut-core", + "arrays", + "effect", + "foreign-object", + "identity", + "integers", + "maybe", + "nonempty", + "ordered-collections", + "prelude", + "record" + ] + }, + "argonaut-core": { + "type": "registry", + "version": "7.0.0", + "integrity": "sha256-RC82GfAjItydxrO24cdX373KHVZiLqybu19b5X8u7B4=", + "dependencies": [ + "arrays", + "control", + "either", + "foreign-object", + "functions", + "gen", + "maybe", + "nonempty", + "prelude", + "strings", + "tailrec" + ] + }, + "arrays": { + "type": "registry", + "version": "7.3.0", + "integrity": "sha256-tmcklBlc/muUtUfr9RapdCPwnlQeB3aSrC4dK85gQlc=", + "dependencies": [ + "bifunctors", + "control", + "foldable-traversable", + "functions", + "maybe", + "nonempty", + "partial", + "prelude", + "safe-coerce", + "st", + "tailrec", + "tuples", + "unfoldable", + "unsafe-coerce" + ] + }, + "bifunctors": { + "type": "registry", + "version": "6.0.0", + "integrity": "sha256-/gZwC9YhNxZNQpnHa5BIYerCGM2jeX9ukZiEvYxm5Nw=", + "dependencies": [ + "const", + "either", + "newtype", + "prelude", + "tuples" + ] + }, + "codec": { + "type": "registry", + "version": "6.1.0", + "integrity": "sha256-6vMLNlsJxQarVQ9cn1FYfl5x6opfzxAza15SzRdxFxQ=", + "dependencies": [ + "bifunctors", + "profunctor" + ] + }, + "console": { + "type": "registry", + "version": "6.1.0", + "integrity": "sha256-CxmAzjgyuGDmt9FZW51VhV6rBPwR6o0YeKUzA9rSzcM=", + "dependencies": [ + "effect", + "prelude" + ] + }, + "const": { + "type": "registry", + "version": "6.0.0", + "integrity": "sha256-tNrxDW8D8H4jdHE2HiPzpLy08zkzJMmGHdRqt5BQuTc=", + "dependencies": [ + "invariant", + "newtype", + "prelude" + ] + }, + "contravariant": { + "type": "registry", + "version": "6.0.0", + "integrity": "sha256-TP+ooAp3vvmdjfQsQJSichF5B4BPDHp3wAJoWchip6c=", + "dependencies": [ + "const", + "either", + "newtype", + "prelude", + "tuples" + ] + }, + "control": { + "type": "registry", + "version": "6.0.0", + "integrity": "sha256-sH7Pg9E96JCPF9PIA6oQ8+BjTyO/BH1ZuE/bOcyj4Jk=", + "dependencies": [ + "newtype", + "prelude" + ] + }, + "debug": { + "type": "registry", + "version": "6.0.2", + "integrity": "sha256-vmkYFuXYuELBzeauvgHG6E6Kf/Hp1dAnxwE9ByHfwSg=", + "dependencies": [ + "functions", + "prelude" + ] + }, + "distributive": { + "type": "registry", + "version": "6.0.0", + "integrity": "sha256-HTDdmEnzigMl+02SJB88j+gAXDx9VKsbvR4MJGDPbOQ=", + "dependencies": [ + "identity", + "newtype", + "prelude", + "tuples", + "type-equality" + ] + }, + "effect": { + "type": "registry", + "version": "4.0.0", + "integrity": "sha256-eBtZu+HZcMa5HilvI6kaDyVX3ji8p0W9MGKy2K4T6+M=", + "dependencies": [ + "prelude" + ] + }, + "either": { + "type": "registry", + "version": "6.1.0", + "integrity": "sha256-6hgTPisnMWVwQivOu2PKYcH8uqjEOOqDyaDQVUchTpY=", + "dependencies": [ + "control", + "invariant", + "maybe", + "prelude" + ] + }, + "enums": { + "type": "registry", + "version": "6.0.1", + "integrity": "sha256-HWaD73JFLorc4A6trKIRUeDMdzE+GpkJaEOM1nTNkC8=", + "dependencies": [ + "control", + "either", + "gen", + "maybe", + "newtype", + "nonempty", + "partial", + "prelude", + "tuples", + "unfoldable" + ] + }, + "exceptions": { + "type": "registry", + "version": "6.1.0", + "integrity": "sha256-K0T89IHtF3vBY7eSAO7eDOqSb2J9kZGAcDN5+IKsF8E=", + "dependencies": [ + "effect", + "either", + "maybe", + "prelude" + ] + }, + "exists": { + "type": "registry", + "version": "6.0.0", + "integrity": "sha256-A0JQHpTfo1dNOj9U5/Fd3xndlRSE0g2IQWOGor2yXn8=", + "dependencies": [ + "unsafe-coerce" + ] + }, + "foldable-traversable": { + "type": "registry", + "version": "6.0.0", + "integrity": "sha256-fLeqRYM4jUrZD5H4WqcwUgzU7XfYkzO4zhgtNc3jcWM=", + "dependencies": [ + "bifunctors", + "const", + "control", + "either", + "functors", + "identity", + "maybe", + "newtype", + "orders", + "prelude", + "tuples" + ] + }, + "foreign-object": { + "type": "registry", + "version": "4.1.0", + "integrity": "sha256-q24okj6mT+yGHYQ+ei/pYPj5ih6sTbu7eDv/WU56JVo=", + "dependencies": [ + "arrays", + "foldable-traversable", + "functions", + "gen", + "lists", + "maybe", + "prelude", + "st", + "tailrec", + "tuples", + "typelevel-prelude", + "unfoldable" + ] + }, + "functions": { + "type": "registry", + "version": "6.0.0", + "integrity": "sha256-adMyJNEnhGde2unHHAP79gPtlNjNqzgLB8arEOn9hLI=", + "dependencies": [ + "prelude" + ] + }, + "functors": { + "type": "registry", + "version": "5.0.0", + "integrity": "sha256-zfPWWYisbD84MqwpJSZFlvM6v86McM68ob8p9s27ywU=", + "dependencies": [ + "bifunctors", + "const", + "contravariant", + "control", + "distributive", + "either", + "invariant", + "maybe", + "newtype", + "prelude", + "profunctor", + "tuples", + "unsafe-coerce" + ] + }, + "gen": { + "type": "registry", + "version": "4.0.0", + "integrity": "sha256-f7yzAXWwr+xnaqEOcvyO3ezKdoes8+WXWdXIHDBCAPI=", + "dependencies": [ + "either", + "foldable-traversable", + "identity", + "maybe", + "newtype", + "nonempty", + "prelude", + "tailrec", + "tuples", + "unfoldable" + ] + }, + "identity": { + "type": "registry", + "version": "6.0.0", + "integrity": "sha256-4wY0XZbAksjY6UAg99WkuKyJlQlWAfTi2ssadH0wVMY=", + "dependencies": [ + "control", + "invariant", + "newtype", + "prelude" + ] + }, + "integers": { + "type": "registry", + "version": "6.0.0", + "integrity": "sha256-sf+sK26R1hzwl3NhXR7WAu9zCDjQnfoXwcyGoseX158=", + "dependencies": [ + "maybe", + "numbers", + "prelude" + ] + }, + "invariant": { + "type": "registry", + "version": "6.0.0", + "integrity": "sha256-RGWWyYrz0Hs1KjPDA+87Kia67ZFBhfJ5lMGOMCEFoLo=", + "dependencies": [ + "control", + "prelude" + ] + }, + "lazy": { + "type": "registry", + "version": "6.0.0", + "integrity": "sha256-lMsfFOnlqfe4KzRRiW8ot5ge6HtcU3Eyh2XkXcP5IgU=", + "dependencies": [ + "control", + "foldable-traversable", + "invariant", + "prelude" + ] + }, + "lcg": { + "type": "registry", + "version": "4.0.0", + "integrity": "sha256-h7ME5cthLfbgJOJdsZcSfFpwXsx4rf8YmhebU+3iSYg=", + "dependencies": [ + "effect", + "integers", + "maybe", + "partial", + "prelude", + "random" + ] + }, + "lists": { + "type": "registry", + "version": "7.0.0", + "integrity": "sha256-EKF15qYqucuXP2lT/xPxhqy58f0FFT6KHdIB/yBOayI=", + "dependencies": [ + "bifunctors", + "control", + "foldable-traversable", + "lazy", + "maybe", + "newtype", + "nonempty", + "partial", + "prelude", + "tailrec", + "tuples", + "unfoldable" + ] + }, + "maybe": { + "type": "registry", + "version": "6.0.0", + "integrity": "sha256-5cCIb0wPwbat2PRkQhUeZO0jcAmf8jCt2qE0wbC3v2Q=", + "dependencies": [ + "control", + "invariant", + "newtype", + "prelude" + ] + }, + "newtype": { + "type": "registry", + "version": "5.0.0", + "integrity": "sha256-gdrQu8oGe9eZE6L3wOI8ql/igOg+zEGB5ITh2g+uttw=", + "dependencies": [ + "prelude", + "safe-coerce" + ] + }, + "nonempty": { + "type": "registry", + "version": "7.0.0", + "integrity": "sha256-54ablJZUHGvvlTJzi3oXyPCuvY6zsrWJuH/dMJ/MFLs=", + "dependencies": [ + "control", + "foldable-traversable", + "maybe", + "prelude", + "tuples", + "unfoldable" + ] + }, + "numbers": { + "type": "registry", + "version": "9.0.1", + "integrity": "sha256-/9M6aeMDBdB4cwYDeJvLFprAHZ49EbtKQLIJsneXLIk=", + "dependencies": [ + "functions", + "maybe" + ] + }, + "ordered-collections": { + "type": "registry", + "version": "3.2.0", + "integrity": "sha256-o9jqsj5rpJmMdoe/zyufWHFjYYFTTsJpgcuCnqCO6PM=", + "dependencies": [ + "arrays", + "foldable-traversable", + "gen", + "lists", + "maybe", + "partial", + "prelude", + "st", + "tailrec", + "tuples", + "unfoldable" + ] + }, + "orders": { + "type": "registry", + "version": "6.0.0", + "integrity": "sha256-nBA0g3/ai0euH8q9pSbGqk53W2q6agm/dECZTHcoink=", + "dependencies": [ + "newtype", + "prelude" + ] + }, + "partial": { + "type": "registry", + "version": "4.0.0", + "integrity": "sha256-fwXerld6Xw1VkReh8yeQsdtLVrjfGiVuC5bA1Wyo/J4=", + "dependencies": [] + }, + "prelude": { + "type": "registry", + "version": "6.0.1", + "integrity": "sha256-o8p6SLYmVPqzXZhQFd2hGAWEwBoXl1swxLG/scpJ0V0=", + "dependencies": [] + }, + "profunctor": { + "type": "registry", + "version": "6.0.1", + "integrity": "sha256-E58hSYdJvF2Qjf9dnWLPlJKh2Z2fLfFLkQoYi16vsFk=", + "dependencies": [ + "control", + "distributive", + "either", + "exists", + "invariant", + "newtype", + "prelude", + "tuples" + ] + }, + "quickcheck": { + "type": "registry", + "version": "8.0.1", + "integrity": "sha256-ZvpccKQCvgslTXZCNmpYW4bUsFzhZd/kQUr2WmxFTGY=", + "dependencies": [ + "arrays", + "console", + "control", + "effect", + "either", + "enums", + "exceptions", + "foldable-traversable", + "gen", + "identity", + "integers", + "lazy", + "lcg", + "lists", + "maybe", + "newtype", + "nonempty", + "numbers", + "partial", + "prelude", + "record", + "st", + "strings", + "tailrec", + "transformers", + "tuples", + "unfoldable" + ] + }, + "random": { + "type": "registry", + "version": "6.0.0", + "integrity": "sha256-CJ611a35MPCE7XQMp0rdC6MCn76znlhisiCRgboAG+Q=", + "dependencies": [ + "effect", + "integers" + ] + }, + "record": { + "type": "registry", + "version": "4.0.0", + "integrity": "sha256-Za5U85bTRJEfGK5Sk4hM41oXy84YQI0I8TL3WUn1Qzg=", + "dependencies": [ + "functions", + "prelude", + "unsafe-coerce" + ] + }, + "refs": { + "type": "registry", + "version": "6.0.0", + "integrity": "sha256-Vgwne7jIbD3ZMoLNNETLT8Litw6lIYo3MfYNdtYWj9s=", + "dependencies": [ + "effect", + "prelude" + ] + }, + "safe-coerce": { + "type": "registry", + "version": "2.0.0", + "integrity": "sha256-a1ibQkiUcbODbLE/WAq7Ttbbh9ex+x33VCQ7GngKudU=", + "dependencies": [ + "unsafe-coerce" + ] + }, + "st": { + "type": "registry", + "version": "6.2.0", + "integrity": "sha256-z9X0WsOUlPwNx9GlCC+YccCyz8MejC8Wb0C4+9fiBRY=", + "dependencies": [ + "partial", + "prelude", + "tailrec", + "unsafe-coerce" + ] + }, + "strings": { + "type": "registry", + "version": "6.0.1", + "integrity": "sha256-WssD3DbX4OPzxSdjvRMX0yvc9+pS7n5gyPv5I2Trb7k=", + "dependencies": [ + "arrays", + "control", + "either", + "enums", + "foldable-traversable", + "gen", + "integers", + "maybe", + "newtype", + "nonempty", + "partial", + "prelude", + "tailrec", + "tuples", + "unfoldable", + "unsafe-coerce" + ] + }, + "tailrec": { + "type": "registry", + "version": "6.1.0", + "integrity": "sha256-Xx19ECVDRrDWpz9D2GxQHHV89vd61dnXxQm0IcYQHGk=", + "dependencies": [ + "bifunctors", + "effect", + "either", + "identity", + "maybe", + "partial", + "prelude", + "refs" + ] + }, + "transformers": { + "type": "registry", + "version": "6.1.0", + "integrity": "sha256-3Bm+Z6tsC/paG888XkywDngJ2JMos+JfOhRlkVfb7gI=", + "dependencies": [ + "control", + "distributive", + "effect", + "either", + "exceptions", + "foldable-traversable", + "identity", + "lazy", + "maybe", + "newtype", + "prelude", + "st", + "tailrec", + "tuples", + "unfoldable" + ] + }, + "tuples": { + "type": "registry", + "version": "7.0.0", + "integrity": "sha256-1rXgTomes9105BjgXqIw0FL6Fz1lqqUTLWOumhWec1M=", + "dependencies": [ + "control", + "invariant", + "prelude" + ] + }, + "type-equality": { + "type": "registry", + "version": "4.0.1", + "integrity": "sha256-Hs9D6Y71zFi/b+qu5NSbuadUQXe5iv5iWx0226vOHUw=", + "dependencies": [] + }, + "typelevel-prelude": { + "type": "registry", + "version": "7.0.0", + "integrity": "sha256-uFF2ph+vHcQpfPuPf2a3ukJDFmLhApmkpTMviHIWgJM=", + "dependencies": [ + "prelude", + "type-equality" + ] + }, + "unfoldable": { + "type": "registry", + "version": "6.0.0", + "integrity": "sha256-JtikvJdktRap7vr/K4ITlxUX1QexpnqBq0G/InLr6eg=", + "dependencies": [ + "foldable-traversable", + "maybe", + "partial", + "prelude", + "tuples" + ] + }, + "unsafe-coerce": { + "type": "registry", + "version": "6.0.0", + "integrity": "sha256-IqIYW4Vkevn8sI+6aUwRGvd87tVL36BBeOr0cGAE7t0=", + "dependencies": [] + }, + "variant": { + "type": "registry", + "version": "8.0.0", + "integrity": "sha256-SR//zQDg2dnbB8ZHslcxieUkCeNlbMToapvmh9onTtw=", + "dependencies": [ + "enums", + "lists", + "maybe", + "partial", + "prelude", + "record", + "tuples", + "unsafe-coerce" + ] + } + } +} diff --git a/spago.yaml b/spago.yaml new file mode 100644 index 0000000..e1668a0 --- /dev/null +++ b/spago.yaml @@ -0,0 +1,24 @@ +package: + name: codec-argonaut + dependencies: + - argonaut-core + - codec + - console + - effect + - foreign-object + - ordered-collections + - prelude + - type-equality + - variant + + test: + main: Test.Main + dependencies: + - argonaut-codecs + - debug + - quickcheck + +workspace: + packageSet: + registry: 62.2.0 + extraPackages: {} diff --git a/src/Data/Codec/Argonaut/Sum.purs b/src/Data/Codec/Argonaut/Sum.purs index c9a3cab..bc8474d 100644 --- a/src/Data/Codec/Argonaut/Sum.purs +++ b/src/Data/Codec/Argonaut/Sum.purs @@ -4,6 +4,7 @@ module Data.Codec.Argonaut.Sum , class GCases , class GFields , class GFlatCases + , CaseDecodeError(..) , defaultEncoding , defaultFlatEncoding , enumSum @@ -18,12 +19,10 @@ module Data.Codec.Argonaut.Sum , sumFlatWith , sumWith , taggedSum - ) - where + ) where import Prelude -import Control.Alt ((<|>)) import Data.Argonaut.Core (Json) import Data.Argonaut.Core (Json, fromString) as J import Data.Array (catMaybes) @@ -34,7 +33,7 @@ import Data.Codec as Codec import Data.Codec.Argonaut (JPropCodec, JsonCodec, JsonDecodeError(..), jobject) import Data.Codec.Argonaut as CA import Data.Codec.Argonaut.Record as CAR -import Data.Either (Either(..), note) +import Data.Either (Either(..), either, note) import Data.Generic.Rep (class Generic, Argument(..), Constructor(..), NoArguments(..), Product(..), Sum(..), from, to) import Data.Maybe (Maybe(..), maybe) import Data.Profunctor (dimap) @@ -135,43 +134,84 @@ sumWith ∷ ∀ r rep a. GCases r rep ⇒ Generic a rep ⇒ Encoding → String sumWith encoding name r = dimap from to $ codec' decode encode where - decode = gCasesDecode encoding r >>> (lmap $ Named name) + decodeObj obj = gCasesDecode encoding r obj # lmap finalizeError + decode = CA.decode jobject >>> either Left decodeObj >>> (lmap $ Named name) encode = gCasesEncode encoding r +data CaseDecodeError + = UnmatchedCase (Maybe String) + | DecodeError JsonDecodeError + +inQuotes ∷ String → String +inQuotes s = "`" <> s <> "`" + +finalizeError ∷ CaseDecodeError → JsonDecodeError +finalizeError = + case _ of + UnmatchedCase val → TypeMismatch $ "No case matched" + <> maybe "" (\v → ", unexpected tag value " <> inQuotes v) val + DecodeError error → error + +tagError ∷ String → JsonDecodeError → CaseDecodeError +tagError tag error = + DecodeError (Named ("case " <> tag) error) + +noTagError ∷ String → CaseDecodeError +noTagError tagKey = + DecodeError $ TypeMismatch ("Expecting a tag property " <> inQuotes tagKey) + +expectingAtLeastOneElementError ∷ JsonDecodeError +expectingAtLeastOneElementError = + TypeMismatch "Expecting at least one element" + +expectingOneElementError ∷ JsonDecodeError +expectingOneElementError = + TypeMismatch "Expecting exactly one element" + +expectingEmptyArrayError ∷ JsonDecodeError +expectingEmptyArrayError = + TypeMismatch "Expecting an empty array" + +noValueTagError ∷ String → JsonDecodeError +noValueTagError valuesKey = + TypeMismatch ("Expecting a value property " <> inQuotes valuesKey) + -------------------------------------------------------------------------------- +type GCasesEncode r rep = Encoding → Record r → rep → Json +type GCasesDecode r rep = Encoding → Record r → Object Json → Either CaseDecodeError rep + class GCases ∷ Row Type → Type → Constraint class GCases r rep where - gCasesEncode ∷ Encoding → Record r → rep → Json - gCasesDecode ∷ Encoding → Record r → Json → Either JsonDecodeError rep + gCasesEncode ∷ GCasesEncode r rep + gCasesDecode ∷ GCasesDecode r rep instance gCasesConstructorNoArgs ∷ ( Row.Cons name Unit () r , IsSymbol name ) ⇒ GCases r (Constructor name NoArguments) where - gCasesEncode ∷ Encoding → Record r → Constructor name NoArguments → Json + gCasesEncode ∷ GCasesEncode r (Constructor name NoArguments) gCasesEncode encoding _ _ = let name = reflectSymbol @name Proxy ∷ String in encodeSumCase encoding name [] - gCasesDecode ∷ Encoding → Record r → Json → Either JsonDecodeError (Constructor name NoArguments) + gCasesDecode ∷ GCasesDecode r (Constructor name NoArguments) gCasesDecode encoding _ json = do let name = reflectSymbol @name Proxy ∷ String - - parseNoFields encoding json name - pure $ Constructor NoArguments + _ ← parseNoFields encoding json name + pure (Constructor NoArguments) else instance gCasesConstructorSingleArg ∷ ( Row.Cons name (JsonCodec a) () r , IsSymbol name ) ⇒ GCases r (Constructor name (Argument a)) where - gCasesEncode ∷ Encoding → Record r → Constructor name (Argument a) → Json + gCasesEncode ∷ GCasesEncode r (Constructor name (Argument a)) gCasesEncode encoding r (Constructor (Argument x)) = let codec = Record.get (Proxy @name) r ∷ JsonCodec a @@ -179,13 +219,12 @@ else instance gCasesConstructorSingleArg ∷ in encodeSumCase encoding name [ CA.encode codec x ] - gCasesDecode ∷ Encoding → Record r → Json → Either JsonDecodeError (Constructor name (Argument a)) - gCasesDecode encoding r json = do + gCasesDecode ∷ GCasesDecode r (Constructor name (Argument a)) + gCasesDecode encoding r obj = do let name = reflectSymbol @name Proxy ∷ String - - field ← parseSingleField encoding json name ∷ _ Json + json ← parseSingleField encoding obj name let codec = Record.get (Proxy @name) r ∷ JsonCodec a - result ← CA.decode codec field ∷ _ a + result ← lmap (tagError name) $ CA.decode codec json ∷ _ a pure $ Constructor (Argument result) else instance gCasesConstructorManyArgs ∷ @@ -194,7 +233,7 @@ else instance gCasesConstructorManyArgs ∷ , IsSymbol name ) ⇒ GCases r (Constructor name args) where - gCasesEncode ∷ Encoding → Record r → Constructor name args → Json + gCasesEncode ∷ GCasesEncode r (Constructor name args) gCasesEncode encoding r (Constructor rep) = let codecs = Record.get (Proxy @name) r ∷ codecs @@ -203,14 +242,16 @@ else instance gCasesConstructorManyArgs ∷ in encodeSumCase encoding name jsons - gCasesDecode ∷ Encoding → Record r → Json → Either JsonDecodeError (Constructor name args) - gCasesDecode encoding r json = do + gCasesDecode ∷ GCasesDecode r (Constructor name args) + gCasesDecode encoding r obj = do let name = reflectSymbol @name Proxy ∷ String - - jsons ← parseManyFields encoding json name ∷ _ (Array Json) - let codecs = Record.get (Proxy @name) r ∷ codecs - result ← gFieldsDecode encoding codecs jsons ∷ _ args - pure $ Constructor result + do + jsons ← parseManyFields encoding obj name + let codecs = Record.get (Proxy @name) r ∷ codecs + result ← + lmap (tagError name) $ + gFieldsDecode encoding codecs jsons 0 ∷ _ args + pure $ Constructor result instance gCasesSum ∷ ( GCases r1 (Constructor name lhs) @@ -222,7 +263,7 @@ instance gCasesSum ∷ , IsSymbol name ) ⇒ GCases r (Sum (Constructor name lhs) rhs) where - gCasesEncode ∷ Encoding → Record r → Sum (Constructor name lhs) rhs → Json + gCasesEncode ∷ GCasesEncode r (Sum (Constructor name lhs) rhs) gCasesEncode encoding r = let codec = Record.get (Proxy @name) r ∷ codec @@ -233,36 +274,40 @@ instance gCasesSum ∷ Inl lhs → gCasesEncode encoding r1 lhs Inr rhs → gCasesEncode encoding r2 rhs - gCasesDecode ∷ Encoding → Record r → Json → Either JsonDecodeError (Sum (Constructor name lhs) rhs) + gCasesDecode ∷ GCasesDecode r (Sum (Constructor name lhs) rhs) gCasesDecode encoding r tagged = do let codec = Record.get (Proxy @name) r ∷ codec r1 = Record.insert (Proxy @name) codec {} ∷ Record r1 - r2 = Record.delete (Proxy @name) r ∷ Record r2 - let lhs = gCasesDecode encoding r1 tagged ∷ _ (Constructor name lhs) - rhs = gCasesDecode encoding r2 tagged ∷ _ rhs - (Inl <$> lhs) <|> (Inr <$> rhs) + + case lhs of + Right result → + pure (Inl result) + Left (UnmatchedCase _) → do + let r2 = Record.delete (Proxy @name) r ∷ Record r2 + let rhs = gCasesDecode encoding r2 tagged ∷ _ rhs + Inr <$> rhs + Left err → Left err -------------------------------------------------------------------------------- +type GFieldsEncode codecs rep = Encoding → codecs → rep → Array Json +type GFieldsDecode codecs rep = Encoding → codecs → Array Json → Int → Either JsonDecodeError rep + class GFields ∷ Type → Type → Constraint class GFields codecs rep where - gFieldsEncode ∷ Encoding → codecs → rep → Array Json - gFieldsDecode ∷ Encoding → codecs → Array Json → Either JsonDecodeError rep + gFieldsEncode ∷ GFieldsEncode codecs rep + gFieldsDecode ∷ GFieldsDecode codecs rep instance gFieldsArgument ∷ GFields (JsonCodec a) (Argument a) where - gFieldsEncode ∷ Encoding → JsonCodec a → Argument a → Array Json + gFieldsEncode ∷ GFieldsEncode (JsonCodec a) (Argument a) gFieldsEncode _ codec (Argument val) = [ CA.encode codec val ] - gFieldsDecode ∷ Encoding → JsonCodec a → Array Json → Either JsonDecodeError (Argument a) - gFieldsDecode _ codec jsons = do - json ← - ( case jsons of - [ head ] → pure head - _ → Left $ TypeMismatch "Expecting exactly one element" - ) ∷ _ Json - res ← CA.decode codec json ∷ _ a + gFieldsDecode ∷ GFieldsDecode (JsonCodec a) (Argument a) + gFieldsDecode _ codec jsons idx = do + json ← expectOneElement jsons + res ← lmap (AtIndex idx) $ CA.decode codec json ∷ _ a pure $ Argument res instance gFieldsProduct ∷ @@ -270,7 +315,7 @@ instance gFieldsProduct ∷ , GFields codecs reps ) ⇒ GFields (codec /\ codecs) (Product rep reps) where - gFieldsEncode ∷ Encoding → (codec /\ codecs) → Product rep reps → Array Json + gFieldsEncode ∷ GFieldsEncode (codec /\ codecs) (Product rep reps) gFieldsEncode encoding (codec /\ codecs) (Product rep reps) = let r1 = gFieldsEncode encoding codec rep ∷ Array Json @@ -278,102 +323,86 @@ instance gFieldsProduct ∷ in r1 <> r2 - gFieldsDecode ∷ Encoding → (codec /\ codecs) → Array Json → Either JsonDecodeError (Product rep reps) - gFieldsDecode encoding (codec /\ codecs) jsons = do + gFieldsDecode ∷ GFieldsDecode (codec /\ codecs) (Product rep reps) + gFieldsDecode encoding (codec /\ codecs) jsons idx = do { head, tail } ← - (Array.uncons jsons # note (TypeMismatch "Expecting at least one element")) + (Array.uncons jsons # note expectingAtLeastOneElementError) ∷ _ { head ∷ Json, tail ∷ Array Json } - rep ← gFieldsDecode encoding codec [ head ] ∷ _ rep - reps ← gFieldsDecode encoding codecs tail ∷ _ reps + rep ← gFieldsDecode encoding codec [ head ] idx ∷ _ rep + reps ← gFieldsDecode encoding codecs tail (idx + 1) ∷ _ reps pure $ Product rep reps -------------------------------------------------------------------------------- -checkTag ∷ String → Object Json → String → Either JsonDecodeError Unit -checkTag tagKey obj expectedTag = do - val ← - ( Obj.lookup tagKey obj - # note (TypeMismatch ("Expecting a tag property `" <> tagKey <> "`")) - ) ∷ _ Json - tag ← CA.decode CA.string val ∷ _ String - unless (tag == expectedTag) - $ Left - $ TypeMismatch ("Expecting tag `" <> expectedTag <> "`, got `" <> tag <> "`") - -parseNoFields ∷ Encoding → Json → String → Either JsonDecodeError Unit -parseNoFields encoding json expectedTag = +ifTagOk ∷ ∀ a. String → Object Json → String → (Unit → Either JsonDecodeError a) → Either CaseDecodeError a +ifTagOk tagKey obj expectedTag act = + case Obj.lookup tagKey obj <#> CA.decode CA.string of + Just (Right tag) | tag == expectedTag → + lmap (tagError expectedTag) (act unit) + Just (Right v) → Left $ UnmatchedCase (Just v) + Just (Left _) → Left $ noTagError tagKey + Nothing → Left $ noTagError tagKey + +ifNestedOk ∷ ∀ a. Object Json → String → (Json → Either JsonDecodeError a) → Either CaseDecodeError a +ifNestedOk obj expectedTag decodeVal = + maybe (Left $ UnmatchedCase Nothing) + (lmap (tagError expectedTag) <<< decodeVal) + (Obj.lookup expectedTag obj) + +getValue ∷ String → Object Json → Either JsonDecodeError Json +getValue valuesKey obj = + Obj.lookup valuesKey obj + # note (noValueTagError valuesKey) + +expectOneElement ∷ ∀ a. Array a → Either JsonDecodeError a +expectOneElement = + case _ of + [ head ] → pure head + _ → Left $ expectingOneElementError + +type ParseFields a = Encoding → Object Json → String → Either CaseDecodeError a + +parseNoFields ∷ ParseFields Unit +parseNoFields encoding obj expectedTag = case encoding of EncodeNested {} → do - obj ← CA.decode jobject json - val ← - ( Obj.lookup expectedTag obj # note (TypeMismatch ("Expecting a property `" <> expectedTag <> "`")) - ) ∷ _ Json - fields ← CA.decode CA.jarray val ∷ _ (Array Json) - when (fields /= []) - $ Left - $ TypeMismatch "Expecting an empty array" + ifNestedOk obj expectedTag expectEmpty EncodeTagged { tagKey, valuesKey, omitEmptyArguments } → do - obj ← CA.decode jobject json - checkTag tagKey obj expectedTag - when (not omitEmptyArguments) do - val ← - ( Obj.lookup valuesKey obj - # note (TypeMismatch ("Expecting a value property `" <> valuesKey <> "`")) - ) ∷ _ Json - fields ← CA.decode CA.jarray val ∷ _ (Array Json) - when (fields /= []) - $ Left - $ TypeMismatch "Expecting an empty array" - -parseSingleField ∷ Encoding → Json → String → Either JsonDecodeError Json -parseSingleField encoding json expectedTag = case encoding of + ifTagOk tagKey obj expectedTag \_ → + when (not omitEmptyArguments) do + getValue valuesKey obj >>= expectEmpty + where + expectEmpty val = do + fields ← CA.decode CA.jarray val ∷ _ (Array Json) + when (fields /= []) do + Left $ expectingEmptyArrayError + +parseSingleField ∷ ParseFields Json +parseSingleField encoding obj expectedTag = case encoding of EncodeNested { unwrapSingleArguments } → do - obj ← CA.decode jobject json - val ← - ( Obj.lookup expectedTag obj # note (TypeMismatch ("Expecting a property `" <> expectedTag <> "`")) - ) ∷ _ Json - if unwrapSingleArguments then - pure val - else do - fields ← CA.decode CA.jarray val - case fields of - [ head ] → pure head - _ → Left $ TypeMismatch "Expecting exactly one element" + ifNestedOk obj expectedTag (handleVal unwrapSingleArguments) EncodeTagged { tagKey, valuesKey, unwrapSingleArguments } → do - obj ← CA.decode jobject json - checkTag tagKey obj expectedTag - val ← - ( Obj.lookup valuesKey obj - # note (TypeMismatch ("Expecting a value property `" <> valuesKey <> "`")) - ) ∷ _ Json + ifTagOk tagKey obj expectedTag \_ → + getValue valuesKey obj >>= handleVal unwrapSingleArguments + + where + handleVal unwrapSingleArguments val = if unwrapSingleArguments then pure val - else do - fields ← CA.decode CA.jarray val - case fields of - [ head ] → pure head - _ → Left $ TypeMismatch "Expecting exactly one element" - -parseManyFields ∷ Encoding → Json → String → Either JsonDecodeError (Array Json) -parseManyFields encoding json expectedTag = + else + CA.decode CA.jarray val >>= expectOneElement + +parseManyFields ∷ ParseFields (Array Json) +parseManyFields encoding obj expectedTag = case encoding of EncodeNested {} → do - obj ← CA.decode jobject json - val ← - ( Obj.lookup expectedTag obj # note (TypeMismatch ("Expecting a property `" <> expectedTag <> "`")) - ) ∷ _ Json - CA.decode CA.jarray val + ifNestedOk obj expectedTag (CA.decode CA.jarray) EncodeTagged { tagKey, valuesKey } → do - obj ← CA.decode jobject json - checkTag tagKey obj expectedTag - val ← - ( Obj.lookup valuesKey obj - # note (TypeMismatch ("Expecting a value property `" <> valuesKey <> "`")) - ) ∷ _ Json - CA.decode CA.jarray val + ifTagOk tagKey obj expectedTag \_ → + getValue valuesKey obj >>= CA.decode CA.jarray encodeSumCase ∷ Encoding → String → Array Json → Json encodeSumCase encoding tag jsons = @@ -412,19 +441,23 @@ defaultFlatEncoding = { tag: Proxy } sumFlat ∷ ∀ r rep a. GFlatCases "tag" r rep ⇒ Generic a rep ⇒ String → Record r → JsonCodec a sumFlat = sumFlatWith defaultFlatEncoding -sumFlatWith ∷ ∀ @tag r rep a. GFlatCases tag r rep ⇒ Generic a rep ⇒ FlatEncoding tag -> String → Record r → JsonCodec a +sumFlatWith ∷ ∀ @tag r rep a. IsSymbol tag ⇒ GFlatCases tag r rep ⇒ Generic a rep ⇒ FlatEncoding tag → String → Record r → JsonCodec a sumFlatWith _ name r = - dimap from to $ codec' dec enc + dimap from to $ codec' decode encode where - dec = gFlatCasesDecode @tag r >>> (lmap $ Named name) - enc = gFlatCasesEncode @tag r + decodeObj obj = gFlatCasesDecode @tag r obj # lmap finalizeError + decode = CA.decode jobject >>> either Left decodeObj >>> (lmap $ Named name) + encode = gFlatCasesEncode @tag r + +type GFlatCasesEncode r rep = Record r → rep → Json +type GFlatCasesDecode r rep = Record r → Object Json → Either CaseDecodeError rep class GFlatCases ∷ Symbol → Row Type → Type → Constraint class GFlatCases tag r rep where - gFlatCasesEncode ∷ Record r → rep → Json - gFlatCasesDecode ∷ Record r → Json → Either JsonDecodeError rep + gFlatCasesEncode ∷ GFlatCasesEncode r rep + gFlatCasesDecode ∷ GFlatCasesDecode r rep instance gFlatCasesConstructorNoArg ∷ ( Row.Cons name Unit () rc @@ -433,7 +466,7 @@ instance gFlatCasesConstructorNoArg ∷ , IsSymbol tag ) ⇒ GFlatCases tag rc (Constructor name NoArguments) where - gFlatCasesEncode ∷ Record rc → Constructor name NoArguments → Json + gFlatCasesEncode ∷ GFlatCasesEncode rc (Constructor name NoArguments) gFlatCasesEncode _ (Constructor NoArguments) = let name = reflectSymbol (Proxy @name) ∷ String @@ -444,22 +477,13 @@ instance gFlatCasesConstructorNoArg ∷ in CA.encode codecWithTag rcWithTag - gFlatCasesDecode ∷ Record rc → Json → Either JsonDecodeError (Constructor name NoArguments) - gFlatCasesDecode _ json = do - let - name = reflectSymbol (Proxy @name) ∷ String - - propCodec = CAR.record {} ∷ JPropCodec {} - propCodecWithTag = CA.recordProp (Proxy @tag) CA.string propCodec ∷ JPropCodec (Record rf) - codecWithTag = CA.object ("case " <> name) propCodecWithTag ∷ JsonCodec (Record rf) - r ← CA.decode codecWithTag json ∷ _ (Record rf) - let actualTag = Record.get (Proxy @tag) r ∷ String - - when (actualTag /= name) - $ Left - $ TypeMismatch ("Expecting tag `" <> name <> "`, got `" <> actualTag <> "`") + gFlatCasesDecode ∷ GFlatCasesDecode rc (Constructor name NoArguments) + gFlatCasesDecode _ obj = do + let name = reflectSymbol (Proxy @name) + let tagKey = reflectSymbol (Proxy @tag) - pure (Constructor NoArguments) + ifTagOk tagKey obj name \_ → do + pure $ Constructor NoArguments instance gFlatCasesConstructorSingleArg ∷ ( Row.Cons name (JPropCodec (Record rf)) () rc @@ -469,7 +493,7 @@ instance gFlatCasesConstructorSingleArg ∷ , IsSymbol tag ) ⇒ GFlatCases tag rc (Constructor name (Argument (Record rf))) where - gFlatCasesEncode ∷ Record rc → Constructor name (Argument (Record rf)) → Json + gFlatCasesEncode ∷ GFlatCasesEncode rc (Constructor name (Argument (Record rf))) gFlatCasesEncode rc (Constructor (Argument rf)) = let name = reflectSymbol (Proxy @name) ∷ String @@ -480,22 +504,15 @@ instance gFlatCasesConstructorSingleArg ∷ in CA.encode codecWithTag rcWithTag - gFlatCasesDecode ∷ Record rc → Json → Either JsonDecodeError (Constructor name (Argument (Record rf))) - gFlatCasesDecode rc json = do - let - name = reflectSymbol (Proxy @name) ∷ String - propCodec = Record.get (Proxy @name) rc ∷ JPropCodec (Record rf) - propCodecWithTag = CA.recordProp (Proxy @tag) CA.string propCodec ∷ JPropCodec (Record rf') - codecWithTag = CA.object ("case " <> name) propCodecWithTag ∷ JsonCodec (Record rf') - r ← CA.decode codecWithTag json ∷ _ (Record rf') - - let actualTag = Record.get (Proxy @tag) r ∷ String - when (actualTag /= name) - $ Left - $ TypeMismatch ("Expecting tag `" <> name <> "`, got `" <> actualTag <> "`") + gFlatCasesDecode ∷ GFlatCasesDecode rc (Constructor name (Argument (Record rf))) + gFlatCasesDecode rc obj = do + let name = reflectSymbol (Proxy @name) + let tagKey = reflectSymbol (Proxy @tag) - let r' = Record.delete (Proxy @tag) r ∷ Record rf - pure (Constructor (Argument r')) + ifTagOk tagKey obj name \_ → do + let propCodec = Record.get (Proxy @name) rc ∷ JPropCodec (Record rf) + r ← CA.decode propCodec obj + pure $ (Constructor (Argument r)) instance gFlatCasesSum ∷ ( GFlatCases tag r1 (Constructor name lhs) @@ -507,7 +524,7 @@ instance gFlatCasesSum ∷ , IsSymbol name ) ⇒ GFlatCases tag r (Sum (Constructor name lhs) rhs) where - gFlatCasesEncode ∷ Record r → Sum (Constructor name lhs) rhs → Json + gFlatCasesEncode ∷ GFlatCasesEncode r (Sum (Constructor name lhs) rhs) gFlatCasesEncode r = let codec = Record.get (Proxy @name) r ∷ codec @@ -518,19 +535,23 @@ instance gFlatCasesSum ∷ Inl lhs → gFlatCasesEncode @tag r1 lhs Inr rhs → gFlatCasesEncode @tag r2 rhs - gFlatCasesDecode ∷ Record r → Json → Either JsonDecodeError (Sum (Constructor name lhs) rhs) + gFlatCasesDecode ∷ GFlatCasesDecode r (Sum (Constructor name lhs) rhs) gFlatCasesDecode r tagged = do let codec = Record.get (Proxy @name) r ∷ codec r1 = Record.insert (Proxy @name) codec {} ∷ Record r1 - r2 = Record.delete (Proxy @name) r ∷ Record r2 - let lhs = gFlatCasesDecode @tag r1 tagged ∷ _ (Constructor name lhs) - rhs = gFlatCasesDecode @tag r2 tagged ∷ _ rhs - (Inl <$> lhs) <|> (Inr <$> rhs) + + case lhs of + Right result → + pure $ Inl result + Left (UnmatchedCase _) → do + let r2 = Record.delete (Proxy @name) r ∷ Record r2 + let rhs = gFlatCasesDecode @tag r2 tagged ∷ _ rhs + Inr <$> rhs + Left err → Left err -- | Same as `Record.delete` but deleting only happens at the type level -- | and the value is left untouched. unsafeDelete ∷ ∀ r1 r2 l a. IsSymbol l ⇒ Row.Lacks l r1 ⇒ Row.Cons l a r1 r2 ⇒ Proxy l → Record r2 → Record r1 unsafeDelete _ r = unsafeCoerce r - diff --git a/test/Test/Sum.purs b/test/Test/Sum.purs index f1d82b9..c8dc597 100644 --- a/test/Test/Sum.purs +++ b/test/Test/Sum.purs @@ -3,14 +3,15 @@ module Test.Sum where import Prelude import Control.Monad.Error.Class (liftEither) -import Data.Argonaut.Core (stringifyWithIndent) +import Data.Argonaut.Core (fromString, stringifyWithIndent) import Data.Argonaut.Decode (parseJson) import Data.Bifunctor (lmap) import Data.Codec (decode, encode) -import Data.Codec.Argonaut (JsonCodec) +import Data.Codec.Argonaut (JsonCodec, JsonDecodeError(..)) import Data.Codec.Argonaut as C import Data.Codec.Argonaut.Record as CR -import Data.Codec.Argonaut.Sum (Encoding(..), defaultEncoding, sumFlat, sumFlatWith, sumWith) +import Data.Codec.Argonaut.Sum (Encoding(..), defaultEncoding, sumFlatWith, sumWith) +import Data.Either (Either(..), either) import Data.Generic.Rep (class Generic) import Data.Show.Generic (genericShow) import Data.String as Str @@ -22,7 +23,6 @@ import Test.QuickCheck (class Arbitrary, arbitrary, quickCheck) import Test.QuickCheck.Arbitrary (genericArbitrary) import Test.Util (propCodec) import Type.Prelude (Proxy(..)) -import Type.Proxy (Proxy) -------------------------------------------------------------------------------- @@ -96,12 +96,47 @@ check codec val expectEncoded = do when (decoded /= val) $ throw ("check failed, expected: " <> show val <> ", got: " <> show decoded) +checkError ∷ ∀ a. Show a ⇒ JsonCodec a → JsonDecodeError → String → Effect Unit +checkError codec expectError encodedStr = do + + json ← liftEither $ lmap (show >>> error) $ parseJson encodedStr + + decoded ← liftEither $ lmap (show >>> error) $ either Right Left $ decode codec json + + when (decoded /= expectError) $ + throw ("decode error check failed, expected: " <> show expectError <> ", got: " <> show decoded) + main ∷ Effect Unit main = do log "Check sum" log " - Default encoding" + let + noMathErr keys = + Named "Sample" (TypeMismatch $ "No match for sum cases in nested keys: " <> keys) do + checkError (codecSample defaultEncoding) + (Named "Sample" (TypeMismatch "Object")) + $ Str.joinWith "\n" + [ "42" + ] + + -- checkError (codecSample defaultEncoding) + -- (Named "Sample" (AtKey "tag" (UnexpectedValue $ fromString "Zoo"))) + -- $ Str.joinWith "\n" + -- [ "{" + -- , " \"tag\": \"Zoo\"" + -- , "}" + -- ] + + checkError (codecSample defaultEncoding) + --(Named "Sample" (AtKey "tag" MissingValue)) + (Named "Sample" (TypeMismatch "Expecting a tag property `tag`")) + $ Str.joinWith "\n" + [ "{" + , " \"type\": \"Boo\"" + , "}" + ] -- Encode/Decode constructor without arguments check (codecSample defaultEncoding) Foo @@ -112,6 +147,14 @@ main = do , "}" ] + checkError (codecSample defaultEncoding) + (Named "Sample" (Named "case Foo" (TypeMismatch "Expecting a value property `values`"))) + $ Str.joinWith "\n" + [ "{" + , " \"tag\": \"Foo\"" + , "}" + ] + -- Encode/Decode constructor with single argument check (codecSample defaultEncoding) (Bar 42) $ Str.joinWith "\n" @@ -123,6 +166,16 @@ main = do , "}" ] + checkError (codecSample defaultEncoding) + (Named "Sample" (Named "case Bar" (TypeMismatch "Expecting exactly one element"))) + $ Str.joinWith "\n" + [ "{" + , " \"tag\": \"Bar\"," + , " \"values\": [" + , " ]" + , "}" + ] + -- Encode/Decode constructor with multiple arguments check (codecSample defaultEncoding) (Baz true "hello" 42) $ Str.joinWith "\n" @@ -259,6 +312,18 @@ main = do , "}" ] + checkError + (codecSample opts) + (Named "Sample" (Named "case Bar" (TypeMismatch "Int"))) + $ Str.joinWith "\n" + [ "{" + , " \"tag\": \"Bar\"," + , " \"values\": \"42\"" + --, " \"values\": 42" + , "}" + ] + --pure unit + check (codecSample opts) (Baz true "hello" 42) @@ -273,6 +338,20 @@ main = do , "}" ] + checkError + (codecSample opts) + (Named "Sample" (Named "case Baz" (AtIndex 2 (TypeMismatch "Int")))) + $ Str.joinWith "\n" + [ "{" + , " \"tag\": \"Baz\"," + , " \"values\": [" + , " true," + , " \"hello\"," + , " \"42\"" + , " ]" + , "}" + ] + log " - EncodeNested" do log " - default" @@ -282,61 +361,52 @@ main = do { unwrapSingleArguments: false } - check + checkError (codecSample opts) - Foo + (Named "Sample" (TypeMismatch "No case matched")) $ Str.joinWith "\n" [ "{" - , " \"Foo\": []" + , " \"Zoo\": [42]" , "}" ] check (codecSample opts) - (Bar 42) + Foo $ Str.joinWith "\n" [ "{" - , " \"Bar\": [" - , " 42" - , " ]" + , " \"Foo\": []" , "}" ] - check + checkError (codecSample opts) - (Baz true "hello" 42) + (Named "Sample" (Named "case Foo" (TypeMismatch "Expecting an empty array"))) $ Str.joinWith "\n" [ "{" - , " \"Baz\": [" - , " true," - , " \"hello\"," - , " 42" - , " ]" + , " \"Foo\": [42]" , "}" ] - log " - Option: Unwrap single arguments" - do - let - opts = EncodeNested - { unwrapSingleArguments: true - } - check (codecSample opts) - Foo + (Bar 42) $ Str.joinWith "\n" [ "{" - , " \"Foo\": []" + , " \"Bar\": [" + , " 42" + , " ]" , "}" ] - check + checkError (codecSample opts) - (Bar 42) + (Named "Sample" (Named "case Bar" (TypeMismatch "Int"))) $ Str.joinWith "\n" [ "{" - , " \"Bar\": 42" + , " \"Bar\": [" + , " \"42\"" + , " ]" , "}" ] @@ -353,10 +423,64 @@ main = do , "}" ] + log " - Option: Unwrap single arguments" + do + let + opts = EncodeNested + { unwrapSingleArguments: true + } + + check + (codecSample opts) + Foo + $ Str.joinWith "\n" + [ "{" + , " \"Foo\": []" + , "}" + ] + + check + (codecSample opts) + (Bar 42) + $ Str.joinWith "\n" + [ "{" + , " \"Bar\": 42" + , "}" + ] + + check + (codecSample opts) + (Baz true "hello" 42) + $ Str.joinWith "\n" + [ "{" + , " \"Baz\": [" + , " true," + , " \"hello\"," + , " 42" + , " ]" + , "}" + ] + quickCheck (propCodec arbitrary (codecSample defaultEncoding)) log "Check sum flat" do + checkError codecSampleFlat + (Named "Sample" (TypeMismatch "Expecting a tag property `tag`")) + $ Str.joinWith "\n" + [ "{" + , " \"x\": \"FlatFoo\"" + , "}" + ] + + checkError codecSampleFlat + (Named "Sample" (TypeMismatch "No case matched, unexpected tag value `FlatZoo`")) + $ Str.joinWith "\n" + [ "{" + , " \"tag\": \"FlatZoo\"" + , "}" + ] + check codecSampleFlat FlatFoo $ Str.joinWith "\n" [ "{" @@ -372,6 +496,15 @@ main = do , "}" ] + checkError codecSampleFlat + (Named "Sample" (Named "case FlatBar" (AtKey "errors" (TypeMismatch "Int")))) + $ Str.joinWith "\n" + [ "{" + , " \"tag\": \"FlatBar\"," + , " \"errors\": \"42\"" + , "}" + ] + check codecSampleFlat (FlatBaz { active: true, name: "hello", pos: { x: 42, y: 42 } }) $ Str.joinWith "\n" [ "{" @@ -385,5 +518,17 @@ main = do , "}" ] - quickCheck (propCodec arbitrary codecSampleFlat) + checkError codecSampleFlat + (Named "Sample" (Named "case FlatBaz" (AtKey "pos" (Named "Pos" (AtKey "y" MissingValue))))) + $ Str.joinWith "\n" + [ "{" + , " \"tag\": \"FlatBaz\"," + , " \"active\": true," + , " \"name\": \"hello\"," + , " \"pos\": {" + , " \"x\": 42" + , " }" + , "}" + ] + quickCheck (propCodec arbitrary codecSampleFlat)