#lang typed/syndicate/roles ;; Expected Output ;; leader learns that there are 5 copies of The Wind in the Willows ;; tony responds to suggested book The Wind in the Willows: #f ;; sam responds to suggested book The Wind in the Willows: #f ;; leader finds enough negative nancys for The Wind in the Willows ;; leader learns that there are 2 copies of Catch 22 ;; leader learns that there are 3 copies of Candide ;; tony responds to suggested book Candide: #t ;; sam responds to suggested book Candide: #t ;; leader finds enough affirmation for Candide (define-constructor (price v) #:type-constructor PriceT #:with Price (PriceT Int)) (define-constructor (book-quote title quantity) #:type-constructor BookQuoteT #:with BookQuote (BookQuoteT String Int)) (define-constructor (club-member name) #:type-constructor ClubMemberT #:with ClubMember (ClubMemberT String)) (define-constructor (book-interest title client id) #:type-constructor BookInterestT #:with BookInterest (BookInterestT String String Bool)) (define-constructor (book-of-the-month title) #:type-constructor BookOfTheMonthT #:with BookOfTheMonth (BookOfTheMonthT String)) (define-type-alias τc (U BookQuote (Observe (BookQuoteT String ★/t)) (Observe (Observe (BookQuoteT ★/t ★/t))) ClubMember (Observe (ClubMemberT ★/t)) BookInterest (Observe (BookInterestT String ★/t ★/t)) (Observe (Observe (BookInterestT ★/t ★/t ★/t))) BookOfTheMonth (Observe (BookOfTheMonthT ★/t)))) (define-type-alias Inventory (List (Tuple String Int))) (define (lookup [title : String] [inv : Inventory] -> Int) (for/fold [stock 0] [item inv] (if (equal? title (select 0 item)) (select 1 item) stock))) (define-type-alias seller-role (Role (seller) (Reacts (Know (Observe (BookQuoteT String ★/t))) (Role (_) ;; nb no mention of retracting this assertion (Shares (BookQuoteT String Int)))))) (define (spawn-seller [inventory : Inventory]) (spawn τc (begin (start-facet seller (field [books Inventory inventory]) ;; Give quotes to interested parties. (during (observe (book-quote (bind title String) discard)) ;; TODO - lookup (assert (book-quote title (lookup title (ref books))))))))) (define-type-alias leader-role (Role (leader) (Reacts (Know (BookQuoteT String Int)) (Role (poll) (Reacts (Know (BookInterestT String String Bool)) ;; this is actually implemented indirectly through dataflow (U (Stop leader (Role (_) (Shares (BookOfTheMonthT String)))) (Stop poll))))))) (define-type-alias leader-actual (Role (get-quotes31) (Reacts (Know (BookQuoteT String (Bind Int))) (Stop get-quotes) (Role (poll-members36) (Reacts OnDataflow (Stop poll-members (Stop get-quotes)) (Stop get-quotes (Role (announce39) (Shares (BookOfTheMonthT String))))) (Reacts (¬Know (BookInterestT String (Bind String) Bool))) (Reacts (Know (BookInterestT String (Bind String) Bool))) (Reacts (¬Know (BookInterestT String (Bind String) Bool))) (Reacts (Know (BookInterestT String (Bind String) Bool))))) (Reacts (¬Know (ClubMemberT (Bind String)))) (Reacts (Know (ClubMemberT (Bind String)))))) (define (spawn-leader [titles : (List String)]) (spawn τc (begin (start-facet get-quotes (field [book-list (List String) (rest titles)] [title String (first titles)]) (define (next-book) (cond [(empty? (ref book-list)) (printf "leader fails to find a suitable book\n") (stop get-quotes)] [#t (set! title (first (ref book-list))) (set! book-list (rest (ref book-list)))])) ;; keep track of book club members (define/query-set members (club-member (bind name String)) name #;#:on-add #;(printf "leader acknowledges member ~a\n" name)) (on (asserted (book-quote (ref title) (bind quantity Int))) (printf "leader learns that there are ~a copies of ~a\n" quantity (ref title)) (cond [(< quantity (+ 1 (set-count (ref members)))) ;; not enough in stock for each member (next-book)] [#t ;; find out if at least half of the members want to read the book (start-facet poll-members (define/query-set yays (book-interest (ref title) (bind name String) #t) name) (define/query-set nays (book-interest (ref title) (bind name String) #f) name) (on (asserted (book-interest (ref title) (bind name String) discard)) ;; count the leader as a 'yay' (when (>= (set-count (ref yays)) (/ (set-count (ref members)) 2)) (printf "leader finds enough affirmation for ~a\n" (ref title)) (stop get-quotes (start-facet announce (assert (book-of-the-month (ref title)))))) (when (> (set-count (ref nays)) (/ (set-count (ref members)) 2)) (printf "leader finds enough negative nancys for ~a\n" (ref title)) (stop poll-members (next-book)))) ;; begin/dataflow is a problem for simulation checking #;(begin/dataflow ;; count the leader as a 'yay' (when (>= (set-count (ref yays)) (/ (set-count (ref members)) 2)) (printf "leader finds enough affirmation for ~a\n" (ref title)) (stop get-quotes (start-facet announce (assert (book-of-the-month (ref title)))))) (when (> (set-count (ref nays)) (/ (set-count (ref members)) 2)) (printf "leader finds enough negative nancys for ~a\n" (ref title)) (stop poll-members (next-book)))))])))))) (define-type-alias member-role (Role (member) (Shares (ClubMemberT String)) ;; should this be the type of the pattern? or lowered to concrete types? (Reacts (Know (Observe (BookInterestT String ★/t ★/t))) (Role (_) (Shares (BookInterestT String String Bool)))))) (define (spawn-club-member [name : String] [titles : (List String)]) (spawn τc (begin (start-facet member ;; assert our presence (assert (club-member name)) ;; respond to polls (during (observe (book-interest (bind title String) discard discard)) (define answer (member? title titles)) (printf "~a responds to suggested book ~a: ~a\n" name title answer) (assert (book-interest title name answer))))))) (run-ground-dataspace τc (spawn-seller (list (tuple "The Wind in the Willows" 5) (tuple "Catch 22" 2) (tuple "Candide" 3))) (spawn-leader (list "The Wind in the Willows" "Catch 22" "Candide" "Encyclopaedia Brittannica")) (spawn-club-member "tony" (list "Candide")) (spawn-club-member "sam" (list "Encyclopaedia Brittannica" "Candide")))