generated from tpl/purs
fix: some ergonomics, tests use postgres
This commit is contained in:
parent
08dd5fe964
commit
340cee4745
GPG Key ID:
6D4165AE4C928719
495
spago.lock
495
spago.lock
@ -14,6 +14,7 @@ workspace:
|
||||
- foldable-traversable
|
||||
- foreign
|
||||
- integers
|
||||
- js-bigints
|
||||
- lists
|
||||
- maybe
|
||||
- mmorph
|
||||
@ -72,6 +73,7 @@ workspace:
|
||||
- identity
|
||||
- integers
|
||||
- invariant
|
||||
- js-bigints
|
||||
- js-date
|
||||
- lazy
|
||||
- lcg
|
||||
@ -120,6 +122,487 @@ workspace:
|
||||
- unicode
|
||||
- unsafe-coerce
|
||||
- variant
|
||||
package_set:
|
||||
address:
|
||||
registry: 50.5.0
|
||||
compiler: ">=0.15.15 <0.16.0"
|
||||
content:
|
||||
abc-parser: 2.0.1
|
||||
ace: 9.1.0
|
||||
aff: 7.1.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
|
||||
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.5.6
|
||||
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.3.4
|
||||
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
|
||||
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.1
|
||||
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: 1.1.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-frameworks: 1.0.1
|
||||
data-mvc: 0.0.2
|
||||
datetime: 6.1.0
|
||||
datetime-parsing: 0.2.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
|
||||
dotenv: 4.0.3
|
||||
droplet: 0.6.0
|
||||
dts: 1.0.0
|
||||
dual-numbers: 1.0.2
|
||||
dynamic-buffer: 3.0.1
|
||||
echarts-simple: 0.0.1
|
||||
effect: 4.0.0
|
||||
either: 6.1.0
|
||||
elmish: 0.11.3
|
||||
elmish-enzyme: 0.1.1
|
||||
elmish-hooks: 0.10.0
|
||||
elmish-html: 0.8.2
|
||||
elmish-testing-library: 0.3.2
|
||||
email-validate: 7.0.0
|
||||
encoding: 0.0.9
|
||||
enums: 6.0.1
|
||||
env-names: 0.3.4
|
||||
error: 2.0.0
|
||||
eta-conversion: 0.3.2
|
||||
exceptions: 6.0.0
|
||||
exists: 6.0.0
|
||||
exitcodes: 4.0.0
|
||||
expect-inferred: 3.0.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
|
||||
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
|
||||
geometry-plane: 1.0.3
|
||||
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.0
|
||||
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
|
||||
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.0.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
|
||||
json: 1.0.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.4.1
|
||||
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.1.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.0
|
||||
node-sqlite3: 8.0.0
|
||||
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.1.0
|
||||
numbers: 9.0.1
|
||||
oak: 3.1.1
|
||||
oak-debug: 1.2.2
|
||||
object-maps: 0.3.0
|
||||
ocarina: 1.5.4
|
||||
open-folds: 6.3.0
|
||||
open-memoize: 6.1.0
|
||||
open-pairing: 6.1.0
|
||||
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
|
||||
precise: 6.0.0
|
||||
precise-datetime: 7.0.0
|
||||
prelude: 6.0.1
|
||||
prettier-printer: 3.0.0
|
||||
profunctor: 6.0.1
|
||||
profunctor-lenses: 8.0.0
|
||||
protobuf: 4.3.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: 6.1.0
|
||||
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.4
|
||||
react-markdown: 0.1.0
|
||||
react-testing-library: 4.0.1
|
||||
react-virtuoso: 1.0.0
|
||||
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
|
||||
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
|
||||
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-ulid: 3.0.0
|
||||
sized-matrices: 1.0.0
|
||||
sized-vectors: 5.0.2
|
||||
slug: 3.0.8
|
||||
small-ffi: 4.0.1
|
||||
soundfonts: 4.1.0
|
||||
sparse-matrices: 1.3.0
|
||||
sparse-polynomials: 2.0.5
|
||||
spec: 7.6.0
|
||||
spec-mocha: 5.1.0
|
||||
spec-quickcheck: 5.0.0
|
||||
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
|
||||
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
|
||||
transformation-matrix: 1.0.1
|
||||
transformers: 6.0.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
|
||||
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
|
||||
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
|
||||
web-clipboard: 5.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
|
||||
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-tree: 1.0.0
|
||||
z3: 0.0.2
|
||||
zipperarray: 2.0.0
|
||||
extra_packages: {}
|
||||
packages:
|
||||
aff:
|
||||
@ -497,6 +980,14 @@ packages:
|
||||
dependencies:
|
||||
- control
|
||||
- prelude
|
||||
js-bigints:
|
||||
type: registry
|
||||
version: 2.2.1
|
||||
integrity: sha256-hKWZo9NxtsAaHmNXr6B8GY4c0olQbYLXPVGWm4TF2Ss=
|
||||
dependencies:
|
||||
- integers
|
||||
- maybe
|
||||
- prelude
|
||||
js-date:
|
||||
type: registry
|
||||
version: 8.0.0
|
||||
@ -745,8 +1236,8 @@ packages:
|
||||
- prelude
|
||||
parallel:
|
||||
type: registry
|
||||
version: 6.0.0
|
||||
integrity: sha256-VJbkGD0rAKX+NUEeBJbYJ78bEKaZbgow+QwQEfPB6ko=
|
||||
version: 7.0.0
|
||||
integrity: sha256-gUC9i4Txnx9K9RcMLsjujbwZz6BB1bnE2MLvw4GIw5o=
|
||||
dependencies:
|
||||
- control
|
||||
- effect
|
||||
|
||||
@ -2,7 +2,7 @@ package:
|
||||
name: pg
|
||||
build:
|
||||
strict: true
|
||||
pedantic_packages: true
|
||||
pedanticPackages: true
|
||||
dependencies:
|
||||
- aff
|
||||
- aff-promise
|
||||
@ -15,6 +15,7 @@ package:
|
||||
- foldable-traversable
|
||||
- foreign
|
||||
- integers
|
||||
- js-bigints
|
||||
- lists
|
||||
- maybe
|
||||
- mmorph
|
||||
@ -41,6 +42,6 @@ package:
|
||||
- spec
|
||||
- spec-quickcheck
|
||||
workspace:
|
||||
extra_packages: {}
|
||||
extraPackages: {}
|
||||
packageSet:
|
||||
registry: 50.5.0
|
||||
|
||||
107
src/Data.Postgres.Query.Builder.purs
Normal file
107
src/Data.Postgres.Query.Builder.purs
Normal file
@ -0,0 +1,107 @@
|
||||
module Data.Postgres.Query.Builder where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Control.Monad.State (StateT, get, modify, runStateT)
|
||||
import Data.Array as Array
|
||||
import Data.Newtype (unwrap)
|
||||
import Data.Newtype as Newtype
|
||||
import Data.Postgres (class Rep, serialize, smash)
|
||||
import Data.Postgres.Query (Query, emptyQuery)
|
||||
import Data.Tuple (snd)
|
||||
import Data.Tuple.Nested (type (/\))
|
||||
import Effect (Effect)
|
||||
import Effect.Class (class MonadEffect, liftEffect)
|
||||
import Record as Record
|
||||
import Type.Prelude (Proxy(..))
|
||||
|
||||
-- | Monad for building parameterized queries without managing positional
|
||||
-- | parameters directly
|
||||
-- |
|
||||
-- | For example, given the table `CREATE TABLE foo (id INT NOT NULL PRIMARY KEY, bar TEXT NOT NULL)`
|
||||
-- |
|
||||
-- | ```purescript
|
||||
-- | updateFoo :: Int -> String -> Effect Query
|
||||
-- | updateFoo id newBar =
|
||||
-- | build do
|
||||
-- | idP <- param id
|
||||
-- | newBarP <- param newBar
|
||||
-- | pure $
|
||||
-- | [ "update foo"
|
||||
-- | , "set bar = " <> newBarP
|
||||
-- | , "where id = " <> idP
|
||||
-- | ]
|
||||
-- | ```
|
||||
-- | `updateFoo 1 "test"` will yield:
|
||||
-- | ```purescript
|
||||
-- | { text: "update foo\nset bar = $2\nwhere id = $1"
|
||||
-- | , values: ["test", 1]
|
||||
-- | }
|
||||
-- | ```
|
||||
type QueryBuilderT m a = StateT Query m a
|
||||
type QueryBuilder a = QueryBuilderT Effect a
|
||||
|
||||
-- | Yields a SQL string referencing the last parameter in the parameter list
|
||||
-- |
|
||||
-- | Examples:
|
||||
-- | - if no parameters have been appended this will yield `"$0"` (invalid)
|
||||
-- | - if 1 parameter has been appended this will yield `"$1"`
|
||||
-- | - if 5 parameters have been appended this will yield `"$5"`
|
||||
lastParamString :: forall m. Monad m => QueryBuilderT m String
|
||||
lastParamString = map (("$" <> _) <<< show <<< Array.length <<< _.values <<< unwrap) $ get
|
||||
|
||||
-- | Append a serializable SQL value to the parameter list
|
||||
appendParam :: forall m a. MonadEffect m => Rep a => a -> QueryBuilderT m Unit
|
||||
appendParam a =
|
||||
let
|
||||
values = Proxy @"values"
|
||||
in
|
||||
do
|
||||
a' <- liftEffect $ smash $ serialize a
|
||||
void $ modify (Newtype.modify $ Record.modify values (_ <> [ a' ]))
|
||||
|
||||
-- | Replace the builder's query string with a new value
|
||||
putText :: forall m. Monad m => String -> QueryBuilderT m Unit
|
||||
putText t =
|
||||
let
|
||||
text = Proxy @"text"
|
||||
in
|
||||
void $ modify $ Newtype.modify $ Record.set text t
|
||||
|
||||
-- | Adds a parameter to the query
|
||||
-- |
|
||||
-- | This accepts any value `Rep`resentable in SQL, and
|
||||
-- | yields the SQL string for the new parameter.
|
||||
-- |
|
||||
-- | ```purescript
|
||||
-- | do
|
||||
-- | p1 <- param 1 -- "$1"
|
||||
-- | p2 <- param "foo" -- "$2"
|
||||
-- | p3 <- param true -- "$3"
|
||||
-- | pure unit
|
||||
-- | ```
|
||||
param :: forall m a. MonadEffect m => Rep a => a -> QueryBuilderT m String
|
||||
param a = do
|
||||
appendParam a
|
||||
lastParamString
|
||||
|
||||
-- | Accepts a `QueryBuilder` monad that yields the built query string
|
||||
-- | and yields the finished `Query`.
|
||||
-- |
|
||||
-- | ```
|
||||
-- | build $ pure "select 1"
|
||||
-- | -- Query {text: "select 1", values: [], name: Nothing}
|
||||
-- | ```
|
||||
-- |
|
||||
-- | ```
|
||||
-- | build do
|
||||
-- | foo <- param "foo"
|
||||
-- | pure $ "select " <> foo
|
||||
-- | -- Query {text: "select $1", values: ["foo"], name: Nothing}
|
||||
-- | ```
|
||||
build :: QueryBuilder String -> Effect Query
|
||||
build m = map snd $ build' $ putText =<< m
|
||||
|
||||
-- | Executes a `QueryBuilderT`
|
||||
build' :: forall m a. MonadEffect m => QueryBuilderT m a -> m (a /\ Query)
|
||||
build' = flip runStateT emptyQuery
|
||||
54
src/Data.Postgres.Query.purs
Normal file
54
src/Data.Postgres.Query.purs
Normal file
@ -0,0 +1,54 @@
|
||||
module Data.Postgres.Query where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Data.Maybe (Maybe(..))
|
||||
import Data.Newtype (class Newtype)
|
||||
import Data.Nullable (Nullable, toNullable)
|
||||
import Data.Postgres.Raw (Raw)
|
||||
import Data.Tuple.Nested (type (/\), (/\))
|
||||
import Effect (Effect)
|
||||
import Record (insert, modify)
|
||||
import Type.Prelude (Proxy(..))
|
||||
|
||||
-- | FFI Query type
|
||||
type QueryRaw = { text :: String, values :: Array Raw, name :: Nullable String, rowMode :: String }
|
||||
|
||||
-- | SQL Query
|
||||
-- |
|
||||
-- | * `text` - the query string
|
||||
-- | * `values` - query parameter values
|
||||
-- | * `name` (optional) - providing this will create this query as a [prepared statement](https://node-postgres.com/features/queries#prepared-statements)
|
||||
newtype Query = Query { text :: String, values :: Array Raw, name :: Maybe String }
|
||||
|
||||
derive instance Newtype Query _
|
||||
derive newtype instance Eq Query
|
||||
derive newtype instance Show Query
|
||||
|
||||
-- | An empty query
|
||||
emptyQuery :: Query
|
||||
emptyQuery = Query { text: "", values: [], name: Nothing }
|
||||
|
||||
queryToRaw :: Query -> QueryRaw
|
||||
queryToRaw (Query r) =
|
||||
let
|
||||
name = Proxy @"name"
|
||||
rowMode = Proxy @"rowMode"
|
||||
in
|
||||
insert rowMode "array" $ modify name toNullable $ r
|
||||
|
||||
-- | Values that can be rendered as a SQL query
|
||||
class AsQuery a where
|
||||
asQuery :: a -> Effect Query
|
||||
|
||||
instance AsQuery a => AsQuery (Effect a) where
|
||||
asQuery = flip bind asQuery
|
||||
|
||||
instance AsQuery Query where
|
||||
asQuery = pure
|
||||
|
||||
instance AsQuery String where
|
||||
asQuery text = pure $ Query { text, values: [], name: Nothing }
|
||||
|
||||
instance AsQuery (String /\ Array Raw) where
|
||||
asQuery (text /\ values) = pure $ Query { text, values, name: Nothing }
|
||||
@ -1,9 +1,10 @@
|
||||
import Pg from 'pg'
|
||||
import Range from 'postgres-range'
|
||||
|
||||
export const null_ = null
|
||||
export const jsNull = null
|
||||
|
||||
export const modifyPgTypes = () => {
|
||||
// https://github.com/brianc/node-pg-types/blob/master/lib/textParsers.js
|
||||
const oid = {
|
||||
'text[]': 1009,
|
||||
json: 114,
|
||||
|
||||
@ -21,9 +21,12 @@ import Effect (Effect)
|
||||
import Effect.Exception (error)
|
||||
import Foreign (ForeignError(..))
|
||||
import Foreign as F
|
||||
import JS.BigInt (BigInt)
|
||||
import JS.BigInt as BigInt
|
||||
import Node.Buffer (Buffer)
|
||||
import Simple.JSON (class ReadForeign, class WriteForeign, readJSON', writeJSON)
|
||||
|
||||
-- | Newtype hinting that this value should be serialized / deserialized as a JSON string.
|
||||
newtype JSON a = JSON a
|
||||
|
||||
derive instance Newtype (JSON a) _
|
||||
@ -33,7 +36,8 @@ derive newtype instance Ord a => Ord (JSON a)
|
||||
derive newtype instance WriteForeign a => WriteForeign (JSON a)
|
||||
derive newtype instance ReadForeign a => ReadForeign (JSON a)
|
||||
|
||||
foreign import null_ :: Raw
|
||||
-- | Literal javascript `null`
|
||||
foreign import jsNull :: Raw
|
||||
|
||||
-- | This mutates `import('pg').types`, setting deserialization
|
||||
-- | for some types to unmarshal as strings rather than JS values.
|
||||
@ -51,7 +55,7 @@ instance Show Null where
|
||||
-- | The serialization & deserialization monad.
|
||||
type RepT a = ExceptT (NonEmptyList ForeignError) Effect a
|
||||
|
||||
-- | Flatten to an Effect, rendering any `RepError`s to `String` using `Show`.
|
||||
-- | Flatten to an Effect, `show`ing errors
|
||||
smash :: forall a. RepT a -> Effect a
|
||||
smash = liftEither <=< map (lmap (error <<< show)) <<< runExceptT
|
||||
|
||||
@ -68,20 +72,26 @@ class (Serialize a, Deserialize a) <= Rep a
|
||||
|
||||
instance (Serialize a, Deserialize a) => Rep a
|
||||
|
||||
-- | Coerces the value to `Raw`
|
||||
-- | Coerces the value to `Raw`.
|
||||
-- |
|
||||
-- | This is only safe for values whose javascript representation
|
||||
-- | can be directly serialized by `node-postgres` to the corresponding
|
||||
-- | SQL type.
|
||||
unsafeSerializeCoerce :: forall m a. Monad m => a -> m Raw
|
||||
unsafeSerializeCoerce = pure <<< Raw.unsafeFromForeign <<< F.unsafeToForeign
|
||||
|
||||
instance Serialize Raw where
|
||||
serialize = pure
|
||||
|
||||
-- | Serializes as `Null`.
|
||||
-- | `NULL`
|
||||
instance Serialize Unit where
|
||||
serialize _ = serialize Null
|
||||
|
||||
-- | `NULL`
|
||||
instance Serialize Null where
|
||||
serialize _ = unsafeSerializeCoerce null_
|
||||
serialize _ = unsafeSerializeCoerce jsNull
|
||||
|
||||
-- | `json`, `jsonb`
|
||||
instance WriteForeign a => Serialize (JSON a) where
|
||||
serialize = serialize <<< writeJSON <<< unwrap
|
||||
|
||||
@ -89,45 +99,51 @@ instance WriteForeign a => Serialize (JSON a) where
|
||||
instance Serialize Buffer where
|
||||
serialize = unsafeSerializeCoerce
|
||||
|
||||
-- | `int2`, `int4`
|
||||
instance Serialize Int where
|
||||
serialize = unsafeSerializeCoerce
|
||||
|
||||
-- | `int8`
|
||||
instance Serialize BigInt where
|
||||
serialize = serialize <<< BigInt.toString
|
||||
|
||||
-- | `bool`
|
||||
instance Serialize Boolean where
|
||||
serialize = unsafeSerializeCoerce
|
||||
|
||||
-- | `text`, `inet`, `tsquery`, `tsvector`, `uuid`, `xml`, `cidr`, `time`, `timetz`
|
||||
instance Serialize String where
|
||||
serialize = unsafeSerializeCoerce
|
||||
|
||||
-- | `float4`, `float8`
|
||||
instance Serialize Number where
|
||||
serialize = unsafeSerializeCoerce
|
||||
|
||||
instance Serialize Char where
|
||||
serialize = unsafeSerializeCoerce
|
||||
|
||||
-- | `timestamp`, `timestamptz`
|
||||
instance Serialize DateTime where
|
||||
serialize = serialize <<< unwrap <<< DateTime.ISO.fromDateTime
|
||||
|
||||
-- | `Just` -> `a`, `Nothing` -> `NULL`
|
||||
instance Serialize a => Serialize (Maybe a) where
|
||||
serialize (Just a) = serialize a
|
||||
serialize Nothing = unsafeSerializeCoerce null_
|
||||
serialize Nothing = unsafeSerializeCoerce jsNull
|
||||
|
||||
-- | postgres `array`
|
||||
instance Serialize a => Serialize (Array a) where
|
||||
serialize = unsafeSerializeCoerce <=< traverse serialize
|
||||
|
||||
instance Deserialize Raw where
|
||||
deserialize = pure
|
||||
|
||||
-- | Note: this will always succeed, discarding
|
||||
-- | the actual raw value yielded.
|
||||
-- |
|
||||
-- | To explicitly deserialize NULL values and fail
|
||||
-- | when the value is non-null, use `Null`.
|
||||
-- | `NULL` (always succeeds)
|
||||
instance Deserialize Unit where
|
||||
deserialize _ = pure unit
|
||||
|
||||
-- | `NULL` (fails if non-null)
|
||||
instance Deserialize Null where
|
||||
deserialize = map (const Null) <<< F.readNullOrUndefined <<< Raw.unsafeToForeign
|
||||
|
||||
-- | `json`, `jsonb`
|
||||
instance ReadForeign a => Deserialize (JSON a) where
|
||||
deserialize = map wrap <<< (hoist (pure <<< unwrap) <<< readJSON') <=< deserialize @String
|
||||
|
||||
@ -135,30 +151,43 @@ instance ReadForeign a => Deserialize (JSON a) where
|
||||
instance Deserialize Buffer where
|
||||
deserialize = (F.unsafeReadTagged "Buffer") <<< Raw.unsafeToForeign
|
||||
|
||||
-- | `int2`, `int4`
|
||||
instance Deserialize Int where
|
||||
deserialize = F.readInt <<< Raw.unsafeToForeign
|
||||
|
||||
-- | `int8`
|
||||
instance Deserialize BigInt where
|
||||
deserialize =
|
||||
let
|
||||
invalid s = pure $ ForeignError $ "Invalid bigint: " <> s
|
||||
fromString s = liftMaybe (invalid s) $ BigInt.fromString s
|
||||
in
|
||||
fromString <=< deserialize @String
|
||||
|
||||
-- | `bool`
|
||||
instance Deserialize Boolean where
|
||||
deserialize = F.readBoolean <<< Raw.unsafeToForeign
|
||||
|
||||
-- | `text`, `inet`, `tsquery`, `tsvector`, `uuid`, `xml`, `cidr`, `time`, `timetz`
|
||||
instance Deserialize String where
|
||||
deserialize = F.readString <<< Raw.unsafeToForeign
|
||||
|
||||
-- | `float4`, `float8`
|
||||
instance Deserialize Number where
|
||||
deserialize = F.readNumber <<< Raw.unsafeToForeign
|
||||
|
||||
instance Deserialize Char where
|
||||
deserialize = F.readChar <<< Raw.unsafeToForeign
|
||||
|
||||
-- | `timestamp`, `timestamptz`
|
||||
instance Deserialize DateTime where
|
||||
deserialize raw = do
|
||||
s :: String <- deserialize raw
|
||||
let invalid = pure $ ForeignError $ "Not a valid ISO8601 string: `" <> s <> "`"
|
||||
liftMaybe invalid $ DateTime.ISO.toDateTime $ wrap s
|
||||
|
||||
-- | postgres `array`
|
||||
instance Deserialize a => Deserialize (Array a) where
|
||||
deserialize = traverse (deserialize <<< Raw.unsafeFromForeign) <=< F.readArray <<< Raw.unsafeToForeign
|
||||
|
||||
-- | non-NULL -> `Just`, NULL -> `Nothing`
|
||||
instance Deserialize a => Deserialize (Maybe a) where
|
||||
deserialize raw =
|
||||
let
|
||||
|
||||
@ -4,51 +4,21 @@ import Prelude
|
||||
|
||||
import Control.Promise (Promise)
|
||||
import Control.Promise as Promise
|
||||
import Data.Maybe (Maybe(..), fromMaybe)
|
||||
import Data.Nullable (Nullable, toNullable)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Postgres (smash)
|
||||
import Data.Postgres.Raw (Raw)
|
||||
import Data.Postgres.Query (class AsQuery, QueryRaw, asQuery, queryToRaw)
|
||||
import Data.Postgres.Result (class FromResult, Result, fromRow, rows, rowsAffected)
|
||||
import Data.Traversable (traverse)
|
||||
import Data.Tuple.Nested (type (/\), (/\))
|
||||
import Effect (Effect)
|
||||
import Effect.Aff (Aff)
|
||||
import Effect.Class (liftEffect)
|
||||
import Effect.Postgres.Client (Client, Config, make)
|
||||
import Prim.Row (class Union)
|
||||
import Record (insert, modify)
|
||||
import Type.Prelude (Proxy(..))
|
||||
|
||||
type QueryRaw = { text :: String, values :: Array Raw, name :: Nullable String, rowMode :: String }
|
||||
|
||||
foreign import connectImpl :: Client -> Effect (Promise Unit)
|
||||
foreign import endImpl :: Client -> Effect (Promise Unit)
|
||||
foreign import queryImpl :: QueryRaw -> Client -> Effect (Promise Result)
|
||||
|
||||
newtype Query = Query { text :: String, values :: Array Raw, name :: Maybe String }
|
||||
|
||||
queryToRaw :: Query -> QueryRaw
|
||||
queryToRaw (Query r) =
|
||||
let
|
||||
name = Proxy @"name"
|
||||
rowMode = Proxy @"rowMode"
|
||||
in
|
||||
insert rowMode "array"
|
||||
$ modify name toNullable
|
||||
$ r
|
||||
|
||||
class AsQuery a where
|
||||
asQuery :: a -> Query
|
||||
|
||||
instance AsQuery Query where
|
||||
asQuery = identity
|
||||
|
||||
instance AsQuery String where
|
||||
asQuery text = Query { text, values: [], name: Nothing }
|
||||
|
||||
instance AsQuery (String /\ Array Raw) where
|
||||
asQuery (text /\ values) = Query { text, values, name: Nothing }
|
||||
|
||||
connected :: forall r trash. Union r trash (Config ()) => Record r -> Aff Client
|
||||
connected c = do
|
||||
client <- liftEffect $ make c
|
||||
@ -62,7 +32,9 @@ end :: Client -> Aff Unit
|
||||
end = Promise.toAffE <<< endImpl
|
||||
|
||||
queryRaw :: forall q. AsQuery q => q -> Client -> Aff Result
|
||||
queryRaw q = Promise.toAffE <<< queryImpl (queryToRaw $ asQuery q)
|
||||
queryRaw q c = do
|
||||
q' <- queryToRaw <$> liftEffect (asQuery q)
|
||||
Promise.toAffE $ queryImpl q' c
|
||||
|
||||
exec :: forall q. AsQuery q => q -> Client -> Aff Int
|
||||
exec q = map (fromMaybe 0 <<< rowsAffected) <<< queryRaw q
|
||||
|
||||
26
test/Test.Common.purs
Normal file
26
test/Test.Common.purs
Normal file
@ -0,0 +1,26 @@
|
||||
module Test.Common where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Effect (Effect)
|
||||
import Effect.Aff (Aff, bracket)
|
||||
import Effect.Aff.Postgres.Client (connected, end)
|
||||
import Effect.Class (liftEffect)
|
||||
import Effect.Postgres.Client (Client)
|
||||
import Node.Path as Path
|
||||
import Node.Process (cwd)
|
||||
|
||||
config
|
||||
:: Effect
|
||||
{ database :: String
|
||||
, host :: String
|
||||
, password :: String
|
||||
, user :: String
|
||||
}
|
||||
config = do
|
||||
cwd' <- liftEffect cwd
|
||||
host <- liftEffect $ Path.resolve [ cwd' ] "./pg"
|
||||
pure { host, user: "postgres", password: "password", database: "postgres" }
|
||||
|
||||
withClient :: (Client -> Aff Unit) -> Aff Unit
|
||||
withClient = bracket (connected =<< liftEffect config) end
|
||||
4
test/Test.Data.Postgres.js
Normal file
4
test/Test.Data.Postgres.js
Normal file
@ -0,0 +1,4 @@
|
||||
/** @type {(_: Buffer) => () => bigint} */
|
||||
export const readBigInt64BE = buf => () => buf.readBigInt64BE(0)
|
||||
|
||||
export const dbg = a => () => typeof a === 'string' ? console.log(Buffer.from(a).toString('hex')) : undefined
|
||||
@ -2,30 +2,129 @@ module Test.Data.Postgres where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Control.Monad.Error.Class (liftEither)
|
||||
import Control.Monad.Except (runExceptT)
|
||||
import Data.DateTime (DateTime(..))
|
||||
import Control.Monad.Gen (chooseInt, elements, oneOf)
|
||||
import Data.Array as Array
|
||||
import Data.Array.NonEmpty as Array.NonEmpty
|
||||
import Data.DateTime (DateTime(..), canonicalDate)
|
||||
import Data.DateTime.Instant as Instant
|
||||
import Data.Enum (toEnum)
|
||||
import Data.Foldable (fold)
|
||||
import Data.Identity (Identity)
|
||||
import Data.Int as Int
|
||||
import Data.Maybe (Maybe, fromJust, fromMaybe, maybe)
|
||||
import Data.Newtype (unwrap, wrap)
|
||||
import Data.Postgres (class Rep, JSON(..), Null(..), deserialize, null_, serialize, smash)
|
||||
import Data.Postgres.Range as Range
|
||||
import Data.Maybe (Maybe(..), fromJust, maybe)
|
||||
import Data.Newtype (class Newtype, unwrap, wrap)
|
||||
import Data.Number (abs) as Number
|
||||
import Data.Postgres (class Rep, jsNull)
|
||||
import Data.Postgres.Query.Builder as Q
|
||||
import Data.Postgres.Raw (Raw)
|
||||
import Data.Postgres.Raw as Raw
|
||||
import Data.Postgres.Result (class FromResult)
|
||||
import Data.RFC3339String as DateTime.ISO
|
||||
import Data.Tuple.Nested (type (/\), (/\))
|
||||
import Data.String as String
|
||||
import Data.Time (Time(..))
|
||||
import Data.Traversable (for, sequence)
|
||||
import Data.Tuple.Nested ((/\))
|
||||
import Effect (Effect)
|
||||
import Effect.Aff (Aff)
|
||||
import Effect.Aff.Postgres.Client (exec, query)
|
||||
import Effect.Class (liftEffect)
|
||||
import Effect.Console (log)
|
||||
import Effect.Postgres.Client (Client)
|
||||
import Effect.Unsafe (unsafePerformEffect)
|
||||
import Foreign (unsafeToForeign)
|
||||
import Foreign (Foreign, unsafeToForeign)
|
||||
import Foreign.Object as Object
|
||||
import JS.BigInt (BigInt)
|
||||
import JS.BigInt as BigInt
|
||||
import Node.Buffer (Buffer)
|
||||
import Node.Buffer as Buffer
|
||||
import Partial.Unsafe (unsafePartial)
|
||||
import Simple.JSON (writeImpl, writeJSON)
|
||||
import Test.QuickCheck (class Arbitrary, (==?))
|
||||
import Test.Spec (Spec, describe, it)
|
||||
import Test.Spec.Assertions (shouldEqual)
|
||||
import Test.Spec.QuickCheck (quickCheck)
|
||||
import Simple.JSON (writeJSON)
|
||||
import Test.Common (withClient)
|
||||
import Test.QuickCheck (class Arbitrary, arbitrary, randomSeed)
|
||||
import Test.QuickCheck.Gen (sample, vectorOf)
|
||||
import Test.Spec (Spec, SpecT, around, describe, it)
|
||||
import Test.Spec.Assertions (fail)
|
||||
|
||||
foreign import readBigInt64BE :: Buffer -> Effect BigInt
|
||||
foreign import dbg :: forall a. a -> Effect Unit
|
||||
|
||||
newtype GenSmallInt = GenSmallInt Int
|
||||
derive instance Newtype GenSmallInt _
|
||||
instance Arbitrary GenSmallInt where
|
||||
arbitrary = wrap <$> chooseInt (-32768) 32767
|
||||
|
||||
newtype GenDateTime = GenDateTime DateTime
|
||||
derive instance Newtype GenDateTime _
|
||||
instance Arbitrary GenDateTime where
|
||||
arbitrary = do
|
||||
yr <- chooseInt 1970 2100
|
||||
mo <- chooseInt 1 12
|
||||
dy <- chooseInt 1 28
|
||||
hr <- chooseInt 0 23
|
||||
mn <- chooseInt 0 59
|
||||
sc <- chooseInt 0 59
|
||||
ms <- chooseInt 0 999
|
||||
let
|
||||
date = unsafePartial fromJust $ Just canonicalDate <*> toEnum yr <*> toEnum mo <*> toEnum dy
|
||||
time = unsafePartial fromJust $ Just Time <*> toEnum hr <*> toEnum mn <*> toEnum sc <*> toEnum ms
|
||||
pure $ wrap $ DateTime date time
|
||||
|
||||
newtype GenString = GenString String
|
||||
derive instance Newtype GenString _
|
||||
instance Arbitrary GenString where
|
||||
arbitrary = do
|
||||
let chars = unsafePartial fromJust $ Array.NonEmpty.fromArray $ String.split (wrap "") "abcdefghijklmnopqrstuvwxyz01234567890 _-=><|\\/"
|
||||
len <- chooseInt 0 100
|
||||
chars' <- vectorOf len (elements chars)
|
||||
pure $ wrap $ fold chars'
|
||||
|
||||
newtype GenSmallFloat = GenSmallFloat Number
|
||||
derive instance Newtype GenSmallFloat _
|
||||
instance Arbitrary GenSmallFloat where
|
||||
arbitrary = do
|
||||
let byte = chooseInt 0 7
|
||||
bytes <- sequence $ Array.replicate 4 byte
|
||||
pure
|
||||
$ wrap
|
||||
$ unsafePerformEffect do
|
||||
buf <- Buffer.fromArray bytes
|
||||
Buffer.read Buffer.FloatBE 0 buf
|
||||
|
||||
newtype GenBigInt = GenBigInt BigInt
|
||||
|
||||
derive instance Newtype GenBigInt _
|
||||
|
||||
instance Arbitrary GenBigInt where
|
||||
arbitrary = do
|
||||
let byte = chooseInt 0 7
|
||||
bytes <- sequence $ Array.replicate 8 byte
|
||||
let
|
||||
bigint = unsafePerformEffect do
|
||||
buf <- Buffer.fromArray bytes
|
||||
readBigInt64BE buf
|
||||
pure $ wrap bigint
|
||||
|
||||
newtype GenJSON = GenJSON Foreign
|
||||
|
||||
derive instance Newtype GenJSON _
|
||||
|
||||
instance Arbitrary GenJSON where
|
||||
arbitrary =
|
||||
let
|
||||
json _ = map wrap $ oneOf' [ prim, array unit, obj unit ]
|
||||
oneOf' = oneOf <<< unsafePartial fromJust <<< Array.NonEmpty.fromArray
|
||||
elements' = elements <<< unsafePartial fromJust <<< Array.NonEmpty.fromArray
|
||||
prim = oneOf'
|
||||
[ pure $ unsafeToForeign jsNull
|
||||
, unsafeToForeign <$> arbitrary @Number
|
||||
, unsafeToForeign <$> arbitrary @String
|
||||
]
|
||||
array _ = map unsafeToForeign $ vectorOf 3 prim
|
||||
obj _ = do
|
||||
keys <- vectorOf 3 (elements' [ "foo", "bar", "baz", "quux", "duck", "dog", "cat", "cow" ])
|
||||
kvs <- for keys \k -> (k /\ _) <$> prim
|
||||
pure $ unsafeToForeign $ Object.fromFoldable kvs
|
||||
in
|
||||
json unit
|
||||
|
||||
asRaw :: forall a. a -> Raw
|
||||
asRaw = Raw.unsafeFromForeign <<< unsafeToForeign
|
||||
@ -33,59 +132,52 @@ asRaw = Raw.unsafeFromForeign <<< unsafeToForeign
|
||||
spec :: Spec Unit
|
||||
spec =
|
||||
let
|
||||
check :: forall @a @x. Eq a => Show a => Arbitrary x => Rep a => String -> (x -> a) -> (a -> Raw) -> Spec Unit
|
||||
check s xa asRaw_ =
|
||||
describe s do
|
||||
it "serialize" $ quickCheck \(x :: x) -> (unsafePerformEffect $ runExceptT $ serialize $ xa x) ==? pure (asRaw_ $ xa x)
|
||||
it "deserialize" $ quickCheck \(x :: x) -> (unsafePerformEffect $ runExceptT $ deserialize $ asRaw_ $ xa x) ==? pure (xa x)
|
||||
check :: forall @a @x. Show a => Arbitrary x => Rep a => FromResult a => String -> String -> (x -> a) -> (a -> Raw) -> (a -> a -> Boolean) -> SpecT Aff Client Identity Unit
|
||||
check purs sql xa asRaw_ isEq =
|
||||
it (purs <> " <> " <> sql) \c -> do
|
||||
let
|
||||
tab = String.replace (wrap " ") (wrap "_") $ String.replace (wrap "[") (wrap "") $ String.replace (wrap "]") (wrap "") $ sql <> "_is_" <> String.toLower purs
|
||||
ser x =
|
||||
Q.build do
|
||||
x' <- Q.param $ xa x
|
||||
pure $ "insert into " <> tab <> " values (" <> x' <> " :: " <> sql <> ")"
|
||||
de x =
|
||||
Q.build do
|
||||
x' <- Q.param $ xa x
|
||||
pure $ "select " <> x' <> " :: " <> sql
|
||||
void $ exec ("create temp table " <> tab <> " (val " <> sql <> ")") c
|
||||
seed <- liftEffect randomSeed
|
||||
let
|
||||
xs = sample seed 20 (arbitrary @x)
|
||||
void $ for xs \x -> do
|
||||
void $ exec (ser x) c
|
||||
res :: Array a <- query (de x) c
|
||||
let
|
||||
exp = xa x
|
||||
act = unsafePartial fromJust $ Array.head res
|
||||
when (not $ isEq exp act) $ fail $ "expected " <> show exp <> " to equal " <> show act
|
||||
|
||||
check_ :: forall @a. Eq a => Show a => Arbitrary a => Rep a => String -> Spec Unit
|
||||
check_ s = check @a @a s identity asRaw
|
||||
check_ :: forall @a. Eq a => Show a => Arbitrary a => FromResult a => Rep a => String -> String -> SpecT Aff Client Identity Unit
|
||||
check_ purs sql = check @a @a purs sql identity asRaw eq
|
||||
|
||||
dateTimeFromArbitrary :: Int -> DateTime
|
||||
dateTimeFromArbitrary = Instant.toDateTime <<< unsafePartial fromJust <<< Instant.instant <<< wrap <<< Int.toNumber
|
||||
in
|
||||
describe "Data.Postgres" do
|
||||
check_ @Int "Int"
|
||||
check_ @String "String"
|
||||
check_ @Boolean "Boolean"
|
||||
check_ @Number "Number"
|
||||
check_ @Char "Char"
|
||||
around withClient
|
||||
$ describe "Data.Postgres"
|
||||
$ do
|
||||
check @Int @GenSmallInt "Int" "int2" unwrap asRaw eq
|
||||
check_ @Int "Int" "int4"
|
||||
|
||||
check @(Maybe String) "Maybe String" identity (maybe null_ asRaw)
|
||||
check @(Array String) "Array String" identity asRaw
|
||||
check @DateTime "DateTime" dateTimeFromArbitrary (asRaw <<< DateTime.ISO.fromDateTime)
|
||||
check @String @GenString "String" "text" unwrap asRaw eq
|
||||
|
||||
describe "JSON" do
|
||||
describe "Record" do
|
||||
it "deserialize" $
|
||||
quickCheck \(a /\ b /\ c :: Int /\ String /\ Array { "foo" :: String }) -> unsafePerformEffect do
|
||||
let
|
||||
obj = { a, b, c }
|
||||
json = writeJSON obj
|
||||
act :: JSON _ <- smash $ deserialize $ asRaw json
|
||||
pure $ obj ==? unwrap act
|
||||
it "serialize" $
|
||||
quickCheck \(a /\ b /\ c :: Int /\ String /\ Array { "foo" :: String }) -> unsafePerformEffect do
|
||||
let obj = { a, b, c }
|
||||
act <- smash $ serialize $ JSON obj
|
||||
pure $ asRaw (writeJSON obj) ==? act
|
||||
check_ @Boolean "Boolean" "bool"
|
||||
|
||||
describe "Null" do
|
||||
it "serialize" $ liftEffect $ shouldEqual null_ =<< (smash $ serialize Null)
|
||||
it "deserialize" $ liftEffect $ shouldEqual Null =<< (smash $ deserialize null_)
|
||||
check @Number @GenSmallFloat "Number" "float4" unwrap asRaw (\a b -> Number.abs (a - b) <= 0.0001)
|
||||
check_ @Number "Number" "float8"
|
||||
|
||||
describe "Range" do
|
||||
it "deserialize" do
|
||||
quickCheck \(up /\ lo /\ uinc /\ linc :: Int /\ Int /\ Boolean /\ Boolean) -> unsafePerformEffect do
|
||||
let
|
||||
record =
|
||||
{ upper: unsafePerformEffect $ smash $ serialize up
|
||||
, lower: unsafePerformEffect $ smash $ serialize lo
|
||||
, upperIncl: uinc
|
||||
, lowerIncl: linc
|
||||
}
|
||||
raw = asRaw $ Range.rangeRawFromRecord record
|
||||
exp :: Range.Range Int <- smash $ Range.rangeFromRaw record
|
||||
act :: Range.Range Int <- smash $ deserialize raw
|
||||
pure $ exp ==? act
|
||||
check @BigInt @GenBigInt "BigInt" "int8" unwrap (asRaw <<< BigInt.toString) eq
|
||||
check @(Maybe String) @(Maybe GenString) "Maybe String" "text" (map unwrap) (maybe jsNull asRaw) eq
|
||||
check @(Array String) @(Array GenString) "Array String" "text[]" (map unwrap) asRaw eq
|
||||
check @DateTime @GenDateTime "DateTime" "timestamptz" unwrap (asRaw <<< DateTime.ISO.fromDateTime) eq
|
||||
check @String @GenJSON "JSON" "json" (writeJSON <<< unwrap) asRaw eq
|
||||
|
||||
@ -7,32 +7,12 @@ import Data.Either (Either, isLeft)
|
||||
import Data.Newtype (wrap)
|
||||
import Data.Postgres (JSON(..))
|
||||
import Data.PreciseDateTime (fromRFC3339String, toDateTimeLossy)
|
||||
import Effect (Effect)
|
||||
import Effect.Aff (Aff, bracket)
|
||||
import Effect.Aff.Postgres.Client (query)
|
||||
import Effect.Aff.Postgres.Client as PG.Aff.Client
|
||||
import Effect.Class (liftEffect)
|
||||
import Effect.Postgres.Client as PG
|
||||
import Node.Path as Path
|
||||
import Node.Process (cwd)
|
||||
import Test.Common (withClient)
|
||||
import Test.Spec (Spec, around, describe, it)
|
||||
import Test.Spec.Assertions (shouldEqual)
|
||||
|
||||
config
|
||||
:: Effect
|
||||
{ database :: String
|
||||
, host :: String
|
||||
, password :: String
|
||||
, user :: String
|
||||
}
|
||||
config = do
|
||||
cwd' <- liftEffect cwd
|
||||
host <- liftEffect $ Path.resolve [ cwd' ] "./pg"
|
||||
pure { host, user: "postgres", password: "password", database: "postgres" }
|
||||
|
||||
withClient :: (PG.Client -> Aff Unit) -> Aff Unit
|
||||
withClient = bracket (PG.Aff.Client.connected =<< liftEffect config) PG.Aff.Client.end
|
||||
|
||||
spec :: Spec Unit
|
||||
spec =
|
||||
around withClient do
|
||||
@ -46,12 +26,9 @@ spec =
|
||||
isLeft res `shouldEqual` true
|
||||
it "rowsAffected is correct" \c -> do
|
||||
void $ PG.Aff.Client.exec "create temp table foo (bar int);" c
|
||||
cta <- PG.Aff.Client.exec "insert into foo values (1);" c
|
||||
cta `shouldEqual` 1
|
||||
ctb <- PG.Aff.Client.exec "insert into foo values (1), (2), (3);" c
|
||||
ctb `shouldEqual` 3
|
||||
ctc <- PG.Aff.Client.exec "update foo set bar = 10;" c
|
||||
ctc `shouldEqual` 4
|
||||
shouldEqual 1 =<< PG.Aff.Client.exec "insert into foo values (1);" c
|
||||
shouldEqual 3 =<< PG.Aff.Client.exec "insert into foo values (1), (2), (3);" c
|
||||
shouldEqual 4 =<< PG.Aff.Client.exec "update foo set bar = 10;" c
|
||||
describe "timestamp" do
|
||||
it "unmarshals" \c -> do
|
||||
let exp = toDateTimeLossy <$> fromRFC3339String (wrap "2020-01-01T00:00:00Z")
|
||||
|
||||
Loading…
Reference in New Issue
Block a user