changeset 1749:f9e5a8e09cdf

Simplify type of Basis.tag, regarding 'class' attribute; new compatibility parsing of 'class' values given as string literals
author Adam Chlipala <adam@chlipala.net>
date Sun, 06 May 2012 13:07:13 -0400
parents 95dd9f427bb2
children 277480862cef
files doc/manual.tex lib/ur/basis.urs src/monoize.sml src/urweb.grm tests/css.ur
diffstat 5 files changed, 23 insertions(+), 9 deletions(-) [+]
line wrap: on
line diff
--- a/doc/manual.tex	Sun May 06 12:37:43 2012 -0400
+++ b/doc/manual.tex	Sun May 06 13:07:13 2012 -0400
@@ -1954,13 +1954,13 @@
   \mt{val} \; \mt{tag} : \mt{attrsGiven} ::: \{\mt{Type}\} \to \mt{attrsAbsent} ::: \{\mt{Type}\} \to \mt{ctxOuter} ::: \{\mt{Unit}\} \to \mt{ctxInner} ::: \{\mt{Unit}\} \\
   \hspace{.1in} \to \mt{useOuter} ::: \{\mt{Type}\} \to \mt{useInner} ::: \{\mt{Type}\} \to \mt{bindOuter} ::: \{\mt{Type}\} \to \mt{bindInner} ::: \{\mt{Type}\} \\
   \hspace{.1in} \to [\mt{attrsGiven} \sim \mt{attrsAbsent}] \Rightarrow [\mt{useOuter} \sim \mt{useInner}] \Rightarrow [\mt{bindOuter} \sim \mt{bindInner}] \\
-  \hspace{.1in} \Rightarrow \mt{option} \; \mt{css\_class} \\
+  \hspace{.1in} \Rightarrow \mt{css\_class} \\
   \hspace{.1in} \to \mt{option} \; (\mt{signal} \; \mt{css\_class}) \\
   \hspace{.1in} \to \$\mt{attrsGiven} \\
   \hspace{.1in} \to \mt{tag} \; (\mt{attrsGiven} \rc \mt{attrsAbsent}) \; \mt{ctxOuter} \; \mt{ctxInner} \; \mt{useOuter} \; \mt{bindOuter} \\
   \hspace{.1in} \to \mt{xml} \; \mt{ctxInner} \; \mt{useInner} \; \mt{bindInner} \to \mt{xml} \; \mt{ctxOuter} \; (\mt{useOuter} \rc \mt{useInner}) \; (\mt{bindOuter} \rc \mt{bindInner})
 \end{array}$$
-Note that any tag may be assigned a CSS class.  This is the sole way of making use of the values produced by $\mt{style}$ declarations.  Ur/Web itself doesn't deal with the syntax or semantics of style sheets; they can be linked via URLs with \texttt{link} tags.  However, Ur/Web does make it easy to calculate upper bounds on usage of CSS classes through program analysis.  The function $\mt{Basis.classes}$ can be used to specify a list of CSS classes for a single tag.
+Note that any tag may be assigned a CSS class, or left without a class by passing $\mt{Basis.null}$ as the first value-level argument.  This is the sole way of making use of the values produced by $\mt{style}$ declarations.  Ur/Web itself doesn't deal with the syntax or semantics of style sheets; they can be linked via URLs with \texttt{link} tags.  However, Ur/Web does make it easy to calculate upper bounds on usage of CSS classes through program analysis.  The function $\mt{Basis.classes}$ can be used to specify a list of CSS classes for a single tag.
 
 Also note that two different arguments are available for setting CSS classes: the first, associated with the \texttt{class} pseudo-attribute syntactic sugar, fixes the class of a tag for the duration of the tag's life; while the second, associated with the \texttt{dynClass} pseudo-attribute, allows the class to vary over the tag's life.  See Section \ref{signals} for an introduction to the $\mt{signal}$ type family.
 
@@ -2234,6 +2234,7 @@
   &&& \{e\} & \textrm{computed value} \\
 \end{array}$$
 
