# HG changeset patch # User Adam Chlipala # Date 1224178240 14400 # Node ID 28d3d72106874b08486dd2bb6dafe1610f2bfc67 # Parent 3004f8843e36d067e3e73e1a9b6d66fc68813da7 Improving indentation of XML after antiquote diff -r 3004f8843e36 -r 28d3d7210687 lib/top.ur --- a/lib/top.ur Thu Oct 16 13:17:09 2008 -0400 +++ b/lib/top.ur Thu Oct 16 13:30:40 2008 -0400 @@ -34,10 +34,10 @@ (fn _ => i) fun foldT2R (tf :: (Type * Type) -> Type) (tr :: {(Type * Type)} -> Type) - (f : nm :: Name -> t :: (Type * Type) -> rest :: {(Type * Type)} - -> fn [[nm] ~ rest] => - tf t -> tr rest -> tr ([nm = t] ++ rest)) - (i : tr []) = + (f : nm :: Name -> t :: (Type * Type) -> rest :: {(Type * Type)} + -> fn [[nm] ~ rest] => + tf t -> tr rest -> tr ([nm = t] ++ rest)) + (i : tr []) = fold [fn r :: {(Type * Type)} => $(mapT2T tf r) -> tr r] (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) (acc : _ -> tr rest) [[nm] ~ rest] r => @@ -45,10 +45,10 @@ (fn _ => i) fun foldTR2 (tf1 :: Type -> Type) (tf2 :: Type -> Type) (tr :: {Type} -> Type) - (f : nm :: Name -> t :: Type -> rest :: {Type} - -> fn [[nm] ~ rest] => - tf1 t -> tf2 t -> tr rest -> tr ([nm = t] ++ rest)) - (i : tr []) = + (f : nm :: Name -> t :: Type -> rest :: {Type} + -> fn [[nm] ~ rest] => + tf1 t -> tf2 t -> tr rest -> tr ([nm = t] ++ rest)) + (i : tr []) = fold [fn r :: {Type} => $(mapTT tf1 r) -> $(mapTT tf2 r) -> tr r] (fn (nm :: Name) (t :: Type) (rest :: {Type}) (acc : _ -> _ -> tr rest) [[nm] ~ rest] r1 r2 => diff -r 3004f8843e36 -r 28d3d7210687 src/elisp/urweb-mode.el --- a/src/elisp/urweb-mode.el Thu Oct 16 13:17:09 2008 -0400 +++ b/src/elisp/urweb-mode.el Thu Oct 16 13:30:40 2008 -0400 @@ -478,6 +478,25 @@ (setq done t)))) (and (not done) (> depth 0))))) +(defun skip-matching-braces () + "Skip backwards past matching brace pairs, to calculate XML indentation after quoted Ur code" + (beginning-of-line) + (let ((start-pos (point)) + (depth 0)) + (end-of-line) + (while (re-search-backward "[{}]" start-pos t) + (cond + ((looking-at "}") + (incf depth)) + ((looking-at "{") + (decf depth)))) + (while (and (> depth 0) (re-search-backward "[{}]" nil t) + (cond + ((looking-at "}") + (incf depth)) + ((looking-at "{") + (decf depth))))))) + (defun urweb-tag-matching-indent () "Seek back to a matching opener tag and get its line's indent" (save-excursion @@ -520,7 +539,7 @@ (and (urweb-in-xml) (let ((prev-indent (save-excursion (previous-line 1) - (end-of-line 1) + (skip-matching-braces) (re-search-backward "^[^\n]" nil t) (current-indentation)))) (cond diff -r 3004f8843e36 -r 28d3d7210687 tests/crud.ur --- a/tests/crud.ur Thu Oct 16 13:17:09 2008 -0400 +++ b/tests/crud.ur Thu Oct 16 13:30:40 2008 -0400 @@ -46,111 +46,113 @@ sequence seq fun create (inputs : $(mapT2T sndTT M.cols)) = - id <- nextval seq; - () <- dml (insert tab (foldT2R2 [sndTT] [colMeta] - [fn cols => $(mapT2T (fn t :: (Type * Type) => - sql_exp [] [] [] t.1) cols)] - (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) - [[nm] ~ rest] => - fn input col acc => acc with nm = sql_inject col.Inject (col.Parse input)) - {} [M.cols] inputs M.cols - with #Id = (SQL {id}))); - return - Inserted with ID {txt _ id}. - + id <- nextval seq; + () <- dml (insert tab + (foldT2R2 [sndTT] [colMeta] + [fn cols => $(mapT2T (fn t :: (Type * Type) => + sql_exp [] [] [] t.1) cols)] + (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) + [[nm] ~ rest] => + fn input col acc => acc with nm = sql_inject col.Inject (col.Parse input)) + {} [M.cols] inputs M.cols + with #Id = (SQL {id}))); + return + Inserted with ID {txt _ id}. + fun save (id : int) (inputs : $(mapT2T sndTT M.cols)) = - () <- dml (update [mapT2T fstTT M.cols] (foldT2R2 [sndTT] [colMeta] - [fn cols => $(mapT2T (fn t :: (Type * Type) => - sql_exp [T = [Id = int] ++ mapT2T fstTT M.cols] [] [] t.1) cols)] - (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) - [[nm] ~ rest] => - fn input col acc => acc with nm = sql_inject col.Inject (col.Parse input)) - {} [M.cols] inputs M.cols) - tab (WHERE T.Id = {id})); - return - Saved! - + () <- dml (update [mapT2T fstTT M.cols] + (foldT2R2 [sndTT] [colMeta] + [fn cols => $(mapT2T (fn t :: (Type * Type) => + sql_exp [T = [Id = int] ++ mapT2T fstTT M.cols] [] [] t.1) cols)] + (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) + [[nm] ~ rest] => + fn input col acc => acc with nm = sql_inject col.Inject (col.Parse input)) + {} [M.cols] inputs M.cols) + tab (WHERE T.Id = {id})); + return + Saved! + fun update (id : int) = - fso <- oneOrNoRows (SELECT tab.{{mapT2T fstTT M.cols}} FROM tab WHERE tab.Id = {id}); - case fso : (Basis.option {Tab : $(mapT2T fstTT M.cols)}) of - None => return Not found! - | Some fs => return

