Fix parsing of space-free .urp directives; use 'class' for 'c*' tags

6 files changed, 48 insertions, 21 deletions

diff --git a/lib/ur/top.ur b/lib/ur/top.ur
index 703c7bae..b6e4f6cf 100644
--- a/lib/ur/top.ur
+++ b/lib/ur/top.ur
@@ -138,15 +138,6 @@ fun foldUR2 [tf1 :: Type] [tf2 :: Type] [tr :: {Unit} -> Type]
            f [nm] [rest] ! r1.nm r2.nm (acc (r1 -- nm) (r2 -- nm)))
        (fn _ _ => i)
 
-fun foldURX2 [tf1 :: Type] [tf2 :: Type] [ctx :: {Unit}]
-           (f : nm :: Name -> rest :: {Unit}
-                -> [[nm] ~ rest] =>
-                      tf1 -> tf2 -> xml ctx [] []) =
-    @@foldUR2 [tf1] [tf2] [fn _ => xml ctx [] []]
-      (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] v1 v2 acc =>
-          <xml>{f [nm] [rest] ! v1 v2}{acc}</xml>)
-      <xml/>
-
 fun foldR [K] [tf :: K -> Type] [tr :: {K} -> Type]
            (f : nm :: Name -> t :: K -> rest :: {K}
                 -> [[nm] ~ rest] =>
@@ -195,6 +186,15 @@ fun mapX [K] [tf :: K -> Type] [ctx :: {Unit}]
           <xml>{f [nm] [t] [rest] ! r}{acc}</xml>)
       <xml/>
 
+fun mapUX2 [tf1 :: Type] [tf2 :: Type] [ctx :: {Unit}]
+           (f : nm :: Name -> rest :: {Unit}
+                -> [[nm] ~ rest] =>
+            tf1 -> tf2 -> xml ctx [] []) =
+    @@foldUR2 [tf1] [tf2] [fn _ => xml ctx [] []]
+      (fn [nm :: Name] [rest :: {Unit}] [[nm] ~ rest] v1 v2 acc =>
+          <xml>{f [nm] [rest] ! v1 v2}{acc}</xml>)
+      <xml/>
+
 fun mapX2 [K] [tf1 :: K -> Type] [tf2 :: K -> Type] [ctx :: {Unit}]
              (f : nm :: Name -> t :: K -> rest :: {K}
                   -> [[nm] ~ rest] =>
diff --git a/lib/ur/top.urs b/lib/ur/top.urs
index de2ac03b..83f24000 100644
--- a/lib/ur/top.urs
+++ b/lib/ur/top.urs
@@ -70,12 +70,6 @@ val foldUR2 : tf1 :: Type -> tf2 :: Type -> tr :: ({Unit} -> Type)
                        tf1 -> tf2 -> tr rest -> tr ([nm] ++ rest))
              -> tr [] -> r ::: {Unit} -> folder r -> $(mapU tf1 r) -> $(mapU tf2 r) -> tr r
 
-val foldURX2: tf1 :: Type -> tf2 :: Type -> ctx :: {Unit}
-              -> (nm :: Name -> rest :: {Unit}
-                  -> [[nm] ~ rest] =>
-                        tf1 -> tf2 -> xml ctx [] [])
-              -> r ::: {Unit} -> folder r -> $(mapU tf1 r) -> $(mapU tf2 r) -> xml ctx [] []
-
 val foldR : K --> tf :: (K -> Type) -> tr :: ({K} -> Type)
              -> (nm :: Name -> t :: K -> rest :: {K}
                  -> [[nm] ~ rest] =>
@@ -109,6 +103,13 @@ val mapX : K --> tf :: (K -> Type) -> ctx :: {Unit}
                tf t -> xml ctx [] [])
            -> r ::: {K} -> folder r -> $(map tf r) -> xml ctx [] []
 
+val mapUX2 : tf1 :: Type -> tf2 :: Type -> ctx :: {Unit}
+            -> (nm :: Name -> rest :: {Unit}
+                -> [[nm] ~ rest] =>
+                tf1 -> tf2 -> xml ctx [] [])
+            -> r ::: {Unit} -> folder r
+            -> $(mapU tf1 r) -> $(mapU tf2 r) -> xml ctx [] []
+
 val mapX2 : K --> tf1 :: (K -> Type) -> tf2 :: (K -> Type) -> ctx :: {Unit}
             -> (nm :: Name -> t :: K -> rest :: {K}
                 -> [[nm] ~ rest] =>
diff --git a/src/compiler.sml b/src/compiler.sml
index f0313c8b..63b28fb7 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -292,7 +292,8 @@ fun parseUrp' accLibs fname =
                 fun hasSpaceLine () =
                     case TextIO.inputLine inf of
                         NONE => false
-                      | SOME s => CharVector.exists (fn ch => ch = #" " orelse ch = #"\t") s orelse hasSpaceLine ()
+                      | SOME s => s = "debug\n" orelse s = "profile\n"
+                                  orelse CharVector.exists (fn ch => ch = #" " orelse ch = #"\t") s orelse hasSpaceLine ()
 
                 val hasBlankLine = hasSpaceLine ()
 
diff --git a/src/monoize.sml b/src/monoize.sml
index 0e122c29..a5dc3929 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -2787,12 +2787,28 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                                        (L'.EJavaScript (L'.Script, e), loc),
                                                        str ");"]))
                                      attrs
+
+                        val t = (L'.TFfi ("Basis", "string"), loc)
+                        val setClass = (L'.ECase (class,
+                                                  [((L'.PNone t, loc),
+                                                    str ""),
+                                                   ((L'.PSome (t, (L'.PVar ("x", t), loc)), loc),
+                                                    (L'.EStrcat ((L'.EPrim (Prim.String "d.className=\""), loc),
+                                                                 (L'.EStrcat ((L'.ERel 0, loc),
+                                                                              (L'.EPrim (Prim.String "\";"), loc)), loc)),
+                                                     loc))],
+                                                  {disc = (L'.TOption t, loc),
+                                                   result = t}), loc)
                     in
                         case assgns of
-                            [] => jexp
+                            [] => strcat [str "var d=",
+                                          jexp,
+                                          str ";",
+                                          setClass]
                           | _ => strcat (str "var d="
                                          :: jexp
                                          :: str ";"
+                                         :: setClass
                                          :: assgns)
                     end
 
diff --git a/tests/ctextbox.ur b/tests/ctextbox.ur
index c2a322e3..38c6c577 100644
--- a/tests/ctextbox.ur
+++ b/tests/ctextbox.ur
@@ -1,7 +1,15 @@
+style foo
+
 fun main () : transaction page =
     s <- source "Initial";
-    return <xml><body>
-      <ctextbox source={s} size=5/>
+    return <xml>
+      <head>
+        <link rel="stylesheet" type="text/css" href="http://localhost/static/style.css"/>
+      </head>
+      <body>
+        <ctextbox source={s} size=5/>
+        <ctextbox class={foo} source={s}/>
 
-      <dyn signal={s <- signal s; return (cdata s)}/>
-    </body></xml>
+        <dyn signal={s <- signal s; return (cdata s)}/>
+      </body>
+    </xml>
diff --git a/tests/ctextbox.urp b/tests/ctextbox.urp
index 93c828ac..d5cb5e9f 100644
--- a/tests/ctextbox.urp
+++ b/tests/ctextbox.urp
@@ -1,3 +1,4 @@
 debug
+allow url http://localhost/*
 
 ctextbox