From 84168a777e28ab53917bc3ed448cc90e6b00a4ed Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 12 Apr 2009 12:31:54 -0400 Subject: Stop tracking CSS classes in XML types --- lib/ur/basis.urs | 124 +++++++++++++++++++++++-------------------------------- 1 file changed, 51 insertions(+), 73 deletions(-) (limited to 'lib/ur/basis.urs') diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 7a55d8e4..9eeb4891 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -408,64 +408,40 @@ val nextval : sql_sequence -> transaction int con css_class :: {Unit} -> Type (* The argument lists categories of properties that this class could set usefully. *) -con tag :: {Type} -> {Unit} -> {Unit} -> {Type} -> {Type} -> {Unit} -> Type -(* Arguments: - * 1. Attributes - * 2. Context for this tag - * 3. Context for inner XML - * 4. Form fields used - * 5. Form fields defined - * 6. CSS property categories that the tag might use - *) - -con xml :: {Unit} -> {Type} -> {Type} -> {Unit} -> Type -(* Arguments: - * 1. Context - * 2. Form fields used - * 3. Form fields defined - * 4. CSS property categories that this XML fragment might use - *) - -con css_subset :: {Unit} -> {Unit} -> Type -val css_subset : cs1 ::: {Unit} -> cs2 ::: {Unit} -> [cs1 ~ cs2] - => css_subset cs1 (cs1 ++ cs2) - -val cdata : ctx ::: {Unit} -> use ::: {Type} -> css ::: {Unit} -> string -> xml ctx use [] css +con tag :: {Type} -> {Unit} -> {Unit} -> {Type} -> {Type} -> Type + + +con xml :: {Unit} -> {Type} -> {Type} -> Type +val cdata : ctx ::: {Unit} -> use ::: {Type} -> string -> xml ctx use [] val tag : attrsGiven ::: {Type} -> attrsAbsent ::: {Type} -> ctxOuter ::: {Unit} -> ctxInner ::: {Unit} -> useOuter ::: {Type} -> useInner ::: {Type} -> bindOuter ::: {Type} -> bindInner ::: {Type} - -> css ::: {Unit} -> cssOuter ::: {Unit} -> cssInner ::: {Unit} -> [attrsGiven ~ attrsAbsent] => [useOuter ~ useInner] => [bindOuter ~ bindInner] => $attrsGiven -> tag (attrsGiven ++ attrsAbsent) - ctxOuter ctxInner useOuter bindOuter cssOuter - -> css_subset cssOuter css - -> css_subset cssInner css - -> xml ctxInner useInner bindInner cssInner - -> xml ctxOuter (useOuter ++ useInner) (bindOuter ++ bindInner) css + ctxOuter ctxInner useOuter bindOuter + -> xml ctxInner useInner bindInner + -> xml ctxOuter (useOuter ++ useInner) (bindOuter ++ bindInner) val join : ctx ::: {Unit} - -> use1 ::: {Type} -> bind1 ::: {Type} -> bind2 ::: {Type} - -> css ::: {Unit} -> css1 ::: {Unit} -> css2 ::: {Unit} - -> [use1 ~ bind1] => [bind1 ~ bind2] - => xml ctx use1 bind1 css1 - -> xml ctx (use1 ++ bind1) bind2 css2 - -> css_subset css1 css - -> css_subset css2 css - -> xml ctx use1 (bind1 ++ bind2) css + -> use1 ::: {Type} -> bind1 ::: {Type} -> bind2 ::: {Type} + -> [use1 ~ bind1] => [bind1 ~ bind2] => + xml ctx use1 bind1 + -> xml ctx (use1 ++ bind1) bind2 + -> xml ctx use1 (bind1 ++ bind2) val useMore : ctx ::: {Unit} -> use1 ::: {Type} -> use2 ::: {Type} - -> bind ::: {Type} -> css ::: {Unit} + -> bind ::: {Type} -> [use1 ~ use2] => - xml ctx use1 bind css - -> xml ctx (use1 ++ use2) bind css + xml ctx use1 bind + -> xml ctx (use1 ++ use2) bind con xhtml = xml [Html] con page = xhtml [] [] -con xbody = xml [Body] [] [] [] -con xtr = xml [Body, Tr] [] [] [] -con xform = xml [Body, Form] [] [] [] +con xbody = xml [Body] [] [] +con xtr = xml [Body, Tr] [] [] +con xform = xml [Body, Form] [] [] (*** HTML details *) @@ -477,21 +453,21 @@ con form = [Body, Form] con tabl = [Body, Table] con tr = [Body, Tr] -val dyn : use ::: {Type} -> bind ::: {Type} -> unit -> css ::: {Unit} - -> tag [Signal = signal (xml body use bind css)] body [] use bind css +val dyn : use ::: {Type} -> bind ::: {Type} -> unit + -> tag [Signal = signal (xml body use bind)] body [] use bind -val head : unit -> tag [] html head [] [] [] -val title : unit -> tag [] head [] [] [] [] +val head : unit -> tag [] html head [] [] +val title : unit -> tag [] head [] [] [] -val body : unit -> tag [Onload = transaction unit] html body [] [] [] +val body : unit -> tag [Onload = transaction unit] html body [] [] con bodyTag = fn (attrs :: {Type}) => ctx ::: {Unit} -> [[Body] ~ ctx] => - unit -> tag attrs ([Body] ++ ctx) ([Body] ++ ctx) [] [] [] + unit -> tag attrs ([Body] ++ ctx) ([Body] ++ ctx) [] [] con bodyTagStandalone = fn (attrs :: {Type}) => ctx ::: {Unit} -> [[Body] ~ ctx] => - unit -> tag attrs ([Body] ++ ctx) [] [] [] [] + unit -> tag attrs ([Body] ++ ctx) [] [] [] val br : bodyTagStandalone [] @@ -516,19 +492,19 @@ val hr : bodyTag [] type url val bless : string -> url -val a : css ::: {Unit} -> bodyTag [Link = transaction (page css), Href = url, Onclick = transaction unit] +val a : bodyTag [Link = transaction page, Href = url, Onclick = transaction unit] val img : bodyTag [Src = url] -val form : ctx ::: {Unit} -> bind ::: {Type} -> css ::: {Unit} +val form : ctx ::: {Unit} -> bind ::: {Type} -> [[Body] ~ ctx] => - xml form [] bind css - -> xml ([Body] ++ ctx) [] [] css + xml form [] bind + -> xml ([Body] ++ ctx) [] [] con formTag = fn (ty :: Type) (inner :: {Unit}) (attrs :: {Type}) => ctx ::: {Unit} -> [[Form] ~ ctx] => nm :: Name -> unit - -> tag attrs ([Form] ++ ctx) inner [] [nm = ty] [] + -> tag attrs ([Form] ++ ctx) inner [] [nm = ty] val textbox : formTag string [] [Value = string, Size = int, Source = source string] val password : formTag string [] [Value = string, Size = int] val textarea : formTag string [] [Rows = int, Cols = int] @@ -537,40 +513,42 @@ val checkbox : formTag bool [] [Checked = bool] con radio = [Body, Radio] val radio : formTag string radio [] -val radioOption : unit -> tag [Value = string] radio [] [] [] [] +val radioOption : unit -> tag [Value = string] radio [] [] [] con select = [Select] val select : formTag string select [] -val option : unit -> tag [Value = string, Selected = bool] select [] [] [] [] +val option : unit -> tag [Value = string, Selected = bool] select [] [] [] -val submit : ctx ::: {Unit} -> use ::: {Type} -> css ::: {Unit} +val submit : ctx ::: {Unit} -> use ::: {Type} -> [[Form] ~ ctx] => unit - -> tag [Value = string, Action = $use -> transaction (page css)] - ([Form] ++ ctx) ([Form] ++ ctx) use [] [] + -> tag [Value = string, Action = $use -> transaction page] + ([Form] ++ ctx) ([Form] ++ ctx) use [] -(*** Tables *) - -val tabl : other ::: {Unit} -> [other ~ [Body, Table]] => - unit -> tag [Border = int] ([Body] ++ other) ([Body, Table] ++ other) [] [] [Table] -val tr : other ::: {Unit} -> [other ~ [Body, Table, Tr]] => - unit -> tag [] ([Body, Table] ++ other) ([Body, Tr] ++ other) [] [] [] -val th : other ::: {Unit} -> [other ~ [Body, Tr]] => - unit -> tag [] ([Body, Tr] ++ other) ([Body] ++ other) [] [] [Cell] -val td : other ::: {Unit} -> [other ~ [Body, Tr]] => - unit -> tag [] ([Body, Tr] ++ other) ([Body] ++ other) [] [] [Cell] - (*** AJAX-oriented widgets *) con cformTag = fn (attrs :: {Type}) => ctx ::: {Unit} -> [[Body] ~ ctx] => - unit -> tag attrs ([Body] ++ ctx) [] [] [] [] + unit -> tag attrs ([Body] ++ ctx) [] [] [] val ctextbox : cformTag [Value = string, Size = int, Source = source string] val button : cformTag [Value = string, Onclick = transaction unit] +(*** Tables *) + +val tabl : other ::: {Unit} -> [other ~ [Body, Table]] => + unit -> tag [Border = int] ([Body] ++ other) ([Body, Table] ++ other) [] [] +val tr : other ::: {Unit} -> [other ~ [Body, Table, Tr]] => + unit -> tag [] ([Body, Table] ++ other) ([Body, Tr] ++ other) [] [] +val th : other ::: {Unit} -> [other ~ [Body, Tr]] => + unit -> tag [] ([Body, Tr] ++ other) ([Body] ++ other) [] [] +val td : other ::: {Unit} -> [other ~ [Body, Tr]] => + unit -> tag [] ([Body, Tr] ++ other) ([Body] ++ other) [] [] + (** Aborting *) -val error : t ::: Type -> xml [Body] [] [] [] -> t +val error : t ::: Type -> xml [Body] [] [] -> t + + -- cgit v1.2.3