Cleanup & apply revamp of deletionR

messages/dummy/de.msg

@@ -1 +1,2 @@
 DummyIdent: Nutzer-Kennung
+DummyNoFormData: Keine Formulardaten empfangen

messages/uniworx/de.msg

@@ -93,6 +93,7 @@ SheetEditOk        tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetNa
 SheetNameDup       tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: Es gibt bereits ein Übungsblatt #{sheetName} in diesem Kurs #{display tid}-#{display ssh}-#{csh}.
 SheetDelHead       tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: #{sheetName} wirklich aus Kurs #{display tid}-#{display ssh}-#{csh} herauslöschen? Alle assoziierten Abgaben und Korrekturen gehen ebenfalls verloren!
 SheetDelOk         tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: #{display tid}-#{display ssh}-#{csh}: #{sheetName} gelöscht.
+SheetDelHasSubmissions count@Int: Inkl. #{tshow count} #{pluralDE count "Abgabe" "Abgaben"}!
 
 SheetDeleteQuestion: Wollen Sie das unten aufgeführte Übungsblatt und alle zugehörigen Abgaben wirklich löschen?
 SheetDeleted: Übungsblatt gelöscht

src/Auth/Dummy.hs

@@ -13,6 +13,7 @@ import qualified Data.CaseInsensitive as CI
 
 
 data DummyMessage = MsgDummyIdent
