From ccdb438862e43e4d0fd49193e180591f9b7b0abf Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 30 Jan 2019 11:14:30 +0100
Subject: [PATCH 01/15] Initial work on MassInput

---
 messages/uniworx/de.msg             |   3 +-
 package.yaml                        |   1 +
 src/Handler/Utils/Form/MassInput.hs | 117 ++++++++++++++++++++++++++++
 3 files changed, 120 insertions(+), 1 deletion(-)
 create mode 100644 src/Handler/Utils/Form/MassInput.hs

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 4f6f91a82..c638a4ba4 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -608,4 +608,5 @@ DeleteCopyStringIfSure n@Int: Wenn Sie sich sicher sind, dass Sie #{pluralDE n "
 DeleteConfirmation: Bestätigung
 DeleteConfirmationWrong: Bestätigung muss genau dem angezeigten Text entsprechen.
 
-DBTIRowsMissing n@Int: #{pluralDE n "Eine Zeile ist" "Einige Zeile sind"} aus der Datenbank verschwunden, seit das Formular für Sie generiert wurde
\ No newline at end of file
+DBTIRowsMissing n@Int: #{pluralDE n "Eine Zeile ist" "Einige Zeile sind"} aus der Datenbank verschwunden, seit das Formular für Sie generiert wurde
+MassInputUpdate: Formular aktualisieren
diff --git a/package.yaml b/package.yaml
index 46af6eab8..57b4b508d 100644
--- a/package.yaml
+++ b/package.yaml
@@ -114,6 +114,7 @@ dependencies:
   - memcached-binary
   - directory-tree
   - lifted-base
+  - lattices
 
 other-extensions:
   - GeneralizedNewtypeDeriving
