diff options
author | Eduardo Julian | 2019-01-09 23:32:07 -0400 |
---|---|---|
committer | Eduardo Julian | 2019-01-09 23:32:07 -0400 |
commit | 9a6d43895330f7c71bde85aa46230a40ada5dbd5 (patch) | |
tree | 26fb91f454cf6feb62e3952462d8a792d6626385 /stdlib/source | |
parent | 4681dcbf1007657b7017e5d75204ade18e6e58ec (diff) |
Added more services.
Diffstat (limited to 'stdlib/source')
-rw-r--r-- | stdlib/source/lux/macro/poly/equivalence.lux | 38 | ||||
-rw-r--r-- | stdlib/source/lux/world/service/authentication.lux | 25 | ||||
-rw-r--r-- | stdlib/source/lux/world/service/journal.lux | 36 | ||||
-rw-r--r-- | stdlib/source/lux/world/service/mail.lux | 19 |
4 files changed, 99 insertions, 19 deletions
diff --git a/stdlib/source/lux/macro/poly/equivalence.lux b/stdlib/source/lux/macro/poly/equivalence.lux index edb1f8dfc..4b5b80e13 100644 --- a/stdlib/source/lux/macro/poly/equivalence.lux +++ b/stdlib/source/lux/macro/poly/equivalence.lux @@ -40,7 +40,7 @@ inputT poly.peek #let [@Equivalence (: (-> Type Code) (function (_ type) - (` (eq.Equivalence (~ (poly.to-code *env* type))))))]] + (` ((~! eq.Equivalence) (~ (poly.to-code *env* type))))))]] ($_ p.either ## Basic types (~~ (do-template [<matcher> <eq>] @@ -50,12 +50,12 @@ <eq>))))] [(poly.exactly Any) (function ((~ g!_) (~ g!_) (~ g!_)) #1)] - [(poly.sub Bit) bit.Equivalence<Bit>] - [(poly.sub Nat) number.Equivalence<Nat>] - [(poly.sub Int) number.Equivalence<Int>] - [(poly.sub Rev) number.Equivalence<Rev>] - [(poly.sub Frac) number.Equivalence<Frac>] - [(poly.sub Text) text.Equivalence<Text>])) + [(poly.sub Bit) (~! bit.Equivalence<Bit>)] + [(poly.sub Nat) (~! number.Equivalence<Nat>)] + [(poly.sub Int) (~! number.Equivalence<Int>)] + [(poly.sub Rev) (~! number.Equivalence<Rev>)] + [(poly.sub Frac) (~! number.Equivalence<Frac>)] + [(poly.sub Text) (~! text.Equivalence<Text>)])) ## Composite types (~~ (do-template [<name> <eq>] [(do @ @@ -64,13 +64,13 @@ (wrap (` (: (~ (@Equivalence inputT)) (<eq> (~ argC))))))] - [.Maybe maybe.Equivalence<Maybe>] - [.List list.Equivalence<List>] - [row.Row row.Equivalence<Row>] - [array.Array array.Equivalence<Array>] - [queue.Queue queue.Equivalence<Queue>] - [set.Set set.Equivalence<Set>] - [rose.Tree rose.Equivalence<Tree>] + [.Maybe (~! maybe.Equivalence<Maybe>)] + [.List (~! list.Equivalence<List>)] + [row.Row (~! row.Equivalence<Row>)] + [array.Array (~! array.Equivalence<Array>)] + [queue.Queue (~! queue.Equivalence<Queue>)] + [set.Set (~! set.Equivalence<Set>)] + [rose.Tree (~! rose.Equivalence<Tree>)] )) (do @ [[_ _ valC] (poly.apply ($_ p.and @@ -78,7 +78,7 @@ poly.any Equivalence<?>))] (wrap (` (: (~ (@Equivalence inputT)) - (dict.Equivalence<Dictionary> (~ valC)))))) + ((~! dict.Equivalence<Dictionary>) (~ valC)))))) ## Models (~~ (do-template [<type> <eq>] [(do @ @@ -129,8 +129,8 @@ [[g!self bodyC] (poly.recursive Equivalence<?>) #let [g!_ (code.local-identifier "_____________")]] (wrap (` (: (~ (@Equivalence inputT)) - (eq.rec (.function ((~ g!_) (~ g!self)) - (~ bodyC))))))) + ((~! eq.rec) (.function ((~ g!_) (~ g!self)) + (~ bodyC))))))) poly.recursive-self ## Type applications (do @ @@ -142,8 +142,8 @@ (do @ [[funcC varsC bodyC] (poly.polymorphic Equivalence<?>)] (wrap (` (: (All [(~+ varsC)] - (-> (~+ (list/map (|>> (~) eq.Equivalence (`)) varsC)) - (eq.Equivalence ((~ (poly.to-code *env* inputT)) (~+ varsC))))) + (-> (~+ (list/map (|>> (~) ((~! eq.Equivalence)) (`)) varsC)) + ((~! eq.Equivalence) ((~ (poly.to-code *env* inputT)) (~+ varsC))))) (function ((~ funcC) (~+ varsC)) (~ bodyC)))))) poly.recursive-call diff --git a/stdlib/source/lux/world/service/authentication.lux b/stdlib/source/lux/world/service/authentication.lux new file mode 100644 index 000000000..2cd35f7dd --- /dev/null +++ b/stdlib/source/lux/world/service/authentication.lux @@ -0,0 +1,25 @@ +(.module: + [lux #* + [control + [security + [capability (#+ Capability)]]] + [data + [error (#+ Error)]]]) + +(type: #export (Can-Register ! account secret value) + (Capability [account secret value] (! (Error Any)))) + +(type: #export (Can-Authenticate ! account secret value) + (Capability [account secret] (! (Error value)))) + +(type: #export (Can-Reset ! account secret) + (Capability [account secret] (! (Error Any)))) + +(type: #export (Can-Forget ! account) + (Capability [account] (! (Error Any)))) + +(type: #export (Service ! account secret value) + {#can-register (Can-Register ! account secret value) + #can-authenticate (Can-Authenticate ! account secret value) + #can-reset (Can-Reset ! account secret) + #can-forget (Can-Forget ! account)}) diff --git a/stdlib/source/lux/world/service/journal.lux b/stdlib/source/lux/world/service/journal.lux new file mode 100644 index 000000000..aa151fdab --- /dev/null +++ b/stdlib/source/lux/world/service/journal.lux @@ -0,0 +1,36 @@ +(.module: + [lux #* + [control + [security + [capability (#+ Capability)]]] + [data + [error (#+ Error)]] + [time + [instant (#+ Instant)]] + [macro + [poly (#+ derived:) + [equivalence (#+ Equivalence<?>)]]]]) + +(type: #export Entry + {#what Text + #why Text + #how Text + #who (List Text) + #where Text + #when Instant}) + +(derived: #export (Equivalence<?> Entry)) + +(type: #export (Can-Write !) + (Capability Entry (! (Error Any)))) + +(type: #export Range + {#from Instant + #to Instant}) + +(type: #export (Can-Read !) + (Capability Range (! (Error (List Entry))))) + +(type: #export (Service !) + {#can-write (Can-Write !) + #can-read (Can-Read !)}) diff --git a/stdlib/source/lux/world/service/mail.lux b/stdlib/source/lux/world/service/mail.lux new file mode 100644 index 000000000..115afb5e3 --- /dev/null +++ b/stdlib/source/lux/world/service/mail.lux @@ -0,0 +1,19 @@ +(.module: + [lux #* + [control + [concurrency + [frp (#+ Channel)]] + [security + [capability (#+ Capability)]]] + [data + [error (#+ Error)]]]) + +(type: #export (Can-Send ! address message) + (Capability [address message] (! (Error Any)))) + +(type: #export (Can-Subscribe ! address message) + (Capability [address] (! (Error (Channel message))))) + +(type: #export (Service ! address message) + {#can-send (Can-Send ! address message) + #can-subscribe (Can-Subscribe ! address message)}) |