<mfp>
I have what boils down to type ('a, 'b) statement = { c : cache option; d : ('a, 'b) directive } ... now, let stmt = { c = Some c; d = d } is weakly polymorphic, while let stmt = { c = None; d = d } isn't
<f[x]>
order of stmt and stmt2 doesn't matter?
<mfp>
it shouldn't, let me check
<mfp>
yes, no diff
<flux>
mfp, how about adding a call to make_cache to the latter?
<mfp>
right, it becomes weakly polymorphic the moment I add it
<mfp>
so I guess the relaxation of the value restriction doesn't allow applications
_andre has joined #ocaml
<mfp>
this is funny
<f[x]>
let _ = ignore (make_cache ()) in
<f[x]>
still weak :)
<mfp>
I was actually doing let cache = Sqlexpr.make_cache () in let cache = None in -> weak
<f[x]>
calling function - side effect
<mfp>
but ignore (Sqlexpr.make_cache ()); let cache = None in ... -> polymorphic
<f[x]>
I don't get it
<mfp>
in fact, let _ = Sqlexpr.make_cache () in let cache = None in .... is weak
<mfp>
while ignore (Sqlexpr.make_cache ()); let cache = None in ... isn't
<mfp>
Sqlexpr.make_cache () creates a hashtbl, I'll try to switch to a map so that no function application is needed to create the cache
lpereira has quit [Ping timeout: 264 seconds]
boscop_ has joined #ocaml
boscop has quit [Ping timeout: 264 seconds]
<f[x]>
I was using make_cache () = 0 and the results are same
init1 has joined #ocaml
<mfp>
this gets worse: { ... stmt_cache = None ... } and { ... stmt_cache = Some Sqlexpr.empty_cache ... } are both weakly polymorphic
<mfp>
presumably because I had to make the stmt_cache field mutable in order to use a map instead of a hashtbl
<f[x]>
btw if you factor out make_stmt cache it will be polymorphic, but result of its application is weak
<f[x]>
i.e. let make_stmt cache = { ... }
<mfp>
btw, the big picture > I want to allow SQL stmt caching in HOFs like let fold_users db f acc = S.fold db (fun acc x -> f x) acc sql"SELECT @s{login}, @s{password}, @s?{email} FROM users"
<mfp>
by doing sqlc"..." instead of sql"...", it's rewritten to let fold_users = let stmt = .... in fun db f acc -> ... S.fold db (fun acc x -> f x) acc stmt
<mfp>
which allows to cache the prepared stmt across fold_users applications
Nahra has quit [Remote host closed the connection]
valross has quit [Quit: Ex-Chat]
seanmcl has quit [Quit: seanmcl]
<f[x]>
mfp, let x = let _ = ignore (print_endline "qq") in (fun x -> x)
<f[x]>
let x = let _ = ignore (print_endline "qq") in [];;
<f[x]>
let x = let _ = None in (fun x -> x);;
<mfp>
I'm giving up for now, maybe someday will read the paper on OCaml's relaxed value restriction
<f[x]>
mfp did you try to use reference for map instead of mutable cell in record?
<mfp>
nope, I assumed that 'a ref would introduce the same restriction as mutable x : 'a
seanmcl has joined #ocaml
<f[x]>
it makes difference, but I am not sure about this particular case
<mfp>
might try later
ztfw has joined #ocaml
<f[x]>
moving cache initialization out of stmt solves the issue
ztfw has quit [Read error: Connection reset by peer]
ztfw has joined #ocaml
avsm has joined #ocaml
CoryDambach has quit [Quit: Leaving]
pikachuyann has joined #ocaml
seanmcl has quit [Quit: seanmcl]
seafood has quit [Quit: seafood]
yezariaely has joined #ocaml
yezariaely has left #ocaml []
<adrien>
has anyone ever "caught" special keys in lablgtk? I need pageup and pagedown but they are mapped to 65365 and 65366 and I can't find an easy way to match against these
<adrien>
basically, I'd like to match against `PAGE_UP, not against an integer code
ygrek has joined #ocaml
<adrien>
ok, I was using 'Char.chr (GdkEvent.Key.keyval gdk_event)' and matching against 't', 'w'...
<adrien>
but it's possible to compare 'GdkEvent.Key.keyval gdk_event' (without Char.chr) and compare to GdkKeysyms._t, GdkKeysyms._w, GdkKeysyms._Page_up...
Edward__ has joined #ocaml
ccasin has joined #ocaml
lpereira has joined #ocaml
ygrek has quit [Ping timeout: 245 seconds]
Edward__ has quit [Ping timeout: 240 seconds]
joewilliams_away is now known as joewilliams
<hcarty>
mfp: Sqlexpr looks interesting. Does it add anything to the to Batteries Print.* functions' special syntax?
<hcarty>
s/to the/beyond/
<mfp>
hcarty: it handles prepared statement caching, param binding, data extraction, error checking (including automatic stmt reset to avoid BUSY/LOCKED errors in subsequent queries), stmt finalization on db close, etc.
<mfp>
also some HOFs like iter, fold, transaction (transaction : db -> (db -> 'a M.t) -> 'a M.t)) --- everything functorized over a THREAD monad (so you can for instance do concurrent folds/iters)
<hcarty>
Very nice
<mfp>
ah and also support for SQL stmt syntax check and some extra semantic checking (column names, etc)
<mfp>
the let auto_init_db, check_db, auto_check_db = sql_check"sqlite" in example.ml
<mfp>
generates 3 funcs val auto_init_db : Sqlite3.db -> Format.formatter -> bool val check_db : Sqlite3.db -> Format.formatter -> bool val auto_check_db : Format.formatter -> bool
<mfp>
auto_init_db applies all the sqlinit"..." statements to the DB (used for table defs), prints errors to the provided formatter and returns false on error
<mfp>
check_db tries to prepare all the sql"..." sqlc"..." queries, which will catch all the syntax errors and things like non-existent columns
<mfp>
auto_check_db creates an in-mem Sqlite3 DB, initializes it with auto_init_db and runs check_db
<mfp>
so you can use auto_init_db and/or check_db (with another initialization function) in your unit tests
<mfp>
so, unlike PGOCaml, errors in the SQL stmts (except when they affect the type of the expression) are caught at runtime, but you can check both in the unit tests and on program startup (which is arguably better)
philtor has joined #ocaml
ftrvxmtrx has quit [Quit: Leaving]
ftrvxmtrx has joined #ocaml
jonafan_ is now known as jonafan
<rwmjones>
mfp: not sure I understand ... PG'OCaml should pick up syntax errors and type errors at compile time
<mfp>
rwmjones: I meant that, unlike PG'OCaml, which detects errors at compile time, ocaml-sqlexpr detects them at "early runtime" (in the unit tests / on program startup)
<mfp>
it's worse in that it, well, doesn't catch them at compile time, but OTOH the generated check_db function can verify (at runtime) that the schema corresponds to the assumed one
<rwmjones>
ah ok, I was misreading you :-)
Edward__ has joined #ocaml
larhat has quit [Quit: Leaving.]
munga has quit [Quit: Ex-Chat]
<flux>
mfp, iow, it guarantees lack of errors, if the assumptions match the database?
<flux>
you could just stick check_db to your build process and you should get all errors at compile time..
<thelema>
I'm sure there's the possibility of some errors, just not simple "using text as a number" errors
<thelema>
and you'd still wast check_db at db open time, as the db file could be replaced after compile time
ftrvxmtrx_ has joined #ocaml
ftrvxmtrx has quit [Ping timeout: 276 seconds]
<mfp>
thelema, flux: indeed, it cannot catch all errors (in particular, not CONSTRAINT violations like a non-nullable column), but it catches many things including syntax errors in SQL stmts, wrong/missing tables/columns in predicates, etc.
<mfp>
e.g. taken from my unit tests OUnit: Error in statement "INSERT OR IGNORE INTO blobs(keyspace, hash, data) VALUES(?, ?, ?)": Sqlite3.prepare: table blobs has no column named hash
<mfp>
non-null columns (i.e., that you're not missing a non-nullable column in an insert) & foreign keys are necessarily checked at ("late") runtime, same as PG'OCaml
mjuad has joined #ocaml
avsm has quit [Quit: Leaving.]
ikaros has joined #ocaml
tautologico has joined #ocaml
ftrvxmtrx_ has quit [Quit: Leaving]
Tobu has quit [Ping timeout: 250 seconds]
Tobu has joined #ocaml
Edward__ has quit [Ping timeout: 272 seconds]
Nahra has joined #ocaml
ftrvxmtrx has joined #ocaml
Nahra has quit [Remote host closed the connection]
Edward__ has joined #ocaml
Nahra has joined #ocaml
Nahra has quit [Remote host closed the connection]
Nahra has joined #ocaml
_andre has quit [Quit: leaving]
tautologico has quit [Quit: tautologico]
philtor has quit [Ping timeout: 245 seconds]
Nahra has quit [Remote host closed the connection]
Nahra has joined #ocaml
schmrkc has joined #ocaml
Nahra has quit [Remote host closed the connection]
Nahra has joined #ocaml
Tobu has quit [Ping timeout: 240 seconds]
avsm has joined #ocaml
Snark has quit [Quit: Ex-Chat]
Nahra has quit [Remote host closed the connection]
|marius| has quit [Remote host closed the connection]
Edward__ has quit []
ftrvxmtrx_ has joined #ocaml
ftrvxmtrx has quit [Ping timeout: 265 seconds]
ftrvxmtrx_ has quit [Quit: Leaving]
ftrvxmtrx has joined #ocaml
lpereira has quit [Quit: Leaving.]
boscop_ is now known as boscop
mjonsson has joined #ocaml
philtor has joined #ocaml
ulfdoz has joined #ocaml
drunK has joined #ocaml
seafood has joined #ocaml
Nahra has joined #ocaml
init1 has quit [Quit: Quitte]
ccasin has quit [Quit: Leaving]
mjonsson has quit [Remote host closed the connection]
Nahra has quit [Remote host closed the connection]
oriba has joined #ocaml
oriba has quit [Client Quit]
Edward_ has joined #ocaml
Nahra has joined #ocaml
seafood has quit [Quit: seafood]
Nahra has quit [Remote host closed the connection]
Nahra has joined #ocaml
<pikachuyann>
bonne nuit
pikachuyann has quit [Quit: Quitte]
Nahra has quit [Remote host closed the connection]
ulfdoz has quit [Ping timeout: 245 seconds]
ztfw has quit [Quit: ERC Version 5.3 (IRC client for Emacs)]
Nahra has joined #ocaml
ztfw has joined #ocaml
Edward_ has quit [Ping timeout: 276 seconds]
Nahra` has joined #ocaml
Nahra` has quit [Remote host closed the connection]