+                  | MsgDummyNoFormData
 
 
 dummyForm :: ( RenderMessage site FormMessage
@@ -48,7 +49,9 @@ dummyLogin = AuthPlugin{..}
         FormFailure errs -> do
           lift . forM_ errs $ addMessage Error . toHtml
           redirect LoginR
-        FormMissing -> redirect LoginR
+        FormMissing -> do
+          lift $ addMessageI Warning MsgDummyNoFormData
+          redirect LoginR
         FormSuccess ident ->
           lift . setCredsRedirect $ Creds "dummy" (CI.original ident) []
     apDispatch _ _ = notFound

src/Handler/Course.hs

@@ -6,6 +6,7 @@ import Utils.Lens
 -- import Utils.DB
 import Handler.Utils
 import Handler.Utils.Table.Cells
+import Handler.Utils.Course
 import Handler.Utils.Delete
 
 -- import Data.Time
@@ -391,28 +392,10 @@ getCDeleteR, postCDeleteR :: TermId -> SchoolId -> CourseShorthand -> Handler Ht
 getCDeleteR = postCDeleteR
 postCDeleteR tid ssh csh = do
   Entity cId _ <- runDB . getBy404 $ TermSchoolCourseShort tid ssh csh
-  deleteR DeleteRoute
+  deleteR $ (courseDeleteRoute $ Set.singleton cId)
-    { drRecords = Set.singleton cId
+    { drAbort = SomeRoute $ CourseR tid ssh csh CShowR
-    , drRenderRecord = \(Entity _ Course{courseName, courseTerm, courseSchool}) -> do
+    , drSuccess = SomeRoute $ TermSchoolCourseListR tid ssh
-        School{schoolName} <- getJust courseSchool
-        return [whamlet|
-          #{courseName} (_{SomeMessage $ ShortTermIdentifier (unTermKey courseTerm)}, #{schoolName})
-        |]
-    , drRecordConfirmString = \(Entity _ Course{courseShorthand, courseTerm, courseSchool}) -> 
-        return [st|#{unSchoolKey courseSchool}/#{termToText (unTermKey courseTerm)}/#{courseShorthand}|]
-    , drCaption = SomeMessage MsgCourseDeleteQuestion
-    , drSuccessMessage = SomeMessage MsgCourseDeleted
-    , drAbort = SomeRoute $ CourseR tid ssh csh CShowR
-    , drSuccess = SomeRoute CourseListR
     }
-{- TODO
-        | False -- DELETE -- TODO: This no longer works that way!!! See new way in Handler.Term.termEditHandler
-        , Just cid <- cfCourseId res -> do
-            runDB $ deleteCascade cid -- TODO Sicherheitsabfrage einbauen!
-            let cti = toPathPiece $ cfTerm res
-            addMessage Info [shamlet| Kurs #{cti}/#{cfShort res} wurde gelöscht!|]
-            redirect $ TermCourseListR $ cfTerm res
--}
 
 
 -- | Course Creation and Editing

src/Handler/Profile.hs

@@ -106,9 +106,9 @@ postProfileDataR = do
       defaultLayout
         $(widgetFile "deletedUser")
 
-    (FormSuccess BtnAbort ) -> do
+    -- (FormSuccess BtnAbort ) -> do
-      addMessageI Info MsgAborted
+    --   addMessageI Info MsgAborted
-      redirect ProfileDataR
+    --   redirect ProfileDataR
     _other -> getProfileDataR
 
 

src/Handler/Sheet.hs

@@ -533,20 +533,8 @@ getSDelR, postSDelR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Han
 getSDelR = postSDelR
 postSDelR tid ssh csh shn = do
   sid <- runDB $ fetchSheetId tid ssh csh shn
-  deleteR DeleteRoute
+  deleteR $ (sheetDeleteRoute $ Set.singleton sid)
-    { drRecords = Set.singleton sid
+    { drAbort = SomeRoute $ CSheetR tid ssh csh shn SShowR
-    , drRenderRecord = \(Entity _ Sheet{sheetName, sheetCourse}) -> do
-        Course{courseTerm, courseSchool, courseName} <- getJust sheetCourse
-        School{schoolName} <- getJust courseSchool
-        return [whamlet|
-          #{sheetName} (_{ShortTermIdentifier (unTermKey courseTerm)}, #{schoolName}, #{courseName})
-        |]
-    , drRecordConfirmString = \(Entity _ Sheet{sheetName, sheetCourse}) -> do
-        Course{courseTerm, courseSchool, courseShorthand} <- getJust sheetCourse
-        return [st|#{termToText (unTermKey courseTerm)}/#{unSchoolKey courseSchool}/#{courseShorthand}/#{sheetName}|]
-    , drCaption = SomeMessage MsgSheetDeleteQuestion
-    , drSuccessMessage = SomeMessage MsgSheetDeleted
-    , drAbort = SomeRoute $ CSheetR tid ssh csh shn SShowR
     , drSuccess = SomeRoute $ CourseR tid ssh csh SheetListR
     }
 

src/Handler/Submission.hs

@@ -20,7 +20,6 @@ import Network.Mime
 import Data.Monoid (Any(..))
 import Data.Maybe (fromJust)
 -- import qualified Data.Maybe
-import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 
 import Data.CaseInsensitive (CI)
@@ -397,30 +396,7 @@ getSubDelR, postSubDelR :: TermId -> SchoolId -> CourseShorthand -> SheetName ->
 getSubDelR = postSubDelR
 postSubDelR tid ssh csh shn cID = do
   subId <- runDB $ submissionMatchesSheet tid ssh csh shn cID
-  deleteR DeleteRoute
+  deleteR $ (submissionDeleteRoute $ Set.singleton subId)
-    { drRecords = Set.singleton subId
+    { drAbort = SomeRoute $ CSubmissionR tid ssh csh shn cID SubShowR
-    , drRenderRecord = \(Entity subId' Submission{submissionSheet}) -> do
-        Sheet{sheetName, sheetCourse} <- getJust submissionSheet
-        Course{courseName, courseSchool, courseTerm} <- getJust sheetCourse
-        School{schoolName} <- getJust courseSchool
-        subUsers <- selectList [SubmissionUserSubmission ==. subId'] []
-        subNames <- fmap (sortOn snd) . forM subUsers $ \(Entity _ SubmissionUser{submissionUserUser}) -> (userDisplayName &&& userSurname) <$> getJust submissionUserUser
-        return [whamlet|
-          $newline never
-          <ul .list--comma-separated .list--inline .list--iconless>
-            $forall (dName, sName) <- subNames
-              <li>^{nameWidget dName sName}
-          &nbsp;(_{ShortTermIdentifier (unTermKey courseTerm)}, #{schoolName}, #{courseName}, #{sheetName})
-        |]
-    , drRecordConfirmString = \(Entity subId' Submission{submissionSheet}) -> do
-        Sheet{sheetName, sheetCourse} <- getJust submissionSheet
-        Course{courseShorthand, courseSchool, courseTerm} <- getJust sheetCourse
-        subUsers <- selectList [SubmissionUserSubmission ==. subId'] []
-        subNames <- fmap sort . forM subUsers $ \(Entity _ SubmissionUser{submissionUserUser}) -> userSurname <$> getJust submissionUserUser
-        let subNames' = Text.intercalate ", " subNames
-        return [st|#{termToText (unTermKey courseTerm)}/#{unSchoolKey courseSchool}/#{courseShorthand}/#{sheetName}/#{subNames'}|]
-    , drCaption = SomeMessage $ MsgSubmissionsDeleteQuestion 1
-    , drSuccessMessage = SomeMessage $ MsgSubmissionsDeleted 1
-    , drAbort = SomeRoute $ CSubmissionR tid ssh csh shn cID SubShowR
     , drSuccess = SomeRoute $ CSheetR tid ssh csh shn SShowR
     }

src/Handler/Utils/Course.hs

@@ -0,0 +1,27 @@
+module Handler.Utils.Course where
+
+import Import
+import Handler.Utils.Delete
+
+import qualified Database.Esqueleto as E
+  
+
+courseDeleteRoute :: Set CourseId -> DeleteRoute Course
+courseDeleteRoute drRecords = DeleteRoute
+  { drRecords
+  , drGetInfo = \(course `E.InnerJoin` school) -> do
+      E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
+      E.orderBy [E.asc $ course E.^. CourseName]
+      return (course E.^. CourseName, school E.^. SchoolShorthand, school E.^. SchoolName, course E.^. CourseTerm)
+  , drUnjoin = \(course `E.InnerJoin` _) -> course
+  , drRenderRecord = \(E.Value cName, _, E.Value sName, E.Value tid') ->
+      return [whamlet|
+        #{cName} (_{ShortTermIdentifier (unTermKey tid')}, #{sName})
+      |]
+  , drRecordConfirmString = \(E.Value cName, E.Value ssh', _, E.Value tid') -> 
+      return [st|#{termToText (unTermKey tid')}/#{ssh'}/#{cName}|]
+  , drCaption = SomeMessage MsgCourseDeleteQuestion
+  , drSuccessMessage = SomeMessage MsgCourseDeleted
+  , drAbort = error "drAbort undefined"
+  , drSuccess = error "drSuccess undefined"
+  }

src/Handler/Utils/Delete.hs

@@ -36,14 +36,11 @@ data DeleteRoute record = forall tables infoExpr info. (E.SqlSelect infoExpr inf
 confirmForm :: ( MonadHandler m, HandlerSite m ~ UniWorX )
            => Text -- ^ Confirmation string
            -> AForm m Bool
-confirmForm confirmString = flip traverseAForm aform $ \case
+confirmForm confirmString = flip traverseAForm aform $ \(inpConfirmStr, BtnDelete) -> if
-  (inpConfirmStr, BtnDelete)
+  | ((==) `on` map (CI.mk . filter isAlphaNum) . Text.words) confirmString inpConfirmStr
-    | ((==) `on` map (CI.mk . filter isAlphaNum) . Text.words) confirmString inpConfirmStr
+    -> return $ pure True
-      -> return $ pure True
+  | otherwise
-    | otherwise
+    -> formFailure [MsgDeleteConfirmationWrong]
-      -> formFailure [MsgDeleteConfirmationWrong]
-  (_, BtnAbort)
-    -> return $ pure False
   where
     aform = (,)
         <$> areq confirmField (fslI MsgDeleteConfirmation) Nothing
@@ -53,6 +50,14 @@ confirmForm confirmString = flip traverseAForm aform $ \case
       | otherwise = textField
     multiple = length (filter (not . Text.null . Text.strip) $ Text.lines confirmString) > 1
 
+confirmForm' :: PersistEntity record => Set (Key record) -> Text -> Form Bool
+confirmForm' drRecords confirmString = addDeleteTargets . identForm FIDDelete . renderAForm FormStandard $ confirmForm confirmString
+  where
+    addDeleteTargets :: Form a -> Form a
+    addDeleteTargets form csrf = do
+      (_, fvTargets) <- mreq secretJsonField ("" & addName (toPathPiece PostDeleteTarget)) (Just drRecords)
+      over _2 (mappend $ fvInput fvTargets) <$> form csrf
+
 
 postDeleteR :: ( DeleteCascade record SqlBackend )
             => (Set (Key record) -> DeleteRoute record) -- ^ Construct `DeleteRoute` based on incoming record keys
@@ -64,13 +69,7 @@ postDeleteR mkRoute = do
   void . for drResult $ \DeleteRoute{..} -> do
     confirmString <- fmap Text.unlines . runDB $ mapM drRecordConfirmString <=< E.select . E.from $ \t -> drGetInfo t <* E.where_ (drUnjoin t E.^. persistIdField `E.in_` E.valList (Set.toList drRecords))
 
-    let
+    ((confirmRes, _), _) <- runFormPost $ confirmForm' drRecords confirmString
-      addDeleteTargets :: Form a -> Form a
-      addDeleteTargets form csrf = do
-        (_, fvTargets) <- mreq secretJsonField ("" & addName (toPathPiece PostDeleteTarget)) (Just drRecords)
-        over _2 (mappend $ fvInput fvTargets) <$> form csrf
-
-    ((confirmRes, _), _) <- runFormPost . identForm FIDDelete . addDeleteTargets . renderAForm FormStandard $ confirmForm confirmString
 
     formResult confirmRes $ \case
       True -> do
@@ -88,7 +87,7 @@ getDeleteR DeleteRoute{..} = do
 
   let confirmString = Text.unlines $ view _2 <$> targets
 
-  ((_, deleteFormWdgt), deleteFormEnctype) <- runFormPost . identForm FIDDelete . renderAForm FormStandard $ confirmForm confirmString
+  ((_, deleteFormWdgt), deleteFormEnctype) <- runFormPost $ confirmForm' drRecords confirmString
 
   Just targetRoute <- getCurrentRoute
   

src/Handler/Utils/Form.hs

@@ -23,8 +23,6 @@ import qualified Data.Text as T
 import Yesod.Form.Functions (parseHelper)
 import Yesod.Form.Bootstrap3
 
-import Web.PathPieces (showToPathPiece, readFromPathPiece)
-
 import Handler.Utils.Zip
 import qualified Data.Conduit.List as C
 
@@ -53,29 +51,26 @@ import Data.Aeson.Text (encodeToLazyText)
 -- Buttons (new version ) --
 ----------------------------
 
-data BtnDelete = BtnDelete | BtnAbort
+data BtnDelete = BtnDelete
   deriving (Enum, Eq, Ord, Bounded, Read, Show)
 
 instance Universe BtnDelete
 instance Finite BtnDelete
 
-instance PathPiece BtnDelete where    -- for displaying the button only, not really for paths
+nullaryPathPiece ''BtnDelete $ camelToPathPiece' 1
-  toPathPiece   = showToPathPiece
-  fromPathPiece = readFromPathPiece
 
 instance Button UniWorX BtnDelete where
   label BtnDelete = [whamlet|_{MsgBtnDelete}|]
-  label BtnAbort  = [whamlet|_{MsgBtnAbort}|]
 
   cssClass BtnDelete = BCDanger
-  cssClass BtnAbort  = BCDefault
 
 data RegisterButton = BtnRegister  | BtnDeregister
   deriving (Enum, Eq, Ord, Bounded, Read, Show)
 
-instance PathPiece RegisterButton where
+instance Universe RegisterButton
-  toPathPiece   = showToPathPiece
+instance Finite RegisterButton
-  fromPathPiece = readFromPathPiece
+
+nullaryPathPiece ''RegisterButton $ camelToPathPiece' 1
 
 instance Button UniWorX RegisterButton where
   label BtnRegister   = [whamlet|_{MsgBtnRegister}|]
@@ -87,9 +82,10 @@ instance Button UniWorX RegisterButton where
 data AdminHijackUserButton = BtnHijack
   deriving (Enum, Eq, Ord, Bounded, Read, Show)
 
-instance PathPiece AdminHijackUserButton where
+instance Universe AdminHijackUserButton
-  toPathPiece   = showToPathPiece
+instance Finite AdminHijackUserButton
-  fromPathPiece = readFromPathPiece
+
+nullaryPathPiece ''AdminHijackUserButton $ camelToPathPiece' 1
 
 instance Button UniWorX AdminHijackUserButton where
   label BtnHijack = [whamlet|_{MsgBtnHijack}|]
@@ -109,7 +105,10 @@ instance Button UniWorX BtnSubmitDelete where
   cssClass BtnSubmit' = BCPrimary
   cssClass BtnDelete' = BCDanger
 
-nullaryPathPiece ''BtnSubmitDelete (camelToPathPiece' 1 . dropSuffix "'")
+  btnValidate _ BtnSubmit' = True
+  btnValidate _ BtnDelete' = False
+
+nullaryPathPiece ''BtnSubmitDelete $ camelToPathPiece' 1 . dropSuffix "'"
 
 
 -- -- Looks like a button, but is just a link (e.g. for create course, etc.)

src/Handler/Utils/Sheet.hs

@@ -1,13 +1,12 @@
 module Handler.Utils.Sheet where
 
 import Import
+import Handler.Utils.Delete
 
 import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Internal.Sql as E
 
 
-
-
 fetchSheetAux ::  ( BaseBackend backend ~ SqlBackend
                   , E.SqlSelect b a
                   , Typeable a, MonadHandler m, IsPersistBackend backend
@@ -41,3 +40,31 @@ fetchSheetId tid ssh cid shn = E.unValue <$> fetchSheetAux (E.^. SheetId) tid ss
 
 fetchSheetIdCourseId :: TermId -> SchoolId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Key Sheet, Key Course)
 fetchSheetIdCourseId tid ssh cid shn = bimap E.unValue E.unValue <$> fetchSheetAux ((,) <$> (E.^. SheetId) <*> (E.^. SheetCourse)) tid ssh cid shn
+
+
+sheetDeleteRoute :: Set SheetId -> DeleteRoute Sheet
+sheetDeleteRoute drRecords = DeleteRoute
+  { drRecords
+  , drGetInfo = \(sheet `E.InnerJoin` course `E.InnerJoin` school) -> do
+      E.on $ school E.^. SchoolId E.==. course E.^. CourseSchool
+      E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
+      let submissions = E.sub_select . E.from $ \submission -> do
+            E.where_ $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId
+            return E.countRows
+      E.orderBy [E.asc $ sheet E.^. SheetName]
+      return (submissions, sheet E.^. SheetName, course E.^. CourseShorthand, course E.^. CourseName, school E.^. SchoolShorthand, school E.^. SchoolName, course E.^. CourseTerm)
+  , drUnjoin = \(sheet `E.InnerJoin` _ `E.InnerJoin` _) -> sheet
+  , drRenderRecord = \(E.Value submissions, E.Value shn', _, E.Value cName, _, E.Value sName, E.Value tid') ->
+      return [whamlet|
+        $newline never
+        #{shn'} (_{SomeMessage $ ShortTermIdentifier (unTermKey tid')}, #{sName}, #{cName})
+        $if submissions /= 0
+          &nbsp;<i>_{SomeMessage $ MsgSheetDelHasSubmissions submissions}
+      |]
+  , drRecordConfirmString = \(E.Value submissions, E.Value shn', E.Value csh', _, E.Value ssh', _, E.Value tid') ->
+      return $ [st|#{termToText (unTermKey tid')}/#{ssh'}/#{csh'}/#{shn'}|] <> bool mempty [st| + #{tshow submissions} Subs|] (submissions /= 0)
+  , drCaption = SomeMessage MsgSheetDeleteQuestion
+  , drSuccessMessage = SomeMessage MsgSheetDeleted
+  , drAbort = error "drAbort undefined"
+  , drSuccess = error "drSuccess undefined"
+  }

src/Handler/Utils/Submission.hs

@@ -8,6 +8,7 @@ module Handler.Utils.Submission
   , msgSubmissionErrors -- wrap around sinkSubmission/sinkMultiSubmission, but outside of runDB!
   , sinkSubmission, sinkMultiSubmission
   , submissionMatchesSheet
+  , submissionDeleteRoute
   ) where
 
 import Import hiding (joinPath)
@@ -37,11 +38,10 @@ import Data.Ratio
 import Data.Monoid (Monoid, Any(..), Sum(..))
 import Generics.Deriving.Monoid (memptydefault, mappenddefault)
 
-import Handler.Utils.Rating hiding (extractRatings)
+import Handler.Utils
 import qualified Handler.Utils.Rating as Rating (extractRatings)
-import Handler.Utils.Zip
-import Handler.Utils.Sheet
 import Handler.Utils.Submission.TH
+import Handler.Utils.Delete
 
 import qualified Database.Esqueleto as E
 
@@ -601,3 +601,40 @@ submissionMatchesSheet tid ssh csh shn cid = do
   Submission{..} <- get404 sid
   when (shid /= submissionSheet) $ invalidArgsI [MsgSubmissionWrongSheet]
   return sid
+
+
+submissionDeleteRoute :: Set SubmissionId -> DeleteRoute Submission
+submissionDeleteRoute drRecords = DeleteRoute
+  { drRecords
+  , drUnjoin = \(submission `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> submission
+  , drGetInfo = \(submission `E.InnerJoin` sheet `E.InnerJoin` course `E.InnerJoin` school) -> do
+      E.on $ school E.^. SchoolId E.==. course E.^. CourseSchool
+      E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
+      E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet
+      let lastEdit = E.sub_select . E.from $ \submissionEdit -> do
+            E.where_ $ submissionEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId
+            E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
+            E.limit 1
+            return $ submissionEdit E.^. SubmissionEditTime
+      E.orderBy [E.desc lastEdit]
+      return (submission E.^. SubmissionId, sheet E.^. SheetName, course E.^. CourseShorthand, course E.^. CourseName, school E.^. SchoolShorthand, school E.^. SchoolName, course E.^. CourseTerm)
+  , drRenderRecord = \(E.Value subId', E.Value shn', _, E.Value cName, _, E.Value sName, E.Value tid') -> do
+      subUsers <- selectList [SubmissionUserSubmission ==. subId'] []
+      subNames <- fmap (sortOn snd) . forM subUsers $ \(Entity _ SubmissionUser{submissionUserUser}) -> (userDisplayName &&& userSurname) <$> getJust submissionUserUser
+      return [whamlet|
+        $newline never
+        <ul .list--comma-separated .list--inline .list--iconless>
+          $forall (dName, sName) <- subNames
+            <li>^{nameWidget dName sName}
+        &nbsp;(_{ShortTermIdentifier (unTermKey tid')}, #{sName}, #{cName}, #{shn'})
+      |]
+  , drRecordConfirmString = \(E.Value subId', E.Value shn', E.Value csh', _, E.Value ssh', _, E.Value tid') -> do
+      subUsers <- selectList [SubmissionUserSubmission ==. subId'] []
+      subNames <- fmap sort . forM subUsers $ \(Entity _ SubmissionUser{submissionUserUser}) -> userSurname <$> getJust submissionUserUser
+      let subNames' = Text.intercalate ", " subNames
+      return [st|#{termToText (unTermKey tid')}/#{ssh'}/#{csh'}/#{shn'}/#{subNames'}|]
+  , drCaption = SomeMessage $ MsgSubmissionsDeleteQuestion 1
+  , drSuccessMessage = SomeMessage $ MsgSubmissionsDeleted 1
+  , drAbort = error "drAbort undefined"
+  , drSuccess = error "drSuccess undefined"
+  }

src/Utils/Form.hs

@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
+
 module Utils.Form where
 
 import ClassyPrelude.Yesod hiding (addMessage, cons, Proxy(..))
@@ -26,6 +28,7 @@ import Web.PathPieces
 import Data.UUID
 
 import Utils.Message
+import Utils.PathPiece
 
 import Data.Proxy
 
@@ -206,6 +209,9 @@ class (Enum a, Bounded a, Ord a, PathPiece a) => Button site a where
   label :: a -> WidgetT site IO ()
   label = toWidget . toPathPiece
 
+  btnValidate :: forall p. p site -> a -> Bool
+  btnValidate _ _ = True
+
   cssClass :: a -> ButtonCssClass site
 
 data ButtonMessage = MsgAmbiguousButtons
@@ -218,9 +224,7 @@ data SubmitButton = BtnSubmit
 instance Universe SubmitButton
 instance Finite SubmitButton
 
-instance PathPiece SubmitButton where
+nullaryPathPiece ''SubmitButton $ camelToPathPiece' 1
-  toPathPiece   = showToPathPiece
-  fromPathPiece = readFromPathPiece
 
 buttonField :: forall a m.
              ( Button (HandlerSite m) a
@@ -229,7 +233,7 @@ buttonField :: forall a m.
              , Monad m
              ) => a -> Field m a
 -- | Already validates that the correct button press was received (result only neccessary for combinedButtonField)
-buttonField btn = Field {fieldParse, fieldView, fieldEnctype}
+buttonField btn = Field{..}
   where
     fieldEnctype = UrlEncoded
 
@@ -237,13 +241,15 @@ buttonField btn = Field {fieldParse, fieldView, fieldEnctype}
     fieldView fid name attrs _val _ = let
       cssClass' :: ButtonCssClass (HandlerSite m)
       cssClass' = cssClass btn
+      validate = btnValidate (Proxy @(HandlerSite m)) btn
       in [whamlet|
-        <button .btn .#{bcc2txt cssClass'} type=submit name=#{name} value=#{toPathPiece btn} *{attrs} ##{fid}>^{label btn}
+        $newline never
+        <button .btn .#{bcc2txt cssClass'} type=submit name=#{name} value=#{toPathPiece btn} *{attrs} ##{fid} :not validate:formnovalidate>^{label btn}
       |]
 
     fieldParse []    [] = return $ Right Nothing
     fieldParse [str] []
-      | str == toPathPiece btn = return $ Right $ Just btn
+      | str == toPathPiece btn = return . Right $ Just btn
       | otherwise  = return . Left $ SomeMessage MsgWrongButtonValue
     fieldParse _ _ = return . Left $ SomeMessage MsgMultipleButtonValues
 
@@ -255,8 +261,8 @@ combinedButtonField :: forall a m.
                      ) => [a] -> FieldSettings (HandlerSite m) -> AForm m [Maybe a]
 combinedButtonField bs FieldSettings{..} = formToAForm $ do
   mr <- getMessageRender
-  fvId <- maybe newIdent return fsId
+  fvId <- maybe newFormIdent return fsId
-  name <- maybe newIdent return fsName
+  name <- maybe newFormIdent return fsName
   (ress, fvs) <- fmap unzip . for bs $ \b -> mopt (buttonField b) ("" { fsId = Just $ fvId <> "__" <> toPathPiece b
                                                                       , fsName = Just $ name <> "__" <> toPathPiece b
                                                                       }) Nothing
@@ -310,7 +316,7 @@ submitButton :: (Button (HandlerSite m) SubmitButton, Show (ButtonCssClass (Hand
 submitButton = combinedButtonFieldF_ (Proxy @SubmitButton) ""
 
 autosubmitButton :: (Button (HandlerSite m) SubmitButton, Show (ButtonCssClass (HandlerSite m)), MonadHandler m, RenderMessage (HandlerSite m) ButtonMessage) => AForm m ()
-autosubmitButton = void $ aopt (buttonField BtnSubmit) ("" & addAutosubmit) Nothing
+autosubmitButton = combinedButtonFieldF_ (Proxy @SubmitButton) $ "" & addAutosubmit
 
 -------------------
 -- Custom Fields --

templates/default-layout.lucius

@@ -439,6 +439,18 @@ input[type="button"].btn-info:hover,
 }
 
 .list--inline {
+  ul {
+    display: inline-block;
+    margin-left: 0;
+
+    li {
+      display: inline-block;
+    }
+  }
+}
+
+ul.list--inline {
+  
   display: inline-block;
   margin-left: 0;
 

templates/widgets/form.julius

@@ -77,7 +77,7 @@ document.addEventListener('setup', function(e) {
   var forms = e.detail.scope.querySelectorAll('form');
   Array.from(forms).forEach(function(form) {
     // auto reactiveButton submit-buttons with required fields
-    var submitBtns = Array.from(form.querySelectorAll('[type=submit]'));
+    var submitBtns = Array.from(form.querySelectorAll('[type=submit]:not([formnovalidate])'));
     submitBtns.forEach(function(submitBtn) {
       window.utils.reactiveButton(form, submitBtn, validateForm);
     });