summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--main.ur27
-rw-r--r--mdl/lib.urp2
-rw-r--r--mdl/mdl.ur21
-rw-r--r--mdl/mdlFfi.urs2
-rw-r--r--ugtd.css6
5 files changed, 45 insertions, 13 deletions
diff --git a/main.ur b/main.ur
index dd43f47..b9b5699 100644
--- a/main.ur
+++ b/main.ur
@@ -20,6 +20,8 @@ table nextAction : {
Done : bool,
} PRIMARY KEY Id
+sequence nextActionId
+
(* Forces JavaScript to be enabled on the given page, so as to pull in external
scripts specified in the .urp file. *)
val forceJavaScript = <xml><script code={return ()} /></xml>
@@ -34,7 +36,7 @@ fun renderNextAction action =
<li class="mdl-list__item">
<span class="mdl-list__item-primary-content">
<span class="mdl-list__item-icon">
- <label class="mdl-checkbox mdl-js-checkbox mdl-js-ripple-effect" for={c}>
+ <label class="mdl-checkbox" for={c}>
<ccheckbox id={c} source={done} class="mdl-checkbox__input"
onchange={
b <- get done;
@@ -47,6 +49,14 @@ fun renderNextAction action =
</li>
</xml>
+val renderNextActions =
+ queryX1' (SELECT * FROM nextAction WHERE nextAction.Done = FALSE) renderNextAction
+
+fun newNextAction name =
+ id <- nextval nextActionId;
+ dml (INSERT INTO nextAction (Id, Nam, Done) VALUES ({[4 + id]}, {[name]}, FALSE));
+ renderNextActions
+
style hidden
style visible
@@ -54,8 +64,7 @@ style visible
datatype mode = NextActions | NewNextAction
val main =
- actionItems <- queryX1' (SELECT * FROM nextAction) renderNextAction;
- setHeader (blessResponseHeader "X-UA-Compatible") "IE=edge";
+ actionItems <- bind renderNextActions source;
mode <- source NextActions;
newNextActionDescription <- Mdl.Textbox.make "Description";
return <xml>
@@ -95,11 +104,17 @@ val main =
<div class="mdl-layout__header-row">
<span class="mdl-layout-title">New action</span>
<div class="mdl-layout-spacer" />
- (* <button class="mdl-button mdl-js-button" value="Save" /> *)
+ <button class="mdl-button mdl-js-button" value="Save" onclick={fn _ =>
+ name <- get newNextActionDescription.Source;
+ bind (rpc (newNextAction name)) (set actionItems);
+ sleep 0;
+ set mode NextActions;
+ set newNextActionDescription.Source ""
+ } />
</div>
</header>
<div class="mdl-layout__content">
- {newNextActionDescription}
+ {newNextActionDescription.Xml}
</div>
</div>
</div>
@@ -117,7 +132,7 @@ val main =
</div>
<div class="mdl-layout__content">
<ul class="mdl-list">
- {actionItems}
+ <dyn signal={signal actionItems} />
</ul>
<button class="mdl-button mdl-js-button mdl-button--fab mdl-button--colored" onclick={fn _ => set mode NewNextAction}>
<i class="material-icons">add</i>
diff --git a/mdl/lib.urp b/mdl/lib.urp
index 0853cbe..e4447db 100644
--- a/mdl/lib.urp
+++ b/mdl/lib.urp
@@ -1,8 +1,10 @@
benignEffectful MdlFfi.showSnackbar
+benignEffectful MdlFfi.upgradeAllRegistered
ffi mdlFfi
file /zoBIS4V6.js mdlFfi.js
html5
jsFunc MdlFfi.showSnackbar=UrWeb.MdlFfi.showSnackbar
+jsFunc MdlFfi.upgradeAllRegistered=componentHandler.upgradeAllRegistered
library mdlClasses
script /zoBIS4V6.js
diff --git a/mdl/mdl.ur b/mdl/mdl.ur
index 5f68ab1..90f03a1 100644
--- a/mdl/mdl.ur
+++ b/mdl/mdl.ur
@@ -15,15 +15,22 @@ specific language governing permissions and limitations under the License. *)
structure Classes = MdlClasses
open Classes
+val upgradeAllRegistered = MdlFfi.upgradeAllRegistered
+
structure Textbox = struct
- fun make (placeholder : string) : transaction xbody =
+ fun make (placeholder : string) : transaction {Source : source string,
+ Xml : xbody} =
+ contents <- source "";
id <- fresh;
- return <xml>
- <div class="mdl-textfield mdl-js-textfield">
- <ctextbox class="mdl-textfield__input" id={id} />
- <label class="mdl-textfield__label" for={id}>{[placeholder]}</label>
- </div>
- </xml>
+ return {
+ Source = contents,
+ Xml = <xml>
+ <div class="mdl-textfield mdl-js-textfield">
+ <ctextbox class="mdl-textfield__input" id={id} source={contents} />
+ <label class="mdl-textfield__label" for={id}>{[placeholder]}</label>
+ </div>
+ </xml>
+ }
end
structure Toast = struct
diff --git a/mdl/mdlFfi.urs b/mdl/mdlFfi.urs
index 74dd636..6e8188a 100644
--- a/mdl/mdlFfi.urs
+++ b/mdl/mdlFfi.urs
@@ -12,4 +12,6 @@ under the License is distributed on an “AS IS” BASIS, WITHOUT WARRANTIES OR
CONDITIONS OF ANY KIND, either express or implied. See the License for the
specific language governing permissions and limitations under the License. *)
+val upgradeAllRegistered : transaction unit
+
val showSnackbar : string (* id *) -> string (* text *) -> transaction unit
diff --git a/ugtd.css b/ugtd.css
index 6bd370b..79c2bb9 100644
--- a/ugtd.css
+++ b/ugtd.css
@@ -18,3 +18,9 @@ header .mdl-button {
.Main_hidden {
display: none;
}
+
+.mdl-button--fab {
+ position: fixed;
+ right: 16px;
+ bottom: 16px;
+}