1. Alex Suraci
  2. web

Commits

Alex Suraci  committed 2a90b9b

initial record

  • Participants
  • Branches default

Comments (0)

Files changed (6)

File combinators.atomo

View file
+use: "ehtml"
+
+CHTML = HTML clone
+
+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 :=
+  send: { url | c do: { form: body action: url method: "post" } } next: page
+
+(c: CHTML) link: (str: String) to: page :=
+  send: { url | c do: { a: str href: url } } next: page
+
+
+(w: Website) send/suspend: (body: Block) :=
+  { cc |
+    w connection respond-to: *request* _? with:
+      (w send: body next: { cc yield: @ok })
+
+    w finish yield: @ok
+  } call/cc
+
+(w: Website) send: (body: Block) next: (next: Block) :=
+  { cc = { r | with: [*request* -> r] do: { next web: w } }
+  
+    id = uuid!
+    ccs =
+      *continuations* _? (lookup: w user-id) match: {
+        @none -> [id -> cc]
+        @(ok: ccs) -> ccs set: id to: cc
+      }
+
+    *continuations* =! *continuations* _? set: w user-id to: ccs
+
+    body call: ["/continue?id=" .. id]
+  } call
+
+(w: Website) respond-with: (body: String) :=
+  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 :=
+  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: Website) parameter: (name: String) :=
+  *request* _? parameter: name
+
+super join: {
+  send: (body: Block) next: (next: Block) :=
+    *website* _? send: body next: next
+
+  send/suspend: (body: Block) :=
+    *website* _? send/suspend: body
+
+  respond-with: (body: String) :=
+    *website* _? respond-with: body
+
+  form: (body: Block) action: page :=
+    *website* _? form: body action: page
+
+  link: (text: String) to: page :=
+    *website* _? link: text to: page
+
+  parameter: (name: String) :=
+    *website* _? parameter: name
+}

File core.atomo

View file
+define: *website* as: @no-website
+define: *request* as: @no-request
+define: *continuations* as: []
+
+super Website = M2 Handler clone do:
+  { headers = []
+  }
+
+(w: Website) new := w clone
+
+(w: Website) new: (routes: List) :=
+  { n = w new
+
+    routes each:
+      { route |
+        evaluate: `((w: { n }) run: { route from } := ~(route to) web: w) expand
+      }
+
+    n
+  } call
+
+(w: Website) bind: (os: List) :=
+  [os lookup: @id, os lookup: @from, os lookup: @to] match: {
+    [@(ok: id), @(ok: from), @(ok: to)] ->
+      w new: id from: from to: to
+
+    _ -> error: @incomplete-options
+  }
+
+(w: Website) run: _ :=
+  w respond-with: "404 Not Found" status: 404
+(w: Website) run: "/continue" :=
+  *continuations* _? (lookup: w user-id) match: {
+    @none ->
+      w respond-with: "no continuations" status: 500
+
+    @(ok: cs) ->
+      cs (lookup: (w parameter: "id")) match: {
+        @none -> w respond-with: "unknown continuation" status: 500
+        @(ok: cont) ->
+          { *continuations* =! *continuations* _? filter: { c | c from /= w user-id }
+            cont call: [*request* _?]
+          } call
+      }
+  }
+
+(w: Website) set-cookie: (name: String) to: (val: String) :=
+  { w headers = w headers .. [@Set-Cookie -> (name .. "=" .. val)]
+    *request* _? headers Cookie = (name .. "=" .. val)
+    val
+  } call
+
+-- TODO: handle multiple cookies, check cookie name
+(w: Website) cookie: (name: String) :=
+  if: *request* _? headers (responds-to?: @cookie)
+    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!)
+    @(ok: uuid) -> uuid
+  }
+
+(w: Website) process: (r: M2 Request) :=
+  { responder = w clone
+
+    with: *website* as: responder do: {
+      w connection respond-to: r with: "hi!"
+    }
+  } call
+  --{ responder = w clone
+    --with: [
+      --*website* -> responder
+      --*request* -> r
+    --] do: {
+      --{ responder run: r path } catch: { e |
+        --responder respond-with: (html: { pre: ("server error:\n\n" .. e describe-error) })
+      --}
+    --}
+  --} call
+
+(b: Block) web: (w: Website) :=
+  { cc |
+    with: *website* as: (w do: { finish = cc }) do: {
+      respond-with: (html: b)
+    }
+  } call/cc

File example.atomo

View file
+use: "web"
+
+Site = Website new: [
+  "/" -> { cdata: "hi!" }
+
+  "/test" ->
+    { h1: "hi!"
+
+      form: {
+        input: "foo"
+        submit
+      } action: {
+        foo = parameter: "foo"
+        p: "perhaps you should..."
+        link: "click here" to: {
+          link: "down the rabbit hole..." to: {
+            link: "how far does it go?" to: {
+              p: ("you said: " .. foo)
+            }
+          }
+        }
+
+        link: "no, here!" to: {
+          p: "good choice."
+        }
+      }
+    }
+]
+
+test =
+  Site bind: [
+    @id -> "f284b010-ef92-11df-98cf-0800200c9a66"
+    @from -> "tcp://127.0.0.1:9997"
+    @to -> "tcp://127.0.0.1:9996"
+  ]
+
+"running" print
+{ test listen } spawn

File main.atomo

View file
+M2 = use: "mongrel2"
+
+require: "uuid"
+require: "core"
+require: "combinators"

File package.eco

View file
+name: "web"
+description: "experimental mongrel2 web framework"
+author: "Alex Suraci"
+version: (0 . 1)
+include:
+  [ "core.atomo"
+    "combinators.atomo"
+    "uuid.hs"
+  ]
+depends-on:
+  [ "ehtml"
+    "mongrel2"
+  ]

File uuid.hs

View file
+{-# LANGUAGE QuasiQuotes #-}
+import Atomo
+
+import System.UUID.V4
+
+load =
+    [$p|uuid!|] =: fmap (string . show) (liftIO uuid)