- {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] - (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) - [[nm] ~ rest] (v : t.1) (col : colMeta t) - (acc : xml form [] (mapT2T sndTT rest)) => - -

{cdata col.Nam}: {col.WidgetPopulated [nm] v}

- {useMore acc} - ) - - [M.cols] fs.Tab M.cols} + fso <- oneOrNoRows (SELECT tab.{{mapT2T fstTT M.cols}} FROM tab WHERE tab.Id = {id}); + case fso : (Basis.option {Tab : $(mapT2T fstTT M.cols)}) of + None => return Not found! + | Some fs => return + {foldT2R2 [fstTT] [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] + (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) + [[nm] ~ rest] (v : t.1) (col : colMeta t) + (acc : xml form [] (mapT2T sndTT rest)) => + +

{cdata col.Nam}: {col.WidgetPopulated [nm] v}

+ {useMore acc} + ) + + [M.cols] fs.Tab M.cols} - - + + fun delete (id : int) = - () <- dml (DELETE FROM tab WHERE Id = {id}); - return - The deed is done. - + () <- dml (DELETE FROM tab WHERE Id = {id}); + return + The deed is done. + fun confirm (id : int) = return -

Are you sure you want to delete ID #{txt _ id}?

- -

I was born sure!

Are you sure you want to delete ID #{txt _ id}?

+ +

I was born sure!

fun main () = - rows <- queryX (SELECT * FROM tab AS T) - (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => - - {txt _ fs.T.Id} - {foldT2RX2 [fstTT] [colMeta] [tr] - (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) - [[nm] ~ rest] v col => - {col.Show v} - ) - [M.cols] (fs.T -- #Id) M.cols} - [Update] [Delete] - - ); - return - {cdata M.title} + rows <- queryX (SELECT * FROM tab AS T) + (fn (fs : {T : $([Id = int] ++ mapT2T fstTT M.cols)}) => + + {txt _ fs.T.Id} + {foldT2RX2 [fstTT] [colMeta] [tr] + (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) + [[nm] ~ rest] v col => + {col.Show v} + ) + [M.cols] (fs.T -- #Id) M.cols} + [Update] [Delete] + + ); + return + {cdata M.title} - + -

{cdata M.title}

- - - - {foldT2RX [colMeta] [tr] - (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) - [[nm] ~ rest] col => - - ) - [M.cols] M.cols} - - {rows} -

ID	{cdata col.Nam}

+ + + + {foldT2RX [colMeta] [tr] + (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) + [[nm] ~ rest] col => + + ) + [M.cols] M.cols} + + {rows} +

ID	{cdata col.Nam}

-
+
-

- {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] - (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) - [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => -

{cdata col.Nam}: {col.Widget [nm]}

- {useMore acc} - ) - - [M.cols] M.cols} + + {foldT2R [colMeta] [fn cols :: {(Type * Type)} => xml form [] (mapT2T sndTT cols)] + (fn (nm :: Name) (t :: (Type * Type)) (rest :: {(Type * Type)}) + [[nm] ~ rest] (col : colMeta t) (acc : xml form [] (mapT2T sndTT rest)) => +

{cdata col.Nam}: {col.Widget [nm]}

+ {useMore acc} + ) + + [M.cols] M.cols} - - - + + +

end