Welcome, guest! Login / Register - Why register?
Psst.. new poll here.
[email protected] webmail now available. Want one? Go here.
Cannot use outlook/hotmail/live here to register as they blocking our mail servers. #microsoftdeez
Obey the Epel!

Paste

Pasted as Plain Text by anonymous ( 14 years ago )
(*
 * initially, create a number of "sources"; every source is a reference to a mutable data structure.
 *
 * after that, wire up your handlers to particular events
 * in the case of form controls you can just give "source" attribute: propagation is automatic
 * I believe this is called data binding.
 *
 * now, you can "render" your sources by wiring them up to <dyn> tags. every such tag is defined
 * by the pure function from sources to signal (a monadic thing, actually)
 * the <dyn> tags propagate updates automatically when any of their inputs changes
 *
 * in other words, "sources" are external stimuli (i.e. inputs), whereas "signals" are outputs
 * FIXME: no, WHAT ARE SIGNALS? why the need for another monad?
 *        oh, I get it: it's for the sake of prohibiting certain effects (okay, which ones?)
 *
 * the programming style is "reactive" in a sense: the programmer is freed
 * from the necessity to imperatively update <dyn> tags
 *)

fun readInt (x:string): int = case read x of
  | Some x => x
  | None => 0

(* let the user sum things up *)
val sumup =
  a <- source "0";
  b <- source "0";
  return <xml><body>
    <label>A: <ctextbox source={a}/></label><br/>
    <label>B: <ctextbox source={b}/></label><br/>
    <p>The sum is: <dyn signal={a' <- signal a; b' <- signal b; return <xml>{[readInt a' + readInt b']}</xml>}/></p>
  </body></xml>

(*
 * class Functor f where fmap :: (a -> b) -> f a -> f b
 * class Functor f => Applicative f where
 *   pure :: a -> f a
 *   (<*>) :: f (a -> b) -> f a -> f b
 *)

(* a demo which allows users to edit a list
 * what do we need to make a list editable?
 * user controls:
 * - a textbox for selecting the current value
 * - a button to cons the current value onto the list
 * - a view on the list (shows what the list is)
 *)

fun showL (xs: list string): xbody = case xs of
    Nil => <xml>Nil</xml>
  | Cons (x, xs) => <xml>{[x]} :: {showL xs}</xml>

(* list editing *)
val listed =
  ls <- source Nil;
  a <- source "";
  return <xml><body>
    <label>Value: <ctextbox source={a}/></label><br/>
    <label>Cons: <button<- get a; ls' <- get ls; set ls (Cons (a', ls'))}/></label><br/>
    <dyn signal={ls' <- signal ls; return (showL ls')}/>
  </body></xml>

datatype either a b = Left of a | Right of b

(* in-place editing *)
(* TODO: extend this by letting users insert new "blocks" -- each block is either a textbox, an image, or ...,
 * and the final result is a list of these
 *)
(* TODO: play with list zippers *)

