From 4e718ee28760f37f607a2ddddd69a8bc9ede3c65 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 17 Jan 2019 11:44:18 +0100 Subject: [PATCH] Cleanup & haddock --- haddock.sh | 3 +++ src/Application.hs | 2 +- src/Handler/Home.hs | 4 ++-- src/Handler/Sheet.hs | 2 +- src/Handler/Submission.hs | 2 +- src/Handler/Utils/Submission.hs | 6 +++--- src/Handler/Utils/Table/Pagination.hs | 9 +++++---- src/Jobs.hs | 2 +- src/Mail.hs | 2 +- 9 files changed, 18 insertions(+), 14 deletions(-) create mode 100755 haddock.sh diff --git a/haddock.sh b/haddock.sh new file mode 100755 index 000000000..b7336921d --- /dev/null +++ b/haddock.sh @@ -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" diff --git a/src/Application.hs b/src/Application.hs index 144945e00..e92163430 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -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 diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index 390c349e9..6e7966103 100644 --- a/src/Handler/Home.hs +++ b/src/Handler/Home.hs @@ -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 diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 86dbc9a03..3fb979a6a 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -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 diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index 9626ba382..d3d624d86 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -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 diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs index 98bbd12ac..a397041a8 100644 --- a/src/Handler/Utils/Submission.hs +++ b/src/Handler/Utils/Submission.hs @@ -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 ] [] diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index c48f8b2d9..3ef8450e0 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -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 = [] diff --git a/src/Jobs.hs b/src/Jobs.hs index f214f2c3c..2a9a42556 100644 --- a/src/Jobs.hs +++ b/src/Jobs.hs @@ -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 diff --git a/src/Mail.hs b/src/Mail.hs index e05f8fa1c..c125bf88d 100644 --- a/src/Mail.hs +++ b/src/Mail.hs @@ -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 }