Mercurial > urweb

comparison lib/ur/basis.urs @ 719:5c099b1308ae

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
hello compiles with CSS
author Adam Chlipala <adamc@hcoop.net>
date Sun, 12 Apr 2009 11:08:00 -0400
parents f152f215a02c
children acb8537f58f0
comparison
equal deleted inserted replaced
718:f152f215a02c 719:5c099b1308ae
406 (** XML *) 406 (** XML *)
407 407
408 con css_class :: {Unit} -> Type 408 con css_class :: {Unit} -> Type
409 (* The argument lists categories of properties that this class could set usefully. *) 409 (* The argument lists categories of properties that this class could set usefully. *)
410 410
411 con tag :: {Type} -> {Unit} -> {Unit} -> {Type} -> {Type} -> Type 411 con tag :: {Type} -> {Unit} -> {Unit} -> {Type} -> {Type} -> {Unit} -> Type
412 412 (* Arguments:
413 413 * 1. Attributes
414 con xml :: {Unit} -> {Type} -> {Type} -> Type 414 * 2. Context for this tag
415 val cdata : ctx ::: {Unit} -> use ::: {Type} -> string -> xml ctx use [] 415 * 3. Context for inner XML
416 * 4. Form fields used
417 * 5. Form fields defined
418 * 6. CSS property categories that the tag might use
419 *)
420
421 con xml :: {Unit} -> {Type} -> {Type} -> {Unit} -> Type
422 (* Arguments:
423 * 1. Context
424 * 2. Form fields used
425 * 3. Form fields defined
426 * 4. CSS property categories that this XML fragment might use
427 *)
428
429 con css_subset :: {Unit} -> {Unit} -> Type
430 val css_subset : cs1 ::: {Unit} -> cs2 ::: {Unit} -> [cs1 ~ cs2]
431 => css_subset cs1 (cs1 ++ cs2)
432
433 val cdata : ctx ::: {Unit} -> use ::: {Type} -> css ::: {Unit} -> string -> xml ctx use [] css
416 val tag : attrsGiven ::: {Type} -> attrsAbsent ::: {Type} 434 val tag : attrsGiven ::: {Type} -> attrsAbsent ::: {Type}
417 -> ctxOuter ::: {Unit} -> ctxInner ::: {Unit} 435 -> ctxOuter ::: {Unit} -> ctxInner ::: {Unit}
418 -> useOuter ::: {Type} -> useInner ::: {Type} 436 -> useOuter ::: {Type} -> useInner ::: {Type}
419 -> bindOuter ::: {Type} -> bindInner ::: {Type} 437 -> bindOuter ::: {Type} -> bindInner ::: {Type}
438 -> css ::: {Unit} -> cssOuter ::: {Unit} -> cssInner ::: {Unit}
420 -> [attrsGiven ~ attrsAbsent] => 439 -> [attrsGiven ~ attrsAbsent] =>
421 [useOuter ~ useInner] => 440 [useOuter ~ useInner] =>
422 [bindOuter ~ bindInner] => 441 [bindOuter ~ bindInner] =>
423 $attrsGiven 442 $attrsGiven
424 -> tag (attrsGiven ++ attrsAbsent) 443 -> tag (attrsGiven ++ attrsAbsent)
425 ctxOuter ctxInner useOuter bindOuter 444 ctxOuter ctxInner useOuter bindOuter cssOuter
426 -> xml ctxInner useInner bindInner 445 -> css_subset cssOuter css
427 -> xml ctxOuter (useOuter ++ useInner) (bindOuter ++ bindInner) 446 -> css_subset cssInner css
447 -> xml ctxInner useInner bindInner cssInner
448 -> xml ctxOuter (useOuter ++ useInner) (bindOuter ++ bindInner) css
428 val join : ctx ::: {Unit} 449 val join : ctx ::: {Unit}
429 -> use1 ::: {Type} -> bind1 ::: {Type} -> bind2 ::: {Type} 450 -> use1 ::: {Type} -> bind1 ::: {Type} -> bind2 ::: {Type}
430 -> [use1 ~ bind1] => [bind1 ~ bind2] => 451 -> css ::: {Unit} -> css1 ::: {Unit} -> css2 ::: {Unit}
431 xml ctx use1 bind1 452 -> [use1 ~ bind1] => [bind1 ~ bind2]
432 -> xml ctx (use1 ++ bind1) bind2 453 => xml ctx use1 bind1 css1
433 -> xml ctx use1 (bind1 ++ bind2) 454 -> xml ctx (use1 ++ bind1) bind2 css2
455 -> css_subset css1 css
456 -> css_subset css2 css
457 -> xml ctx use1 (bind1 ++ bind2) css
434 val useMore : ctx ::: {Unit} -> use1 ::: {Type} -> use2 ::: {Type} 458 val useMore : ctx ::: {Unit} -> use1 ::: {Type} -> use2 ::: {Type}
435 -> bind ::: {Type} 459 -> bind ::: {Type} -> css ::: {Unit}
436 -> [use1 ~ use2] => 460 -> [use1 ~ use2] =>
437 xml ctx use1 bind 461 xml ctx use1 bind css
438 -> xml ctx (use1 ++ use2) bind 462 -> xml ctx (use1 ++ use2) bind css
439 463
440 con xhtml = xml [Html] 464 con xhtml = xml [Html]
441 con page = xhtml [] [] 465 con page = xhtml [] []
442 con xbody = xml [Body] [] [] 466 con xbody = xml [Body] [] [] []
443 con xtr = xml [Body, Tr] [] [] 467 con xtr = xml [Body, Tr] [] [] []
444 con xform = xml [Body, Form] [] [] 468 con xform = xml [Body, Form] [] [] []
445 469
446 470
447 (*** HTML details *) 471 (*** HTML details *)
448 472
449 con html = [Html] 473 con html = [Html]
451 con body = [Body] 475 con body = [Body]
452 con form = [Body, Form] 476 con form = [Body, Form]
453 con tabl = [Body, Table] 477 con tabl = [Body, Table]
454 con tr = [Body, Tr] 478 con tr = [Body, Tr]
455 479
456 val dyn : use ::: {Type} -> bind ::: {Type} -> unit 480 val dyn : use ::: {Type} -> bind ::: {Type} -> unit -> css ::: {Unit}
457 -> tag [Signal = signal (xml body use bind)] body [] use bind 481 -> tag [Signal = signal (xml body use bind css)] body [] use bind css
458 482
459 val head : unit -> tag [] html head [] [] 483 val head : unit -> tag [] html head [] [] []
460 val title : unit -> tag [] head [] [] [] 484 val title : unit -> tag [] head [] [] [] []
461 485
462 val body : unit -> tag [Onload = transaction unit] html body [] [] 486 val body : unit -> tag [Onload = transaction unit] html body [] [] []
463 con bodyTag = fn (attrs :: {Type}) => 487 con bodyTag = fn (attrs :: {Type}) =>
464 ctx ::: {Unit} -> 488 ctx ::: {Unit} ->
465 [[Body] ~ ctx] => 489 [[Body] ~ ctx] =>
466 unit -> tag attrs ([Body] ++ ctx) ([Body] ++ ctx) [] [] 490 unit -> tag attrs ([Body] ++ ctx) ([Body] ++ ctx) [] [] []
467 con bodyTagStandalone = fn (attrs :: {Type}) => 491 con bodyTagStandalone = fn (attrs :: {Type}) =>
468 ctx ::: {Unit} 492 ctx ::: {Unit}
469 -> [[Body] ~ ctx] => 493 -> [[Body] ~ ctx] =>
470 unit -> tag attrs ([Body] ++ ctx) [] [] [] 494 unit -> tag attrs ([Body] ++ ctx) [] [] [] []
471 495
472 val br : bodyTagStandalone [] 496 val br : bodyTagStandalone []
473 497
474 val span : bodyTag [] 498 val span : bodyTag []
475 499
490 514
491 val hr : bodyTag [] 515 val hr : bodyTag []
492 516
493 type url 517 type url
494 val bless : string -> url 518 val bless : string -> url
495 val a : bodyTag [Link = transaction page, Href = url, Onclick = transaction unit] 519 val a : css ::: {Unit} -> bodyTag [Link = transaction (page css), Href = url, Onclick = transaction unit]
496 520
497 val img : bodyTag [Src = url] 521 val img : bodyTag [Src = url]
498 522
499 val form : ctx ::: {Unit} -> bind ::: {Type} 523 val form : ctx ::: {Unit} -> bind ::: {Type} -> css ::: {Unit}
500 -> [[Body] ~ ctx] => 524 -> [[Body] ~ ctx] =>
501 xml form [] bind 525 xml form [] bind css
502 -> xml ([Body] ++ ctx) [] [] 526 -> xml ([Body] ++ ctx) [] [] css
503 con formTag = fn (ty :: Type) (inner :: {Unit}) (attrs :: {Type}) => 527 con formTag = fn (ty :: Type) (inner :: {Unit}) (attrs :: {Type}) =>
504 ctx ::: {Unit} 528 ctx ::: {Unit}
505 -> [[Form] ~ ctx] => 529 -> [[Form] ~ ctx] =>
506 nm :: Name -> unit 530 nm :: Name -> unit
507 -> tag attrs ([Form] ++ ctx) inner [] [nm = ty] 531 -> tag attrs ([Form] ++ ctx) inner [] [nm = ty] []
508 val textbox : formTag string [] [Value = string, Size = int, Source = source string] 532 val textbox : formTag string [] [Value = string, Size = int, Source = source string]
509 val password : formTag string [] [Value = string, Size = int] 533 val password : formTag string [] [Value = string, Size = int]
510 val textarea : formTag string [] [Rows = int, Cols = int] 534 val textarea : formTag string [] [Rows = int, Cols = int]
511 535
512 val checkbox : formTag bool [] [Checked = bool] 536 val checkbox : formTag bool [] [Checked = bool]
513 537
514 con radio = [Body, Radio] 538 con radio = [Body, Radio]
515 val radio : formTag string radio [] 539 val radio : formTag string radio []
516 val radioOption : unit -> tag [Value = string] radio [] [] [] 540 val radioOption : unit -> tag [Value = string] radio [] [] [] []
517 541
518 con select = [Select] 542 con select = [Select]
519 val select : formTag string select [] 543 val select : formTag string select []
520 val option : unit -> tag [Value = string, Selected = bool] select [] [] [] 544 val option : unit -> tag [Value = string, Selected = bool] select [] [] [] []
521 545
522 val submit : ctx ::: {Unit} -> use ::: {Type} 546 val submit : ctx ::: {Unit} -> use ::: {Type} -> css ::: {Unit}
523 -> [[Form] ~ ctx] => 547 -> [[Form] ~ ctx] =>
524 unit 548 unit
525 -> tag [Value = string, Action = $use -> transaction page] 549 -> tag [Value = string, Action = $use -> transaction (page css)]
526 ([Form] ++ ctx) ([Form] ++ ctx) use [] 550 ([Form] ++ ctx) ([Form] ++ ctx) use [] []
527 551
552 (*** Tables *)
553
554 val tabl : other ::: {Unit} -> [other ~ [Body, Table]] =>
555 unit -> tag [Border = int] ([Body] ++ other) ([Body, Table] ++ other) [] [] [Table]
556 val tr : other ::: {Unit} -> [other ~ [Body, Table, Tr]] =>
557 unit -> tag [] ([Body, Table] ++ other) ([Body, Tr] ++ other) [] [] []
558 val th : other ::: {Unit} -> [other ~ [Body, Tr]] =>
559 unit -> tag [] ([Body, Tr] ++ other) ([Body] ++ other) [] [] [Cell]
560 val td : other ::: {Unit} -> [other ~ [Body, Tr]] =>
561 unit -> tag [] ([Body, Tr] ++ other) ([Body] ++ other) [] [] [Cell]
562
528 (*** AJAX-oriented widgets *) 563 (*** AJAX-oriented widgets *)
529 564
530 con cformTag = fn (attrs :: {Type}) => 565 con cformTag = fn (attrs :: {Type}) =>
531 ctx ::: {Unit} 566 ctx ::: {Unit}
532 -> [[Body] ~ ctx] => 567 -> [[Body] ~ ctx] =>
533 unit -> tag attrs ([Body] ++ ctx) [] [] [] 568 unit -> tag attrs ([Body] ++ ctx) [] [] [] []
534 569
535 val ctextbox : cformTag [Value = string, Size = int, Source = source string] 570 val ctextbox : cformTag [Value = string, Size = int, Source = source string]
536 val button : cformTag [Value = string, Onclick = transaction unit] 571 val button : cformTag [Value = string, Onclick = transaction unit]
537 572
538 (*** Tables *)
539
540 val tabl : other ::: {Unit} -> [other ~ [Body, Table]] =>
541 unit -> tag [Border = int] ([Body] ++ other) ([Body, Table] ++ other) [] []
542 val tr : other ::: {Unit} -> [other ~ [Body, Table, Tr]] =>
543 unit -> tag [] ([Body, Table] ++ other) ([Body, Tr] ++ other) [] []
544 val th : other ::: {Unit} -> [other ~ [Body, Tr]] =>
545 unit -> tag [] ([Body, Tr] ++ other) ([Body] ++ other) [] []
546 val td : other ::: {Unit} -> [other ~ [Body, Tr]] =>
547 unit -> tag [] ([Body, Tr] ++ other) ([Body] ++ other) [] []
548
549 573
550 (** Aborting *) 574 (** Aborting *)
551 575
552 val error : t ::: Type -> xml [Body] [] [] -> t 576 val error : t ::: Type -> xml [Body] [] [] [] -> t
553
554