From 9a6d43895330f7c71bde85aa46230a40ada5dbd5 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 9 Jan 2019 23:32:07 -0400 Subject: Added more services. --- stdlib/source/lux/macro/poly/equivalence.lux | 38 +++++++++++----------- stdlib/source/lux/world/service/authentication.lux | 25 ++++++++++++++ stdlib/source/lux/world/service/journal.lux | 36 ++++++++++++++++++++ stdlib/source/lux/world/service/mail.lux | 19 +++++++++++ 4 files changed, 99 insertions(+), 19 deletions(-) create mode 100644 stdlib/source/lux/world/service/authentication.lux create mode 100644 stdlib/source/lux/world/service/journal.lux create mode 100644 stdlib/source/lux/world/service/mail.lux 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 [ ] @@ -50,12 +50,12 @@ ))))] [(poly.exactly Any) (function ((~ g!_) (~ g!_) (~ g!_)) #1)] - [(poly.sub Bit) bit.Equivalence] - [(poly.sub Nat) number.Equivalence] - [(poly.sub Int) number.Equivalence] - [(poly.sub Rev) number.Equivalence] - [(poly.sub Frac) number.Equivalence] - [(poly.sub Text) text.Equivalence])) + [(poly.sub Bit) (~! bit.Equivalence)] + [(poly.sub Nat) (~! number.Equivalence)] + [(poly.sub Int) (~! number.Equivalence)] + [(poly.sub Rev) (~! number.Equivalence)] + [(poly.sub Frac) (~! number.Equivalence)] + [(poly.sub Text) (~! text.Equivalence)])) ## Composite types (~~ (do-template [ ] [(do @ @@ -64,13 +64,13 @@ (wrap (` (: (~ (@Equivalence inputT)) ( (~ argC))))))] - [.Maybe maybe.Equivalence] - [.List list.Equivalence] - [row.Row row.Equivalence] - [array.Array array.Equivalence] - [queue.Queue queue.Equivalence] - [set.Set set.Equivalence] - [rose.Tree rose.Equivalence] + [.Maybe (~! maybe.Equivalence)] + [.List (~! list.Equivalence)] + [row.Row (~! row.Equivalence)] + [array.Array (~! array.Equivalence)] + [queue.Queue (~! queue.Equivalence)] + [set.Set (~! set.Equivalence)] + [rose.Tree (~! rose.Equivalence)] )) (do @ [[_ _ valC] (poly.apply ($_ p.and @@ -78,7 +78,7 @@ poly.any Equivalence))] (wrap (` (: (~ (@Equivalence inputT)) - (dict.Equivalence (~ valC)))))) + ((~! dict.Equivalence) (~ valC)))))) ## Models (~~ (do-template [ ] [(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)}) -- cgit v1.2.3