Commits

Alex Suraci  committed 0af68bf

* CHTML -> Page
* reorganization & cleanups
* added @website: macro which defines the website, or just redefines its routes
if it's already defined (useful for reloading the file to update at runtime)
* user-id -> session-id

  • Participants
  • Parent commits ab06129

Comments (0)

Files changed (4)

File combinators.atomo

 use: "ehtml"
 
-CHTML = HTML clone
+require: "page"
 
-html: x := CHTML (new: x) as: String
 
-(c: HTML) submit :=
-  c submit: "submit"
-(c: HTML) submit: (name: String) :=
-  c input type: "submit" value: name
-
-(c: HTML) input: (name: String) :=
-  c input name: name
-
-(c: CHTML) form: (body: Block) action: (page: Block) :=
-  continue: { url | c do: { form: body action: url method: "post" } } next: page
-
-(c: CHTML) link: (str: String) to: (page: Block) :=
-  continue: { url | c do: { a: str href: url } } next: page
-
-(c: CHTML) prompt: (body: Block) :=
-  *request* =! send/suspend: { url |
-    c clone do: body with: [url]
-  }
-
+-- send a body, finishing early and setting the continuation to pick up from
+-- this point on
 (w: Website) send/suspend: (body: Block) :=
   { cc |
     w connection respond-to: *request* _? with:
     w finish yield: @ok
   } call/cc
 
+-- create a continuation and pass a URL for it to the block
 (w: Website) continue: (body: Block) next: (next: Block) :=
   { cc = { r | with: [*request* -> r] do: { next web: w } }
-  
+
     id = uuid!
     ccs =
-      w continuations (lookup: w user-id) match: {
+      w continuations (lookup: w session-id) match: {
         @none -> [id -> cc]
         @(ok: ccs) -> ccs set: id to: cc
       }
 
-    w super continuations = w continuations set: w user-id to: ccs
+    w super continuations = w continuations set: w session-id to: ccs
 
     body call: ["/continue?id=" .. id]
   } call
   w connection respond-to: *request* _? with: body headers: w headers
 
 (w: Website) respond-with: (body: String) status: (status: Integer) :=
-  w connection respond-to: *request* _? with: body headers: w headers status: status
-
-(w: Website) form: (body: Block) action: (page: Block) :=
-  with: *request* as: (send/suspend: { url | html: { form: body action: url method: "post" } }) do: {
-    page web: w
-  }
-
-(w: Website) link: (str: String) to: page :=
-  with: *request* as: (send/suspend: { url | html: { a: str href: url } }) do: {
-    page web: w
-  }
+  w connection respond-to: *request* _?
+                 with: body
+                 headers: w headers
+                 status: status
 
 (w: Website) parameter: (name: String) :=
   *request* _? parameter: name
 
+(w: Website) not-found :=
+  w respond-with: "404 Not Found" status: 404
+
 super join: {
-  continue: (body: Block) next: (next: Block) :=
-    *website* _? continue: body next: next
-
   send/suspend: (body: Block) :=
     *website* _? send/suspend: body
 
   respond-with: (body: String) :=
     *website* _? respond-with: body
 
-  form: (body: Block) action: (page: Block) :=
-    *website* _? form: body action: page
+  parameter: (name: String) :=
+    *request* _? parameter: name
 
-  link: (text: String) to: page :=
-    *website* _? link: text to: page
+  session-id :=
+    *website* session-id
 
-  parameter: (name: String) :=
-    *website* _? parameter: name
+  not-found :=
+    *website* not-found
 }
     continuations = []
   }
 
-(w: Website) new := w clone
+html: x := Page (new: x) as: String
 
-(w: Website) new: (routes: List) :=
-  { n = w new
+-- define a website; if it's already defined, redefine its routes
+macro (website: (define: Dispatch))
+  { name = Particle new: define names head
+    d = `Dispatch new: name to: ['this]
 
-    routes each:
-      { route |
-        evaluate: `((w: { n }) run: { route from } := ~(route to) web: w) expand
+    define-routes = define targets (at: 1) contents map:
+      { `(~route -> ~action) |
+        `((w: { ~d }) run: ~route := ~action web: w)
       }
 
-    n
+    `(if: (responds-to?: ~name)
+        then: ~(`Block new: define-routes)
+        else: {
+          ~d = Website new
+          ~(`Block new: define-routes) call
+          ~d
+        } in-context)
   } call
 
+(w: Website) new := w clone
+
 (w: Website) bind: (os: List) :=
   [os lookup: @id, os lookup: @from, os lookup: @to] match: {
     [@(ok: id), @(ok: from), @(ok: to)] ->
     _ -> error: @incomplete-options
   }
 
-(w: Website) run: _ :=
-  w respond-with: "404 Not Found" status: 404
+(w: Website) run: _ := w not-found
 (w: Website) run: "/continue" :=
-  w continuations (lookup: w user-id) match: {
+  w continuations (lookup: w session-id) match: {
     @none ->
       w respond-with: "no continuations" status: 500
 
         @none -> w respond-with: "unknown continuation" status: 500
         @(ok: cont) ->
           { w super continuations =
-              w continuations filter: { c | c from /= w user-id }
+              w continuations filter: { c | c from /= w session-id }
 
             cont call: [*request* _?]
           } call
     then: { @(ok: *request* _? headers cookie (split-on: $=) last) }
     else: { @none }
 
-(w: Website) user-id :=
-  (w cookie: "user-id") match: {
-    @none -> (w set-cookie: "user-id" to: uuid!)
+(w: Website) session-id :=
+  (w cookie: "session-id") match: {
+    @none -> (w set-cookie: "session-id" to: uuid!)
     @(ok: uuid) -> uuid
   }
 
       respond-with: (html: b)
     }
   } call/cc
+
+(w: Website) listen: (options: List) :=
+  (w bind: options) listen
 include:
   [ "core.atomo"
     "combinators.atomo"
+    "page.atomo"
     "uuid.hs"
   ]
 depends-on:
+Page = HTML clone
+
+(c: Page) submit :=
+  c submit: "submit"
+(c: Page) submit: (name: String) :=
+  c input type: "submit" value: name
+
+(c: Page) input: (name: String) :=
+  c input name: name
+
+(c: Page) password: (name: String) :=
+  c input type: "password" name: name
+
+(c: Page) prompt: (body: Block) :=
+  *request* =! send/suspend: { url |
+    c clone do: body with: [url]
+  }
+
+(c: Page) redirect-to: (location: String) :=
+  *website* do:
+    { headers = headers .. [@Location -> location]
+      respond-with: "" status: 303
+      finish yield: @ok
+    }
+
+(c: Page) form: (body: Block) action: (page: Block) :=
+  *website* continue: { url | c form: body action: url method: "post" } next: page
+
+(c: Page) link: (str: String) to: (page: Block) :=
+  *website* continue: { url | c a: str href: url } next: page
+
+(c: Page) continue: (page: Block) to: (next: Block) :=
+  *website* continue: { url | c do: page with: [url] } next: next