Undo/accept for blocks of edits

src/JS.hs

@@ -55,7 +55,9 @@ allJSFunctions = JS . T.unlines . map fromJS $ [
   moveItemUp, moveItemDown, deleteItem,
   -- Admin things
   acceptEdit,
-  undoEdit ]
+  undoEdit,
+  acceptBlock,
+  undoBlock ]
 
 -- | A class for things that can be converted to Javascript syntax.
 class ToJS a where toJS :: a -> JS
@@ -489,6 +491,29 @@ undoEdit =
      });
   |]
 
+acceptBlock :: JSFunction a => a
+acceptBlock =
+  makeJSFunction "acceptBlock" ["editLatest", "editEarliest", "blockNode"]
+  [text|
+    $.post("/admin/edits/"+editLatest+"/"+editEarliest+"/accept")
+     .done(function () {
+        fadeOutAndRemove(blockNode);
+     });
+  |]
+
+undoBlock :: JSFunction a => a
+undoBlock =
+  makeJSFunction "undoBlock" ["editLatest", "editEarliest", "blockNode"]
+  [text|
+    $.post("/admin/edits/"+editLatest+"/"+editEarliest+"/undo")
+     .done(function (data) {
+        if (data == "")
+          fadeOutAndRemove(blockNode);
+        else
+          $(blockNode).replaceWith(data);
+     });
+  |]
+
 deleteItem :: JSFunction a => a
 deleteItem =
   makeJSFunction "deleteItem" ["itemId", "itemNode"]

src/Main.hs

@@ -545,6 +545,20 @@ main = do
               Left err -> Spock.text (T.pack err)
               Right () -> do dbUpdate (RemovePendingEdit n)
                              Spock.text ""
