refactoring: move each widget into its own subfolder

This commit is contained in:
Felix Hamann 2019-02-16 23:35:57 +01:00
parent a017168ecb
commit 3db08a841c
44 changed files with 26 additions and 26 deletions

View File

@ -7,7 +7,7 @@ import Import.NoFoundation
import Database.Persist.Sql (SqlBackendCanRead) import Database.Persist.Sql (SqlBackendCanRead)
import Utils.Form import Utils.Form
import Data.CaseInsensitive (CI) import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI import qualified Data.CaseInsensitive as CI
@ -54,4 +54,4 @@ dummyLogin = AuthPlugin{..}
apDispatch _ _ = notFound apDispatch _ _ = notFound
apLogin toMaster = do apLogin toMaster = do
(login, loginEnctype) <- handlerToWidget . generateFormPost $ renderAForm FormStandard dummyForm (login, loginEnctype) <- handlerToWidget . generateFormPost $ renderAForm FormStandard dummyForm
$(widgetFile "widgets/dummy-login-form") $(widgetFile "widgets/dummy-login-form/dummy-login-form")

View File

@ -36,7 +36,7 @@ data CampusMessage = MsgCampusIdentNote
| MsgCampusSubmit | MsgCampusSubmit
| MsgCampusInvalidCredentials | MsgCampusInvalidCredentials
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable) deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
findUser :: LdapConf -> Ldap -> Text -> [Ldap.Attr] -> IO [Ldap.SearchEntry] findUser :: LdapConf -> Ldap -> Text -> [Ldap.Attr] -> IO [Ldap.SearchEntry]
findUser LdapConf{..} ldap campusIdent = Ldap.search ldap ldapBase userSearchSettings userFilter findUser LdapConf{..} ldap campusIdent = Ldap.search ldap ldapBase userSearchSettings userFilter
@ -48,7 +48,7 @@ findUser LdapConf{..} ldap campusIdent = Ldap.search ldap ldapBase userSearchSet
, Ldap.time ldapSearchTimeout , Ldap.time ldapSearchTimeout
, Ldap.derefAliases Ldap.DerefAlways , Ldap.derefAliases Ldap.DerefAlways
] ]
userPrincipalName :: Ldap.Attr userPrincipalName :: Ldap.Attr
userPrincipalName = Ldap.Attr "userPrincipalName" userPrincipalName = Ldap.Attr "userPrincipalName"
@ -105,7 +105,7 @@ campusLogin conf@LdapConf{..} pool = AuthPlugin{..}
apDispatch _ _ = notFound apDispatch _ _ = notFound
apLogin toMaster = do apLogin toMaster = do
(login, loginEnctype) <- handlerToWidget . generateFormPost $ renderAForm FormStandard campusForm (login, loginEnctype) <- handlerToWidget . generateFormPost $ renderAForm FormStandard campusForm
$(widgetFile "widgets/campus-login-form") $(widgetFile "widgets/campus-login/campus-login-form")
data CampusUserException = CampusUserLdapError LdapPoolError data CampusUserException = CampusUserLdapError LdapPoolError
| CampusUserHostNotResolved String | CampusUserHostNotResolved String

View File

