extra/webapps/fjsc/fjsc.factor

   1 ! Copyright (C) 2008 Chris Double. All Rights Reserved.
   2 USING:
   3     accessors
   4     fjsc
   5     furnace
   6     furnace.actions
   7     furnace.boilerplate
   8     furnace.redirection
   9     furnace.utilities
  10     html.forms
  11     http
  12     http.client
  13     http.server
  14     http.server.dispatchers
  15     http.server.responses
  16     http.server.static
  17     io
  18     io.pathnames
  19     io.streams.string
  20     kernel
  21     namespaces
  22     peg
  23     sequences
  24     urls
  25     validators
  26 ;
  27 IN: webapps.fjsc
  28
  29 TUPLE: fjsc < dispatcher ;
  30
  31 : absolute-url ( url -- url )
  32     "http://" request get "host" header append
  33     over "/" head? [ "/" append ] unless
  34     swap append  ;
  35
  36 : do-compile-url ( url -- response )
  37     [
  38         absolute-url http-get nip 'expression' parse
  39         fjsc-compile write "();" write
  40     ] with-string-writer
  41     "application/javascript" <content> ;
  42
  43 : v-local ( string -- string )
  44     dup "http:" head? [ "Unable to compile code from remote sites" throw ] when ;
  45
  46 : validate-compile-url ( -- )
  47     {
  48         { "url" [ v-required v-local ] }
  49     } validate-params ;
  50
  51 : <compile-url-action> ( -- action )
  52     <action>
  53         [ validate-compile-url ] >>validate
  54         [ "url" value do-compile-url ] >>submit
  55         [ validate-compile-url "url" value do-compile-url ] >>display ;
  56
  57 : do-compile ( code -- response )
  58     [
  59         'expression' parse fjsc-compile write
  60     ] with-string-writer
  61     "application/javascript" <content> ;
  62
  63 : validate-compile ( -- )
  64     {
  65         { "code" [ v-required ] }
  66     } validate-params ;
  67
  68 : <compile-action> ( -- action )
  69     <action>
  70         [ validate-compile ] >>validate
  71         [ "code" value do-compile ] >>submit
  72         [ validate-compile "code" value do-compile ] >>display ;
  73
  74 : <main-action> ( -- action )
  75     <page-action>
  76         { fjsc "main" } >>template ;
  77
  78 : <fjsc> ( -- fjsc )
  79     dispatcher new-dispatcher
  80         "extra/webapps/fjsc/www" resource-path <static> "static" add-responder
  81         "extra/fjsc/resources" resource-path <static> "fjsc" add-responder
  82         fjsc new-dispatcher
  83             <main-action> "" add-responder
  84             <compile-action> "compile" add-responder
  85             <compile-url-action> "compile-url" add-responder
  86             <boilerplate>
  87                 { fjsc "fjsc" } >>template
  88          >>default ;
  89
  90 : activate-fjsc ( -- )
  91     <fjsc> main-responder set-global ;