+          Spock.post ("edits" <//> var <//> var <//> "accept") $ \m n -> do
+            dbUpdate (RemovePendingEdits m n)
+          Spock.post ("edits" <//> var <//> var <//> "undo") $ \m n -> do
+            edits <- dbQuery (GetEdits m n)
+            s <- dbQuery GetGlobalState
+            failed <- fmap catMaybes $ for edits $ \(edit, details) -> do
+              res <- undoEdit edit
+              case res of
+                Left err -> return (Just ((edit, details), Just err))
+                Right () -> do dbUpdate (RemovePendingEdit (editId details))
+                               return Nothing
+            case failed of
+              [] -> Spock.text ""
+              _  -> lucidIO $ renderEdits s failed
 
       -- Donation page
       Spock.get "donate" $

src/Types.hs

@@ -96,9 +96,9 @@ module Types
   DeleteTrait(..),
 
   -- ** edits
-  GetEdit(..),
+  GetEdit(..), GetEdits(..),
   RegisterEdit(..),
-  RemovePendingEdit(..),
+  RemovePendingEdit(..), RemovePendingEdits(..),
 
   -- ** other
   MoveItem(..),
@@ -574,8 +574,10 @@ instance Migrate EditDetails where
 data GlobalState = GlobalState {
   _categories :: [Category],
   _categoriesDeleted :: [Category],
+  -- | Pending edits, newest first
   _pendingEdits :: [(Edit, EditDetails)],
-  _editIdCounter :: Int }            -- ID of next edit that will be made
+  -- | ID of next edit that will be made
+  _editIdCounter :: Int }
   deriving (Show)
 
 deriveSafeCopySimple 3 'extension ''GlobalState
@@ -737,8 +739,8 @@ addCon itemId traitId text' = do
 
 -- set
 
--- Almost all of these return an edit that could be used to undo the action
--- they've just done
+-- Almost all of these return an 'Edit' that corresponds to the edit that has
+-- been performed.
 
 -- | Can be useful sometimes (e.g. if you want to regenerate all uids), but
 -- generally shouldn't be used.
@@ -1010,6 +1012,14 @@ getEdit n = do
     Nothing   -> error ("no edit with id " ++ show n)
     Just edit -> return edit
 
+-- | Returns edits in order from latest to earliest.
+getEdits
+  :: Int            -- ^ Id of latest edit
+  -> Int            -- ^ Id of earliest edit
+  -> Acid.Query GlobalState [(Edit, EditDetails)]
+getEdits m n =
+  filter (\(_, d) -> n <= editId d && editId d <= m) <$> view pendingEdits
+
 -- | The edit won't be registered if it's vacuous (see 'isVacuousEdit').
 registerEdit
   :: Edit
@@ -1034,6 +1044,13 @@ removePendingEdit n = do
       pendingEdits %= deleteFirst ((== n) . editId . snd)
       return edit
 
+removePendingEdits
+  :: Int            -- ^ Id of latest edit
+  -> Int            -- ^ Id of earliest edit
+  -> Acid.Update GlobalState ()
+removePendingEdits m n = do
+  pendingEdits %= filter (\(_, d) -> editId d < n || m < editId d)
+
 makeAcidic ''GlobalState [
   -- queries
   'getGlobalState,
@@ -1057,9 +1074,9 @@ makeAcidic ''GlobalState [
   'deleteItem,
   'deleteTrait,
   -- edits
-  'getEdit,
+  'getEdit, 'getEdits,
   'registerEdit,
-  'removePendingEdit,
+  'removePendingEdit, 'removePendingEdits,
   -- other
   'moveItem, 'moveTrait,
   'restoreCategory, 'restoreItem, 'restoreTrait

src/View.hs

@@ -4,6 +4,7 @@ OverloadedStrings,
 FlexibleContexts,
 ViewPatterns,
 RecordWildCards,
+TupleSections,
 NoImplicitPrelude
   #-}
 
@@ -13,6 +14,7 @@ module View
   -- * Pages
   renderRoot,
   renderAdmin,
+  renderEdits,
   renderHaskellRoot,
   renderDonate,
   renderCategoryPage,
@@ -166,29 +168,52 @@ renderAdmin globalState edits = do
 
   body_ $ do
     h1_ "Pending edits"
-    -- Group edits by IP
-    let editGroups = groupBy (equating (editIP . snd)) edits
-    -- For each group, show the IP and then edits as a list
-    for_ editGroups $ \editGroup -> do
-      h2_ $ case editIP (snd (head editGroup)) of
-              Nothing -> "<unknown IP>"
-              Just ip -> toHtml (show ip)
-      ul_ $ do
-        for_ editGroup $ \(edit, EditDetails{..}) -> li_ $ do
-          editNode <- thisNode
-          p_ $ do
-            toHtml =<< liftIO (humanReadableTime editDate)
-            emptySpan "1em"
-            textButton "accept" $
-              JS.acceptEdit (editId, editNode)
-            emptySpan "0.5em"
-            textButton "try to undo" $
-              JS.undoEdit (editId, editNode)
-          renderEdit globalState edit
+    renderEdits globalState (map (,Nothing) edits)
 
 -- TODO: when showing Edit'DeleteCategory, show the amount of items in that
 -- category and titles of items themselves
 
+-- | Group edits by IP and render them
+renderEdits
+  :: MonadIO m
+  => GlobalState
+  -> [((Edit, EditDetails), Maybe String)]
+  -> HtmlT m ()
+renderEdits globalState edits = do
+  let editBlocks = groupBy (equating (editIP . snd . fst)) edits
+  for_ editBlocks $ \editBlock -> div_ $ do
+    blockNode <- thisNode
+    h2_ $ do
+      case editIP (editBlock ^?! _head._1._2) of
+        Nothing -> "<unknown IP>"
+        Just ip -> toHtml (show ip)
+      emptySpan "1em"
+      textButton "accept all" $
+        JS.acceptBlock (editId (editBlock ^?! _head._1._2),
+                        editId (editBlock ^?! _last._1._2),
+                        blockNode)
+      emptySpan "0.5em"
+      textButton "undo all" $
+        JS.undoBlock (editId (editBlock ^?! _head._1._2),
+                      editId (editBlock ^?! _last._1._2),
+                      blockNode)
+    ul_ $ do
+      for_ editBlock $ \((edit, EditDetails{..}), mbErr) -> li_ $ do
+        editNode <- thisNode
+        p_ $ do
+          toHtml =<< liftIO (humanReadableTime editDate)
+          emptySpan "1em"
+          textButton "accept" $
+            JS.acceptEdit (editId, editNode)
+          emptySpan "0.5em"
+          textButton "try to undo" $
+            JS.undoEdit (editId, editNode)
+        case mbErr of
+          Nothing  -> return ()
+          Just err -> p_ $ span_ [style_ "background-color:#E57373"] $
+            "Can't apply the edit: " >> toHtml err
+        renderEdit globalState edit
+
 renderEdit :: Monad m => GlobalState -> Edit -> HtmlT m ()
 renderEdit globalState edit = do
   let quote :: Monad m => HtmlT m () -> HtmlT m ()