@ -35,7 +35,7 @@ hashForm = HashLogin
<*> areq passwordField (fslpI MsgPWHashPassword "Passwort") Nothing <*> areq passwordField (fslpI MsgPWHashPassword "Passwort") Nothing
<* submitButton <* submitButton
hashLogin :: ( YesodAuth site hashLogin :: ( YesodAuth site
, YesodPersist site , YesodPersist site
, SqlBackendCanRead (YesodPersistBackend site) , SqlBackendCanRead (YesodPersistBackend site)
@ -90,5 +90,5 @@ hashLogin pwHashAlgo = AuthPlugin{..}
apDispatch _ _ = notFound apDispatch _ _ = notFound
apLogin toMaster = do apLogin toMaster = do
(login, loginEnctype) <- handlerToWidget . generateFormPost $ renderAForm FormStandard hashForm (login, loginEnctype) <- handlerToWidget . generateFormPost $ renderAForm FormStandard hashForm
$(widgetFile "widgets/hash-login-form") $(widgetFile "widgets/hash-login-form/hash-login-form")

View File

@ -969,19 +969,19 @@ siteLayout' headingOverride widget = do
-- you to use normal widget features in default-layout. -- you to use normal widget features in default-layout.
navbar :: Widget navbar :: Widget
navbar = $(widgetFile "widgets/navbar") navbar = $(widgetFile "widgets/navbar/navbar")
asidenav :: Widget asidenav :: Widget
asidenav = $(widgetFile "widgets/asidenav/asidenav") asidenav = $(widgetFile "widgets/asidenav/asidenav")
footer :: Widget footer :: Widget
footer = $(widgetFile "widgets/footer") footer = $(widgetFile "widgets/footer/footer")
alerts :: Widget alerts :: Widget
alerts = $(widgetFile "widgets/alerts/alerts") alerts = $(widgetFile "widgets/alerts/alerts")
contentHeadline :: Maybe Widget contentHeadline :: Maybe Widget
contentHeadline = headingOverride <|> (pageHeading =<< mcurrentRoute) contentHeadline = headingOverride <|> (pageHeading =<< mcurrentRoute)
breadcrumbsWgt :: Widget breadcrumbsWgt :: Widget
breadcrumbsWgt = $(widgetFile "widgets/breadcrumbs") breadcrumbsWgt = $(widgetFile "widgets/breadcrumbs/breadcrumbs")
pageaction :: Widget pageaction :: Widget
pageaction = $(widgetFile "widgets/pageaction") pageaction = $(widgetFile "widgets/pageaction/pageaction")
-- functions to determine if there are page-actions (primary or secondary) -- functions to determine if there are page-actions (primary or secondary)
hasPageActions, hasSecondaryPageActions, hasPrimaryPageActions :: Bool hasPageActions, hasSecondaryPageActions, hasPrimaryPageActions :: Bool
hasPageActions = hasPrimaryPageActions || hasSecondaryPageActions hasPageActions = hasPrimaryPageActions || hasSecondaryPageActions

View File

@ -162,7 +162,7 @@ colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(E
cid <- encrypt subId cid <- encrypt subId
return $ CSubmissionR tid ssh csh sheetName cid CorrectionR return $ CSubmissionR tid ssh csh sheetName cid CorrectionR
in mconcat in mconcat
[ anchorCellM mkRoute $(widgetFile "widgets/rating") [ anchorCellM mkRoute $(widgetFile "widgets/rating/rating")
, writerCell $ do , writerCell $ do
let let
summary :: SheetTypeSummary summary :: SheetTypeSummary

View File

@ -295,7 +295,7 @@ registerForm registered msecret extra = do
(Just _) | not registered -> bimap Just Just <$> mreq textField (fslpI MsgCourseSecret "Code") Nothing (Just _) | not registered -> bimap Just Just <$> mreq textField (fslpI MsgCourseSecret "Code") Nothing
_ -> return (Nothing,Nothing) _ -> return (Nothing,Nothing)
(btnRes, btnView) <- mreq (buttonField $ bool BtnRegister BtnDeregister registered) "buttonField ignores settings anyway" Nothing (btnRes, btnView) <- mreq (buttonField $ bool BtnRegister BtnDeregister registered) "buttonField ignores settings anyway" Nothing
let widget = $(widgetFile "widgets/registerForm") let widget = $(widgetFile "widgets/register-form/register-form")
let msecretRes | Just res <- msecretRes' = Just <$> res let msecretRes | Just res <- msecretRes' = Just <$> res
| otherwise = FormSuccess Nothing | otherwise = FormSuccess Nothing
return (btnRes *> ((==msecret) <$> msecretRes), widget) -- checks that correct button was pressed, and ignores result of btnRes return (btnRes *> ((==msecret) <$> msecretRes), widget) -- checks that correct button was pressed, and ignores result of btnRes

View File

@ -221,7 +221,7 @@ getProfileDataR = do
-- Delete Button -- Delete Button
(btnWdgt, btnEnctype) <- generateFormPost (buttonForm :: Form ButtonDelete) (btnWdgt, btnEnctype) <- generateFormPost (buttonForm :: Form ButtonDelete)
defaultLayout $ do defaultLayout $ do
let delWdgt = $(widgetFile "widgets/data-delete") let delWdgt = $(widgetFile "widgets/data-delete/data-delete")
$(widgetFile "profileData") $(widgetFile "profileData")
$(widgetFile "dsgvDisclaimer") $(widgetFile "dsgvDisclaimer")

View File

@ -205,7 +205,7 @@ getSheetListR tid ssh csh = do
mkRoute = do mkRoute = do
cid' <- mkCid cid' <- mkCid
return $ CSubmissionR tid ssh csh sheetName cid' CorrectionR return $ CSubmissionR tid ssh csh sheetName cid' CorrectionR
acell = anchorCellM mkRoute $(widgetFile "widgets/rating") acell = anchorCellM mkRoute $(widgetFile "widgets/rating/rating")
in cellTell acell $ stats submissionRatingPoints in cellTell acell $ stats submissionRatingPoints
, sortable Nothing -- (Just "percent") , sortable Nothing -- (Just "percent")

View File

@ -144,7 +144,7 @@ postAdminUserR uuid = do
return (school, cbAdmin, cbLecturer) return (school, cbAdmin, cbLecturer)
let result = forM boxRights $ \(Entity sid _, (resAdmin,_), (resLecturer, _)) -> let result = forM boxRights $ \(Entity sid _, (resAdmin,_), (resLecturer, _)) ->
(,,) <$> pure sid <*> resAdmin <*> resLecturer (,,) <$> pure sid <*> resAdmin <*> resLecturer
return (result,$(widgetFile "widgets/user-rights-form")) return (result,$(widgetFile "widgets/user-rights-form/user-rights-form"))
let userRightsAction changes = do let userRightsAction changes = do
void . runDB $ void . runDB $
forM changes $ \(sid, userAdmin, userLecturer) -> forM changes $ \(sid, userAdmin, userLecturer) ->

View File

@ -90,9 +90,9 @@ getDeleteR DeleteRoute{..} = do
(deleteFormWdgt, deleteFormEnctype) <- generateFormPost $ confirmForm' drRecords confirmString (deleteFormWdgt, deleteFormEnctype) <- generateFormPost $ confirmForm' drRecords confirmString
Just targetRoute <- getCurrentRoute Just targetRoute <- getCurrentRoute
sendResponse =<< sendResponse =<<
defaultLayout $(widgetFile "widgets/delete-confirmation") defaultLayout $(widgetFile "widgets/delete-confirmation/delete-confirmation")

View File

@ -588,9 +588,9 @@ multiAction acts defAction = do
widgets <- mapM mToWidget results widgets <- mapM mToWidget results
let actionWidgets = Map.foldrWithKey accWidget [] widgets let actionWidgets = Map.foldrWithKey accWidget [] widgets
accWidget _act Nothing = id accWidget _act Nothing = id
accWidget act (Just w) = cons $(widgetFile "widgets/multiAction") accWidget act (Just w) = cons $(widgetFile "widgets/multi-action/multi-action")
actionResults = Map.map fst results actionResults = Map.map fst results
return ((actionResults Map.!) =<< actionRes, $(widgetFile "widgets/multiActionCollect")) return ((actionResults Map.!) =<< actionRes, $(widgetFile "widgets/multi-action/multi-action-collect"))
multiActionA :: (RenderMessage UniWorX action, PathPiece action, Ord action, Eq action) multiActionA :: (RenderMessage UniWorX action, PathPiece action, Ord action, Eq action)
=> FieldSettings UniWorX => FieldSettings UniWorX

View File

@ -25,7 +25,7 @@ gradeSummaryWidget title sts =
hasMarkedPasses = positiveSum $ numMarkedPasses sumSummaries hasMarkedPasses = positiveSum $ numMarkedPasses sumSummaries
hasPoints = positiveSum $ numSheetsPoints sumSummaries hasPoints = positiveSum $ numSheetsPoints sumSummaries
hasMarkedPoints = positiveSum $ numMarkedPoints sumSummaries hasMarkedPoints = positiveSum $ numMarkedPoints sumSummaries
rowWdgts = [ $(widgetFile "widgets/gradingSummaryRow") rowWdgts = [ $(widgetFile "widgets/grading-summary/grading-summary-row")
| (sumHeader,summary) <- | (sumHeader,summary) <-
[ (MsgSheetTypeNormal' ,normalSummary) [ (MsgSheetTypeNormal' ,normalSummary)
, (MsgSheetTypeBonus' ,bonusSummary) , (MsgSheetTypeBonus' ,bonusSummary)
@ -33,4 +33,4 @@ gradeSummaryWidget title sts =
] ] ] ]
in if 0 == numSheets sumSummaries in if 0 == numSheets sumSummaries
then mempty then mempty
else $(widgetFile "widgets/gradingSummary") else $(widgetFile "widgets/grading-summary/grading-summary")

View File

@ -9,7 +9,7 @@ modal modalTrigger modalContent = do
let modalDynamic = isLeft modalContent let modalDynamic = isLeft modalContent
modalId <- newIdent modalId <- newIdent
triggerId <- newIdent triggerId <- newIdent
$(widgetFile "widgets/modal") $(widgetFile "widgets/modal/modal")
case modalContent of case modalContent of
Left route -> do Left route -> do
route' <- toTextUrl route route' <- toTextUrl route

View File

@ -41,7 +41,7 @@ data FormLayout = FormStandard | FormDBTableFilter | FormDBTablePagesize
renderAForm :: Monad m => FormLayout -> FormRender m a renderAForm :: Monad m => FormLayout -> FormRender m a
renderAForm formLayout aform fragment = do renderAForm formLayout aform fragment = do
(res, ($ []) -> fieldViews) <- aFormToForm aform (res, ($ []) -> fieldViews) <- aFormToForm aform
let widget = $(widgetFile "widgets/form") let widget = $(widgetFile "widgets/form/form")
return (res, widget) return (res, widget)
-------------------- --------------------
@ -367,7 +367,7 @@ reorderField optList = Field{..}
isSel n = (==) (either (const $ map optionInternalValue olOptions) id val !! pred n) . optionInternalValue isSel n = (==) (either (const $ map optionInternalValue olOptions) id val !! pred n) . optionInternalValue
nums = map (id &&& withNum theId) [1..length olOptions] nums = map (id &&& withNum theId) [1..length olOptions]
withNum t n = tshow n <> "." <> t withNum t n = tshow n <> "." <> t
$(widgetFile "widgets/permutation") $(widgetFile "widgets/permutation/permutation")
optionsFinite :: ( MonadHandler m optionsFinite :: ( MonadHandler m
, Finite a , Finite a

View File

@ -51,4 +51,4 @@ $#
\ (_{title $ getSum $ summary ^. _numSheetsPoints}) \ (_{title $ getSum $ summary ^. _numSheetsPoints})
$# Kurze Alternative mit Hashtag-Symbol für "Anzahl" $# Kurze Alternative mit Hashtag-Symbol für "Anzahl"
$# \ (##{display $ summary ^. _numSheetsPoints}) $# \ (##{display $ summary ^. _numSheetsPoints})
<td .table__td>#{display $ summary ^. _numSheets} <td .table__td>#{display $ summary ^. _numSheets}