Cleanup & haddock
This commit is contained in:
parent
7f103ec7a9
commit
4e718ee287
3
haddock.sh
Executable file
3
haddock.sh
Executable file
@ -0,0 +1,3 @@
|
||||
#!/usr/bin/env bash
|
||||
|
||||
exec -- stack build --fast --flag uniworx:library-only --flag uniworx:dev --haddock --haddock-hyperlink-source --haddock-deps --haddock-internal --haddock-arguments "--optghc -cpp"
|
||||
@ -157,7 +157,7 @@ makeFoundation appSettings@AppSettings{..} = do
|
||||
|
||||
flip runLoggingT logFunc $ do
|
||||
$logDebugS "InstanceID" $ UUID.toText appInstanceID
|
||||
-- $logDebugS "Configuration" $ tshow appSettings
|
||||
-- logDebugS "Configuration" $ tshow appSettings
|
||||
|
||||
smtpPool <- traverse createSmtpPool appSmtpConf
|
||||
|
||||
|
||||
@ -80,7 +80,7 @@ homeAnonymous = do
|
||||
-- let features = $(widgetFile "featureList")
|
||||
-- addMessage Warning "Vorabversion! Die Implementierung von Uni2work ist noch nicht abgeschlossen!"
|
||||
defaultLayout
|
||||
-- $(widgetFile "dsgvDisclaimer")
|
||||
-- (widgetFile "dsgvDisclaimer")
|
||||
$(widgetFile "home")
|
||||
|
||||
homeUser :: Key User -> Handler Html
|
||||
@ -181,7 +181,7 @@ homeUser uid = do
|
||||
defaultLayout $
|
||||
-- setTitle "Willkommen zum Uni2work Test!"
|
||||
$(widgetFile "homeUser")
|
||||
-- $(widgetFile "dsgvDisclaimer")
|
||||
-- (widgetFile "dsgvDisclaimer")
|
||||
|
||||
|
||||
getVersionR :: Handler TypedContent
|
||||
|
||||
@ -644,7 +644,7 @@ defaultLoads shid = do
|
||||
toMap = foldMap $ \(E.Value uid, E.Value load, E.Value state) -> Map.singleton uid (state, load)
|
||||
|
||||
|
||||
correctorForm :: SheetId -> MForm Handler (FormResult (Bool {- ^ autoDistribute -} , Set SheetCorrector), [FieldView UniWorX])
|
||||
correctorForm :: SheetId -> MForm Handler (FormResult (Bool, Set SheetCorrector), [FieldView UniWorX])
|
||||
correctorForm shid = do
|
||||
cListIdent <- newFormIdent
|
||||
let
|
||||
|
||||
@ -115,7 +115,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
||||
E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val uid
|
||||
E.&&. submission E.^. SubmissionSheet E.==. E.val shid
|
||||
return $ submission E.^. SubmissionId
|
||||
-- $logDebugS "Submission.DUPLICATENEW" (tshow submissions)
|
||||
-- logDebugS "Submission.DUPLICATENEW" (tshow submissions)
|
||||
case submissions of
|
||||
[] -> do
|
||||
-- fetch buddies from previous submission in this course
|
||||
|
||||
@ -64,9 +64,9 @@ instance Exception AssignSubmissionException
|
||||
-- | Assigns all submissions according to sheet corrector loads
|
||||
assignSubmissions :: SheetId -- ^ Sheet do distribute to correction
|
||||
-> Maybe (Set SubmissionId) -- ^ Optionally restrict submission to consider
|
||||
-> YesodDB UniWorX ( Set SubmissionId -- ^ assigned submissions
|
||||
, Set SubmissionId -- ^ unassigend submissions (no tutors by load)
|
||||
)
|
||||
-> YesodDB UniWorX ( Set SubmissionId
|
||||
, Set SubmissionId
|
||||
) -- ^ Returns assigned and unassigned submissions; unassigned submissions occur only if no tutors have an assigned load
|
||||
assignSubmissions sid restriction = do
|
||||
Sheet{..} <- getJust sid
|
||||
correctors <- selectList [ SheetCorrectorSheet ==. sid, SheetCorrectorState ==. CorrectorNormal ] []
|
||||
|
||||
@ -330,11 +330,12 @@ data DBStyle = DBStyle
|
||||
{ dbsEmptyStyle :: DBEmptyStyle
|
||||
, dbsEmptyMessage :: UniWorXMessage
|
||||
, dbsAttrs :: [(Text, Text)]
|
||||
, dbsFilterLayout :: Widget -- ^ Filter UI
|
||||
, dbsFilterLayout :: Widget
|
||||
-> Enctype
|
||||
-> Text -- ^ Filter action (target uri)
|
||||
-> Widget -- ^ Table
|
||||
-> Text
|
||||
-> Widget
|
||||
-> Widget
|
||||
-- ^ Filter UI, Filter Encoding, Filter action, table
|
||||
}
|
||||
|
||||
instance Default DBStyle where
|
||||
@ -839,7 +840,7 @@ getDBFormResult initial (DBFormResult m) = Map.map (\(r, f) -> f $ initial r) m
|
||||
formCell :: forall res r i a. (Ord i, Monoid res)
|
||||
=> Lens' res (DBFormResult i a (DBRow r))
|
||||
-> (DBRow r -> MForm (HandlerT UniWorX IO) i)
|
||||
-> (DBRow r -> (forall p. PathPiece p => p -> Text {- ^ Make input name suitably unique -}) -> MForm (HandlerT UniWorX IO) (FormResult (a -> a), Widget))
|
||||
-> (DBRow r -> (forall p. PathPiece p => p -> Text) -> MForm (HandlerT UniWorX IO) (FormResult (a -> a), Widget)) -- ^ Given the row data and a callback to make an input name suitably unique generate the `MForm`
|
||||
-> (DBRow r -> DBCell (MForm (HandlerT UniWorX IO)) (FormResult res))
|
||||
formCell resLens genIndex genForm input@(DBRow{dbrKey}) = FormCell
|
||||
{ formCellAttrs = []
|
||||
|
||||
@ -274,7 +274,7 @@ handleJobs' wNum = C.mapM_ $ \jctl -> do
|
||||
runDB $ delete jId
|
||||
handleCmd JobCtlDetermineCrontab = do
|
||||
newCTab <- liftHandlerT . runDB $ setSerializable determineCrontab'
|
||||
-- $logDebugS logIdent $ tshow newCTab
|
||||
-- logDebugS logIdent $ tshow newCTab
|
||||
mapReaderT (liftIO . atomically) $
|
||||
lift . void . flip swapTMVar newCTab =<< asks jobCrontab
|
||||
|
||||
|
||||
@ -249,7 +249,7 @@ defMailT ls (MailT mailC) = do
|
||||
fromAddress <- defaultFromAddress
|
||||
(ret, mail, smtpData) <- runRWST mailC ls (emptyMail fromAddress)
|
||||
mail' <- liftIO $ LBS.toStrict <$> renderMail' mail
|
||||
-- $logDebugS "Mail" $ "Rendered mail:\n" <> decodeUtf8 mail'
|
||||
-- logDebugS "Mail" $ "Rendered mail:\n" <> decodeUtf8 mail'
|
||||
ret <$ case smtpData of
|
||||
MailSmtpData{ smtpEnvelopeFrom = Last Nothing } -> throwM MailNoSenderSpecified
|
||||
MailSmtpData{ smtpRecipients }
|
||||
|
||||
Loading…
Reference in New Issue
Block a user