fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Submit sheets from homepage

Browse Source
This commit is contained in:
Gregor Kleen 2019-05-05 21:02:43 +02:00
parent b34a8467ed
commit d030ec1b5f
5 changed files with 9 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Handler/Home.hs
View File

@ -128,7 +128,10 @@ homeUpcomingSheets uid = do
cell $ formatTime SelFormatDateTime deadline >>= toWidget cell $ formatTime SelFormatDateTime deadline >>= toWidget
, sortable (Just "done") (i18nCell MsgDone) $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, E.Value mbsid) } -> , sortable (Just "done") (i18nCell MsgDone) $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, E.Value mbsid) } ->
case mbsid of case mbsid of
Nothing -> mempty Nothing -> cell $ do
let submitRoute = CSheetR tid ssh csh shn SubmissionNewR
whenM (hasWriteAccessTo submitRoute) $
modal [whamlet|_{MsgMenuSubmissionNew}|] . Left $ SomeRoute submitRoute
(Just sid) -> anchorCellM (CSubmissionR tid ssh csh shn <$> encrypt sid <*> pure SubShowR) (Just sid) -> anchorCellM (CSubmissionR tid ssh csh shn <$> encrypt sid <*> pure SubShowR)
(toWidget $ hasTickmark True) (toWidget $ hasTickmark True)
] ]
@ -170,4 +173,4 @@ homeUpcomingSheets uid = do
, dbtParams = def , dbtParams = def
, dbtIdent = "upcoming-sheets" :: Text , dbtIdent = "upcoming-sheets" :: Text
} }
$(widgetFile "home/upcomingSheets") $(widgetFile "home/upcomingSheets")

8
src/Handler/Utils/Form.hs
View File

@ -366,11 +366,7 @@ zipFileField doUnpack = Field{..}
| [f] <- files = return . Right . Just $ bool (yieldM . acceptFile) sourceFiles doUnpack f | [f] <- files = return . Right . Just $ bool (yieldM . acceptFile) sourceFiles doUnpack f
| null files = return $ Right Nothing | null files = return $ Right Nothing
| otherwise = return . Left $ SomeMessage MsgOnlyUploadOneFile | otherwise = return . Left $ SomeMessage MsgOnlyUploadOneFile
fieldView fieldId fieldName attrs _ req = fieldView fieldId fieldName attrs _ req = $(widgetFile "widgets/zipFileField")
[whamlet|
$newline never
<input type=file ##{fieldId} *{attrs} name=#{fieldName} :req:required>
|]
multiFileField :: Handler (Set FileId) -> Field Handler (Source Handler (Either FileId File)) multiFileField :: Handler (Set FileId) -> Field Handler (Source Handler (Either FileId File))
multiFileField permittedFiles' = Field{..} multiFileField permittedFiles' = Field{..}
@ -410,7 +406,7 @@ multiFileField permittedFiles' = Field{..}
E.where_ $ file E.^. FileId `E.in_` E.valList (setToList pVals) E.where_ $ file E.^. FileId `E.in_` E.valList (setToList pVals)
E.orderBy [E.asc $ file E.^. FileTitle] E.orderBy [E.asc $ file E.^. FileTitle]
return (file E.^. FileId, file E.^. FileTitle) return (file E.^. FileId, file E.^. FileTitle)
$(widgetFile "multiFileField") $(widgetFile "widgets/multiFileField")
unpackZips :: Text unpackZips :: Text
unpackZips = "unpack-zip" unpackZips = "unpack-zip"
takeLefts :: Monad m => ConduitM (Either b a) b m () takeLefts :: Monad m => ConduitM (Either b a) b m ()

0
templates/multiFileField.hamlet → templates/widgets/multiFileField.hamlet
View File

0
templates/multiFileField.lucius → templates/widgets/multiFileField.lucius
View File

2
templates/widgets/zipFileField.hamlet Normal file
View File

@ -0,0 +1,2 @@
$newline never
<input type=file uw-file-input ##{fieldId} *{attrs} name=#{fieldName} :req:required>