(* goal: let users manipulate (add/delete/move-via-drag-drop) blocks of text, each block being editable
 * for users, one of the blocks will always be the "selected" one which will have some additional controls exposed:
 * - insert another block thereafter (or before)
 * - move up, move down (if there are any more blocks before or after this one) -- via drag-n-drop
 * - edit or delete
 * users can change their selection when the current block is not being edited (this restriction is meant to minimize confusion)
 *
 * so we need a list with a distinguished element that is under focus
 * also, need ops
 * - to shift this focus left/right
 * - to insert new element to the left or to the right of the focus point
 * - to remove the focused element
 * a zipper of a list is a tuple: {left=list a, foc=a, right=list a}
 *   we can also push sources down: source (zipper a) -> {left=source (list a), foc=source a, right=source (list a)}
 *   and transform list more in this way as well:
 *     list a = Nil | Cons of a * list a  -->
 *     list a = Nil | Cons of a * source (list a)
 * FIXME: how to reconcile this purely functional goodness with the outside imperative world?
 * a <- source (mkZipper ...);
 * a' <- get a;
 * set a (modify a'); -- where modify: zipper a -> zipper a
 * fun render () =
 *   a' <- signal a
 *   return (...)
 *)

fun listeditor () =
  lst <- source (Zipper.mkzipper "foo");
  s <- source "";
  let
    fun app f =
      s' <- get s;
      l' <- get lst;
      set lst (f s' l')
    fun app2 f =
      l' <- get lst;
      case (f l') of
        None => return ()
      | Some x => set lst x
    fun showzipper (z: Zipper.zipper string): signal xbody = let
      val lst = List.mapX (fn x => <xml><li>{[x]}</li></xml>)
    in
      return <xml><ul>
        {lst (Zipper.left z)}
        <li><b>{[Zipper.focus z]}</b></li>
        {lst (Zipper.right z)}
      </ul></xml>
    end
  in
    return <xml><body>
      <label>Text: <ctextbox source={s}/></label>
      <dyn signal={l <- signal lst; showzipper l}/>
      <button>
      <button>
      <button>
      <button>
      <button>
      <button>
    </body></xml>
  end

(* ***************************************************************** *)

datatype rlist t = Nil | Cons of {Data:t, Tail:source (rlist t)}

(*
 * in-place editing: given a paragraph of text, clicking on it turns it into a text-area
 *   with two buttons "apply" and "cancel", both of which, when pressed, turn a text-area
 *   back into a paragraph
 * FIXME: how to write this at all? i need a self-referential definition...
 * the widget depends on it's own [onclick] events, so we need something akin to a [fix]
 *)

(* in-place editable text, x is the starting state *)
fun editbox (x: string): transaction xbody =
  m <- source False;
  t <- source x;
  let
    fun text () =
    t' <- signal t;
    return <xml><div>{[t']}</div></xml>
  in
    return <xml><dyn signal={m' <- signal m;
      return (if m'
        then <xml><ctextbox source={t}/><button></xml>
        else <xml><dyn signal={text ()}/></xml>)}/></xml>
  end

fun editable () = let
  (* editable list *)
  fun editlist (): transaction xbody = let
    (* rendering a mutable list involves traversing it in the signal monad *)
    fun showr (rls: source (rlist xbody)): signal xbody =
      v <- signal rls;
      show' v
    and show' (rl: rlist xbody): signal xbody = return (case rl of
      Nil => <xml/>
    | Cons {Data=ss, Tail=rls} =>
      <xml>{ss}<dyn signal={showr rls}/></xml>)
  in
    head <- source Nil;
    tailP <- source head;
    let
      (* FIXME: these things are buggy! *)
      (* prefix the list (cons) *)
      fun pref () =
        data <- editbox "edit me";
        head' <- get head;
        case head' of
          Nil => t <- source Nil; set head (Cons {Data=data, Tail=t})
        | _ => t <- source head'; set head (Cons {Data=data, Tail=t})

      fun add () =
        data <- editbox "edit me!";
        tail <- get tailP;
        tail' <- source Nil;
        let
          val cons = Cons {Data=data, Tail=tail'}
        in
          set tail cons;
          set tailP tail';
          head' <- get head;
          case head' of
            Nil => set head cons
          | _ => return ()
        end

      (* delete from the beginning of the list *)
      (* TODO: delete from end, delete at arbitrary position *)
      fun delete (): transaction unit =
        head' <- get head;
        case head' of
          Nil => return ()
        | Cons {Data=_, Tail=y} => y' <- get y; set head y'
    in
      return <xml>
        <dyn signal={showr head}/>
        <button value="Add">
        <button value="Cons">
        <button value="Delete">
      </xml>
    end
  end
in
  e1 <- editbox "click to edit this text";
  e2 <- editbox "this one is editable as well";
  el <- editlist ();
  return <xml><body>{e1}{e2}{el}</body></xml>
end

(* ************************************************************************** *)
(* TODO: anything else?
 * list selection -- select one item from the list (since the standard control is lacking ...)
 * client-side CRUD (allow users to edit things in the browser)
 * smooth dragging
 * drag'n'drop (smooth, ala flapjax)
 * image cropping
 * animation
 * ?
 *)


(* ************************************************************************** *)
(* implement the CRUD example (with persistence) on the client side
 * CRUD refers to create-read-update-delete operations on entities, expressed as relations on sets
 * we want to have these operations derived for us automatically, since it's tedious and very repetitive
 *
 * every entity is a table with Id field and other fields, which don't matter at all.
 * that is, for every field we have a serialize/deserialize function (a lense, actually)
 *
 * so this is the task, as it's seen by the user:
 * - provide an interface for creating, reading, updating and deleting entities
 *  - examples of use: generic database administration (you can CRUD on any table),
 *    CMS/blog/forum things (you can CRUD users, posts, comments, categories, tags, etc.)
 *  - this interface shall be generated automatically
 *)

fun crud () = let
  (* FIXME: currently, a call to [rpc] tries to serialize arguments to URL (urlification), this fails for xbody
   * is it possible to use the HTTP POST method here?
   * FIXME: how does ajax form submission work? do we do a GET, PUT, POST or DELETE? what about, say, DB lookups?
   *)
  fun formAction (a:string) (b:int): transaction string =
    return a
in
  a <- source "";
  b <- source 0;
  c <- source "";
  return <xml><body>
    <h1>AJAX forms</h1>
    <div>
      <ctextbox source={a}/>
      <button<- get a; b' <- get b; c' <- rpc (formAction a' b'); set c c'; set a c'}/>
      <dyn signal={c' <- signal c; return <xml>{[c']}</xml>}/>
    </div>
  </body></xml>
end

(* ************************************************************************** *)

(* FIXME: doesn't do what I want *)
(* at the moment, it is only possible to encode the equality constraint, by associating one or more form elements with one source *)
val constr: transaction page =
  a <- source "0";
  b <- source "0";
  (* given two variables A and B and equation A = 2 * B, we can do
   * A <- 2 * B when B changes, and
   * B <- A/2 when A changes
   *)
  return <xml><body>
    <h1>Constraints</h1>
    <p>The values of form controls should obey the equation A = 2 * B</p>
    <label>A: <ctextbox<- get a; set b (show ((readError a') / 2))}/></label>
    <label>B: <ctextbox<- get b; set a (show ((readError b') * 2))}/></label>
  </body></xml>

(* ************************************************************************** *)

fun main () = return <xml><body>
    <p>The <a >sum</a></p>
    <p>The <a >list editing demo</a></p>
    <form>The CRUD: <submit action={crud}/></form>
    <p>In-place <a >editing</a></p>
    <p>Multi-way constraints <a >here</a></p>
    <p>List editing <a >here</a></p>
  </body></xml>

 

Revise this Paste

Your Name: Code Language: