diff --git a/package.yaml b/package.yaml index de481c5b4..fad286442 100644 --- a/package.yaml +++ b/package.yaml @@ -259,6 +259,7 @@ ghc-options: - -j - -freduction-depth=0 - -fprof-auto-calls + - -g when: - condition: flag(pedantic) ghc-options: diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index 9e6cdd55e..09da67f7d 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -2,7 +2,7 @@ -- -- SPDX-License-Identifier: AGPL-3.0-or-later -{-# OPTIONS -Wno-unused-top-binds -Wno-unused-imports #-} -- TODO: remove me, for debugging only +{-# OPTIONS -Wno-unused-top-binds -Wno-unused-imports -Wno-unused-binds #-} -- TODO: remove me, for debugging only {-# OPTIONS_GHC -fno-warn-orphans #-} -- needed for HasEntity instances {-# LANGUAGE TypeApplications #-} @@ -804,7 +804,7 @@ handleFirmCommR ultDest mbFsh = do ) -} - selected <- mapM decryptUserId =<< lookupGlobalGetParams GetRecipient -- retrieve selected users + selected <- mapM decryptUserId =<< lookupGlobalGetParams GetRecipient -- retrieve selected users empys <- ifMaybeM mbCid selected (\cid -> -- get all employees or stick with selected users, if no company was pre-selected (to limit choices) E.unValue <<$>> runDB (E.select $ do (emp :& uc) <- E.from $ E.table @User `E.innerJoin` E.table @UserCompany `E.on` (\(emp :& uc) -> emp E.^. UserId E.==. uc E.^. UserCompanyUser) diff --git a/src/Handler/Utils/Communication.hs b/src/Handler/Utils/Communication.hs index 893b22d14..7e81ba69a 100644 --- a/src/Handler/Utils/Communication.hs +++ b/src/Handler/Utils/Communication.hs @@ -134,6 +134,7 @@ crTestFirmCommunication jCompany comm = do commR :: CommunicationRoute -> Handler Html commR CommunicationRoute{..} = do + $logWarnS "COMM" "Communication handleer started" cUser <- maybeAuth MsgRenderer mr <- getMsgRenderer @@ -153,6 +154,7 @@ commR CommunicationRoute{..} = do chosen' <- fmap (maybe id cons cUser . catMaybes) $ mapM decrypt' =<< lookupGlobalGetParams GetRecipient return (suggested, chosen') + $logWarnS "COMM" "Communication handler DB done" let lookupUser :: UserId -> User @@ -236,6 +238,7 @@ commR CommunicationRoute{..} = do recipientsListMsg <- messageI Info MsgCommRecipientsList + $logWarnS "COMM" "Communication handler some definitions done" attachmentsMaxSize <- getsYesod $ view _appCommunicationAttachmentsMaxSize let attachmentField = genericFileField $ return FileField { fieldIdent = Nothing @@ -246,6 +249,7 @@ commR CommunicationRoute{..} = do , fieldMaxFileSize = Nothing, fieldMaxCumulativeSize = attachmentsMaxSize , fieldAllEmptyOk = True } + $logWarnS "COMM" "Communication handler some parameters done" -SEEN ((commRes,commWdgt),commEncoding) <- runFormPost . identifyForm FIDCommunication . withButtonForm' universeF . renderAForm FormStandard $ Communication <$> recipientAForm <* aformMessage recipientsListMsg @@ -253,7 +257,8 @@ commR CommunicationRoute{..} = do <$> aopt textField (fslI MsgCommSubject & addAttr "uw-enter-as-tab" "") Nothing <*> (markupOutput <$> areq htmlField (fslI MsgCommBody) Nothing) <*> fmap fold (aopt (convertFieldM (runConduit . (.| C.foldMap Set.singleton)) yieldMany attachmentField) (fslI MsgCommAttachments & setTooltip MsgCommAttachmentsTip) Nothing) - ) + ) + $logWarnS "COMM" "Communication handler run form post done" -- NOT SEEN formResult commRes $ \case (comm, BtnCommunicationSend) -> do runDBJobs . runConduit $ transPipe (mapReaderT lift) (crJobs comm) .| sinkDBJobs @@ -262,13 +267,14 @@ commR CommunicationRoute{..} = do (comm, BtnCommunicationTest) -> do runDBJobs . runConduit $ transPipe (mapReaderT lift) (crTestJobs comm) .| sinkDBJobs addMessageI Info MsgCommTestSuccess - + $logWarnS "COMM" "Communication handler form result done" let formWdgt = wrapForm commWdgt def { formMethod = POST , formAction = SomeRoute <$> mbCurrentRoute , formEncoding = commEncoding , formSubmit = FormNoSubmit } + $logWarnS "COMM" "Communication handler finished" siteLayoutMsg crHeading $ do setTitleI crHeading let commTestTip = $(i18nWidgetFile "comm-test-tip")