extra/webapps/counter/counter.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: math kernel accessors http.server http.server.dispatchers
   4 furnace furnace.actions furnace.sessions furnace.redirection
   5 html.components html.forms fry urls ;
   6 IN: webapps.counter
   7
   8 SYMBOL: count
   9
  10 TUPLE: counter-app < dispatcher ;
  11
  12 M: counter-app init-session* drop 0 count sset ;
  13
  14 : <counter-action> ( quot -- action )
  15     <action>
  16         swap '[
  17             count _ schange
  18             URL" $counter-app" <redirect>
  19         ] >>submit ;
  20
  21 : <display-action> ( -- action )
  22     <page-action>
  23         [ count sget "counter" set-value ] >>init
  24         { counter-app "counter" } >>template ;
  25
  26 : <counter-app> ( -- responder )
  27     counter-app new-dispatcher
  28         [ 1+ ] <counter-action> "inc" add-responder
  29         [ 1- ] <counter-action> "dec" add-responder
  30         <display-action> "" add-responder ;
  31
  32 ! Deployment example
  33 USING: db.sqlite furnace.alloy namespaces ;
  34
  35 : counter-db ( -- db ) "counter.db" <sqlite-db> ;
  36
  37 : run-counter ( -- )
  38     <counter-app>
  39         counter-db <alloy>
  40         main-responder set-global
  41     8080 httpd ;
  42
  43 MAIN: run-counter