diff --git a/src/Handler/Utils/Form/MassInput.hs b/src/Handler/Utils/Form/MassInput.hs
new file mode 100644
index 000000000..36b7aea40
--- /dev/null
+++ b/src/Handler/Utils/Form/MassInput.hs
@@ -0,0 +1,117 @@
+module Handler.Utils.Form.MassInput
+  ( massInput
+  , BoxDimension(..), IsBoxCoord(..), Liveliness(..)
+  ) where
+
+import Import
+import Utils.Form
+
+import Data.Aeson
+
+import Algebra.Lattice
+
+import Control.Lens hiding (universe)
+
+import Text.Blaze (Markup)
+
+import Data.List ((!!), elemIndex)
+import qualified Data.Text as Text
+
+
+data BoxDimension x = forall n. Enum n => BoxDimension (Lens' x n)
+  
+class (PathPiece x, ToJSONKey x, FromJSONKey x, Eq x, Ord x) => IsBoxCoord x where
+  boxDimensions :: [BoxDimension x]
+  boxOrigin :: x
+  
+class (ToJSON a, FromJSON a, IsBoxCoord (BoxCoord a), Lattice a, BoundedJoinSemiLattice a) => Liveliness a where
+  type BoxCoord a :: *
+  liveCoords :: Prism' (Set (BoxCoord a)) a
+  liveCoord :: BoxCoord a -> Prism' Bool a
+
+
+data MassInputButton submit
+  = MassInputUpdate
+  | MassInputSubmit submit
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+instance Bounded submit => Bounded (MassInputButton submit) where
+  minBound = MassInputUpdate
+  maxBound = MassInputSubmit maxBound
+  
+instance (Eq submit, Finite submit) => Enum (MassInputButton submit) where
+  toEnum = (!!) universe
+  fromEnum = fromMaybe (error "fromEnum: value not found") . flip elemIndex universeF
+
+instance Finite submit => Universe (MassInputButton submit) where
+  universe = MassInputUpdate : map MassInputSubmit universeF
+instance Finite submit => Finite (MassInputButton submit)
+
+instance PathPiece submit => PathPiece (MassInputButton submit) where
+  toPathPiece = \case
+    MassInputUpdate -> "update"
+    MassInputSubmit s -> "submit__" <> toPathPiece s
+  fromPathPiece t = inpUpdate <|> submit
+    where
+      inpUpdate = MassInputUpdate <$ guard (t == "update")
+      submit = do
+        submitT <- stripPrefix "submit__" t
+        MassInputSubmit <$> fromPathPiece submitT
+
+instance (Button UniWorX submit, Finite submit) => Button UniWorX (MassInputButton submit) where
+  label MassInputUpdate = [whamlet|_{MsgMassInputUpdate}|]
+  label (MassInputSubmit submit) = label submit
+
+  btnValidate _ MassInputUpdate = False
+  btnValidate proxy (MassInputSubmit submit) = btnValidate proxy submit
+
+  cssClass MassInputUpdate = BCDefault
+  cssClass (MassInputSubmit submit) = cssClass submit
+
+
+data MassInputFieldName x
+  = MassInputAddDimension Natural
+  | MassInputDeleteCell x
+  | MassInputCell x Text
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+instance IsBoxCoord x => PathPiece (MassInputFieldName x) where
+  toPathPiece = \case
+    MassInputAddDimension dim -> "addField--" <> tshow dim
+    MassInputDeleteCell (toPathPiece -> coord) -> "delCell--" <> coord
+    MassInputCell (toPathPiece -> coord) name -> coord <> "__" <> name
+
+  fromPathPiece t = addDimension <|> deleteCell <|> cell
+    where
+      addDimension = do
+        dim <- Text.stripPrefix "addField--" t >>= readMay
+        return $ MassInputAddDimension dim
+      deleteCell = do
+        coord <- Text.stripPrefix "delCell--" t >>= fromPathPiece
+        return $ MassInputDeleteCell coord
+      cell = do
+        (coordT, Text.stripPrefix "__" -> Just name) <- return $ Text.breakOn "__" t
+        coord <- fromPathPiece coordT
+        return $ MassInputCell coord name
+
+massInput :: forall handler cellData cellResult liveliness submit p.
+           ( MonadHandler handler, HandlerSite handler ~ UniWorX
+           , ToJSON cellData, FromJSON cellData
+           , Liveliness liveliness
+           , Button UniWorX submit, Finite submit
+           )
+          => (    Natural -- ^ Zero-based dimension index
+               -> liveliness -- ^ Currently live positions
+               -> (Text -> Text) -- ^ Nudge deterministic field ids 
+               -> (Markup -> MForm handler (FormResult (cellData, BoxCoord liveliness), Widget))
+             ) -- ^ Generate a cell-addition widget
+          -> (    BoxCoord liveliness
+               -> cellData
+               -> (Text -> Text) -- ^ Nudge deterministic field ids
+               -> (Markup -> MForm handler (FormResult cellResult, Widget))
+             ) -- ^ Cell-Widget
+          -> FieldSettings UniWorX
+          -> p submit
+          -> MForm handler (FormResult (Map (BoxCoord liveliness) cellResult), FieldView UniWorX)
+massInput mkAddWidget mkCellWidget FieldSettings{..} _ = do
+  error "massInput: not implemented"

From e9c69e6cfb729235612f2598db3aec758be30795 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Thu, 31 Jan 2019 11:43:32 +0100
Subject: [PATCH 02/15] Plan for MassInput-Controls being buttons

---
 messages/uniworx/de.msg             |   4 +-
 src/Handler/Utils/Form/MassInput.hs | 115 +++++++++++++---------------
 src/Import/NoFoundation.hs          |   2 +
 src/Numeric/Natural/Instances.hs    |  13 ++++
 4 files changed, 70 insertions(+), 64 deletions(-)
 create mode 100644 src/Numeric/Natural/Instances.hs

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index d24a09e5c..e6e4663c5 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -611,4 +611,6 @@ DeleteConfirmation: Bestätigung
 DeleteConfirmationWrong: Bestätigung muss genau dem angezeigten Text entsprechen.
 
 DBTIRowsMissing n@Int: #{pluralDE n "Eine Zeile ist" "Einige Zeile sind"} aus der Datenbank verschwunden, seit das Formular für Sie generiert wurde
-MassInputUpdate: Formular aktualisieren
+
+MassInputAddDimension: Hinzufügen
+MassInputDeleteCell: Entfernen
diff --git a/src/Handler/Utils/Form/MassInput.hs b/src/Handler/Utils/Form/MassInput.hs
index 36b7aea40..c24770b61 100644
--- a/src/Handler/Utils/Form/MassInput.hs
+++ b/src/Handler/Utils/Form/MassInput.hs
@@ -1,6 +1,8 @@
 module Handler.Utils.Form.MassInput
   ( massInput
-  , BoxDimension(..), IsBoxCoord(..), Liveliness(..)
+  , BoxDimension(..)
+  , IsBoxCoord(..), boxDimension
+  , Liveliness(..)
   ) where
 
 import Import
@@ -14,15 +16,23 @@ import Control.Lens hiding (universe)
 
 import Text.Blaze (Markup)
 
-import Data.List ((!!), elemIndex)
 import qualified Data.Text as Text
 
+import Data.List (genericLength, genericIndex)
+
 
 data BoxDimension x = forall n. Enum n => BoxDimension (Lens' x n)
   
 class (PathPiece x, ToJSONKey x, FromJSONKey x, Eq x, Ord x) => IsBoxCoord x where
   boxDimensions :: [BoxDimension x]
   boxOrigin :: x
+
+boxDimension :: IsBoxCoord x => Natural -> Maybe (BoxDimension x)
+boxDimension n
+  | n < genericLength dims = Just $ genericIndex dims n
+  | otherwise = Nothing
+  where
+    dims = boxDimensions
   
 class (ToJSON a, FromJSON a, IsBoxCoord (BoxCoord a), Lattice a, BoundedJoinSemiLattice a) => Liveliness a where
   type BoxCoord a :: *
@@ -30,75 +40,55 @@ class (ToJSON a, FromJSON a, IsBoxCoord (BoxCoord a), Lattice a, BoundedJoinSemi
   liveCoord :: BoxCoord a -> Prism' Bool a
 
 
-data MassInputButton submit
-  = MassInputUpdate
-  | MassInputSubmit submit
-  deriving (Eq, Ord, Read, Show, Generic, Typeable)
-
-instance Bounded submit => Bounded (MassInputButton submit) where
-  minBound = MassInputUpdate
-  maxBound = MassInputSubmit maxBound
-  
-instance (Eq submit, Finite submit) => Enum (MassInputButton submit) where
-  toEnum = (!!) universe
-  fromEnum = fromMaybe (error "fromEnum: value not found") . flip elemIndex universeF
-
-instance Finite submit => Universe (MassInputButton submit) where
-  universe = MassInputUpdate : map MassInputSubmit universeF
-instance Finite submit => Finite (MassInputButton submit)
-
-instance PathPiece submit => PathPiece (MassInputButton submit) where
-  toPathPiece = \case
-    MassInputUpdate -> "update"
-    MassInputSubmit s -> "submit__" <> toPathPiece s
-  fromPathPiece t = inpUpdate <|> submit
-    where
-      inpUpdate = MassInputUpdate <$ guard (t == "update")
-      submit = do
-        submitT <- stripPrefix "submit__" t
-        MassInputSubmit <$> fromPathPiece submitT
-
-instance (Button UniWorX submit, Finite submit) => Button UniWorX (MassInputButton submit) where
-  label MassInputUpdate = [whamlet|_{MsgMassInputUpdate}|]
-  label (MassInputSubmit submit) = label submit
-
-  btnValidate _ MassInputUpdate = False
-  btnValidate proxy (MassInputSubmit submit) = btnValidate proxy submit
-
-  cssClass MassInputUpdate = BCDefault
-  cssClass (MassInputSubmit submit) = cssClass submit
-
-
-data MassInputFieldName x
+data ButtonMassInput coord
   = MassInputAddDimension Natural
-  | MassInputDeleteCell x
-  | MassInputCell x Text
+  | MassInputDeleteCell coord
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
-instance IsBoxCoord x => PathPiece (MassInputFieldName x) where
+instance PathPiece coord => PathPiece (ButtonMassInput coord) where
+  toPathPiece = \case
+    MassInputAddDimension n -> "add__" <> toPathPiece n
+    MassInputDeleteCell c -> "delete__" <> toPathPiece c
+  fromPathPiece t = addDim <|> delCell
+    where
+      addDim = do
+        nT <- stripPrefix "add__" t
+        MassInputAddDimension <$> fromPathPiece nT
+      delCell = do
+        coordT <- stripPrefix "delete__" t
+        MassInputDeleteCell <$> fromPathPiece coordT
+
+instance RenderMessage UniWorX (ButtonMassInput coord) where
+  renderMessage f ls = \case
+    MassInputAddDimension _ -> mr MsgMassInputAddDimension
+    MassInputDeleteCell _ -> mr MsgMassInputDeleteCell
+    where
+      mr = renderMessage f ls
+
+instance PathPiece coord => Button UniWorX (ButtonMassInput coord) where
+  btnValidate _ _ = False
+
+  btnClasses (MassInputAddDimension _) = [BCIsButton, BCDefault]
+  btnClasses (MassInputDeleteCell _) = [BCIsButton, BCWarning]
+
+
+data MassInputFieldName coord
+  = MassInputCell coord Text
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+instance IsBoxCoord coord => PathPiece (MassInputFieldName coord) where
   toPathPiece = \case
-    MassInputAddDimension dim -> "addField--" <> tshow dim
-    MassInputDeleteCell (toPathPiece -> coord) -> "delCell--" <> coord
     MassInputCell (toPathPiece -> coord) name -> coord <> "__" <> name
 
-  fromPathPiece t = addDimension <|> deleteCell <|> cell
-    where
-      addDimension = do
-        dim <- Text.stripPrefix "addField--" t >>= readMay
-        return $ MassInputAddDimension dim
-      deleteCell = do
-        coord <- Text.stripPrefix "delCell--" t >>= fromPathPiece
-        return $ MassInputDeleteCell coord
-      cell = do
-        (coordT, Text.stripPrefix "__" -> Just name) <- return $ Text.breakOn "__" t
-        coord <- fromPathPiece coordT
-        return $ MassInputCell coord name
+  fromPathPiece t = do
+    (coordT, Text.stripPrefix "__" -> Just name) <- return $ Text.breakOn "__" t
+    coord <- fromPathPiece coordT
+    return $ MassInputCell coord name
 
-massInput :: forall handler cellData cellResult liveliness submit p.
+massInput :: forall handler cellData cellResult liveliness.
            ( MonadHandler handler, HandlerSite handler ~ UniWorX
            , ToJSON cellData, FromJSON cellData
            , Liveliness liveliness
-           , Button UniWorX submit, Finite submit
            )
           => (    Natural -- ^ Zero-based dimension index
                -> liveliness -- ^ Currently live positions
@@ -111,7 +101,6 @@ massInput :: forall handler cellData cellResult liveliness submit p.
                -> (Markup -> MForm handler (FormResult cellResult, Widget))
              ) -- ^ Cell-Widget
           -> FieldSettings UniWorX
-          -> p submit
           -> MForm handler (FormResult (Map (BoxCoord liveliness) cellResult), FieldView UniWorX)
-massInput mkAddWidget mkCellWidget FieldSettings{..} _ = do
+massInput mkAddWidget mkCellWidget FieldSettings{..} = do
   error "massInput: not implemented"
diff --git a/src/Import/NoFoundation.hs b/src/Import/NoFoundation.hs
index 1f1220787..dbb01adf1 100644
--- a/src/Import/NoFoundation.hs
+++ b/src/Import/NoFoundation.hs
@@ -61,6 +61,8 @@ import Database.Esqueleto.Instances as Import ()
 import Database.Persist.Sql.Instances as Import ()
 import Database.Persist.Sql as Import (SqlReadT,SqlWriteT)
 
+import Numeric.Natural.Instances as Import ()
+
 
 import Control.Monad.Trans.RWS (RWST)
 
diff --git a/src/Numeric/Natural/Instances.hs b/src/Numeric/Natural/Instances.hs
new file mode 100644
index 000000000..cb986f770
--- /dev/null
+++ b/src/Numeric/Natural/Instances.hs
@@ -0,0 +1,13 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Numeric.Natural.Instances
+  (
+  ) where
+
+import ClassyPrelude
+import Numeric.Natural
+import Web.PathPieces
+
+instance PathPiece Natural where
+  toPathPiece = tshow
+  fromPathPiece = readMay

From c0edc87926cecb7f306e128b6c515accd717943f Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 27 Feb 2019 13:07:22 +0100
Subject: [PATCH 03/15] Start on implementation

---
 src/Handler/Utils/Form/MassInput.hs | 83 ++++++++++++++++++++++++-----
 src/Utils.hs                        |  6 +++
 src/Utils/Form.hs                   |  4 +-
 3 files changed, 77 insertions(+), 16 deletions(-)

diff --git a/src/Handler/Utils/Form/MassInput.hs b/src/Handler/Utils/Form/MassInput.hs
index c24770b61..f89991736 100644
--- a/src/Handler/Utils/Form/MassInput.hs
+++ b/src/Handler/Utils/Form/MassInput.hs
@@ -7,6 +7,7 @@ module Handler.Utils.Form.MassInput
 
 import Import
 import Utils.Form
+import Handler.Utils.Form (secretJsonField)
 
 import Data.Aeson
 
@@ -18,23 +19,28 @@ import Text.Blaze (Markup)
 
 import qualified Data.Text as Text
 
+import qualified Data.Set as Set
+import qualified Data.Map as Map
 import Data.List (genericLength, genericIndex)
 
 
-data BoxDimension x = forall n. Enum n => BoxDimension (Lens' x n)
+data BoxDimension x = forall n. (Enum n, Num n) => BoxDimension (Lens' x n)
   
 class (PathPiece x, ToJSONKey x, FromJSONKey x, Eq x, Ord x) => IsBoxCoord x where
   boxDimensions :: [BoxDimension x]
   boxOrigin :: x
 
-boxDimension :: IsBoxCoord x => Natural -> Maybe (BoxDimension x)
+boxDimension :: IsBoxCoord x => Natural -> BoxDimension x
 boxDimension n
-  | n < genericLength dims = Just $ genericIndex dims n
-  | otherwise = Nothing
+  | n < genericLength dims = genericIndex dims n
+  | otherwise = error "boxDimension: insufficient dimensions"
   where
     dims = boxDimensions
+
+zeroDimension :: IsBoxCoord x => Natural -> x -> x
+zeroDimension (boxDimension -> BoxDimension dim) = set dim $ boxOrigin ^. dim
   
-class (ToJSON a, FromJSON a, IsBoxCoord (BoxCoord a), Lattice a, BoundedJoinSemiLattice a) => Liveliness a where
+class (IsBoxCoord (BoxCoord a), Lattice a, BoundedJoinSemiLattice a) => Liveliness a where
   type BoxCoord a :: *
   liveCoords :: Prism' (Set (BoxCoord a)) a
   liveCoord :: BoxCoord a -> Prism' Bool a
@@ -73,17 +79,37 @@ instance PathPiece coord => Button UniWorX (ButtonMassInput coord) where
 
 
 data MassInputFieldName coord
-  = MassInputCell coord Text
+  = MassInputShape { miName :: Text }
+  | MassInputAddWidget { miName :: Text, miCoord :: coord, miAddWidgetField :: Text }
+  | MassInputCell { miName :: Text, miCoord :: coord, miCellField :: Text }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 instance IsBoxCoord coord => PathPiece (MassInputFieldName coord) where
   toPathPiece = \case
-    MassInputCell (toPathPiece -> coord) name -> coord <> "__" <> name
+    MassInputShape{..} -> [st|#{miName}__shape|]
+    MassInputAddWidget{..} -> [st|#{miName}__#{toPathPiece miCoord}__#{miAddWidgetField}|]
+    MassInputCell{..} -> [st|#{miName}__#{toPathPiece miCoord}__#{miCellField}|]
 
   fromPathPiece t = do
-    (coordT, Text.stripPrefix "__" -> Just name) <- return $ Text.breakOn "__" t
-    coord <- fromPathPiece coordT
-    return $ MassInputCell coord name
+    (miName, Text.stripPrefix "__" -> Just t') <- return $ Text.breakOn "__" t
+    choice
+      [ do
+          guard $ t' == "shape"
+          return MassInputShape{..}
+      , do
+          (coordT, Text.stripPrefix "__" -> Just miCellField) <- return $ Text.breakOn "__" t'
+          miCoord <- fromPathPiece coordT
+          return MassInputAddWidget{..}
+      , do
+          (coordT, Text.stripPrefix "__" -> Just miCellField) <- return $ Text.breakOn "__" t'
+          miCoord <- fromPathPiece coordT
+          return MassInputCell{..}
+      ]
+
+data MassInputException = MassInputInvalidShape
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+instance Exception MassInputException
 
 massInput :: forall handler cellData cellResult liveliness.
            ( MonadHandler handler, HandlerSite handler ~ UniWorX
@@ -93,14 +119,43 @@ massInput :: forall handler cellData cellResult liveliness.
           => (    Natural -- ^ Zero-based dimension index
                -> liveliness -- ^ Currently live positions
                -> (Text -> Text) -- ^ Nudge deterministic field ids 
-               -> (Markup -> MForm handler (FormResult (cellData, BoxCoord liveliness), Widget))
+               -> (Markup -> MForm handler (FormResult (BoxCoord liveliness, cellData), Widget))
              ) -- ^ Generate a cell-addition widget
           -> (    BoxCoord liveliness
                -> cellData
+               -> Maybe cellResult
                -> (Text -> Text) -- ^ Nudge deterministic field ids
                -> (Markup -> MForm handler (FormResult cellResult, Widget))
              ) -- ^ Cell-Widget
           -> FieldSettings UniWorX
-          -> MForm handler (FormResult (Map (BoxCoord liveliness) cellResult), FieldView UniWorX)
-massInput mkAddWidget mkCellWidget FieldSettings{..} = do
-  error "massInput: not implemented"
+          -> Maybe (Map (BoxCoord liveliness) (cellData, cellResult))
+          -> MForm handler (FormResult (Map (BoxCoord liveliness) (cellData, cellResult)), Widget)
+massInput _mkAddWidget mkCellWidget FieldSettings{..} initialResult = do
+  miName <- maybe newFormIdent return fsName
+  let
+    shapeName :: MassInputFieldName (BoxCoord liveliness)
+    shapeName = MassInputShape{..}
+  (shape', _shapeWdgt) <- mreq secretJsonField ("" & addName shapeName) $ fmap fst <$> initialResult
+  shape <- if
+    | FormSuccess s <- shape' -> return s
+    | Just (fmap fst -> iS) <- initialResult -> return iS
+    | Just iS <- Set.empty ^? liveCoords -> return iS
+    | otherwise -> throwM MassInputInvalidShape
+  cellResults <- forM shape $ \(miCoord, cData) -> do
+    let
+      nudgeCellName :: Text -> Text
+      nudgeCellName miCellField = toPathPiece MassInputCell{..}
+    (cData, ) <$> mkCellWidget miCoord cData (fmap snd . Map.lookup miCoord =<< initialResult) nudgeCellName mempty
+  liveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet shape ^? liveCoords
+  let result :: FormResult (Map (BoxCoord liveliness) (cellData, cellResult))
+      result = traverse (\(cData, (cResult, _)) -> (cData, ) <$> cResult) cellResults
+      miWidget :: [BoxDimension (BoxCoord liveliness)] -> Widget
+      miWidget = miWidget' nudgeAddWidgetName 0 liveliness
+      nudgeAddWidgetName :: Text -> Text
+      nudgeAddWidgetName miAddWidgetField = toPathPiece MassInputAddWidget{..}
+  return (result, miWidget boxDimensions)
+  where
+    miWidget' :: (Text -> Text) -> Natural -> liveliness -> [BoxDimension (BoxCoord liveliness)] -> Widget
+    miWidget' nudge dimIx liveliness [] = mempty
+    miWidget' nudge dimIx liveliness (BoxDimension dim : remDims)
+      = error "not implemented"
diff --git a/src/Utils.hs b/src/Utils.hs
index 2990778dc..ed9e0ea57 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -508,6 +508,12 @@ mconcatMapM f = foldM (\x my -> mappend x <$> my) mempty . map f . Fold.toList
 mconcatForM :: (Monoid b, Monad m, Foldable f) => f a -> (a -> m b) -> m b
 mconcatForM = flip mconcatMapM
 
+-----------------
+-- Alternative --
+-----------------
+
+choice :: forall f mono a. (Alternative f, MonoFoldable mono, Element mono ~ f a) => mono -> f a
+choice = foldr (<|>) empty
 
 --------------
 -- Sessions --
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index 6fab13a32..0a2487eec 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -108,8 +108,8 @@ addClass = addAttr "class"
 addClasses :: [Text] -> FieldSettings site -> FieldSettings site
 addClasses = addAttrs "class"
 
-addName :: Text -> FieldSettings site -> FieldSettings site
-addName nm fs = fs { fsName = Just nm }
+addName :: PathPiece p => p -> FieldSettings site -> FieldSettings site
+addName nm fs = fs { fsName = Just $ toPathPiece nm }
 
 addNameClass :: Text -> Text -> FieldSettings site -> FieldSettings site
 addNameClass gName gClass fs = fs { fsName = Just gName, fsAttrs = ("class",gClass) : fsAttrs fs }

From 332493f5501495dd684286417af5e9a5d15dd182 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 13 Mar 2019 09:25:00 +0100
Subject: [PATCH 04/15] View-Prototype of MassInput

---
 src/Handler/Utils/Form/MassInput.hs     | 82 ++++++++++++++++++-------
 templates/widgets/massinput/cell.hamlet |  1 +
 templates/widgets/massinput/row.hamlet  |  7 +++
 3 files changed, 68 insertions(+), 22 deletions(-)
 create mode 100644 templates/widgets/massinput/cell.hamlet
 create mode 100644 templates/widgets/massinput/row.hamlet

diff --git a/src/Handler/Utils/Form/MassInput.hs b/src/Handler/Utils/Form/MassInput.hs
index f89991736..b135e3a6c 100644
--- a/src/Handler/Utils/Form/MassInput.hs
+++ b/src/Handler/Utils/Form/MassInput.hs
@@ -21,7 +21,7 @@ import qualified Data.Text as Text
 
 import qualified Data.Set as Set
 import qualified Data.Map as Map
-import Data.List (genericLength, genericIndex)
+import Data.List (genericLength, genericIndex, iterate)
 
 
 data BoxDimension x = forall n. (Enum n, Num n) => BoxDimension (Lens' x n)
@@ -37,8 +37,8 @@ boxDimension n
   where
     dims = boxDimensions
 
-zeroDimension :: IsBoxCoord x => Natural -> x -> x
-zeroDimension (boxDimension -> BoxDimension dim) = set dim $ boxOrigin ^. dim
+-- zeroDimension :: IsBoxCoord x => Natural -> x -> x
+-- zeroDimension (boxDimension -> BoxDimension dim) = set dim $ boxOrigin ^. dim
   
 class (IsBoxCoord (BoxCoord a), Lattice a, BoundedJoinSemiLattice a) => Liveliness a where
   type BoxCoord a :: *
@@ -97,7 +97,7 @@ instance IsBoxCoord coord => PathPiece (MassInputFieldName coord) where
           guard $ t' == "shape"
           return MassInputShape{..}
       , do
-          (coordT, Text.stripPrefix "__" -> Just miCellField) <- return $ Text.breakOn "__" t'
+          (coordT, Text.stripPrefix "__" -> Just miAddWidgetField) <- return $ Text.breakOn "__" t'
           miCoord <- fromPathPiece coordT
           return MassInputAddWidget{..}
       , do
@@ -119,7 +119,7 @@ massInput :: forall handler cellData cellResult liveliness.
           => (    Natural -- ^ Zero-based dimension index
                -> liveliness -- ^ Currently live positions
                -> (Text -> Text) -- ^ Nudge deterministic field ids 
-               -> (Markup -> MForm handler (FormResult (BoxCoord liveliness, cellData), Widget))
+               -> Maybe (Markup -> MForm handler (FormResult (BoxCoord liveliness, cellData), Widget))
              ) -- ^ Generate a cell-addition widget
           -> (    BoxCoord liveliness
                -> cellData
@@ -128,34 +128,72 @@ massInput :: forall handler cellData cellResult liveliness.
                -> (Markup -> MForm handler (FormResult cellResult, Widget))
              ) -- ^ Cell-Widget
           -> FieldSettings UniWorX
+          -> Bool -- ^ Required?
           -> Maybe (Map (BoxCoord liveliness) (cellData, cellResult))
-          -> MForm handler (FormResult (Map (BoxCoord liveliness) (cellData, cellResult)), Widget)
-massInput _mkAddWidget mkCellWidget FieldSettings{..} initialResult = do
+          -> MForm handler (FormResult (Map (BoxCoord liveliness) (cellData, cellResult)), FieldView UniWorX)
+massInput mkAddWidget mkCellWidget FieldSettings{..} fvRequired initialResult = do
+  let initialShape = fmap fst <$> initialResult
+  
   miName <- maybe newFormIdent return fsName
   let
     shapeName :: MassInputFieldName (BoxCoord liveliness)
     shapeName = MassInputShape{..}
-  (shape', _shapeWdgt) <- mreq secretJsonField ("" & addName shapeName) $ fmap fst <$> initialResult
+  (shape', _shapeWdgt) <- mreq secretJsonField ("" & addName shapeName) $ initialShape 
   shape <- if
     | FormSuccess s <- shape' -> return s
-    | Just (fmap fst -> iS) <- initialResult -> return iS
-    | Just iS <- Set.empty ^? liveCoords -> return iS
+    | Just iS <- initialShape -> return iS
+    | Set.null $ review liveCoords (bottom :: liveliness) -> return Map.empty
     | otherwise -> throwM MassInputInvalidShape
-  cellResults <- forM shape $ \(miCoord, cData) -> do
+
+  cellResults <- flip Map.traverseWithKey shape $ \miCoord cData -> do
     let
       nudgeCellName :: Text -> Text
-      nudgeCellName miCellField = toPathPiece MassInputCell{..}
+      nudgeCellName miCellField = toPathPiece (MassInputCell{..} :: MassInputFieldName (BoxCoord liveliness))
     (cData, ) <$> mkCellWidget miCoord cData (fmap snd . Map.lookup miCoord =<< initialResult) nudgeCellName mempty
+
   liveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet shape ^? liveCoords
   let result :: FormResult (Map (BoxCoord liveliness) (cellData, cellResult))
       result = traverse (\(cData, (cResult, _)) -> (cData, ) <$> cResult) cellResults
-      miWidget :: [BoxDimension (BoxCoord liveliness)] -> Widget
-      miWidget = miWidget' nudgeAddWidgetName 0 liveliness
-      nudgeAddWidgetName :: Text -> Text
-      nudgeAddWidgetName miAddWidgetField = toPathPiece MassInputAddWidget{..}
-  return (result, miWidget boxDimensions)
-  where
-    miWidget' :: (Text -> Text) -> Natural -> liveliness -> [BoxDimension (BoxCoord liveliness)] -> Widget
-    miWidget' nudge dimIx liveliness [] = mempty
-    miWidget' nudge dimIx liveliness (BoxDimension dim : remDims)
-      = error "not implemented"
+
+  let addForm :: [BoxDimension (BoxCoord liveliness)] -> MForm handler (Map (Natural, BoxCoord liveliness) (FormResult (BoxCoord liveliness, cellData), Widget))
+      addForm = addForm' boxOrigin . zip [0..]
+        where
+          addForm' _ [] = return Map.empty
+          addForm' miCoord ((dimIx, _) : remDims) = do
+            let nudgeAddWidgetName :: Text -> Text
+                nudgeAddWidgetName miAddWidgetField = toPathPiece MassInputAddWidget{..}
+            dimRes <- traverse ($ mempty) $ mkAddWidget dimIx liveliness nudgeAddWidgetName
+            let dimRes' = maybe Map.empty (Map.singleton (dimIx, miCoord)) dimRes
+            case remDims of
+              [] -> return dimRes'
+              ((_, BoxDimension dim) : _) -> do
+                let
+                  miCoords = Set.fromList . takeWhile (\c -> review (liveCoord c) liveliness) $ iterate (over dim succ) miCoord
+                dimRess <- sequence $ Map.fromSet (\c -> addForm' c remDims) miCoords
+                return $ dimRes' `Map.union` fold dimRess
+
+  addResults <- addForm boxDimensions
+  
+  let miWidget :: BoxCoord liveliness -> [(Natural, BoxDimension (BoxCoord liveliness))] -> Widget
+      miWidget _ [] = mempty
+      miWidget miCoord ((dimIx, BoxDimension dim) : remDims) =
+        let coords = takeWhile (\c -> review (liveCoord c) liveliness) $ iterate (over dim succ) miCoord
+            cells
+              | [] <- remDims = do
+                  coord <- coords
+                  Just (_data, (_cellRes, cellWdgt)) <- return $ Map.lookup coord cellResults 
+                  return (coord, $(widgetFile "widgets/massinput/cell"))
+              | otherwise =
+                  [ (coord, miWidget coord remDims) | coord <- coords ]
+            addWidget = snd <$> Map.lookup (dimIx, miCoord) addResults
+         in $(widgetFile "widgets/massinput/row")
+
+  MsgRenderer mr <- getMsgRenderer
+  fvId <- maybe newIdent return fsId
+  
+  let
+    fvLabel = toHtml $ mr fsLabel
+    fvTooltip = toHtml . mr <$> fsTooltip
+    fvInput = miWidget boxOrigin $ zip [0..] boxDimensions
+    fvErrors = Nothing
+  return (result, FieldView{..})
diff --git a/templates/widgets/massinput/cell.hamlet b/templates/widgets/massinput/cell.hamlet
new file mode 100644
index 000000000..de6e44d7a
--- /dev/null
+++ b/templates/widgets/massinput/cell.hamlet
@@ -0,0 +1 @@
+^{cellWdgt}
diff --git a/templates/widgets/massinput/row.hamlet b/templates/widgets/massinput/row.hamlet
new file mode 100644
index 000000000..8c43c9896
--- /dev/null
+++ b/templates/widgets/massinput/row.hamlet
@@ -0,0 +1,7 @@
+<ul .massinput--row .#{"massinput--dim" <> toPathPiece dimIx}>
+  $forall (cellCoord, cell) <- cells
+    <li .massinput--cell data-massinput-coord=#{toPathPiece cellCoord}>
+      ^{cell}
+  $maybe add <- addWidget
+    <li .massinput--add>
+      ^{add}

From 4b2d6d3aa274df9096b00a3ff683542fd6bad3a8 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 20 Mar 2019 15:13:41 +0100
Subject: [PATCH 05/15] (Semi-)Working Prototype

---
 src/Handler/Admin.hs                    |  62 +++++++
 src/Handler/Utils/Form/MassInput.hs     | 207 +++++++++++++++++++-----
 src/Utils.hs                            |   2 +-
 src/Utils/Form.hs                       |   7 +
 src/Utils/Lens.hs                       |   2 +
 templates/widgets/massinput/cell.hamlet |   2 +
 6 files changed, 238 insertions(+), 44 deletions(-)

diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index 6edcbf05f..a79faabb9 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -2,6 +2,7 @@ module Handler.Admin where
 
 import Import
 import Handler.Utils
+import Handler.Utils.Form.MassInput
 import Jobs
 
 import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder)
@@ -15,6 +16,12 @@ import Control.Monad.Trans.Except
 
 import Database.Persist.Sql (fromSqlKey)
 
+import qualified Data.Text as Text
+import Data.Char (isDigit)
+
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
 -- import Colonnade hiding (fromMaybe)
 -- import Yesod.Colonnade
 
@@ -125,6 +132,45 @@ postAdminTestR = do
                     <li>#{m}
         |]
 
+  let
+    -- | Make a form for adding a point/line/plane/hyperplane/... (in this case: cell)
+    --
+    -- This /needs/ to use @nudge@ (for deterministic field naming) and to replace all occurances of @mreq@ with @mpreq@ (no fields should be /actually/ required)
+    mkAddForm :: ListPosition -- ^ Approximate position of the add-widget
+              -> Natural -- ^ Dimension Index, outermost dimension ist 0 i.e. if dimension is 3 hyperplane-adders get passed 0, planes get passed 1, lines get 2, and points get 3
+              -> ListLength -- ^ Liveliness
+              -> (Text -> Text) -- ^ Nudge deterministic field ids so they're unique
+              -> FieldView UniWorX -- ^ Submit-Button for this add-widget
+              -> Maybe (Form (ListPosition, Int)) -- ^ Nothing if no further cells should be added; returns index of new cell and data needed to initialize cell
+    mkAddForm 0 0 listLength nudge submitBtn
+      | listLength >= 7 = Nothing
+      | otherwise = Just $ \csrf -> do
+        (addRes, addView) <- mpreq textField ("" & addName (nudge "text")) Nothing
+        let addRes' = fromMaybe 0 . readMay . Text.filter isDigit <$> addRes
+        return ((fromIntegral listLength, ) <$> addRes', toWidget csrf >> fvInput addView >> fvInput submitBtn)
+    mkAddForm _pos _dim _ _ _ = error "Dimension and Position is always 0 for our 1-dimensional form"
+    -- | Make a single massInput-Cell
+    --
+    -- This /needs/ to use @nudge@ for deterministic field naming
+    mkCellForm :: ListPosition -- ^ Position of this cell
+               -> Int -- ^ Data needed to initialize the cell (see return of @mkAddForm@)
+               -> Maybe Int -- ^ Initial cell result from Argument to `massInput`
+               -> (Text -> Text) -- ^ Nudge deterministic field ids so they're unique
+               -> Form Int
+    mkCellForm _pos initial previous nudge csrf = do
+      (intRes, intView) <- mreq intField ("" & addName (nudge "int")) $ previous <|> Just initial
+      return (intRes, toWidget csrf >> fvInput intView)
+    -- | How does the shape (`ListLength`) change if a certain cell is deleted?
+    deleteCell :: ListLength -- ^ Current shape
+               -> ListPosition -- ^ Coordinate to delete
+               -> MaybeT (MForm (HandlerT UniWorX IO)) (Map ListPosition ListPosition) -- ^ Monadically compute a set of new positions and their associated old positions
+    deleteCell l pos
+      | l >= 2 = return . Map.fromSet (\pos' -> bool pos' (succ pos') $ pos' >= pos) $ Set.fromList [0..fromIntegral (l - 2)]
+      | otherwise = return Map.empty
+    
+  ((miResult, (fvInput -> miForm)), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell) "" True Nothing
+
+
   let locallyDefinedPageHeading = [whamlet|Admin TestPage for Uni2work|]
   siteLayout locallyDefinedPageHeading $ do
   -- defaultLayout $ do
@@ -135,6 +181,22 @@ postAdminTestR = do
     $(widgetFile "formPage")
     showDemoResult
 
+    [whamlet|
+      <h2>Mass-Input
+      <form enctype=#{miEnc} method=POST>
+        ^{miForm}
+        ^{submitButtonView}
+      $case miResult
+        $of FormMissing
+        $of FormFailure errs
+          <ul>
+            $forall err <- errs
+              <li>#{err}
+        $of FormSuccess res
+          <pre>
+            #{tshow res}
+    |]
+
 
 getAdminErrMsgR, postAdminErrMsgR :: Handler Html
 getAdminErrMsgR = postAdminErrMsgR
diff --git a/src/Handler/Utils/Form/MassInput.hs b/src/Handler/Utils/Form/MassInput.hs
index b135e3a6c..3375f5a24 100644
--- a/src/Handler/Utils/Form/MassInput.hs
+++ b/src/Handler/Utils/Form/MassInput.hs
@@ -1,20 +1,23 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 module Handler.Utils.Form.MassInput
-  ( massInput
+  ( MassInput(..)
+  , massInput
   , BoxDimension(..)
   , IsBoxCoord(..), boxDimension
   , Liveliness(..)
+  , ListLength(..), ListPosition(..)
   ) where
 
 import Import
 import Utils.Form
+import Utils.Lens
 import Handler.Utils.Form (secretJsonField)
 
 import Data.Aeson
 
 import Algebra.Lattice
 
-import Control.Lens hiding (universe)
-
 import Text.Blaze (Markup)
 
 import qualified Data.Text as Text
@@ -23,6 +26,9 @@ import qualified Data.Set as Set
 import qualified Data.Map as Map
 import Data.List (genericLength, genericIndex, iterate)
 
+import Control.Monad.Trans.Maybe
+import Control.Monad.Fix
+
 
 data BoxDimension x = forall n. (Enum n, Num n) => BoxDimension (Lens' x n)
   
@@ -44,29 +50,71 @@ class (IsBoxCoord (BoxCoord a), Lattice a, BoundedJoinSemiLattice a) => Liveline
   type BoxCoord a :: *
   liveCoords :: Prism' (Set (BoxCoord a)) a
   liveCoord :: BoxCoord a -> Prism' Bool a
+  liveCoord bC = prism' (\l -> bC `Set.member` review liveCoords l) (bool (Just bottom) (preview liveCoords $ Set.singleton bC))
 
 
+newtype ListLength = ListLength { unListLength :: Natural }
+  deriving newtype (Num, Integral, Real, Enum, PathPiece)
+  deriving (Eq, Ord, Generic, Typeable, Read, Show)
+
+makeWrapped ''ListLength
+
+instance JoinSemiLattice ListLength where
+  (\/) = max
+instance MeetSemiLattice ListLength where
+  (/\) = min
+instance Lattice ListLength
+instance BoundedJoinSemiLattice ListLength where
+  bottom = 0
+
+newtype ListPosition = ListPosition { unListPosition :: Natural }
+  deriving newtype (Num, Integral, Real, Enum, PathPiece, ToJSONKey, FromJSONKey)
+  deriving (Eq, Ord, Generic, Typeable, Read, Show)
+
+makeWrapped ''ListPosition
+
+instance IsBoxCoord ListPosition where
+  boxDimensions = [BoxDimension id]
+  boxOrigin = 0
+
+instance Liveliness ListLength where
+  type BoxCoord ListLength = ListPosition
+  liveCoords = prism' toSet fromSet
+    where
+      toSet n
+        | n > 0     = Set.fromList [0..pred (fromIntegral n)]
+        | otherwise = Set.empty
+
+      fromSet ns
+        | ns == maybe Set.empty (\n -> Set.fromList [0..n]) max'
+        = fmap (succ . fromIntegral) max' <|> Just 0
+        | otherwise
+        = Nothing
+        where
+          max' = Set.lookupMax ns
+  liveCoord (ListPosition n) = prism' (\(ListLength l) -> n < l) (bool (Just 0) (1 <$ guard (n == 0)))
+
 data ButtonMassInput coord
-  = MassInputAddDimension Natural
+  = MassInputAddDimension Natural coord
   | MassInputDeleteCell coord
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 instance PathPiece coord => PathPiece (ButtonMassInput coord) where
   toPathPiece = \case
-    MassInputAddDimension n -> "add__" <> toPathPiece n
+    MassInputAddDimension n c -> "add__" <> toPathPiece n <> "__" <> toPathPiece c
     MassInputDeleteCell c -> "delete__" <> toPathPiece c
   fromPathPiece t = addDim <|> delCell
     where
       addDim = do
-        nT <- stripPrefix "add__" t
-        MassInputAddDimension <$> fromPathPiece nT
+        (dimT, Text.stripPrefix "__" -> Just coordT) <- Text.breakOn "__" <$> stripPrefix "add__" t
+        MassInputAddDimension <$> fromPathPiece dimT <*> fromPathPiece coordT
       delCell = do
         coordT <- stripPrefix "delete__" t
         MassInputDeleteCell <$> fromPathPiece coordT
 
 instance RenderMessage UniWorX (ButtonMassInput coord) where
   renderMessage f ls = \case
-    MassInputAddDimension _ -> mr MsgMassInputAddDimension
+    MassInputAddDimension _ _ -> mr MsgMassInputAddDimension
     MassInputDeleteCell _ -> mr MsgMassInputDeleteCell
     where
       mr = renderMessage f ls
@@ -74,21 +122,25 @@ instance RenderMessage UniWorX (ButtonMassInput coord) where
 instance PathPiece coord => Button UniWorX (ButtonMassInput coord) where
   btnValidate _ _ = False
 
-  btnClasses (MassInputAddDimension _) = [BCIsButton, BCDefault]
+  btnClasses (MassInputAddDimension _ _) = [BCIsButton, BCDefault]
   btnClasses (MassInputDeleteCell _) = [BCIsButton, BCWarning]
 
 
 data MassInputFieldName coord
   = MassInputShape { miName :: Text }
   | MassInputAddWidget { miName :: Text, miCoord :: coord, miAddWidgetField :: Text }
+  | MassInputAddButton { miName :: Text, miCoord :: coord }
+  | MassInputDeleteButton { miName :: Text, miCoord :: coord }
   | MassInputCell { miName :: Text, miCoord :: coord, miCellField :: Text }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 instance IsBoxCoord coord => PathPiece (MassInputFieldName coord) where
   toPathPiece = \case
     MassInputShape{..} -> [st|#{miName}__shape|]
-    MassInputAddWidget{..} -> [st|#{miName}__#{toPathPiece miCoord}__#{miAddWidgetField}|]
-    MassInputCell{..} -> [st|#{miName}__#{toPathPiece miCoord}__#{miCellField}|]
+    MassInputAddWidget{..} -> [st|#{miName}__add__#{toPathPiece miCoord}__fields__#{miAddWidgetField}|]
+    MassInputAddButton{..} -> [st|#{miName}__add__#{toPathPiece miCoord}__submit|]
+    MassInputDeleteButton{..} -> [st|#{miName}__delete__#{toPathPiece miCoord}|]
+    MassInputCell{..} -> [st|#{miName}__cells__#{toPathPiece miCoord}__#{miCellField}|]
 
   fromPathPiece t = do
     (miName, Text.stripPrefix "__" -> Just t') <- return $ Text.breakOn "__" t
@@ -97,11 +149,26 @@ instance IsBoxCoord coord => PathPiece (MassInputFieldName coord) where
           guard $ t' == "shape"
           return MassInputShape{..}
       , do
-          (coordT, Text.stripPrefix "__" -> Just miAddWidgetField) <- return $ Text.breakOn "__" t'
+          t'' <- Text.stripPrefix "add__" t'
+          (coordT, Text.stripPrefix "__" -> Just rest) <- return $ Text.breakOn "__" t''
+          miAddWidgetField <- Text.stripPrefix "fields__" rest
           miCoord <- fromPathPiece coordT
           return MassInputAddWidget{..}
       , do
-          (coordT, Text.stripPrefix "__" -> Just miCellField) <- return $ Text.breakOn "__" t'
+          t'' <- Text.stripPrefix "add__" t'
+          (coordT, Text.stripPrefix "__" -> Just ident) <- return $ Text.breakOn "__" t''
+          guard $ ident == "submit"
+          miCoord <- fromPathPiece coordT
+          return MassInputAddButton{..}
+      , do
+          t'' <- Text.stripPrefix "delete__" t'
+          (coordT, rest) <- return $ Text.breakOn "__" t''
+          guard $ Text.null rest
+          miCoord <- fromPathPiece coordT
+          return MassInputDeleteButton{..}
+      , do
+          t'' <- Text.stripPrefix "cells__" t'
+          (coordT, Text.stripPrefix "__" -> Just miCellField) <- return $ Text.breakOn "__" t''
           miCoord <- fromPathPiece coordT
           return MassInputCell{..}
       ]
@@ -111,49 +178,50 @@ data MassInputException = MassInputInvalidShape
 
 instance Exception MassInputException
 
+data MassInput handler liveliness cellData cellResult = MassInput
+  { miAdd :: BoxCoord liveliness -- Position (dimensions after @dimIx@ are zero)
+          -> Natural -- Zero-based dimension index @dimIx@
+          -> liveliness
+          -> (Text -> Text) -- Nudge deterministic field ids
+          -> FieldView UniWorX -- Submit button
+          -> Maybe (Markup -> MForm handler (FormResult (BoxCoord liveliness, cellData), Widget))
+  , miCell :: BoxCoord liveliness -- Position
+           -> cellData -- Initialisation data
+           -> Maybe cellResult -- Previous result
+           -> (Text -> Text) -- Nudge deterministic field ids
+           -> (Markup -> MForm handler (FormResult cellResult, Widget))
+  , miDelete :: liveliness -> BoxCoord liveliness -> MaybeT (MForm handler) (Map (BoxCoord liveliness) (BoxCoord liveliness))
+  }
+
 massInput :: forall handler cellData cellResult liveliness.
            ( MonadHandler handler, HandlerSite handler ~ UniWorX
            , ToJSON cellData, FromJSON cellData
            , Liveliness liveliness
+           , MonadFix handler, MonadLogger handler
            )
-          => (    Natural -- ^ Zero-based dimension index
-               -> liveliness -- ^ Currently live positions
-               -> (Text -> Text) -- ^ Nudge deterministic field ids 
-               -> Maybe (Markup -> MForm handler (FormResult (BoxCoord liveliness, cellData), Widget))
-             ) -- ^ Generate a cell-addition widget
-          -> (    BoxCoord liveliness
-               -> cellData
-               -> Maybe cellResult
-               -> (Text -> Text) -- ^ Nudge deterministic field ids
-               -> (Markup -> MForm handler (FormResult cellResult, Widget))
-             ) -- ^ Cell-Widget
+          => MassInput handler liveliness cellData cellResult
           -> FieldSettings UniWorX
           -> Bool -- ^ Required?
           -> Maybe (Map (BoxCoord liveliness) (cellData, cellResult))
-          -> MForm handler (FormResult (Map (BoxCoord liveliness) (cellData, cellResult)), FieldView UniWorX)
-massInput mkAddWidget mkCellWidget FieldSettings{..} fvRequired initialResult = do
+          -> (Markup -> MForm handler (FormResult (Map (BoxCoord liveliness) (cellData, cellResult)), FieldView UniWorX))
+massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do
   let initialShape = fmap fst <$> initialResult
   
   miName <- maybe newFormIdent return fsName
   let
     shapeName :: MassInputFieldName (BoxCoord liveliness)
     shapeName = MassInputShape{..}
-  (shape', _shapeWdgt) <- mreq secretJsonField ("" & addName shapeName) $ initialShape 
-  shape <- if
-    | FormSuccess s <- shape' -> return s
+    shapeField = secretJsonField
+  sentShape <- runMaybeT $ do
+    ts <- fromMaybe [] . Map.lookup (toPathPiece shapeName) <$> MaybeT askParams
+    fs <- fromMaybe [] . Map.lookup (toPathPiece shapeName) <$> MaybeT askFiles
+    MaybeT $ either (const Nothing) id <$> lift (fieldParse shapeField ts fs)
+  sentShape' <- if
+    | Just s <- sentShape -> return s
     | Just iS <- initialShape -> return iS
     | Set.null $ review liveCoords (bottom :: liveliness) -> return Map.empty
     | otherwise -> throwM MassInputInvalidShape
-
-  cellResults <- flip Map.traverseWithKey shape $ \miCoord cData -> do
-    let
-      nudgeCellName :: Text -> Text
-      nudgeCellName miCellField = toPathPiece (MassInputCell{..} :: MassInputFieldName (BoxCoord liveliness))
-    (cData, ) <$> mkCellWidget miCoord cData (fmap snd . Map.lookup miCoord =<< initialResult) nudgeCellName mempty
-
-  liveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet shape ^? liveCoords
-  let result :: FormResult (Map (BoxCoord liveliness) (cellData, cellResult))
-      result = traverse (\(cData, (cResult, _)) -> (cData, ) <$> cResult) cellResults
+  sentLiveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet sentShape' ^? liveCoords :: MForm handler liveliness
 
   let addForm :: [BoxDimension (BoxCoord liveliness)] -> MForm handler (Map (Natural, BoxCoord liveliness) (FormResult (BoxCoord liveliness, cellData), Widget))
       addForm = addForm' boxOrigin . zip [0..]
@@ -162,18 +230,66 @@ massInput mkAddWidget mkCellWidget FieldSettings{..} fvRequired initialResult =
           addForm' miCoord ((dimIx, _) : remDims) = do
             let nudgeAddWidgetName :: Text -> Text
                 nudgeAddWidgetName miAddWidgetField = toPathPiece MassInputAddWidget{..}
-            dimRes <- traverse ($ mempty) $ mkAddWidget dimIx liveliness nudgeAddWidgetName
+            dimRes <- runMaybeT $ do
+              (btnRes, btnView) <- lift $ mpreq (buttonField $ MassInputAddDimension dimIx miCoord) ("" & addName MassInputAddButton{..}) Nothing
+              (addRes, addView) <- MaybeT . traverse ($ mempty) $ miAdd miCoord dimIx sentLiveliness nudgeAddWidgetName btnView
+              return (btnRes *> addRes, addView)
             let dimRes' = maybe Map.empty (Map.singleton (dimIx, miCoord)) dimRes
             case remDims of
               [] -> return dimRes'
               ((_, BoxDimension dim) : _) -> do
                 let
-                  miCoords = Set.fromList . takeWhile (\c -> review (liveCoord c) liveliness) $ iterate (over dim succ) miCoord
+                  miCoords = Set.fromList . takeWhile (\c -> review (liveCoord c) sentLiveliness) $ iterate (over dim succ) miCoord
                 dimRess <- sequence $ Map.fromSet (\c -> addForm' c remDims) miCoords
                 return $ dimRes' `Map.union` fold dimRess
 
   addResults <- addForm boxDimensions
+  let addShape
+        | [FormSuccess (bCoord, cData)] <- Map.elems . Map.filter (is _FormSuccess) $ fmap fst addResults = Just $ Map.insert bCoord cData sentShape'
+        | otherwise = Nothing
+
+  addedShape <- if
+    | Just s <- addShape -> return s
+    | otherwise -> return sentShape'
+  addedLiveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet addedShape ^? liveCoords :: MForm handler liveliness
+
+  let
+    delForm :: BoxCoord liveliness -> MaybeT (MForm handler) (FormResult (Map (BoxCoord liveliness) (BoxCoord liveliness)), FieldView UniWorX)
+    delForm miCoord = do
+      (delRes, delView) <- lift $ mpreq (buttonField $ MassInputDeleteCell miCoord) ("" & addName MassInputDeleteButton{..}) Nothing
+      $logDebugS "delForm" . tshow $ fmap toPathPiece delRes
+      shapeUpdate <- miDelete addedLiveliness miCoord
+      guard $ isJust (Map.keysSet shapeUpdate ^? liveCoords :: Maybe liveliness)
+      return (shapeUpdate <$ delRes, delView)
+
+  delResults <- fmap (Map.mapMaybe id) . sequence $ Map.fromSet (runMaybeT . delForm) (Map.keysSet addedShape)
+  let delShape
+        | [FormSuccess shapeUpdate'] <- Map.elems . Map.filter (is _FormSuccess) $ fmap fst delResults = traverse (flip Map.lookup addedShape) shapeUpdate'
+        | otherwise = Nothing
+
+
+  shape <- if
+    | Just s <- delShape -> return s 
+    | Just s <- addShape -> return s 
+    | otherwise          -> return sentShape'
+
+  shapeId <- newIdent
   
+  let
+    shapeInput = fieldView shapeField shapeId (toPathPiece shapeName) [] (Right shape) True
+
+  cellResults <- flip Map.traverseWithKey shape $ \miCoord cData -> do
+    let
+      nudgeCellName :: Text -> Text
+      nudgeCellName miCellField = toPathPiece (MassInputCell{..} :: MassInputFieldName (BoxCoord liveliness))
+    (cData, ) <$> miCell miCoord cData (fmap snd . Map.lookup miCoord =<< initialResult) nudgeCellName mempty
+  let result :: FormResult (Map (BoxCoord liveliness) (cellData, cellResult))
+      result
+        | isJust addShape || isJust delShape = FormMissing
+        | otherwise = traverse (\(cData, (cResult, _)) -> (cData, ) <$> cResult) cellResults
+
+  liveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet shape ^? liveCoords :: MForm handler liveliness
+
   let miWidget :: BoxCoord liveliness -> [(Natural, BoxDimension (BoxCoord liveliness))] -> Widget
       miWidget _ [] = mempty
       miWidget miCoord ((dimIx, BoxDimension dim) : remDims) =
@@ -182,6 +298,7 @@ massInput mkAddWidget mkCellWidget FieldSettings{..} fvRequired initialResult =
               | [] <- remDims = do
                   coord <- coords
                   Just (_data, (_cellRes, cellWdgt)) <- return $ Map.lookup coord cellResults 
+                  let deleteButton = snd <$> Map.lookup coord delResults
                   return (coord, $(widgetFile "widgets/massinput/cell"))
               | otherwise =
                   [ (coord, miWidget coord remDims) | coord <- coords ]
@@ -194,6 +311,10 @@ massInput mkAddWidget mkCellWidget FieldSettings{..} fvRequired initialResult =
   let
     fvLabel = toHtml $ mr fsLabel
     fvTooltip = toHtml . mr <$> fsTooltip
-    fvInput = miWidget boxOrigin $ zip [0..] boxDimensions
+    fvInput = mconcat
+      [ toWidget csrf
+      , shapeInput
+      , miWidget boxOrigin $ zip [0..] boxDimensions
+      ]
     fvErrors = Nothing
-  return (result, FieldView{..})
+    in return (result, FieldView{..})
diff --git a/src/Utils.hs b/src/Utils.hs
index 4e2b5c6de..fa4ec109c 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -497,7 +497,7 @@ assertM f x = x >>= assertM' f
 assertM_ :: MonadPlus m => (a -> Bool) -> m a -> m ()
 assertM_ f x = guard . f =<< x
 
-assertM' :: MonadPlus m => (a -> Bool) -> a -> m a
+assertM' :: Alternative m => (a -> Bool) -> a -> m a
 assertM' f x = x <$ guard (f x)
 
 -- Some Utility Functions from Agda.Utils.Monad
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index cb7daeb8e..049217701 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -249,6 +249,7 @@ identifyForm' resLens identVal form fragment = do
 
 identifyForm :: (Monad m, PathPiece ident, Eq ident) => ident -> (Html -> MForm m (FormResult a, widget)) -> (Html -> MForm m (FormResult a, widget))
 identifyForm = identifyForm' id
+  
 
 {- Hinweise zur Erinnerung:
   - identForm primär, wenn es mehr als ein Formular pro Handler gibt
@@ -573,6 +574,12 @@ apreq f fs mx = formToAForm $ do
   mr <- getMessageRender
   over _1 (maybe (FormFailure [mr MsgValueRequired]) return =<<) . over _2 (pure . (\fv -> fv { fvRequired = True } )) <$> mopt f fs (Just <$> mx)
 
+mpreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
+      => Field m a -> FieldSettings site -> Maybe a -> MForm m (FormResult a, FieldView site)
+mpreq f fs mx = do
+  mr <- getMessageRender
+  over _1 (maybe (FormFailure [mr MsgValueRequired]) return =<<) . over _2 (\fv -> fv { fvRequired = True } ) <$> mopt f fs (Just <$> mx)
+
 wpreq :: (RenderMessage site FormMessage, HandlerSite m ~ site, MonadHandler m)
       => Field m a -> FieldSettings site -> Maybe a -> WForm m (FormResult a)
 wpreq f fs mx = mFormToWForm $ do
diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs
index b8ac05e63..dcb8f6590 100644
--- a/src/Utils/Lens.hs
+++ b/src/Utils/Lens.hs
@@ -80,6 +80,8 @@ makeLenses_ ''SheetType
 
 makePrisms ''AuthResult
 
+makePrisms ''FormResult
+
 -- makeClassy_ ''Load
 
 
diff --git a/templates/widgets/massinput/cell.hamlet b/templates/widgets/massinput/cell.hamlet
index de6e44d7a..8a9654357 100644
--- a/templates/widgets/massinput/cell.hamlet
+++ b/templates/widgets/massinput/cell.hamlet
@@ -1 +1,3 @@
 ^{cellWdgt}
+$maybe delWdgt <- fmap fvInput deleteButton
+  ^{delWdgt}

From 93fd8788bc25d2e4aa0a991b180f444548f2b243 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 20 Mar 2019 18:30:08 +0100
Subject: [PATCH 06/15] rigid type problem with rendermessage

---
 src/Foundation.hs         | 26 ++++++++++++++++++++++++++
 src/Handler/Utils/Form.hs | 11 ++++-------
 src/Model.hs              | 18 ------------------
 3 files changed, 30 insertions(+), 25 deletions(-)

diff --git a/src/Foundation.hs b/src/Foundation.hs
index 4295f1179..e4f1ada8b 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -253,6 +253,32 @@ instance RenderMessage UniWorX SheetType where
       mr :: RenderMessage UniWorX msg => msg -> Text
       mr = renderMessage foundation ls
 
+instance RenderMessage UniWorX StudyDegree where
+  renderMessage _found _ls StudyDegree{..} = fromMaybe (tshow studyDegreeKey) (studyDegreeName <|> studyDegreeShorthand)
+
+newtype ShortStudyDegree = ShortStudyDegree StudyDegree
+
+instance RenderMessage UniWorX ShortStudyDegree where
+  renderMessage _found _ls (ShortStudyDegree StudyDegree{..}) = fromMaybe (tshow studyDegreeKey) studyDegreeShorthand
+
+instance RenderMessage UniWorX StudyTerms where
+  renderMessage _found _ls StudyTerms{..} = fromMaybe (tshow studyTermsKey) (studyTermsName <|> studyTermsShorthand)
+
+newtype ShortStudyTerms = ShortStudyTerms StudyTerms
+
+instance RenderMessage UniWorX ShortStudyTerms where
+  renderMessage _found _ls (ShortStudyTerms StudyTerms{..}) = fromMaybe (tshow studyTermsKey) studyTermsShorthand
+
+data StudyDegreeTerm = StudyDegreeTerm StudyDegree StudyTerms
+
+instance RenderMessage UniWorX StudyDegreeTerm where
+  renderMessage foundation ls (StudyDegreeTerm deg trm) = (mr trm) <> " (" <> (mr $ ShortStudyDegree deg) <> ")"
+    where
+      mr :: RenderMessage UniWorX msg => msg -> Text
+      mr = renderMessage foundation ls
+
+
+
 newtype ErrorResponseTitle = ErrorResponseTitle ErrorResponse
 embedRenderMessageVariant ''UniWorX ''ErrorResponseTitle ("ErrorResponseTitle" <>)
 
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index b9409d059..8443a680a 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -215,7 +215,6 @@ schoolFieldFor :: [SchoolId] -> Field Handler SchoolId
 schoolFieldFor userSchools = selectField $ optionsPersistKey [SchoolShorthand <-. map unSchoolKey userSchools] [Asc SchoolName] schoolName
 
 -- | Select one of the user's primary active courses, or from a given list of StudyFeatures (regardless of user)
--- (too many special cases, hence not used in course registration anymore)
 studyFeaturesPrimaryFieldFor :: [StudyFeaturesId] -> Maybe UserId -> Field Handler (Maybe StudyFeaturesId)
 studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
     -- we need a join, so we cannot just use optionsPersistCryptoId
@@ -226,7 +225,7 @@ studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
               E.||. isPrimaryActiveUserStudyFeature feature
         return (feature E.^. StudyFeaturesId, degree, field)
     mr <- getMessageRender
-    mkOptionList . nonEmptyOptions (mr MsgNoPrimaryStudyField) <$> mapM procOptions rawOptions
+    mkOptionList . nonEmptyOptions (mr MsgNoPrimaryStudyField) <$> mapM (procOptions mr) rawOptions
   where
     isPrimaryActiveUserStudyFeature feature = case mbuid of
       Nothing    -> E.val False
@@ -234,13 +233,11 @@ studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
               E.&&. feature E.^. StudyFeaturesValid E.==. E.val True
               E.&&. feature E.^. StudyFeaturesType  E.==. E.val FieldPrimary
 
-    procOptions :: (E.Value StudyFeaturesId, Entity StudyDegree, Entity StudyTerms) -> Handler (Option (Maybe StudyFeaturesId))
-    procOptions (E.Value sfid, Entity dgid StudyDegree{..}, Entity stid StudyTerms{..}) = do
-      let dgname = fromMaybe (tshow dgid) (studyDegreeShorthand <|> studyDegreeName)
-          stname = fromMaybe (tshow stid) (studyTermsShorthand  <|> studyTermsName )
+    procOptions :: (RenderMessage UniWorX msg) =>  (msg -> Text) -> (E.Value StudyFeaturesId, Entity StudyDegree, Entity StudyTerms) -> Handler (Option (Maybe StudyFeaturesId))
+    procOptions mr (E.Value sfid, Entity dgid sdegree, Entity stid sterm) = do
       cfid <- encrypt sfid
       return Option
-        { optionDisplay = stname <> " (" <> dgname <> ")"
+        { optionDisplay = mr $ StudyDegreeTerm sdegree sterm
         , optionInternalValue = Just sfid
         , optionExternalValue = toPathPiece (cfid :: CryptoID UUID StudyFeaturesId)
         }
diff --git a/src/Model.hs b/src/Model.hs
index 3fabff444..9210edfde 100644
--- a/src/Model.hs
+++ b/src/Model.hs
@@ -19,7 +19,6 @@ import Data.Aeson (Value)
 import Data.CaseInsensitive (CI)
 import Data.CaseInsensitive.Instances ()
 
-import Text.Blaze (ToMarkup, toMarkup, Markup)
 import Utils.Message (MessageStatus)
 
 import Settings.Cluster (ClusterSettingsKey)
@@ -43,20 +42,3 @@ deriving instance Binary (Key Term)
 
 submissionRatingDone :: Submission -> Bool
 submissionRatingDone Submission{..} = isJust submissionRatingTime
-
--- Do these instances belong here?
-instance ToMarkup StudyDegree where
-  toMarkup StudyDegree{..} = toMarkup $
-    fromMaybe (tshow studyDegreeKey) (studyDegreeName <|> studyDegreeShorthand)
-
-shortStudyDegree :: StudyDegree -> Markup
-shortStudyDegree StudyDegree{..} = toMarkup $
-    fromMaybe (tshow studyDegreeKey) studyDegreeShorthand
-
-instance ToMarkup StudyTerms where
-  toMarkup StudyTerms{..} = toMarkup $
-    fromMaybe (tshow studyTermsKey) (studyTermsName <|> studyTermsShorthand)
-
-shortStudyTerms :: StudyTerms -> Markup
-shortStudyTerms StudyTerms{..} = toMarkup $
-    fromMaybe (tshow studyTermsKey) studyTermsShorthand

From 4d0a1e8020645f2718c344da9ae00df58a44958d Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 20 Mar 2019 18:33:35 +0100
Subject: [PATCH 07/15] minor

---
 src/Handler/Utils/Form.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 8443a680a..21ff05efe 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -224,7 +224,7 @@ studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
         E.where_ $ ((feature E.^. StudyFeaturesId) `E.in_` E.valList oldFeatures)
               E.||. isPrimaryActiveUserStudyFeature feature
         return (feature E.^. StudyFeaturesId, degree, field)
-    mr <- getMessageRender
+    mr <- liftHandler . getMessageRender
     mkOptionList . nonEmptyOptions (mr MsgNoPrimaryStudyField) <$> mapM (procOptions mr) rawOptions
   where
     isPrimaryActiveUserStudyFeature feature = case mbuid of
@@ -233,7 +233,7 @@ studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
               E.&&. feature E.^. StudyFeaturesValid E.==. E.val True
               E.&&. feature E.^. StudyFeaturesType  E.==. E.val FieldPrimary
 
-    procOptions :: (RenderMessage UniWorX msg) =>  (msg -> Text) -> (E.Value StudyFeaturesId, Entity StudyDegree, Entity StudyTerms) -> Handler (Option (Maybe StudyFeaturesId))
+    procOptions :: (StudyDegreeTerm -> Text) -> (E.Value StudyFeaturesId, Entity StudyDegree, Entity StudyTerms) -> Handler (Option (Maybe StudyFeaturesId))
     procOptions mr (E.Value sfid, Entity dgid sdegree, Entity stid sterm) = do
       cfid <- encrypt sfid
       return Option

From f8bba4ac83e73154db6a3491218e4e7283eff960 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 20 Mar 2019 18:42:40 +0100
Subject: [PATCH 08/15] Minor

---
 src/Handler/Utils/Form.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 21ff05efe..c956c16b7 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -224,7 +224,7 @@ studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
         E.where_ $ ((feature E.^. StudyFeaturesId) `E.in_` E.valList oldFeatures)
               E.||. isPrimaryActiveUserStudyFeature feature
         return (feature E.^. StudyFeaturesId, degree, field)
-    mr <- liftHandler . getMessageRender
+    mr <- getMessageRender
     mkOptionList . nonEmptyOptions (mr MsgNoPrimaryStudyField) <$> mapM (procOptions mr) rawOptions
   where
     isPrimaryActiveUserStudyFeature feature = case mbuid of
@@ -233,11 +233,11 @@ studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
               E.&&. feature E.^. StudyFeaturesValid E.==. E.val True
               E.&&. feature E.^. StudyFeaturesType  E.==. E.val FieldPrimary
 
-    procOptions :: (StudyDegreeTerm -> Text) -> (E.Value StudyFeaturesId, Entity StudyDegree, Entity StudyTerms) -> Handler (Option (Maybe StudyFeaturesId))
+    procOptions :: _ -> (E.Value StudyFeaturesId, Entity StudyDegree, Entity StudyTerms) -> Handler (Option (Maybe StudyFeaturesId))
     procOptions mr (E.Value sfid, Entity dgid sdegree, Entity stid sterm) = do
       cfid <- encrypt sfid
       return Option
-        { optionDisplay = mr $ StudyDegreeTerm sdegree sterm
+        { optionDisplay = mr $ SomeMessage $ StudyDegreeTerm sdegree sterm
         , optionInternalValue = Just sfid
         , optionExternalValue = toPathPiece (cfid :: CryptoID UUID StudyFeaturesId)
         }

From 1929c5cace94c02460efec4824adaaeec103fc87 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 20 Mar 2019 18:44:58 +0100
Subject: [PATCH 09/15] Fix build

---
 src/Handler/Course.hs     | 8 ++++----
 src/Handler/Utils/Form.hs | 4 ++--
 2 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 838f81fe7..bf779d136 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -734,19 +734,19 @@ colUserSemester = sortable (Just "semesternr") (i18nCell MsgStudyFeatureAge) $
 
 colUserField :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
 colUserField = sortable (Just "field") (i18nCell MsgCourseStudyFeature) $
-    foldMap htmlCell . view (_userTableFeatures . _3)
+    foldMap i18nCell . view (_userTableFeatures . _3)
 
 colUserFieldShort :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
 colUserFieldShort = sortable (Just "field-short") (i18nCell MsgCourseStudyFeature) $
-    foldMap (htmlCell . shortStudyTerms) . view (_userTableFeatures . _3)
+    foldMap (i18nCell . ShortStudyTerms) . view (_userTableFeatures . _3)
 
 colUserDegree :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
 colUserDegree = sortable (Just "degree") (i18nCell MsgStudyFeatureDegree) $
-    foldMap htmlCell . preview (_userTableFeatures . _2 . _Just)
+    foldMap i18nCell . preview (_userTableFeatures . _2 . _Just)
 
 colUserDegreeShort :: IsDBTable m c => Colonnade Sortable UserTableData (DBCell m c)
 colUserDegreeShort = sortable (Just "degree-short") (i18nCell MsgStudyFeatureDegree) $
-    foldMap (htmlCell . shortStudyDegree) . preview (_userTableFeatures . _2 . _Just)
+    foldMap (i18nCell . ShortStudyDegree) . preview (_userTableFeatures . _2 . _Just)
 
 makeCourseUserTable :: CourseId -> _ -> _ -> DB Widget
 makeCourseUserTable cid colChoices psValidator =
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 21ff05efe..b82d788fa 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -224,7 +224,7 @@ studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
         E.where_ $ ((feature E.^. StudyFeaturesId) `E.in_` E.valList oldFeatures)
               E.||. isPrimaryActiveUserStudyFeature feature
         return (feature E.^. StudyFeaturesId, degree, field)
-    mr <- liftHandler . getMessageRender
+    MsgRenderer mr <- getMsgRenderer
     mkOptionList . nonEmptyOptions (mr MsgNoPrimaryStudyField) <$> mapM (procOptions mr) rawOptions
   where
     isPrimaryActiveUserStudyFeature feature = case mbuid of
@@ -234,7 +234,7 @@ studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
               E.&&. feature E.^. StudyFeaturesType  E.==. E.val FieldPrimary
 
     procOptions :: (StudyDegreeTerm -> Text) -> (E.Value StudyFeaturesId, Entity StudyDegree, Entity StudyTerms) -> Handler (Option (Maybe StudyFeaturesId))
-    procOptions mr (E.Value sfid, Entity dgid sdegree, Entity stid sterm) = do
+    procOptions mr (E.Value sfid, Entity _dgid sdegree, Entity _stid sterm) = do
       cfid <- encrypt sfid
       return Option
         { optionDisplay = mr $ StudyDegreeTerm sdegree sterm

From 0cc2f28089ccafce2fb4db81a0346fd4807035db Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 20 Mar 2019 19:55:44 +0100
Subject: [PATCH 10/15] Show fully info on StudyTerms in UserProfileDataR

---
 src/Handler/Profile.hs       | 11 ++---------
 src/Utils.hs                 | 15 +++++++++++++++
 templates/profileData.hamlet | 28 +++++++++++++---------------
 3 files changed, 30 insertions(+), 24 deletions(-)

diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs
index f615d3899..c67b11abf 100644
--- a/src/Handler/Profile.hs
+++ b/src/Handler/Profile.hs
@@ -193,7 +193,7 @@ deleteUser duid = do
 getProfileDataR :: Handler Html
 getProfileDataR = do
   (uid, User{..}) <- requireAuthPair
-  --   mr <- getMessageRender
+  -- MsgRenderer mr <- getMsgRenderer
   (admin_rights,lecturer_rights,lecture_corrector,studies) <- runDB $ (,,,) <$>
     E.select
       ( E.from $ \(adright `E.InnerJoin` school) -> do
@@ -222,14 +222,7 @@ getProfileDataR = do
           E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid
           E.on $ studyfeat E.^. StudyFeaturesField  E.==. studyterms  E.^. StudyTermsId
           E.on $ studyfeat E.^. StudyFeaturesDegree E.==. studydegree E.^. StudyDegreeId
-          return  ( ( studydegree E.^. StudyDegreeName
-                      , studydegree E.^. StudyDegreeKey
-                      )
-                  , ( studyterms  E.^. StudyTermsName
-                      , studyterms  E.^. StudyTermsKey
-                      )
-                  , studyfeat   E.^. StudyFeaturesType
-                  , studyfeat   E.^. StudyFeaturesSemester)
+          return  (studyfeat, studydegree, studyterms)
       )
   (   (hasRows, ownedCoursesTable)
     , enrolledCoursesTable
diff --git a/src/Utils.hs b/src/Utils.hs
index 25142c944..73efb5aa6 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -276,6 +276,21 @@ stepTextCounter text
 -- Data.Text.groupBy ((==) `on` isDigit) $ Data.Text.pack "12.ProMo  Ue3bung00322 34 (H)"
 -- ["12",".ProMo  Ue","3","bung","00322"," ","34"," (H)"]
 
+-- | Ignore warnings for unused variables with a more specific type
+notUsedT :: a -> Text
+notUsedT = notUsed
+
+
+
+------------
+-- Monoid --
+------------
+
+-- | Ignore warnings for unused variables
+notUsed :: Monoid m => a -> m
+notUsed = const mempty
+
+
 ------------
 -- Tuples --
 ------------
diff --git a/templates/profileData.hamlet b/templates/profileData.hamlet
index 3360b0afa..341ff3662 100644
--- a/templates/profileData.hamlet
+++ b/templates/profileData.hamlet
@@ -12,7 +12,7 @@
       <dd .deflist__dd> #{display userIdent}
       <dt .deflist__dt> _{MsgLastLogin}
       <dd .deflist__dd>
-        $maybe llogin <- lastLogin 
+        $maybe llogin <- lastLogin
           #{llogin}
         $nothing
           _{MsgNever}
@@ -45,25 +45,23 @@
         <div .scrolltable>
           <table .table.table--striped.table--hover.table--condensed>
             <tr .table__row>
-              <th .table__th> Abschluss
               <th .table__th> Studiengang
+              <th .table__th> Abschluss
               <th .table__th> Studienart
               <th .table__th> Semester
+              <th .table__th> Aktiv
+              <th .table__th> Update
 
-            $forall ((degree, degreeKey),(field, fieldKey),fieldtype,semester) <- studies
+
+            $forall ((Entity _ StudyFeatures{..}), (Entity _ degree), (Entity _ field)) <- studies
+              $with _ <- notUsedT studyFeaturesUser
               <tr.table__row>
-                <td .table__td>
-                  $maybe name <- E.unValue degree
-                    #{display name}
-                  $nothing
-                    #{display degreeKey}
-                <td .table__td>
-                  $maybe name <- E.unValue field
-                    #{display name}
-                  $nothing
-                    #{display fieldKey}
-                <td .table__td>_{E.unValue fieldtype}
-                <td .table__td>#{display semester}
+                <td .table__td>_{field}#{notUsedT studyFeaturesField}
+                <td .table__td>_{degree}#{notUsedT studyFeaturesDegree}
+                <td .table__td>_{studyFeaturesType}
+                <td .table__td>#{display studyFeaturesSemester}
+                <td .table__td>#{hasTickmark studyFeaturesValid}
+                <td .table__td>^{formatTimeW SelFormatDateTime studyFeaturesUpdated}
 
   <div .container>
     $if hasRows

From aca5d180bc3f547e4624b95e0a955097e714db87 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 20 Mar 2019 20:53:10 +0100
Subject: [PATCH 11/15] Feature complete MassInput

---
 clean.sh                                     | 29 +++++++
 src/Foundation.hs                            |  1 +
 src/Handler/Admin.hs                         | 26 +++----
 src/Handler/Utils/Form/MassInput.hs          | 80 ++++++++++++--------
 static/js/utils/inputs.js                    | 26 +++++++
 templates/widgets/massinput/massinput.hamlet |  5 ++
 templates/widgets/massinput/massinput.julius | 21 +++++
 7 files changed, 145 insertions(+), 43 deletions(-)
 create mode 100755 clean.sh
 create mode 100644 templates/widgets/massinput/massinput.hamlet
 create mode 100644 templates/widgets/massinput/massinput.julius

diff --git a/clean.sh b/clean.sh
new file mode 100755
index 000000000..2c9c71212
--- /dev/null
+++ b/clean.sh
@@ -0,0 +1,29 @@
+#!/usr/bin/env bash
+
+case $1 in
+    "")
+        exec -- stack clean
+        ;;
+    *)
+        target=".stack-work-${1}"
+        if [[ ! -d "${target}" ]]; then
+            printf "%s does not exist or is no directory\n" "${target}" >&2
+            exit 1
+        fi
+        if [[ -e .stack-work-clean ]]; then
+            printf ".stack-work-clean exists\n" >&2
+            exit 1
+        fi
+
+        move-back() {
+            mv -v .stack-work "${target}"
+            [[ -d .stack-work-clean ]] && mv -v .stack-work-clean .stack-work
+        }
+
+        mv -v .stack-work .stack-work-clean
+        mv -v "${target}" .stack-work
+        trap move-back EXIT
+
+        stack clean
+        ;;
+esac
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 70ad9da14..bfe7ad225 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -307,6 +307,7 @@ data instance ButtonClass UniWorX
   | BCWarning
   | BCDanger
   | BCLink
+  | BCMassInputAdd | BCMassInputDelete
   deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
 instance Universe (ButtonClass UniWorX)
 instance Finite (ButtonClass UniWorX)
diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index a79faabb9..591040b0b 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -135,23 +135,20 @@ postAdminTestR = do
   let
     -- | Make a form for adding a point/line/plane/hyperplane/... (in this case: cell)
     --
-    -- This /needs/ to use @nudge@ (for deterministic field naming) and to replace all occurances of @mreq@ with @mpreq@ (no fields should be /actually/ required)
+    -- This /needs/ to replace all occurances of @mreq@ with @mpreq@ (no fields should be /actually/ required)
     mkAddForm :: ListPosition -- ^ Approximate position of the add-widget
               -> Natural -- ^ Dimension Index, outermost dimension ist 0 i.e. if dimension is 3 hyperplane-adders get passed 0, planes get passed 1, lines get 2, and points get 3
-              -> ListLength -- ^ Liveliness
               -> (Text -> Text) -- ^ Nudge deterministic field ids so they're unique
               -> FieldView UniWorX -- ^ Submit-Button for this add-widget
-              -> Maybe (Form (ListPosition, Int)) -- ^ Nothing if no further cells should be added; returns index of new cell and data needed to initialize cell
-    mkAddForm 0 0 listLength nudge submitBtn
-      | listLength >= 7 = Nothing
-      | otherwise = Just $ \csrf -> do
-        (addRes, addView) <- mpreq textField ("" & addName (nudge "text")) Nothing
-        let addRes' = fromMaybe 0 . readMay . Text.filter isDigit <$> addRes
-        return ((fromIntegral listLength, ) <$> addRes', toWidget csrf >> fvInput addView >> fvInput submitBtn)
-    mkAddForm _pos _dim _ _ _ = error "Dimension and Position is always 0 for our 1-dimensional form"
+              -> Maybe (Form (ListLength -> (ListPosition, Int))) -- ^ Nothing iff adding further cells in this position/dimension makes no sense; returns callback to determine index of new cell and data needed to initialize cell
+    mkAddForm 0 0 nudge submitBtn = Just $ \csrf -> do
+      (addRes, addView) <- mpreq textField ("" & addName (nudge "text")) Nothing
+      let addRes' = fromMaybe 0 . readMay . Text.filter isDigit <$> addRes
+      return ((\dat l -> (fromIntegral l, dat)) <$> addRes', toWidget csrf >> fvInput addView >> fvInput submitBtn)
+    mkAddForm _pos _dim _ _ = error "Dimension and Position is always 0 for our 1-dimensional form"
     -- | Make a single massInput-Cell
     --
-    -- This /needs/ to use @nudge@ for deterministic field naming
+    -- This /needs/ to use @nudge@ and deterministic field naming (this allows for correct value-shifting when cells are deleted)
     mkCellForm :: ListPosition -- ^ Position of this cell
                -> Int -- ^ Data needed to initialize the cell (see return of @mkAddForm@)
                -> Maybe Int -- ^ Initial cell result from Argument to `massInput`
@@ -167,8 +164,11 @@ postAdminTestR = do
     deleteCell l pos
       | l >= 2 = return . Map.fromSet (\pos' -> bool pos' (succ pos') $ pos' >= pos) $ Set.fromList [0..fromIntegral (l - 2)]
       | otherwise = return Map.empty
+    -- | Make a decision on whether an add widget should be allowed to further cells, given the current @liveliness@ (i.e. before performing the addition)
+    allowAdd :: ListPosition -> Natural -> ListLength -> Bool
+    allowAdd _ _ l = l < 7
     
-  ((miResult, (fvInput -> miForm)), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell) "" True Nothing
+  ((miResult, (fvInput -> miForm)), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell allowAdd) "" True Nothing
 
 
   let locallyDefinedPageHeading = [whamlet|Admin TestPage for Uni2work|]
@@ -193,7 +193,7 @@ postAdminTestR = do
             $forall err <- errs
               <li>#{err}
         $of FormSuccess res
-          <pre>
+          <p style="white-space:pre-wrap; font-family:monospace;">
             #{tshow res}
     |]
 
diff --git a/src/Handler/Utils/Form/MassInput.hs b/src/Handler/Utils/Form/MassInput.hs
index 3375f5a24..ad8cb2d2b 100644
--- a/src/Handler/Utils/Form/MassInput.hs
+++ b/src/Handler/Utils/Form/MassInput.hs
@@ -24,9 +24,11 @@ import qualified Data.Text as Text
 
 import qualified Data.Set as Set
 import qualified Data.Map as Map
+import qualified Data.Foldable as Fold
 import Data.List (genericLength, genericIndex, iterate)
 
 import Control.Monad.Trans.Maybe
+import Control.Monad.Reader.Class (MonadReader(local))
 import Control.Monad.Fix
 
 
@@ -122,8 +124,8 @@ instance RenderMessage UniWorX (ButtonMassInput coord) where
 instance PathPiece coord => Button UniWorX (ButtonMassInput coord) where
   btnValidate _ _ = False
 
-  btnClasses (MassInputAddDimension _ _) = [BCIsButton, BCDefault]
-  btnClasses (MassInputDeleteCell _) = [BCIsButton, BCWarning]
+  btnClasses (MassInputAddDimension _ _) = [BCIsButton, BCDefault, BCMassInputAdd]
+  btnClasses (MassInputDeleteCell _) = [BCIsButton, BCWarning, BCMassInputDelete]
 
 
 data MassInputFieldName coord
@@ -181,16 +183,16 @@ instance Exception MassInputException
 data MassInput handler liveliness cellData cellResult = MassInput
   { miAdd :: BoxCoord liveliness -- Position (dimensions after @dimIx@ are zero)
           -> Natural -- Zero-based dimension index @dimIx@
-          -> liveliness
           -> (Text -> Text) -- Nudge deterministic field ids
           -> FieldView UniWorX -- Submit button
-          -> Maybe (Markup -> MForm handler (FormResult (BoxCoord liveliness, cellData), Widget))
+          -> Maybe (Markup -> MForm handler (FormResult (liveliness -> (BoxCoord liveliness, cellData)), Widget))
   , miCell :: BoxCoord liveliness -- Position
            -> cellData -- Initialisation data
            -> Maybe cellResult -- Previous result
            -> (Text -> Text) -- Nudge deterministic field ids
            -> (Markup -> MForm handler (FormResult cellResult, Widget))
   , miDelete :: liveliness -> BoxCoord liveliness -> MaybeT (MForm handler) (Map (BoxCoord liveliness) (BoxCoord liveliness))
+  , miAllowAdd :: BoxCoord liveliness -> Natural -> liveliness -> Bool
   }
 
 massInput :: forall handler cellData cellResult liveliness.
@@ -204,7 +206,7 @@ massInput :: forall handler cellData cellResult liveliness.
           -> Bool -- ^ Required?
           -> Maybe (Map (BoxCoord liveliness) (cellData, cellResult))
           -> (Markup -> MForm handler (FormResult (Map (BoxCoord liveliness) (cellData, cellResult)), FieldView UniWorX))
-massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do
+massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = mdo
   let initialShape = fmap fst <$> initialResult
   
   miName <- maybe newFormIdent return fsName
@@ -223,18 +225,21 @@ massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do
     | otherwise -> throwM MassInputInvalidShape
   sentLiveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet sentShape' ^? liveCoords :: MForm handler liveliness
 
-  let addForm :: [BoxDimension (BoxCoord liveliness)] -> MForm handler (Map (Natural, BoxCoord liveliness) (FormResult (BoxCoord liveliness, cellData), Widget))
+  let addForm :: [BoxDimension (BoxCoord liveliness)] -> MForm handler (Map (Natural, BoxCoord liveliness) (FormResult (Maybe (liveliness -> (BoxCoord liveliness, cellData))), Maybe Widget))
       addForm = addForm' boxOrigin . zip [0..]
         where
           addForm' _ [] = return Map.empty
           addForm' miCoord ((dimIx, _) : remDims) = do
             let nudgeAddWidgetName :: Text -> Text
                 nudgeAddWidgetName miAddWidgetField = toPathPiece MassInputAddWidget{..}
-            dimRes <- runMaybeT $ do
-              (btnRes, btnView) <- lift $ mpreq (buttonField $ MassInputAddDimension dimIx miCoord) ("" & addName MassInputAddButton{..}) Nothing
-              (addRes, addView) <- MaybeT . traverse ($ mempty) $ miAdd miCoord dimIx sentLiveliness nudgeAddWidgetName btnView
-              return (btnRes *> addRes, addView)
-            let dimRes' = maybe Map.empty (Map.singleton (dimIx, miCoord)) dimRes
+            (btnRes', btnView) <- mopt (buttonField $ MassInputAddDimension dimIx miCoord) ("" & addName MassInputAddButton{..}) Nothing
+            let btnRes
+                  | FormSuccess  Nothing <- btnRes' = FormMissing
+                  | FormSuccess (Just x) <- btnRes' = FormSuccess x
+                  | otherwise                       = error "Value of btnRes should only be inspected if FormSuccess" <$ btnRes'
+            addRes' <- over (mapped . _Just . _1) (btnRes *>) . local (bool id (set _1 Nothing) $ is _FormMissing btnRes) . traverse ($ mempty) $
+                  miAdd miCoord dimIx nudgeAddWidgetName btnView
+            let dimRes' = Map.singleton (dimIx, miCoord) (maybe (Nothing <$ btnRes) (fmap Just) $ fmap fst addRes', fmap snd addRes')
             case remDims of
               [] -> return dimRes'
               ((_, BoxDimension dim) : _) -> do
@@ -245,7 +250,8 @@ massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do
 
   addResults <- addForm boxDimensions
   let addShape
-        | [FormSuccess (bCoord, cData)] <- Map.elems . Map.filter (is _FormSuccess) $ fmap fst addResults = Just $ Map.insert bCoord cData sentShape'
+        | [((dimIx, miCoord), FormSuccess (Just mkResult))] <- Map.toList . Map.filter (is $ _FormSuccess . _Just) $ fmap fst addResults
+        = Just $ maybe id (uncurry Map.insert) (mkResult sentLiveliness <$ guard (miAllowAdd miCoord dimIx sentLiveliness)) sentShape'
         | otherwise = Nothing
 
   addedShape <- if
@@ -257,42 +263,58 @@ massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do
     delForm :: BoxCoord liveliness -> MaybeT (MForm handler) (FormResult (Map (BoxCoord liveliness) (BoxCoord liveliness)), FieldView UniWorX)
     delForm miCoord = do
       (delRes, delView) <- lift $ mpreq (buttonField $ MassInputDeleteCell miCoord) ("" & addName MassInputDeleteButton{..}) Nothing
-      $logDebugS "delForm" . tshow $ fmap toPathPiece delRes
+      -- $logDebugS "delForm" . tshow $ fmap toPathPiece delRes
       shapeUpdate <- miDelete addedLiveliness miCoord
       guard $ isJust (Map.keysSet shapeUpdate ^? liveCoords :: Maybe liveliness)
       return (shapeUpdate <$ delRes, delView)
 
   delResults <- fmap (Map.mapMaybe id) . sequence $ Map.fromSet (runMaybeT . delForm) (Map.keysSet addedShape)
-  let delShape
-        | [FormSuccess shapeUpdate'] <- Map.elems . Map.filter (is _FormSuccess) $ fmap fst delResults = traverse (flip Map.lookup addedShape) shapeUpdate'
+  let
+    delShapeUpdate
+        | [FormSuccess shapeUpdate'] <- Map.elems . Map.filter (is _FormSuccess) $ fmap fst delResults = Just shapeUpdate'
         | otherwise = Nothing
+    delShape = traverse (flip Map.lookup addedShape) =<< delShapeUpdate
 
 
+  let shapeChanged = Fold.any (isn't _FormMissing . view _1) addResults || Fold.any (is _FormSuccess . view _1) delResults
+
   shape <- if
-    | Just s <- delShape -> return s 
     | Just s <- addShape -> return s 
+    | Just s <- delShape -> return s 
     | otherwise          -> return sentShape'
 
+  $logDebugS "massInput" [st|Current shape: #{tshow (map toPathPiece (Map.keys shape))}|]
+
   shapeId <- newIdent
-  
+  let shapeInput = fieldView shapeField shapeId (toPathPiece shapeName) [] (Right shape) True
+
   let
-    shapeInput = fieldView shapeField shapeId (toPathPiece shapeName) [] (Right shape) True
+    applyDelShapeUpdate :: Maybe (Env, FileEnv) -> Maybe (Env, FileEnv)
+    applyDelShapeUpdate prevEnv
+      | Just delShapeUpdate' <- delShapeUpdate
+      , Just (env, fEnv) <- prevEnv
+      = let reverseUpdate = Map.fromList . map swap $ Map.toList delShapeUpdate'
+         in Just . (, fEnv) . flip (Map.mapKeysWith mappend) env $ \k -> fromMaybe k $ do
+              cell@MassInputCell{miCoord} <- fromPathPiece k
+              newCoord <- Map.lookup miCoord reverseUpdate
+              return $ toPathPiece cell{ miCoord = newCoord }
+      | otherwise = prevEnv
 
   cellResults <- flip Map.traverseWithKey shape $ \miCoord cData -> do
     let
       nudgeCellName :: Text -> Text
       nudgeCellName miCellField = toPathPiece (MassInputCell{..} :: MassInputFieldName (BoxCoord liveliness))
-    (cData, ) <$> miCell miCoord cData (fmap snd . Map.lookup miCoord =<< initialResult) nudgeCellName mempty
+    local (over _1 applyDelShapeUpdate) $ (cData, ) <$> miCell miCoord cData (fmap snd . Map.lookup miCoord =<< initialResult) nudgeCellName mempty
   let result :: FormResult (Map (BoxCoord liveliness) (cellData, cellResult))
       result
-        | isJust addShape || isJust delShape = FormMissing
+        | shapeChanged = FormMissing
         | otherwise = traverse (\(cData, (cResult, _)) -> (cData, ) <$> cResult) cellResults
 
   liveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet shape ^? liveCoords :: MForm handler liveliness
 
-  let miWidget :: BoxCoord liveliness -> [(Natural, BoxDimension (BoxCoord liveliness))] -> Widget
-      miWidget _ [] = mempty
-      miWidget miCoord ((dimIx, BoxDimension dim) : remDims) =
+  let miWidget' :: BoxCoord liveliness -> [(Natural, BoxDimension (BoxCoord liveliness))] -> Widget
+      miWidget' _ [] = mempty
+      miWidget' miCoord ((dimIx, BoxDimension dim) : remDims) =
         let coords = takeWhile (\c -> review (liveCoord c) liveliness) $ iterate (over dim succ) miCoord
             cells
               | [] <- remDims = do
@@ -301,20 +323,18 @@ massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do
                   let deleteButton = snd <$> Map.lookup coord delResults
                   return (coord, $(widgetFile "widgets/massinput/cell"))
               | otherwise =
-                  [ (coord, miWidget coord remDims) | coord <- coords ]
-            addWidget = snd <$> Map.lookup (dimIx, miCoord) addResults
+                  [ (coord, miWidget' coord remDims) | coord <- coords ]
+            addWidget = (\(_, mWgt) -> mWgt <* guard (miAllowAdd miCoord dimIx liveliness)) =<< Map.lookup (dimIx, miCoord) addResults
          in $(widgetFile "widgets/massinput/row")
 
+      miWidget = miWidget' boxOrigin $ zip [0..] boxDimensions
+
   MsgRenderer mr <- getMsgRenderer
   fvId <- maybe newIdent return fsId
   
   let
     fvLabel = toHtml $ mr fsLabel
     fvTooltip = toHtml . mr <$> fsTooltip
-    fvInput = mconcat
-      [ toWidget csrf
-      , shapeInput
-      , miWidget boxOrigin $ zip [0..] boxDimensions
-      ]
+    fvInput = $(widgetFile "widgets/massinput/massinput")
     fvErrors = Nothing
     in return (result, FieldView{..})
diff --git a/static/js/utils/inputs.js b/static/js/utils/inputs.js
index 68425b5ba..fd4ad906e 100644
--- a/static/js/utils/inputs.js
+++ b/static/js/utils/inputs.js
@@ -229,4 +229,30 @@
     };
   }
 
+  // Override implicit submit (pressing enter) behaviour to trigger a specified submit button instead of the default
+  window.utils.implicitSubmit = function(input, options) {
+    var submit = options.submit;
+
+    console.log('implicitSubmit', input, submit);
+
+    if (!submit) {
+      throw new Error('window.utils.implicitSubmit(input, options) needs to be passed a submit element via options');
+    }
+
+    var doSubmit = function(event) {
+      if (event.keyCode == 13) {
+        event.preventDefault();
+        submit.click();
+      }
+    };
+
+    input.addEventListener('keypress', doSubmit);
+    
+    return {
+      scope: input,
+      destroy: function() {
+        input.removeEventListener('keypress', doSubmit);
+      },
+    };
+  }
 })();
diff --git a/templates/widgets/massinput/massinput.hamlet b/templates/widgets/massinput/massinput.hamlet
new file mode 100644
index 000000000..3dde7384d
--- /dev/null
+++ b/templates/widgets/massinput/massinput.hamlet
@@ -0,0 +1,5 @@
+$newline never
+<div .massinput ##{fvId}>
+  #{csrf}
+  ^{shapeInput}
+  ^{miWidget}
diff --git a/templates/widgets/massinput/massinput.julius b/templates/widgets/massinput/massinput.julius
new file mode 100644
index 000000000..219636e59
--- /dev/null
+++ b/templates/widgets/massinput/massinput.julius
@@ -0,0 +1,21 @@
+document.addEventListener('DOMContentLoaded', function() {
+  var form = document.getElementById(#{String fvId}).closest('form');
+
+
+  var formSubmit = form.querySelector('input[type=submit], button[type=submit]:not(.btn-mass-input-add):not(.btn-mass-input-delete)');
+  var cellInputs = Array.from(form.querySelectorAll('.massinput--cell input:not([type=hidden])'));
+
+  cellInputs.forEach(function(input) {
+    window.utils.setup('implicitSubmit', input, { submit: formSubmit });
+  });
+
+
+  Array.from(form.querySelectorAll('.massinput--add')).forEach(function(wrapper) {
+    var addSubmit = wrapper.querySelector('.btn-mass-input-add');
+    var addInputs = Array.from(wrapper.querySelectorAll('input:not([type=hidden]):not(.btn-mass-input-add)'));
+
+    addInputs.forEach(function(input) {
+      window.utils.setup('implicitSubmit', input, { submit: addSubmit });
+    });
+  });
+});

From 4aaf9933aaa9d0acc6ec4181491625813625fbca Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 20 Mar 2019 21:20:51 +0100
Subject: [PATCH 12/15] Fixup

---
 src/Handler/Admin.hs                | 30 +++++++++++++++++------
 src/Handler/Utils/Form/MassInput.hs | 37 +++++++++++++++++++----------
 2 files changed, 48 insertions(+), 19 deletions(-)

diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index 591040b0b..dbe8cf42c 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -132,7 +132,19 @@ postAdminTestR = do
                     <li>#{m}
         |]
 
+
+  {- The following demonstrates the use of @massInput@.
+
+     @massInput@ takes as arguments:
+       - A configuration struct describing how the Widget should behave (how is the space of sub-forms structured, how many dimensions does it have, which additions/deletions are permitted, what data do they need to operate and what should their effect on the overall shape be?)
+       - Information on how the resulting field fits into the form as a whole (@FieldSettings@ and whether the @massInput@ should be marked required)
+       - An initial value to pre-fill the field with
+
+     @massInput@ then returns an @MForm@ structured for easy downstream consumption of the result
+   -}
   let
+    -- We define the fields of the configuration struct @MassInput@:
+
     -- | Make a form for adding a point/line/plane/hyperplane/... (in this case: cell)
     --
     -- This /needs/ to replace all occurances of @mreq@ with @mpreq@ (no fields should be /actually/ required)
@@ -142,10 +154,12 @@ postAdminTestR = do
               -> FieldView UniWorX -- ^ Submit-Button for this add-widget
               -> Maybe (Form (ListLength -> (ListPosition, Int))) -- ^ Nothing iff adding further cells in this position/dimension makes no sense; returns callback to determine index of new cell and data needed to initialize cell
     mkAddForm 0 0 nudge submitBtn = Just $ \csrf -> do
-      (addRes, addView) <- mpreq textField ("" & addName (nudge "text")) Nothing
-      let addRes' = fromMaybe 0 . readMay . Text.filter isDigit <$> addRes
-      return ((\dat l -> (fromIntegral l, dat)) <$> addRes', toWidget csrf >> fvInput addView >> fvInput submitBtn)
+      (addRes, addView) <- mpreq textField ("" & addName (nudge "text")) Nothing -- Any old field; for demonstration
+      let addRes' = fromMaybe 0 . readMay . Text.filter isDigit <$> addRes -- Do something semi-interesting on the result of the @textField@ to demonstrate that further processing can be done
+          addRes'' = (\dat l -> (fromIntegral l, dat)) <$> addRes' -- Construct the callback to determine new cell position and data within @FormResult@ as required
+      return (addRes'', toWidget csrf >> fvInput addView >> fvInput submitBtn)
     mkAddForm _pos _dim _ _ = error "Dimension and Position is always 0 for our 1-dimensional form"
+
     -- | Make a single massInput-Cell
     --
     -- This /needs/ to use @nudge@ and deterministic field naming (this allows for correct value-shifting when cells are deleted)
@@ -154,19 +168,21 @@ postAdminTestR = do
                -> Maybe Int -- ^ Initial cell result from Argument to `massInput`
                -> (Text -> Text) -- ^ Nudge deterministic field ids so they're unique
                -> Form Int
-    mkCellForm _pos initial previous nudge csrf = do
-      (intRes, intView) <- mreq intField ("" & addName (nudge "int")) $ previous <|> Just initial
+    mkCellForm _pos cData initial nudge csrf = do -- Extremely simple cell
+      (intRes, intView) <- mreq intField ("" & addName (nudge "int")) $ initial <|> Just cData
       return (intRes, toWidget csrf >> fvInput intView)
     -- | How does the shape (`ListLength`) change if a certain cell is deleted?
     deleteCell :: ListLength -- ^ Current shape
                -> ListPosition -- ^ Coordinate to delete
                -> MaybeT (MForm (HandlerT UniWorX IO)) (Map ListPosition ListPosition) -- ^ Monadically compute a set of new positions and their associated old positions
     deleteCell l pos
-      | l >= 2 = return . Map.fromSet (\pos' -> bool pos' (succ pos') $ pos' >= pos) $ Set.fromList [0..fromIntegral (l - 2)]
+      | l >= 2 = return . Map.fromSet (\pos' -> bool pos' (succ pos') $ pos' >= pos) $ Set.fromList [0..fromIntegral (l - 2)] -- Close gap left by deleted position with values from further down the list; try prohibiting certain deletions by utilising `guard`
       | otherwise = return Map.empty
     -- | Make a decision on whether an add widget should be allowed to further cells, given the current @liveliness@ (i.e. before performing the addition)
     allowAdd :: ListPosition -> Natural -> ListLength -> Bool
-    allowAdd _ _ l = l < 7
+    allowAdd _ _ l = l < 7 -- Limit list length; much more complicated checks are possible (this could in principle be monadic, but @massInput@ is probably already complicated enough to cover just current (2019-03) usecases)
+
+  -- The actual call to @massInput@ is comparatively simple:
     
   ((miResult, (fvInput -> miForm)), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell allowAdd) "" True Nothing
 
diff --git a/src/Handler/Utils/Form/MassInput.hs b/src/Handler/Utils/Form/MassInput.hs
index ad8cb2d2b..8da523d3a 100644
--- a/src/Handler/Utils/Form/MassInput.hs
+++ b/src/Handler/Utils/Form/MassInput.hs
@@ -185,14 +185,19 @@ data MassInput handler liveliness cellData cellResult = MassInput
           -> Natural -- Zero-based dimension index @dimIx@
           -> (Text -> Text) -- Nudge deterministic field ids
           -> FieldView UniWorX -- Submit button
-          -> Maybe (Markup -> MForm handler (FormResult (liveliness -> (BoxCoord liveliness, cellData)), Widget))
+          -> Maybe (Markup -> MForm handler (FormResult (liveliness -> (BoxCoord liveliness, cellData)), Widget)) -- ^ Construct a Cell-Addition Widget
   , miCell :: BoxCoord liveliness -- Position
-           -> cellData -- Initialisation data
-           -> Maybe cellResult -- Previous result
+           -> cellData -- @cellData@ from @miAdd@
+           -> Maybe cellResult -- Initial result from Argument to @massInput@
            -> (Text -> Text) -- Nudge deterministic field ids
-           -> (Markup -> MForm handler (FormResult cellResult, Widget))
-  , miDelete :: liveliness -> BoxCoord liveliness -> MaybeT (MForm handler) (Map (BoxCoord liveliness) (BoxCoord liveliness))
-  , miAllowAdd :: BoxCoord liveliness -> Natural -> liveliness -> Bool
+           -> (Markup -> MForm handler (FormResult cellResult, Widget)) -- ^ Construct a singular cell
+  , miDelete :: liveliness
+             -> BoxCoord liveliness
+             -> MaybeT (MForm handler) (Map (BoxCoord liveliness) (BoxCoord liveliness)) -- ^ Decide whether a deletion-operation should be permitted and produce a finite map of new coordinates to their old correspondants
+  , miAllowAdd :: BoxCoord liveliness
+               -> Natural
+               -> liveliness
+               -> Bool -- ^ Decide whether an addition-operation should be permitted
   }
 
 massInput :: forall handler cellData cellResult liveliness.
@@ -206,7 +211,7 @@ massInput :: forall handler cellData cellResult liveliness.
           -> Bool -- ^ Required?
           -> Maybe (Map (BoxCoord liveliness) (cellData, cellResult))
           -> (Markup -> MForm handler (FormResult (Map (BoxCoord liveliness) (cellData, cellResult)), FieldView UniWorX))
-massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = mdo
+massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do
   let initialShape = fmap fst <$> initialResult
   
   miName <- maybe newFormIdent return fsName
@@ -282,12 +287,12 @@ massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = mdo
     | Just s <- addShape -> return s 
     | Just s <- delShape -> return s 
     | otherwise          -> return sentShape'
-
-  $logDebugS "massInput" [st|Current shape: #{tshow (map toPathPiece (Map.keys shape))}|]
+  liveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet shape ^? liveCoords :: MForm handler liveliness
 
   shapeId <- newIdent
   let shapeInput = fieldView shapeField shapeId (toPathPiece shapeName) [] (Right shape) True
 
+
   let
     applyDelShapeUpdate :: Maybe (Env, FileEnv) -> Maybe (Env, FileEnv)
     applyDelShapeUpdate prevEnv
@@ -300,18 +305,26 @@ massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = mdo
               return $ toPathPiece cell{ miCoord = newCoord }
       | otherwise = prevEnv
 
+    justAdded :: Set (BoxCoord liveliness)
+    justAdded = Set.fromList . mapMaybe (addedCoord . fst) $ Map.elems addResults
+      where
+        addedCoord res
+          | FormSuccess (Just mkResult) <- res
+          = Just . fst $ mkResult sentLiveliness
+          | otherwise = Nothing
+    restrictJustAdded :: BoxCoord liveliness -> Maybe a -> Maybe a
+    restrictJustAdded miCoord env = env <* guard (not $ Set.member miCoord justAdded)
+
   cellResults <- flip Map.traverseWithKey shape $ \miCoord cData -> do
     let
       nudgeCellName :: Text -> Text
       nudgeCellName miCellField = toPathPiece (MassInputCell{..} :: MassInputFieldName (BoxCoord liveliness))
-    local (over _1 applyDelShapeUpdate) $ (cData, ) <$> miCell miCoord cData (fmap snd . Map.lookup miCoord =<< initialResult) nudgeCellName mempty
+    local (over _1 (applyDelShapeUpdate . restrictJustAdded miCoord)) $ (cData, ) <$> miCell miCoord cData (fmap snd . Map.lookup miCoord =<< initialResult) nudgeCellName mempty
   let result :: FormResult (Map (BoxCoord liveliness) (cellData, cellResult))
       result
         | shapeChanged = FormMissing
         | otherwise = traverse (\(cData, (cResult, _)) -> (cData, ) <$> cResult) cellResults
 
-  liveliness <- maybe (throwM MassInputInvalidShape) return $ Map.keysSet shape ^? liveCoords :: MForm handler liveliness
-
   let miWidget' :: BoxCoord liveliness -> [(Natural, BoxDimension (BoxCoord liveliness))] -> Widget
       miWidget' _ [] = mempty
       miWidget' miCoord ((dimIx, BoxDimension dim) : remDims) =

From 6dbf8916a5221ee2e63f7bad887d9347a54e8164 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 20 Mar 2019 22:29:08 +0100
Subject: [PATCH 13/15] Remove log comment, which breaks haddock

---
 src/Handler/Utils/Form/MassInput.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/Handler/Utils/Form/MassInput.hs b/src/Handler/Utils/Form/MassInput.hs
index 8da523d3a..0a65194b6 100644
--- a/src/Handler/Utils/Form/MassInput.hs
+++ b/src/Handler/Utils/Form/MassInput.hs
@@ -268,7 +268,6 @@ massInput MassInput{..} FieldSettings{..} fvRequired initialResult csrf = do
     delForm :: BoxCoord liveliness -> MaybeT (MForm handler) (FormResult (Map (BoxCoord liveliness) (BoxCoord liveliness)), FieldView UniWorX)
     delForm miCoord = do
       (delRes, delView) <- lift $ mpreq (buttonField $ MassInputDeleteCell miCoord) ("" & addName MassInputDeleteButton{..}) Nothing
-      -- $logDebugS "delForm" . tshow $ fmap toPathPiece delRes
       shapeUpdate <- miDelete addedLiveliness miCoord
       guard $ isJust (Map.keysSet shapeUpdate ^? liveCoords :: Maybe liveliness)
       return (shapeUpdate <$ delRes, delView)

From 6a1e49bd49f0dc6ca2e2cb98dedc43a2d6606531 Mon Sep 17 00:00:00 2001
From: Felix Hamann <felix.hamann@campus.lmu.de>
Date: Wed, 20 Mar 2019 22:58:16 +0100
Subject: [PATCH 14/15] update name of form identifier for table filters

---
 static/js/utils/asyncTableFilter.js | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/static/js/utils/asyncTableFilter.js b/static/js/utils/asyncTableFilter.js
index 98d9cda75..9106de2c1 100644
--- a/static/js/utils/asyncTableFilter.js
+++ b/static/js/utils/asyncTableFilter.js
@@ -34,7 +34,7 @@
     options = options || {};
     var tableIdent = options.dbtIdent;
 
-    var formId = formElement.querySelector('[name="_formid"]').value;
+    var formId = formElement.querySelector('[name="form-identifier"]').value;
     var inputs = {
       search: [],
       input: [],
@@ -127,7 +127,7 @@
 
     function serializeFormToURL() {
       var url = new URL(options.currentUrl || window.location.href);
-      url.searchParams.set('_formid', formId);
+      url.searchParams.set('form-identifier', formId);
       url.searchParams.set('_hasdata', 'true');
       url.searchParams.set(tableIdent + '-page', '0');
 

From 40bb0ddaf6462a2107a899b6f4d2df713d1ef5c2 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Wed, 20 Mar 2019 22:58:46 +0100
Subject: [PATCH 15/15] Quiet Hlint

---
 src/Handler/Admin.hs | 2 +-
 src/Utils.hs         | 2 ++
 2 files changed, 3 insertions(+), 1 deletion(-)

diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index 9ef15cb84..4b60459b1 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -197,7 +197,7 @@ postAdminTestR = do
 
   -- The actual call to @massInput@ is comparatively simple:
     
-  ((miResult, (fvInput -> miForm)), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell allowAdd) "" True Nothing
+  ((miResult, fvInput -> miForm), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell allowAdd) "" True Nothing
 
 
   let locallyDefinedPageHeading = [whamlet|Admin TestPage for Uni2work|]
diff --git a/src/Utils.hs b/src/Utils.hs
index 8c08d999c..8cfc1a905 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -68,6 +68,8 @@ import qualified Crypto.Data.PKCS7 as PKCS7
 import Data.Fixed (Centi)
 import Data.Ratio ((%))
 
+{-# ANN choice ("HLint: ignore Use asum" :: String) #-}
+
 
 
 -----------