diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/control/security/capability.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/json.lux | 7 | ||||
| -rw-r--r-- | stdlib/source/lux/world/db/jdbc.jvm.lux | 103 | ||||
| -rw-r--r-- | stdlib/source/lux/world/db/jdbc/input.jvm.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/lux/world/net/http/response.lux | 14 | ||||
| -rw-r--r-- | stdlib/source/lux/world/service/journal.lux | 54 | ||||
| -rw-r--r-- | stdlib/source/program/licentia.lux | 5 |
7 files changed, 110 insertions, 78 deletions
diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux index f757ced19..09421e4ee 100644 --- a/stdlib/source/lux/control/security/capability.lux +++ b/stdlib/source/lux/control/security/capability.lux @@ -49,7 +49,8 @@ (wrap (list (` (type: (~+ (writer.export export)) (~ (writer.declaration declaration)) (~ capability))) - (` (def: (~ (code.local-identifier forge)) + (` (def: (~+ (writer.export export)) + (~ (code.local-identifier forge)) (All [(~+ (list/map code.local-identifier vars))] (-> (-> (~ input) (~ output)) (~ capability))) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index a4aad7c83..d4dc36ad0 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -76,7 +76,7 @@ (wrap (list (` (: JSON #Null)))) [_ (#.Tuple members)] - (wrap (list (` (: JSON (#Array (row (~+ (list/map wrapper members)))))))) + (wrap (list (` (: JSON (#Array ((~! row) (~+ (list/map wrapper members)))))))) [_ (#.Record pairs)] (do ..monad @@ -89,11 +89,10 @@ _ (macro.fail "Wrong syntax for JSON object."))) pairs)] - (wrap (list (` (: JSON (#Object (dictionary.from-list text.hash (list (~+ pairs'))))))))) + (wrap (list (` (: JSON (#Object ((~! dictionary.from-list) (~! text.hash) (list (~+ pairs'))))))))) _ - (wrap (list token)) - ))) + (wrap (list token))))) (def: #export (get-fields json) {#.doc "Get all the fields in a JSON object."} diff --git a/stdlib/source/lux/world/db/jdbc.jvm.lux b/stdlib/source/lux/world/db/jdbc.jvm.lux index 9dd3ce890..e73adef88 100644 --- a/stdlib/source/lux/world/db/jdbc.jvm.lux +++ b/stdlib/source/lux/world/db/jdbc.jvm.lux @@ -8,11 +8,10 @@ [concurrency ["." promise (#+ Promise) ("promise/." monad)]] [security - [capability (#+ Capability)]]] + ["!" capability (#+ capability:)]]] [data ["." product] ["." error (#+ Error)] - ["." number] [text format] [collection @@ -57,29 +56,24 @@ (type: #export ID Int) -(def: #export equivalence number.int-equivalence) - (type: #export (Statement input) {#sql sql.Statement #input (Input input) #value input}) -## DB -(do-template [<name> <output>] - [(type: #export (<name> !) - (All [i] - (Capability (Statement i) (! (Error <output>)))))] +(do-template [<name> <forge> <output>] + [(capability: #export (<name> ! i) + (<forge> (Statement i) (! (Error <output>))))] - [Can-Execute Nat] - [Can-Insert (List ID)] + [Can-Execute can-execute Nat] + [Can-Insert can-insert (List ID)] ) -(type: #export (Can-Query !) - (All [i o] - (Capability [(Statement i) (Output o)] (! (Error (List o)))))) +(capability: #export (Can-Query ! i o) + (can-query [(Statement i) (Output o)] (! (Error (List o))))) -(type: #export (Can-Close !) - (Capability Any (! (Error Any)))) +(capability: #export (Can-Close !) + (can-close Any (! (Error Any)))) (signature: #export (DB !) (: (Can-Execute !) @@ -96,7 +90,7 @@ (-> (Statement i) java/sql/Connection (-> java/sql/PreparedStatement (IO (Error a))) (IO (Error a)))) - (do (error.ErrorT io.monad) + (do (error.with-error io.monad) [prepared (io.io (java/sql/Connection::prepareStatement (sql.sql (get@ #sql statement)) (java/sql/Statement::RETURN_GENERATED_KEYS) conn)) @@ -108,43 +102,54 @@ (def: #export (async db) (-> (DB IO) (DB Promise)) (`` (structure - (~~ (do-template [<name>] - [(def: <name> (|>> (:: db <name>) promise.future))] + (~~ (do-template [<name> <forge>] + [(def: <name> (<forge> (|>> (!.use (:: db <name>)) promise.future)))] - [execute] [insert] [close] [query]))))) + [execute can-execute] + [insert can-insert] + [close can-close] + [query can-query]))))) (def: #export (connect creds) (-> Credentials (IO (Error (DB IO)))) - (do (error.ErrorT io.monad) + (do (error.with-error io.monad) [connection (java/sql/DriverManager::getConnection (get@ #url creds) (get@ #user creds) (get@ #password creds))] (wrap (: (DB IO) (structure - (def: (execute statement) - (with-statement statement connection - (function (_ prepared) - (do (error.ErrorT io.monad) - [row-count (java/sql/PreparedStatement::executeUpdate prepared)] - (wrap (.nat row-count)))))) - - (def: (insert statement) - (with-statement statement connection - (function (_ prepared) - (do (error.ErrorT io.monad) - [_ (java/sql/PreparedStatement::executeUpdate prepared) - result-set (io.io (java/sql/Statement::getGeneratedKeys prepared))] - (/output.rows /output.long result-set))))) - - (def: (close _) - (java/sql/Connection::close connection)) - - (def: (query [statement output]) - (with-statement statement connection - (function (_ prepared) - (do (error.ErrorT io.monad) - [result-set (java/sql/PreparedStatement::executeQuery prepared)] - (/output.rows output result-set))))) + (def: execute + (..can-execute + (function (execute statement) + (with-statement statement connection + (function (_ prepared) + (do (error.with-error io.monad) + [row-count (java/sql/PreparedStatement::executeUpdate prepared)] + (wrap (.nat row-count)))))))) + + (def: insert + (..can-insert + (function (insert statement) + (with-statement statement connection + (function (_ prepared) + (do (error.with-error io.monad) + [_ (java/sql/PreparedStatement::executeUpdate prepared) + result-set (io.io (java/sql/Statement::getGeneratedKeys prepared))] + (/output.rows /output.long result-set))))))) + + (def: close + (..can-close + (function (close _) + (java/sql/Connection::close connection)))) + + (def: query + (..can-query + (function (query [statement output]) + (with-statement statement connection + (function (_ prepared) + (do (error.with-error io.monad) + [result-set (java/sql/PreparedStatement::executeQuery prepared)] + (/output.rows output result-set))))))) ))))) (def: #export (with-db creds action) @@ -152,10 +157,10 @@ (-> Credentials (-> (DB IO) (IO (Error a))) (IO (Error a)))) - (do (error.ErrorT io.monad) + (do (error.with-error io.monad) [db (..connect creds) result (action db) - _ (:: db close [])] + _ (!.use (:: db close) [])] (wrap result))) (def: #export (with-async-db creds action) @@ -163,8 +168,8 @@ (-> Credentials (-> (DB Promise) (Promise (Error a))) (Promise (Error a)))) - (do (error.ErrorT promise.monad) + (do (error.with-error promise.monad) [db (promise.future (..connect creds)) result (action (..async db)) - _ (promise/wrap (io.run (:: db close [])))] + _ (promise/wrap (io.run (!.use (:: db close) [])))] (wrap result))) diff --git a/stdlib/source/lux/world/db/jdbc/input.jvm.lux b/stdlib/source/lux/world/db/jdbc/input.jvm.lux index ef9db9009..455cddd01 100644 --- a/stdlib/source/lux/world/db/jdbc/input.jvm.lux +++ b/stdlib/source/lux/world/db/jdbc/input.jvm.lux @@ -49,7 +49,7 @@ (-> a [Nat java/sql/PreparedStatement] (Error [Nat java/sql/PreparedStatement]))) -(structure: #export _ (Contravariant Input) +(structure: #export contravariant (Contravariant Input) (def: (map-1 f fb) (function (fa value circumstance) (fb (f value) circumstance)))) diff --git a/stdlib/source/lux/world/net/http/response.lux b/stdlib/source/lux/world/net/http/response.lux index ef394613f..9b83e9cad 100644 --- a/stdlib/source/lux/world/net/http/response.lux +++ b/stdlib/source/lux/world/net/http/response.lux @@ -1,7 +1,8 @@ (.module: - [lux #* + [lux (#- static) [control [concurrency + ["." promise] ["." frp ("channel/." monad)]]] [data ["." text @@ -10,16 +11,22 @@ [format ["." html] ["." css (#+ CSS)] - ["." context]]] + ["." context] + ["." json (#+ JSON) ("json/." codec)]]] ["." io] [world ["." binary (#+ Binary)]]] - ["." // (#+ Status Body Response) + ["." // (#+ Status Body Response Server) ["." status] ["." mime (#+ MIME)] ["." header] [// (#+ URL)]]) +(def: #export (static response) + (-> Response Server) + (function (_ request) + (promise.resolved response))) + (def: #export empty (-> Status Response) (let [body (channel/wrap (encoding.to-utf8 ""))] @@ -63,4 +70,5 @@ [text Text mime.utf-8 (<|)] [html html.Document mime.html html.html] [css CSS mime.css css.css] + [json JSON mime.json json/encode] ) diff --git a/stdlib/source/lux/world/service/journal.lux b/stdlib/source/lux/world/service/journal.lux index aa151fdab..3919d11f9 100644 --- a/stdlib/source/lux/world/service/journal.lux +++ b/stdlib/source/lux/world/service/journal.lux @@ -1,36 +1,50 @@ (.module: [lux #* [control + [equivalence (#+ Equivalence)] + [interval (#+ Interval)] [security - [capability (#+ Capability)]]] + ["!" capability (#+ capability:)]]] [data - [error (#+ Error)]] + [error (#+ Error)] + [text ("text/." equivalence)]] [time - [instant (#+ Instant)]] - [macro - [poly (#+ derived:) - [equivalence (#+ Equivalence<?>)]]]]) + ["." instant (#+ Instant) ("instant/." equivalence)]]]) -(type: #export Entry - {#what Text +(type: #export (Entry a) + {#what a #why Text #how Text - #who (List Text) + #who Text #where Text #when Instant}) -(derived: #export (Equivalence<?> Entry)) +(type: #export Range + (Interval Instant)) -(type: #export (Can-Write !) - (Capability Entry (! (Error Any)))) +(def: #export (range start end) + (-> Instant Instant Range) + (structure + (def: &enum instant.enum) + (def: bottom start) + (def: top end))) -(type: #export Range - {#from Instant - #to Instant}) +(structure: #export (equivalence (^open "_/.")) + (All [a] (-> (Equivalence a) (Equivalence (Entry a)))) + (def: (= reference sample) + (and (_/= (get@ #what reference) (get@ #what sample)) + (text/= (get@ #why reference) (get@ #why sample)) + (text/= (get@ #how reference) (get@ #how sample)) + (text/= (get@ #who reference) (get@ #who sample)) + (text/= (get@ #where reference) (get@ #where sample)) + (instant/= (get@ #when reference) (get@ #when sample))))) + +(capability: #export (Can-Write ! a) + (can-write (Entry a) (! (Error Any)))) -(type: #export (Can-Read !) - (Capability Range (! (Error (List Entry))))) +(capability: #export (Can-Read ! a) + (can-read Range (! (Error (List (Entry a)))))) -(type: #export (Service !) - {#can-write (Can-Write !) - #can-read (Can-Read !)}) +(type: #export (Journal ! a) + {#can-write (Can-Write ! a) + #can-read (Can-Read ! a)}) diff --git a/stdlib/source/program/licentia.lux b/stdlib/source/program/licentia.lux index 29ecc7eab..42af77bf2 100644 --- a/stdlib/source/program/licentia.lux +++ b/stdlib/source/program/licentia.lux @@ -14,6 +14,7 @@ (.module: [lux #* [control + [remember (#+ to-do)] [monad (#+ do)] ["." parser]] [data @@ -33,6 +34,10 @@ ["/." input] ["/." output]]) +(with-expansions [<expiry> (as-is "2019-04-01")] + (to-do <expiry> "Replace _.work with _.covered-work or _.licensed-work") + (to-do <expiry> "Create a short notice to add as a comment to each file in the _.work")) + (import: #long java/lang/String (trim [] String)) |