aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/security/capability.lux3
-rw-r--r--stdlib/source/lux/data/format/json.lux7
-rw-r--r--stdlib/source/lux/world/db/jdbc.jvm.lux103
-rw-r--r--stdlib/source/lux/world/db/jdbc/input.jvm.lux2
-rw-r--r--stdlib/source/lux/world/net/http/response.lux14
-rw-r--r--stdlib/source/lux/world/service/journal.lux54
-rw-r--r--stdlib/source/program/licentia.lux5
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))