From 9f3a05e89b09d28b8616546ba2cc12912a204290 Mon Sep 17 00:00:00 2001 From: Bogdan Popa Date: Fri, 29 Dec 2023 16:51:20 +0200 Subject: [PATCH] core: reduce racket/contract imports --- deta-lib/private/connection.rkt | 8 +- deta-lib/private/dialect/postgresql.rkt | 16 +-- deta-lib/private/dialect/sqlite3.rkt | 16 +-- deta-lib/private/query.rkt | 136 +++++++++++------------- deta-lib/private/schema.rkt | 21 ++-- deta-lib/schema.rkt | 3 +- 6 files changed, 85 insertions(+), 115 deletions(-) diff --git a/deta-lib/private/connection.rkt b/deta-lib/private/connection.rkt index a531c19..b81b96b 100644 --- a/deta-lib/private/connection.rkt +++ b/deta-lib/private/connection.rkt @@ -1,16 +1,16 @@ #lang racket/base (require db - racket/contract + racket/contract/base "dialect/dialect.rkt" "dialect/postgresql.rkt" "dialect/sqlite3.rkt") (provide - connection-dialect) + (contract-out + [connection-dialect (-> connection? dialect?)])) -(define/contract (connection-dialect conn) - (-> connection? dialect?) +(define (connection-dialect conn) (case (dbsystem-name (connection-dbsystem conn)) [(postgresql) postgresql-dialect] [(sqlite3) sqlite3-dialect] diff --git a/deta-lib/private/dialect/postgresql.rkt b/deta-lib/private/dialect/postgresql.rkt index 649ed8b..9ea1152 100644 --- a/deta-lib/private/dialect/postgresql.rkt +++ b/deta-lib/private/dialect/postgresql.rkt @@ -1,8 +1,6 @@ #lang racket/base -(require db - racket/contract - racket/match +(require racket/match racket/port "../ast.rkt" "../field.rkt" @@ -21,20 +19,16 @@ [(define (dialect-name _) 'postgresql) (define (dialect-supports-returning? _) #t) - (define/contract (dialect-last-id-query _) - (-> dialect? string?) + (define (dialect-last-id-query _) "SELECT lastval()") - (define/contract (dialect-emit-ddl _ d) - (-> dialect? ddl? string?) + (define (dialect-emit-ddl _ d) (emit-ddl d)) - (define/contract (dialect-emit-query/impl _ s) - (-> dialect? stmt? string?) + (define (dialect-emit-query/impl _ s) (emit-stmt s)) - (define/contract (dialect-prepare-parameters _ p args) - (-> dialect? prepared-statement? (listof any/c) (listof any/c)) + (define (dialect-prepare-parameters _ p args) args)]) (values postgresql-dialect? (postgresql-dialect)))) diff --git a/deta-lib/private/dialect/sqlite3.rkt b/deta-lib/private/dialect/sqlite3.rkt index 3f8a2ab..77da555 100644 --- a/deta-lib/private/dialect/sqlite3.rkt +++ b/deta-lib/private/dialect/sqlite3.rkt @@ -1,8 +1,6 @@ #lang racket/base -(require db - racket/contract - racket/match +(require racket/match racket/port "../ast.rkt" "../field.rkt" @@ -22,20 +20,16 @@ [(define (dialect-name _) 'sqlite3) (define (dialect-supports-returning? _) #t) - (define/contract (dialect-last-id-query _) - (-> dialect? string?) + (define (dialect-last-id-query _) "SELECT last_insert_rowid()") - (define/contract (dialect-emit-ddl _ d) - (-> dialect? ddl? string?) + (define (dialect-emit-ddl _ d) (emit-ddl d)) - (define/contract (dialect-emit-query/impl _ s) - (-> dialect? stmt? string?) + (define (dialect-emit-query/impl _ s) (emit-stmt s)) - (define/contract (dialect-prepare-parameters _ _p args) - (-> dialect? prepared-statement? (listof any/c) (listof any/c)) + (define (dialect-prepare-parameters _ _p args) (for/list ([arg (in-list args)]) (match arg [#f 0] diff --git a/deta-lib/private/query.rkt b/deta-lib/private/query.rkt index 5016785..b2d74f6 100644 --- a/deta-lib/private/query.rkt +++ b/deta-lib/private/query.rkt @@ -2,7 +2,7 @@ (require db (only-in racket/class send) - racket/contract + racket/contract/base racket/match racket/struct (prefix-in ast: "ast.rkt") @@ -79,26 +79,42 @@ ;; combinators ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (provide - delete - from - group-by - join - limit - offset - or-where - union - order-by - project-onto - project-virtual-fields - returning - select - select-for-schema - subquery - update - where) - -(define/contract (delete q) - (-> select-query? query?) + (contract-out + [delete (-> select-query? query?)] + [from (-> any/c #:as symbol? query?)] + [group-by (-> select-query? ast:expr? ast:expr? ... query?)] + [join + (-> select-query? + #:type (or/c 'inner 'left 'right 'full 'cross) + #:lateral? boolean? + #:with (or/c ast:subquery? schema? string? symbol?) + #:as symbol? + #:on ast:expr? + query?)] + [limit (-> query? (or/c ast:scalar? ast:placeholder?) query?)] + [offset (-> query? (or/c ast:scalar? ast:placeholder?) query?)] + [or-where (-> query? ast:expr? query?)] + [order-by (-> select-query? ordering/c ordering/c ... query?)] + [project-onto (-> query? schema? query?)] + [project-virtual-fields (-> query? query?)] + [returning (-> query? ast:expr? ast:expr? ... query?)] + [select + (->* (query? ast:expr?) + (#:distinct? boolean?) + #:rest (listof ast:expr?) + query?)] + [select-for-schema + (-> query? + (or/c schema? symbol?) + string? + (hash/c symbol? ast:expr?) + query?)] + [subquery (-> select-query? ast:subquery?)] + [union (-> select-query? select-query? query?)] + [update (-> select-query? assignment/c assignment/c ... query?)] + [where (-> query? ast:expr? query?)])) + +(define (delete q) (match q [(query schema opts (struct* ast:select ([from (ast:from (list table) _)] [where where]))) @@ -109,9 +125,7 @@ #:from (ast:make-from #:tables (list table)) #:where where))])) -(define/contract (from source #:as alias) - (-> any/c #:as symbol? query?) - +(define (from source #:as alias) (define alias:str (symbol->string alias)) (cond [(string? source) @@ -138,20 +152,12 @@ [else (raise-argument-error 'form "a table name, a schema name or a subquery" source)])) -(define/contract (join q - #:type type - #:lateral? lateral? - #:with tbl-e - #:as alias - #:on constraint) - (-> select-query? - #:type (or/c 'inner 'left 'right 'full 'cross) - #:lateral? boolean? - #:with (or/c ast:subquery? schema? string? symbol?) - #:as symbol? - #:on ast:expr? - query?) - +(define (join q + #:type type + #:lateral? lateral? + #:with tbl-e + #:as alias + #:on constraint) (define tbl-clause (match tbl-e [(? ast:subquery?) tbl-e] @@ -167,21 +173,16 @@ (ast:select-from stmt) (ast:join type lateral? (ast:as tbl-clause alias) constraint))]))])) -(define/contract (select q column0 - #:distinct? [distinct? #f] - . columns) - (->* (query? ast:expr?) - (#:distinct? boolean?) - #:rest (listof ast:expr?) - query?) +(define (select q column0 + #:distinct? [distinct? #f] + . columns) (match q [(query _ opts stmt) (query #f opts (struct-copy ast:select stmt [distinct? distinct?] [columns (cons column0 columns)]))])) -(define/contract (select-for-schema q schema-or-id tbl-alias customizations) - (-> query? (or/c schema? symbol?) string? (hash/c symbol? ast:expr?) query?) +(define (select-for-schema q schema-or-id tbl-alias customizations) (define s (schema-registry-lookup schema-or-id)) (define q* (apply select q (for/list ([fld (schema-fields s)]) (hash-ref customizations @@ -190,15 +191,12 @@ (ast:qualified tbl-alias (field-name fld))))))) (project-onto q* s)) -(define/contract (limit q n) - (-> query? (or/c ast:scalar? ast:placeholder?) query?) +(define (limit q n) (match q [(query schema opts stmt) (query schema opts (struct-copy ast:select stmt [limit (ast:limit n)]))])) -(define/contract (group-by q column0 . columns) - (-> select-query? ast:expr? ast:expr? ... query?) - +(define (group-by q column0 . columns) (define all-columns (cons column0 columns)) @@ -209,8 +207,7 @@ [(query schema opts (and (struct* ast:select ([group-by (ast:group-by existing-columns)])) stmt)) (query schema opts (struct-copy ast:select stmt [group-by (ast:group-by (append existing-columns all-columns))]))])) -(define/contract (offset q n) - (-> query? (or/c ast:scalar? ast:placeholder?) query?) +(define (offset q n) (match q [(query schema opts stmt) (query schema opts (struct-copy ast:select stmt [offset (ast:offset n)]))])) @@ -218,9 +215,7 @@ (define ordering/c (list/c ast:expr? (or/c 'asc 'desc) (or/c #f 'nulls-first 'nulls-last))) -(define/contract (union q1 q2) - (-> select-query? select-query? query?) - +(define (union q1 q2) (define (union* s1 s2) (match s1 [(struct* ast:select ([union #f])) @@ -236,9 +231,7 @@ [(query schema opts (and (struct* ast:select ([union u])) stmt)) (query schema opts (struct-copy ast:select stmt [union (ast:union (union* (ast:union-stmt u) (query-stmt q2)))]))])) -(define/contract (order-by q ordering0 . orderings) - (-> select-query? ordering/c ordering/c ... query?) - +(define (order-by q ordering0 . orderings) (define all-orderings (cons ordering0 orderings)) @@ -249,17 +242,13 @@ [(query schema opts (and (struct* ast:select ([order-by (ast:order-by existing-orderings)])) stmt)) (query schema opts (struct-copy ast:select stmt [order-by (ast:order-by (append existing-orderings all-orderings))]))])) -(define/contract (project-onto q s) - (-> query? schema? query?) +(define (project-onto q s) (struct-copy query q [schema s])) -(define/contract (project-virtual-fields q) - (-> query? query?) +(define (project-virtual-fields q) (struct-copy query q [opts (opts #t)])) -(define/contract (returning q e0 . es) - (-> query? ast:expr? ast:expr? ... query?) - +(define (returning q e0 . es) (define all-exprs (cons e0 es)) @@ -281,13 +270,10 @@ [(query schema opts (and (? ast:delete?) stmt)) (query schema opts (struct-copy ast:delete stmt [returning (append-exprs (ast:delete-returning stmt))]))])) -(define/contract (subquery q) - (-> select-query? ast:subquery?) +(define (subquery q) (ast:subquery (query-stmt q))) -(define/contract (update q assignment0 . assignments) - (-> select-query? assignment/c assignment/c ... query?) - +(define (update q assignment0 . assignments) (define all-assignments (cons assignment0 assignments)) @@ -303,8 +289,7 @@ #:assignments (ast:assignments all-assignments) #:where where))])) -(define/contract (where q e) - (-> query? ast:expr? query?) +(define (where q e) (match q [(query schema opts (and (struct* ast:select ([where #f])) stmt)) (query schema opts (struct-copy ast:select stmt [where (ast:where e)]))] @@ -324,8 +309,7 @@ [(query schema opts (and (struct* ast:delete ([where (ast:where e0)])) stmt)) (query schema opts (struct-copy ast:delete stmt [where (ast:where (ast:app (ast:ident 'and) (list e0 e)))]))])) -(define/contract (or-where q e) - (-> query? ast:expr? query?) +(define (or-where q e) (match q [(query schema opts (and (struct* ast:select ([where #f])) stmt)) (query schema opts (struct-copy ast:select stmt [where (ast:where e)]))] diff --git a/deta-lib/private/schema.rkt b/deta-lib/private/schema.rkt index ac4f759..49169b6 100644 --- a/deta-lib/private/schema.rkt +++ b/deta-lib/private/schema.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require racket/contract +(require racket/contract/base "field.rkt") ;; struct ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -55,24 +55,22 @@ (unless virtual? (register! id the-schema)))) -(define/contract (schema-fields/nonvirtual the-schema) - (-> schema? (listof field?)) +(define (schema-fields/nonvirtual the-schema) (filter (compose1 not field-virtual?) (schema-fields the-schema))) ;; registry ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (provide - current-schema-registry - schema-registry-allow-conflicts? - schema-registry-lookup) + (contract-out + [current-schema-registry (parameter/c (hash/c symbol? schema?))] + [schema-registry-allow-conflicts? (parameter/c boolean?)] + [schema-registry-lookup (-> (or/c schema? symbol?) schema?)])) -(define/contract schema-registry-allow-conflicts? - (parameter/c boolean?) +(define schema-registry-allow-conflicts? (make-parameter #f)) -(define/contract current-schema-registry - (parameter/c (hash/c symbol? schema?)) +(define current-schema-registry (make-parameter (make-hasheq))) (define (register! id s) @@ -82,8 +80,7 @@ (hash-set! registry id s)) -(define/contract (schema-registry-lookup schema-or-id) - (-> (or/c schema? symbol?) schema?) +(define (schema-registry-lookup schema-or-id) (cond [(schema? schema-or-id) schema-or-id] diff --git a/deta-lib/schema.rkt b/deta-lib/schema.rkt index bd9b9f4..e9c2bd1 100644 --- a/deta-lib/schema.rkt +++ b/deta-lib/schema.rkt @@ -9,7 +9,8 @@ syntax/parse/experimental/template syntax/parse/pre) db - racket/contract + racket/contract/base + racket/contract/region "private/entity.rkt" "private/field.rkt" "private/meta.rkt"