+Further, there is a special convenience and compatibility form for setting CSS classes of tags.  If a \cd{class} attribute has a value that is a string literal, the literal is parsed in the usual HTML way and replaced with calls to appropriate Ur/Web combinators.  Any dashes in the text are replaced with underscores to determine Ur identifiers.
 
 \section{\label{structure}The Structure of Web Applications}
 
--- a/lib/ur/basis.urs	Sun May 06 12:37:43 2012 -0400
+++ b/lib/ur/basis.urs	Sun May 06 13:07:13 2012 -0400
@@ -648,7 +648,7 @@
           -> [attrsGiven ~ attrsAbsent] =>
              [useOuter ~ useInner] =>
              [bindOuter ~ bindInner] =>
-           option css_class
+           css_class
 	   -> option (signal css_class)
            -> $attrsGiven
            -> tag (attrsGiven ++ attrsAbsent)
--- a/src/monoize.sml	Sun May 06 12:37:43 2012 -0400
+++ b/src/monoize.sml	Sun May 06 13:07:13 2012 -0400
@@ -3077,15 +3077,15 @@
                         val s = (L'.EPrim (Prim.String (String.concat ["<", tag'])), loc)
 
                         val s = (L'.ECase (class,
-                                           [((L'.PNone t, loc),
+                                           [((L'.PPrim (Prim.String ""), loc),
                                              s),
-                                            ((L'.PSome (t, (L'.PVar ("x", t), loc)), loc),
+                                            ((L'.PVar ("x", t), loc),
                                              (L'.EStrcat (s,
                                                          (L'.EStrcat ((L'.EPrim (Prim.String " class=\""), loc),
                                                                       (L'.EStrcat ((L'.ERel 0, loc),
                                                                                    (L'.EPrim (Prim.String "\""), loc)),
                                                                        loc)), loc)), loc))],
-                                           {disc = (L'.TOption t, loc),
+                                           {disc = t,
                                             result = t}), loc)
 
                         val (s, fm) = foldl (fn (("Action", _, _), acc) => acc
--- a/src/urweb.grm	Sun May 06 12:37:43 2012 -0400
+++ b/src/urweb.grm	Sun May 06 13:07:13 2012 -0400
@@ -246,6 +246,15 @@
       | EDisjointApp e => tnamesOf e
       | _ => []
 
+fun classOut (s, pos) = (EVar ([], String.translate (fn #"-" => "_" | ch => str ch) s, Infer), pos)
+
+fun parseClass s pos =
+    case String.tokens Char.isSpace s of
+        [] => (EVar (["Basis"], "null", Infer), pos)
+      | class :: classes =>
+        foldl (fn (s, e) => (EApp ((EApp ((EVar (["Basis"], "classes", Infer), pos), e), pos), classOut (s, pos)), pos))
+                (classOut (class, pos)) classes
+
 %%
 %header (functor UrwebLrValsFn(structure Token : TOKEN))
 
@@ -1521,9 +1530,9 @@
 
                                              val e = (EVar (["Basis"], "tag", Infer), pos)
                                              val eo = case #1 attrs of
-                                                          NONE => (EVar (["Basis"], "None", Infer), pos)
-                                                        | SOME e => (EApp ((EVar (["Basis"], "Some", Infer), pos),
-                                                                           e), pos)
+                                                          NONE => (EVar (["Basis"], "null", Infer), pos)
+                                                        | SOME (EPrim (Prim.String s), pos) => parseClass s pos
+                                                        | SOME e => e
                                              val e = (EApp (e, eo), pos)
                                              val eo = case #2 attrs of
                                                           NONE => (EVar (["Basis"], "None", Infer), pos)
--- a/tests/css.ur	Sun May 06 12:37:43 2012 -0400
+++ b/tests/css.ur	Sun May 06 13:07:13 2012 -0400
@@ -1,6 +1,10 @@
 style st1
 style st2
+style st_3
 
 fun main () = return <xml><body>
   <span title="Whoa" class={classes st1 st2}>Hi!</span>
+  <span class="st-3 st2">Bye!</span>
+  <span class="st1">Appendix!</span>
+  <span class="">Sequel!</span>
 </body></xml>