prompt.arc

; Prompt: Web-based programming application.  4 Aug 06.

(= appdir* "arc/apps/")

(defop prompt req 
  (let user (get-user req)
    (if (admin user)
        (prompt-page user)
        (pr "Sorry."))))

(def prompt-page (user . msg)
  (ensure-dir appdir*)
  (ensure-dir (string appdir* user))
  (whitepage
    (prbold "Prompt")
    (hspace 20)
    (pr user " | ")
    (link "logout")
    (when msg (hspace 10) (apply pr msg))
    (br2)
    (tag (table border 0 cellspacing 10)
      (each app (dir (+ appdir* user))
        (tr (td app)
            (td (ulink user 'edit   (edit-app user app)))
            (td (ulink user 'run    (run-app  user app)))
            (td (hspace 40)
                (ulink user 'delete (rem-app  user app))))))
    (br2)
    (aform (fn (req)
             (when-umatch user req
               (aif (goodname (arg req "app"))
                    (edit-app user it)
                    (prompt-page user "Bad name."))))
       (tab (row "name:" (input "app") (submit "create app"))))))

(def app-path (user app) 
  (and user app (+ appdir* user "/" app)))

(def read-app (user app)
  (aand (app-path user app) 
        (file-exists it)
        (readfile it)))

(def write-app (user app exprs)
  (awhen (app-path user app)
    (w/outfile o it 
      (each e exprs (write e o)))))

(def rem-app (user app)
  (let file (app-path user app)
    (if (file-exists file)
        (do (rmfile (app-path user app))
            (prompt-page user "Program " app " deleted."))
        (prompt-page user "No such app."))))

(def edit-app (user app)
  (whitepage
    (pr "user: " user " app: " app)
    (br2)
    (aform (fn (req)
             (let u2 (get-user req)
               (if (is u2 user)
                   (do (when (is (arg req "cmd") "save")
                         (write-app user app (readall (arg req "exprs"))))
                       (prompt-page user))
                   (login-page 'both nil
                               (fn (u ip) (prompt-page u))))))
      (textarea "exprs" 10 82
        (pprcode (read-app user app)))
      (br2)
      (buts 'cmd "save" "cancel"))))

(def pprcode (exprs) 
  (each e exprs
    (ppr e) 
    (pr "\n\n")))

(def view-app (user app)
  (whitepage
    (pr "user: " user " app: " app)
    (br2)
    (tag xmp (pprcode (read-app user app)))))

(def run-app (user app)
  (let exprs (read-app user app)
    (if exprs 
        (on-err (fn (c) (pr "Error: " (details c)))
          (fn () (map eval exprs)))
        (prompt-page user "Error: No application " app " for user " user))))

(or= repl-history* nil)

(= repl-history-max* 10000)

(defop repl req
  (if (admin (get-user req))
      (replpage req)
      (pr "Sorry.")))

(def replpage (req)
  (whitepage
    (repl (readall (or (arg req "expr") "")) "repl")))

(def repl (exprs url)
    (each expr exprs 
      (on-err (fn (c) (push (list expr c t) repl-history*))
              (fn () 
                (= that (eval expr) thatexpr expr)
                (push (list expr that) repl-history*))))
    (form url
      (textarea "expr" 8 60
        (write:caar repl-history*))
      (sp) 
      (submit))
    (tag xmp
      (each (expr val err) (firstn repl-history-max* repl-history*)
        (pr "> ")
        (ppr expr)
        (prn)
        (prn (if err "Error: " "")
             (ellipsize (tostring (write val)) 800)))))