Save pending/closing time stamps for misc support issues

[hcoop/zz_old/portal.git] / support.sml

diff --git a/support.sml b/support.sml
index b8e7a80..b82175b 100644 (file)
--- a/support.sml
+++ b/support.sml
@@ -9,7 +9,8 @@ datatype status =
        | CLOSED
 
 type category = { id : int, grp : int, name : string, descr : string }
-type issue = { id : int, usr : int, cat : int, title : string, priv : bool, status : status, stamp : C.timestamp }
+type issue = { id : int, usr : int, cat : int, title : string, priv : bool, status : status,
+              stamp : C.timestamp, cstamp : C.timestamp option, pstamp : C.timestamp option }
 type post = { id : int, usr : int, iss : int, body : string, stamp : C.timestamp }
 type subscription = { usr : int, cat : int }
 
@@ -79,19 +80,22 @@ fun statusFromSql v =
       | 2 => CLOSED
       | _ => raise Fail "Bad support issue status"
 
-fun mkIssueRow [id, usr, cat, title, priv, status, stamp] =
+fun mkIssueRow [id, usr, cat, title, priv, status, stamp, pstamp, cstamp] =
     {id = C.intFromSql id, usr = C.intFromSql usr, cat = C.intFromSql cat,
      title = C.stringFromSql title, priv = C.boolFromSql priv,
-     status = statusFromSql status, stamp = C.timestampFromSql stamp}
+     status = statusFromSql status, stamp = C.timestampFromSql stamp,
+     pstamp = if C.isNull pstamp then NONE else SOME (C.timestampFromSql pstamp),
+     cstamp = if C.isNull cstamp then NONE else SOME (C.timestampFromSql cstamp)}
+
   | mkIssueRow row = rowError ("issue", row)
 
 fun lookupIssue id =
-    mkIssueRow (C.oneRow (getDb ()) ($`SELECT id, usr, cat, title, priv, status, stamp
+    mkIssueRow (C.oneRow (getDb ()) ($`SELECT id, usr, cat, title, priv, status, stamp, pstamp, cstamp
                                       FROM SupIssue
                                       WHERE id = ^(C.intToSql id)`))
 
 fun listIssues () =
-    C.map (getDb ()) mkIssueRow ($`SELECT id, usr, cat, title, priv, status, stamp
+    C.map (getDb ()) mkIssueRow ($`SELECT id, usr, cat, title, priv, status, stamp, pstamp, cstamp
                                   FROM SupIssue
                                   ORDER BY stamp DESC`)
 
@@ -99,7 +103,7 @@ fun mkIssueRow' (name :: rest) = (C.stringFromSql name, mkIssueRow rest)
   | mkIssueRow' r = Init.rowError ("issue'", r)
 
 fun listOpenIssues usr =
-    C.map (getDb ()) mkIssueRow' ($`SELECT WebUser.name, SupIssue.id, SupIssue.usr, SupIssue.cat, title, priv, status, stamp
+    C.map (getDb ()) mkIssueRow' ($`SELECT WebUser.name, SupIssue.id, SupIssue.usr, SupIssue.cat, title, priv, status, stamp, pstamp, cstamp
                                    FROM SupIssue JOIN SupCategory ON cat = SupCategory.id
                                       JOIN WebUser ON WebUser.id = SupIssue.usr
                                    WHERE status < 2
@@ -113,14 +117,14 @@ fun listOpenIssues usr =
                                    ORDER BY stamp DESC`)
 
 fun listCategoryIssues cat =
-    C.map (getDb ()) mkIssueRow' ($`SELECT WebUser.name, SupIssue.id, usr, cat, title, priv, status, stamp
+    C.map (getDb ()) mkIssueRow' ($`SELECT WebUser.name, SupIssue.id, usr, cat, title, priv, status, stamp, pstamp, cstamp
                                    FROM SupIssue
                                       JOIN WebUser ON WebUser.id = usr
                                    WHERE cat = ^(C.intToSql cat)
                                    ORDER BY stamp DESC`)
 
 fun listOpenCategoryIssues (cat, usr) =
-    C.map (getDb ()) mkIssueRow' ($`SELECT name, SupIssue.id, usr, cat, title, priv, status, stamp
+    C.map (getDb ()) mkIssueRow' ($`SELECT name, SupIssue.id, usr, cat, title, priv, status, stamp, pstamp, cstamp
                                    FROM SupIssue
                                       JOIN WebUser ON WebUser.id = usr
                                    WHERE cat = ^(C.intToSql cat)
@@ -129,7 +133,7 @@ fun listOpenCategoryIssues (cat, usr) =
                                    ORDER BY stamp DESC`)
 
 fun listOpenCategoryIssuesAdmin cat =
-    C.map (getDb ()) mkIssueRow' ($`SELECT name, SupIssue.id, usr, cat, title, priv, status, stamp
+    C.map (getDb ()) mkIssueRow' ($`SELECT name, SupIssue.id, usr, cat, title, priv, status, stamp, pstamp, cstamp
                                    FROM SupIssue
                                       JOIN WebUser ON WebUser.id = usr
                                    WHERE cat = ^(C.intToSql cat)
@@ -141,10 +145,10 @@ fun addIssue (usr, cat, title, priv, status) =
        val db = getDb ()
        val id = nextSeq (db, "SupIssueSeq")
     in
-       C.dml db ($`INSERT INTO SupIssue (id, usr, cat, title, priv, status, stamp)
+       C.dml db ($`INSERT INTO SupIssue (id, usr, cat, title, priv, status, stamp, pstamp, cstamp)
                    VALUES (^(C.intToSql id), ^(C.intToSql usr), ^(C.intToSql cat),
                            ^(C.stringToSql title), ^(C.boolToSql priv),
-                           ^(statusToSql status), CURRENT_TIMESTAMP)`);
+                           ^(statusToSql status), CURRENT_TIMESTAMP, NULL, NULL)`);
        id
     end
 
@@ -152,6 +156,10 @@ fun modIssue (iss : issue) =
     let
        val db = getDb ()
     in
+       case #status iss of
+           PENDING => ignore (C.dml db ($`UPDATE SupIssue SET pstamp = CURRENT_TIMESTAMP`))
+         | CLOSED => ignore (C.dml db ($`UPDATE SupIssue SET cstamp = CURRENT_TIMESTAMP`))
+         | _ => ();
        ignore (C.dml db ($`UPDATE SupIssue SET
                            usr = ^(C.intToSql (#usr iss)), cat = ^(C.intToSql (#cat iss)),
                               title = ^(C.stringToSql (#title iss)), priv = ^(C.boolToSql (#priv iss)),