New optional suffice for 'rewrite' in .urp files: [-]

6 files changed, 32 insertions, 9 deletions

diff --git a/doc/manual.tex b/doc/manual.tex
index fa321c69..6f1e321e 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -171,7 +171,7 @@ Here is the complete list of directive forms.  ``FFI'' stands for ``foreign func
 \item \texttt{path NAME=VALUE} creates a mapping from \texttt{NAME} to \texttt{VALUE}.  This mapping may be used at the beginnings of filesystem paths given to various other configuration directives.  A path like \texttt{\$NAME/rest} is expanded to \texttt{VALUE/rest}.  There is an initial mapping from the empty name (for paths like \texttt{\$/list}) to the directory where the Ur/Web standard library is installed.  If you accept the default \texttt{configure} options, this directory is \texttt{/usr/local/lib/urweb/ur}.
 \item \texttt{prefix PREFIX} sets the prefix included before every URI within the generated application.  The default is \texttt{/}.
 \item \texttt{profile} generates an executable that may be used with gprof.
-\item \texttt{rewrite KIND FROM TO} gives a rule for rewriting canonical module paths.  For instance, the canonical path of a page may be \texttt{Mod1.Mod2.mypage}, while you would rather the page were accessed via a URL containing only \texttt{page}.  The directive \texttt{rewrite url Mod1/Mod2/mypage page} would accomplish that.  The possible values of \texttt{KIND} determine which kinds of objects are affected.  The kind \texttt{all} matches any object, and \texttt{url} matches page URLs.  The kinds \texttt{table}, \texttt{sequence}, and \texttt{view} match those sorts of SQL entities, and \texttt{relation} matches any of those three.  \texttt{cookie} matches HTTP cookies, and \texttt{style} matches CSS class names.  If \texttt{FROM} ends in \texttt{/*}, it is interpreted as a prefix matching rule, and rewriting occurs by replacing only the appropriate prefix of a path with \texttt{TO}.  The \texttt{TO} field may be left empty to express the idea of deleting a prefix.  For instance, \texttt{rewrite url Main/*} will strip all \texttt{Main/} prefixes from URLs.  While the actual external names of relations and styles have parts separated by underscores instead of slashes, all rewrite rules must be written in terms of slashes.
+\item \texttt{rewrite KIND FROM TO} gives a rule for rewriting canonical module paths.  For instance, the canonical path of a page may be \texttt{Mod1.Mod2.mypage}, while you would rather the page were accessed via a URL containing only \texttt{page}.  The directive \texttt{rewrite url Mod1/Mod2/mypage page} would accomplish that.  The possible values of \texttt{KIND} determine which kinds of objects are affected.  The kind \texttt{all} matches any object, and \texttt{url} matches page URLs.  The kinds \texttt{table}, \texttt{sequence}, and \texttt{view} match those sorts of SQL entities, and \texttt{relation} matches any of those three.  \texttt{cookie} matches HTTP cookies, and \texttt{style} matches CSS class names.  If \texttt{FROM} ends in \texttt{/*}, it is interpreted as a prefix matching rule, and rewriting occurs by replacing only the appropriate prefix of a path with \texttt{TO}.  The \texttt{TO} field may be left empty to express the idea of deleting a prefix.  For instance, \texttt{rewrite url Main/*} will strip all \texttt{Main/} prefixes from URLs.  While the actual external names of relations and styles have parts separated by underscores instead of slashes, all rewrite rules must be written in terms of slashes.  An optional suffix of \cd{[-]} for a \cd{rewrite} directive asks to additionally replace all \cd{\_} characters with \cd{-} characters, which can be handy for, e.g., interfacing with an off-the-shelf CSS library that prefers hyphens over underscores.
 \item \texttt{safeGet URI} asks to allow the page handler assigned this canonical URI prefix to cause persistent side effects, even if accessed via an HTTP \cd{GET} request.
 \item \texttt{script URL} adds \texttt{URL} to the list of extra JavaScript files to be included at the beginning of any page that uses JavaScript.  This is most useful for importing JavaScript versions of functions found in new FFI modules.
 \item \texttt{serverOnly Module.ident} registers an FFI function or transaction that may only be run on the server.
diff --git a/src/compiler.sml b/src/compiler.sml
index dbc478f0..bd6ef493 100644
--- a/src/compiler.sml
+++ b/src/compiler.sml
@@ -426,7 +426,8 @@ fun parseUrp' accLibs fname =
                        jsFuncs = [],
                        rewrites = [{pkind = Settings.Any,
                                     kind = Settings.Prefix,
-                                    from = capitalize (OS.Path.file fname) ^ "/", to = ""}],
+                                    from = capitalize (OS.Path.file fname) ^ "/", to = "",
+                                    hyphenate = false}],
                        filterUrl = [],
                        filterMime = [],
                        filterRequest = [],
@@ -774,17 +775,19 @@ fun parseUrp' accLibs fname =
                                   | "jsFunc" => jsFuncs := ffiM () :: !jsFuncs
                                   | "rewrite" =>
                                     let
-                                        fun doit (pkind, from, to) =
+                                        fun doit (pkind, from, to, hyph) =
                                             let
                                                 val pkind = parsePkind pkind
                                                 val (kind, from) = parseFrom from
                                             in
-                                                rewrites := {pkind = pkind, kind = kind, from = from, to = to} :: !rewrites
+                                                rewrites := {pkind = pkind, kind = kind, from = from, to = to, hyphenate = hyph} :: !rewrites
                                             end
                                     in
                                         case String.tokens Char.isSpace arg of
-                                            [pkind, from, to] => doit (pkind, from, to)
-                                          | [pkind, from] => doit (pkind, from, "")
+                                            [pkind, from, to, "[-]"] => doit (pkind, from, to, true)
+                                          | [pkind, from, "[-]"] => doit (pkind, from, "", true)
+                                          | [pkind, from, to] => doit (pkind, from, to, false)
+                                          | [pkind, from] => doit (pkind, from, "", false)
                                           | _ => ErrorMsg.error "Bad 'rewrite' syntax"
                                     end
                                   | "allow" =>
diff --git a/src/settings.sig b/src/settings.sig
index 4b1ac8ac..7140c645 100644
--- a/src/settings.sig
+++ b/src/settings.sig
@@ -97,7 +97,7 @@ signature SETTINGS = sig
     type rule = { action : action, kind : pattern_kind, pattern : string }
 
     datatype path_kind = Any | Url | Table | Sequence | View | Relation | Cookie | Style
-    type rewrite = { pkind : path_kind, kind : pattern_kind, from : string, to : string }
+    type rewrite = { pkind : path_kind, kind : pattern_kind, from : string, to : string, hyphenate : bool }
 
     (* Rules for rewriting URLs from canonical forms *)
     val setRewriteRules : rewrite list -> unit
diff --git a/src/settings.sml b/src/settings.sml
index 78b02126..a9c2315c 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -326,7 +326,7 @@ datatype action = Allow | Deny
 type rule = { action : action, kind : pattern_kind, pattern : string }
 
 datatype path_kind = Any | Url | Table | Sequence | View | Relation | Cookie | Style
-type rewrite = { pkind : path_kind, kind : pattern_kind, from : string, to : string }
+type rewrite = { pkind : path_kind, kind : pattern_kind, from : string, to : string, hyphenate : bool }
 
 val rewrites = ref ([] : rewrite list)
 
@@ -357,7 +357,15 @@ fun rewrite pk s =
                     if subsume (pk, #pkind rewr) then
                         case match () of
                             NONE => rew ls
-                          | SOME suffixStart => #to rewr ^ String.extract (s, suffixStart, NONE)
+                          | SOME suffixStart =>
+                            let
+                                val s = #to rewr ^ String.extract (s, suffixStart, NONE)
+                            in
+                                if #hyphenate rewr then
+                                    String.translate (fn #"_" => "-" | ch => str ch) s
+                                else
+                                    s
+                            end
                     else
                         rew ls
                 end
diff --git a/tests/hyphenate.ur b/tests/hyphenate.ur
new file mode 100644
index 00000000..48c94f6b
--- /dev/null
+++ b/tests/hyphenate.ur
@@ -0,0 +1,7 @@
+style extra_special
+style somewhat_special
+
+fun main () : transaction page = return <xml><body>
+  <span class={extra_special}>Test</span>
+  <span class={somewhat_special}>Test</span>
+</body></xml>
diff --git a/tests/hyphenate.urp b/tests/hyphenate.urp
new file mode 100644
index 00000000..197fd9d0
--- /dev/null
+++ b/tests/hyphenate.urp
@@ -0,0 +1,5 @@
+rewrite url Hyphenate/*
+rewrite style Hyphenate/somewhat_special spectactularly_great [-]
+rewrite style Hyphenate/* [-]
+
+hyphenate
\ No newline at end of file