;;; Copyright 2022 Christine Lemmer-Webber
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;;    http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

(define-module (test-goblins-blog)
  #:use-module (goblins)
  #:use-module (srfi srfi-64)
  #:use-module (ice-9 match)
  #:use-module (ice-9 regex)
  #:use-module (goblins-blog))

(test-begin "test-goblins-blog")

(define am (make-actormap))
(define-syntax-rule (am-run body ...)
  (actormap-churn-run!
   am
   (lambda ()
     body ...)))

#|
#+BEGIN_SRC wisp
  REPL> define-values (day-in-park-post day-in-park-editor)
  _____   spawn-post-and-editor
  _____     #:title "A Day in the Park"
  _____     #:author "Lauren Ipsdale"
  _____     #:body "It was a good day to take a walk..."
#+END_SRC
|#

(define-values (day-in-park-post day-in-park-editor)
  (am-run
   (spawn-post-and-editor
    #:title "A Day in the Park"
    #:author "Lauren Ipsdale"
    #:body "It was a good day to take a walk...")))

#|
#+BEGIN_SRC wisp
  REPL> display-post day-in-park-post
#+END_SRC
|#

(test-equal "\
A Day in the Park
=================
  By: Lauren Ipsdale

It was a good day to take a walk...
"
  (with-output-to-string
    (lambda ()
      (am-run
       (display-post day-in-park-post)))))
#|
#+BEGIN_SRC wisp
  REPL> $ day-in-park-editor 'update
  _____   #:body "It was a fine day to take a walk..."
#+END_SRC
|#

(am-run ($ day-in-park-editor 'update
           #:body "It was a fine day to take a walk..."))

(test-equal "\
A Day in the Park
=================
  By: Lauren Ipsdale

It was a fine day to take a walk...
"
  (with-output-to-string
    (lambda ()
      (am-run
       (display-post day-in-park-post)))))

#|
#+BEGIN_SRC wisp
REPL> define-values (maple-valley-blog maple-valley-admin)
_____   spawn-blog-and-admin "Maple Valley News"
#+END_SRC
|#

(define-values (maple-valley-blog maple-valley-admin)
  (am-run
   (spawn-blog-and-admin "Maple Valley News")))

#|
#+BEGIN_SRC wisp
REPL> $ maple-valley-blog 'get-posts
; => ()
#+END_SRC
|#

(test-equal '()
  (am-run ($ maple-valley-blog 'get-posts)))

#|
#+BEGIN_SRC wisp
  REPL> $ maple-valley-admin 'add-post day-in-park-post
  REPL> $ maple-valley-blog 'get-posts
  ; => (#<local-object ^post>)
#+END_SRC
|#

(am-run ($ maple-valley-admin 'add-post day-in-park-post))

(let ((blogposts (am-run ($ maple-valley-blog 'get-posts))))
  (test-equal 1 (length blogposts))
  (test-eq day-in-park-post (car blogposts)))

#|
#+BEGIN_SRC wisp
  REPL> display-blog maple-valley-blog
#+END_SRC
|#

(test-equal "\
***********************
** Maple Valley News **
***********************

A Day in the Park
=================
  By: Lauren Ipsdale

It was a fine day to take a walk...

"
  (with-output-to-string
    (lambda ()
      (am-run
       (display-blog maple-valley-blog)))))

#|
#+BEGIN_SRC wisp
  ;; Run by Robert:
  REPL> define-values (spelling-bee-post spelling-bee-editor)
  _____  spawn-post-and-editor
  _____    #:title "Spelling Bee a Success"
  _____    #:author "Robert Busyfellow"
  _____    #:body "Maple Valley School held its annual spelling bee..."
#+END_SRC
|#

(define-values (spelling-bee-post spelling-bee-editor)
  (am-run
   (spawn-post-and-editor
    #:title "Spelling Bee a Success"
    #:author "Robert Busyfellow"
    #:body "Maple Valley School held its annual spelling bee...")))

#|
#+BEGIN_SRC wisp
  ;; Run by Robert:
  REPL> $ spelling-bee-editor 'update
  _____   #:title "Town Buzzing About Spelling Bee"
#+END_SRC
|#

(am-run
 ($ spelling-bee-editor 'update
    #:title "Town Buzzing About Spelling Bee"))

#|
#+BEGIN_SRC wisp
  REPL> $ maple-valley-admin 'add-post spelling-bee-post
#+END_SRC
|#

(am-run
 ($ maple-valley-admin 'add-post spelling-bee-post))

#|
#+BEGIN_SRC wisp
  REPL> display-blog maple-valley-blog
#+END_SRC
|#

(test-equal "\
***********************
** Maple Valley News **
***********************

Town Buzzing About Spelling Bee
===============================
  By: Robert Busyfellow

Maple Valley School held its annual spelling bee...


A Day in the Park
=================
  By: Lauren Ipsdale

It was a fine day to take a walk...

"
  (with-output-to-string
    (lambda ()
      (am-run
       (display-blog maple-valley-blog)))))

#|
#+BEGIN_SRC wisp
   REPL> define-values (bumpy-ride-post bumpy-ride-editor)
   _____   spawn-adminable-post-and-editor
   _____     . maple-valley-admin
   _____     #:title "Main Street's Bumpy Ride"
   _____     #:author "Lauren Ipsdale"
#+END_SRC
|#

;;; Okay, this one requires some re-setup with the new code
(define-values (new-maple-valley-blog new-maple-valley-admin)
  (am-run
   (new-spawn-blog-and-admin "Maple Valley News")))

(define-values (bumpy-ride-post bumpy-ride-editor)
  (am-run
   (spawn-adminable-post-and-editor
    new-maple-valley-admin
    #:title "Main Street's Bumpy Ride"
    #:author "Lauren Ipsdale")))

#|
#+BEGIN_SRC wisp
  REPL> $ maple-valley-admin 'edit-post
  _____   . bumpy-ride-post
  _____   #:body "Anyone who's driven on main street recently..."
#+END_SRC
|#

(am-run
 ($ new-maple-valley-admin 'edit-post
    bumpy-ride-post
    #:body "Anyone who's driven on main street recently..."))

(am-run
 ($ new-maple-valley-admin 'add-post bumpy-ride-post))

#|
#+BEGIN_SRC wisp
REPL> define admin-log
_____   spawn ^logger
#+END_SRC
|#

(define admin-log
  (am-run
   (spawn ^logger)))

#|
#+BEGIN_SRC wisp
REPL> define-values (admin-for-robert roberts-admin-revoked?)
_____   spawn-logged-revocable-proxy-pair
_____     . "Robert"            ; username Lauren holds responsible
_____     . maple-valley-admin  ; object to proxy
_____     . admin-log           ; log to write to
#+END_SRC
|#

(define-values (admin-for-robert roberts-admin-revoked?)
  (am-run
   (spawn-logged-revocable-proxy-pair
    "Robert"                ; username Lauren holds responsible
    new-maple-valley-admin  ; object to proxy
    admin-log)))            ; log to write to

#|
#+BEGIN_SRC wisp
REPL> <- admin-for-robert 'edit-post bumpy-ride-post
_____    #:title "Main Street Takes Some Bumps"
#+END_SRC
|#

(am-run
 (<- admin-for-robert 'edit-post bumpy-ride-post
     #:title "Main Street Takes Some Bumps"))

#|
#+BEGIN_SRC wisp
  REPL> $ admin-log 'get-log
  ; => ((*entry*
  ;      user "Robert"
  ;      object #<local-object ^admin>
  ;      args (edit-post #<local-object ^post>
  ;            #:title "Main Street Takes Some Bumps")))
#+END_SRC
|#

(define log-state1
  (am-run
   ($ admin-log 'get-log)))

(test-assert (match (car log-state1)
               (('*entry*
                 'user "Robert"
                 'object (? local-object-refr?)
                 'args ('edit-post (? local-object-refr?)
                                   #:title "Main Street Takes Some Bumps"))
                #t)))

#|
#+BEGIN_SRC wisp
REPL> $ roberts-admin-revoked? 'set #t
#+END_SRC
|#

(am-run ($ roberts-admin-revoked? 'set #t))

(define promise-result #f)

(test-error #t
            (actormap-churn-run!
             am
             (lambda ()
               (<- admin-for-robert 'edit-post bumpy-ride-post
                   #:title "Main Street Even More Bumps"))
             #:catch-errors? #f))

#|
#+BEGIN_SRC wisp
REPL> $ roberts-admin-revoked? 'set #f
#+END_SRC
|#

(am-run ($ roberts-admin-revoked? 'set #f))

(actormap-churn-run!
 am
 (lambda ()
   (<- admin-for-robert 'edit-post bumpy-ride-post
       #:title "Main Street's Bumpy Ride"))  ; "... And Lauren Is Great
 #:catch-errors? #f)                         ;      I'm Sorry Lauren"

(test-equal "\
Main Street's Bumpy Ride
========================
  By: Lauren Ipsdale

Anyone who's driven on main street recently...
"
  (with-output-to-string
    (lambda ()
      (am-run
       (display-post bumpy-ride-post)))))

#|
#+BEGIN_SRC wisp
  ;; Robert's interactions
  REPL> define-values (science-fair-post science-fair-editor science-fair-reviewer)
  _____   spawn-post-guest-editor-and-reviewer "Matilda Sample" admin-for-robert
#+END_SRC
|#

(define-values (science-fair-post science-fair-editor science-fair-reviewer)
  (am-run
   (spawn-post-guest-editor-and-reviewer "Matilda Sample" admin-for-robert)))

#|
#+BEGIN_SRC wisp
  ;; Matilda's interactions
  REPL> <- science-fair-editor 'set-body
  _____    . "My name is Matilda and I am twelve. I won the science fair..."
#+END_SRC
|#

(am-run
 (<- science-fair-editor 'set-body
     "My name is Matilda and I am twelve. I won the science fair..."))

#|
#+BEGIN_SRC wisp
  ;; Matilda's interactions
  REPL> <- science-fair-editor 'set-title
  _____    . "Winning the Middle School Science Fair: A Personal Account"
  REPL> <- science-fair-editor 'set-body
  _____    . "At twelve years old, winning the local science fair has been..."
#+END_SRC
|#

(am-run
 (<- science-fair-editor 'set-title
     "Winning the Middle School Science Fair: A Personal Account"))
(am-run
 (<- science-fair-editor 'set-body
     "At twelve years old, winning the local science fair has been..."))

#|
#+BEGIN_SRC wisp
  ;; Teacher's interactions
  REPL> <- science-fair-reviewer 'approve
#+END_SRC
|#

(am-run
 (<- science-fair-reviewer 'approve))

;; can't change things after approved
(test-error #t
            (actormap-churn-run!
             am
             (lambda ()
               (<- science-fair-editor 'set-title
                   "I'm feeling frustrated! Article sabotage!"))
             #:catch-errors? #f))

#|
#+BEGIN_SRC wisp
  ;; Widely runnable (by blog readers and those they share it with)
  REPL> display-blog maple-valley-blog
#+END_SRC
|#

(test-equal "\
***********************
** Maple Valley News **
***********************

Winning the Middle School Science Fair: A Personal Account
==========================================================
  By: Matilda Sample

At twelve years old, winning the local science fair has been...


Main Street's Bumpy Ride
========================
  By: Lauren Ipsdale

Anyone who's driven on main street recently...

"
  (with-output-to-string
    (lambda ()
      (am-run (display-blog new-maple-valley-blog)))))

(test-end "test-goblins-blog")