From 3dfc7f8c8b12dd6ef87848a75f1669d700fffe4c Mon Sep 17 00:00:00 2001 From: Steffen Date: Thu, 27 Jun 2024 16:48:47 +0200 Subject: [PATCH] fix(doc): fix erroneous unintentional haddock annotations --- src/Handler/Utils/AvsUpdate.hs | 42 +++++++++++++++++----------------- src/Jobs/Types.hs | 28 +++++++++++------------ src/Utils/Avs.hs | 30 ++++++++++++------------ src/Utils/Icon.hs | 12 +++++----- 4 files changed, 56 insertions(+), 56 deletions(-) diff --git a/src/Handler/Utils/AvsUpdate.hs b/src/Handler/Utils/AvsUpdate.hs index 9a9ef7fed..8a88cb6b0 100644 --- a/src/Handler/Utils/AvsUpdate.hs +++ b/src/Handler/Utils/AvsUpdate.hs @@ -20,7 +20,7 @@ import Import -- import Language.Haskell.TH.Syntax -- -- deriving instance Lift (EntityField User typ) -- possible --- +-- -- Lift instances for lenses are not possible: -- type Getting r s a = (a -> Const r a) -> s -> Const r s -- deriving instance Lift (Getting typ AvsPersonInfo typ) @@ -50,15 +50,15 @@ class MkCheckUpdate a where mkCheckUpdate :: a -> CheckUpdate (MCU_Rec a) (MCU_Raw a) data CU_AvsPersonInfo_User - = CU_API_UserFirstName + = CU_API_UserFirstName | CU_API_UserSurname - | CU_API_UserDisplayName - | CU_API_UserBirthday - | CU_API_UserMobile - | CU_API_UserMatrikelnummer + | CU_API_UserDisplayName + | CU_API_UserBirthday + | CU_API_UserMobile + | CU_API_UserMatrikelnummer | CU_API_UserCompanyPersonalNumber - | CU_API_UserLdapPrimaryKey - -- | CU_API_UserDisplayEmail -- use _avsContactPrimaryEmailAddress instead + | CU_API_UserLdapPrimaryKey + -- CU_API_UserDisplayEmail -- use _avsContactPrimaryEmailAddress instead deriving (Show, Eq) instance MkCheckUpdate CU_AvsPersonInfo_User where @@ -87,7 +87,7 @@ instance MkCheckUpdate CU_AvsDataContcat_User where data CU_AvsFirmInfo_User = CU_AFI_UserPostAddress - -- | CU_AFI_UserDisplayEmail -- use _avsContactPrimaryEmailAddress instead + -- CU_AFI_UserDisplayEmail -- use _avsContactPrimaryEmailAddress instead deriving (Show, Eq) instance MkCheckUpdate CU_AvsFirmInfo_User where @@ -98,25 +98,25 @@ instance MkCheckUpdate CU_AvsFirmInfo_User where -- NOTE: Ensure that the lenses between CU_UserAvs_User and CU_AvsPersonInfo_User/CU_AvsFirmInfo_User agree! -data CU_UserAvs_User - = CU_UA_UserPinPassword - -- | CU_UA_UserPostAddress -- use _avsContactPrimaryPostAddress instead - | CU_UA_UserFirstName - | CU_UA_UserSurname - | CU_UA_UserDisplayName - | CU_UA_UserBirthday - | CU_UA_UserMobile - | CU_UA_UserMatrikelnummer +data CU_UserAvs_User + = CU_UA_UserPinPassword + -- CU_UA_UserPostAddress -- use _avsContactPrimaryPostAddress instead + | CU_UA_UserFirstName + | CU_UA_UserSurname + | CU_UA_UserDisplayName + | CU_UA_UserBirthday + | CU_UA_UserMobile + | CU_UA_UserMatrikelnummer | CU_UA_UserCompanyPersonalNumber - | CU_UA_UserLdapPrimaryKey - -- | CU_UA_UserDisplayEmail -- use _avsContactPrimaryEmailAddress instead + | CU_UA_UserLdapPrimaryKey + -- CU_UA_UserDisplayEmail -- use _avsContactPrimaryEmailAddress instead deriving (Show, Eq) instance MkCheckUpdate CU_UserAvs_User where type MCU_Rec CU_UserAvs_User = User type MCU_Raw CU_UserAvs_User = UserAvs mkCheckUpdate CU_UA_UserPinPassword = CheckUpdateOpt UserPinPassword $ _userAvsLastCardNo . _Just . to avsFullCardNo2pin . re _Just - -- mkCheckUpdate CU_UA_UserPostAddress = CheckUpdateOpt UserPostAddress $ _userAvsLastFirmInfo . _Just . _avsFirmPostAddress + -- mkCheckUpdate CU_UA_UserPostAddress = CheckUpdateOpt UserPostAddress $ _userAvsLastFirmInfo . _Just . _avsFirmPostAddress mkCheckUpdate CU_UA_UserFirstName = CheckUpdateOpt UserFirstName $ _userAvsLastPersonInfo . _Just . _avsInfoFirstName mkCheckUpdate CU_UA_UserSurname = CheckUpdateOpt UserSurname $ _userAvsLastPersonInfo . _Just . _avsInfoLastName mkCheckUpdate CU_UA_UserDisplayName = CheckUpdateOpt UserDisplayName $ _userAvsLastPersonInfo . _Just . _avsInfoDisplayName diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index 1c865a328..5c8f8fde4 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -102,13 +102,13 @@ data Job , jIteration :: Natural , jSynchAfter :: Maybe Day } - -- | JobSynchroniseAvsUser { jUser :: UserId + -- JobSynchroniseAvsUser { jUser :: UserId -- , jSynchAfter :: Maybe Day -- } - -- | JobSynchroniseAvsId { jAvsId :: AvsPersonId + -- JobSynchroniseAvsId { jAvsId :: AvsPersonId -- , jSynchAfter :: Maybe Day - -- } - | JobSynchroniseAvsQueue + -- } + | JobSynchroniseAvsQueue | JobChangeUserDisplayEmail { jUser :: UserId , jDisplayEmail :: UserEmail } @@ -207,7 +207,7 @@ type family ChildrenJobChildren a where instance (Ord b', HasTypesCustom JobChildren a' b' a b) => HasTypesCustom JobChildren (Set a') (Set b') a b where typesCustom = iso Set.toList Set.fromList . traverse . typesCustom @JobChildren - + classifyJob :: Job -> String classifyJob job = unpack tag @@ -225,7 +225,7 @@ data JobCtlPrewarmSource deriving anyclass (Hashable, NFData) makeLenses_ ''JobCtlPrewarmSource - + deriveJSON defaultOptions { constructorTagModifier = camelToPathPiece' 3 , fieldLabelModifier = camelToPathPiece' 1 @@ -276,7 +276,7 @@ data JobHandler site = JobHandlerAtomic (YesodJobDB site ()) | JobHandlerException (HandlerFor site ()) | forall a. JobHandlerAtomicWithFinalizer (YesodJobDB site a) (a -> HandlerFor site ()) - | forall a. JobHandlerAtomicDeferrableWithFinalizer (ReaderT SqlReadBackend (HandlerFor site) a) (a -> HandlerFor site ()) + | forall a. JobHandlerAtomicDeferrableWithFinalizer (ReaderT SqlReadBackend (HandlerFor site) a) (a -> HandlerFor site ()) makePrisms ''JobHandler @@ -338,7 +338,7 @@ prioritiseJob _ = JobPrioBatch data JobNoQueueSame = JobNoQueueSame | JobNoQueueSameTag deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic) deriving anyclass (Universe, Finite) - + jobNoQueueSame :: Job -> Maybe JobNoQueueSame jobNoQueueSame = \case JobSendNotification{jNotification} -> notifyNoQueueSame jNotification @@ -352,29 +352,29 @@ jobNoQueueSame = \case JobSynchroniseAvs{} -> Just JobNoQueueSame -- JobSynchroniseAvsUser{} -> Just JobNoQueueSame -- JobSynchroniseAvsId{} -> Just JobNoQueueSame - JobSynchroniseAvsQueue{} -> Just JobNoQueueSame + JobSynchroniseAvsQueue{} -> Just JobNoQueueSame JobChangeUserDisplayEmail{} -> Just JobNoQueueSame JobPruneSessionFiles{} -> Just JobNoQueueSameTag JobPruneUnreferencedFiles{} -> Just JobNoQueueSameTag JobInjectFiles{} -> Just JobNoQueueSameTag JobPruneFallbackPersonalisedSheetFilesKeys{} -> Just JobNoQueueSameTag JobRechunkFiles{} -> Just JobNoQueueSameTag - JobDetectMissingFiles{} -> Just JobNoQueueSameTag + JobDetectMissingFiles{} -> Just JobNoQueueSameTag JobLmsQualificationsEnqueue -> Just JobNoQueueSame JobLmsEnqueue {} -> Just JobNoQueueSame JobLmsEnqueueUser {} -> Just JobNoQueueSame JobLmsQualificationsDequeue -> Just JobNoQueueSame - JobLmsDequeue {} -> Just JobNoQueueSame + JobLmsDequeue {} -> Just JobNoQueueSame JobLmsReports {} -> Just JobNoQueueSame JobPrintAck {} -> Just JobNoQueueSame JobPrintAckAgain {} -> Just JobNoQueueSame _ -> Nothing notifyNoQueueSame :: Notification -> Maybe JobNoQueueSame -notifyNoQueueSame = \case +notifyNoQueueSame = \case NotificationQualificationRenewal{} -> Just JobNoQueueSame -- send one at once; safe, since the job is rescheduled if sending was not acknowledged NotificationQualificationExpiry{} -> Just JobNoQueueSame -- do not send multiple expiry messages to the same person at once - NotificationQualificationExpired{} -> Just JobNoQueueSame + NotificationQualificationExpired{} -> Just JobNoQueueSame _ -> Nothing jobMovable :: JobCtl -> Bool @@ -389,7 +389,7 @@ makePrisms ''JobQueue jqInsert' :: TimeSpec -> JobCtl -> JobQueue -> JobQueue jqInsert' cTime job = force . over _JobQueue $ PQ.insertBehind (prioritiseJob job, Down cTime) job - + jqInsert :: JobCtl -> JobQueue -> STM JobQueue jqInsert job queue = do cTime <- unsafeIOToSTM $ getTime Monotonic diff --git a/src/Utils/Avs.hs b/src/Utils/Avs.hs index 00e8ef0f7..f9f276c2f 100644 --- a/src/Utils/Avs.hs +++ b/src/Utils/Avs.hs @@ -84,7 +84,7 @@ mkAvsQuery _ _ _ = AvsQuery } where fakePerson :: AvsQueryPerson -> AvsResponsePerson - fakePerson = + fakePerson = let sarah = Set.singleton $ AvsDataPerson "Sarah" "Vaupel" Nothing 2 (AvsPersonId 2) mempty stephan = Set.singleton $ AvsDataPerson "Stephan" "Barth" Nothing 4 (AvsPersonId 4) mempty @@ -92,7 +92,7 @@ mkAvsQuery _ _ _ = AvsQuery sumpfi1 = Set.singleton $ AvsDataPerson "Heribert" "Sumpfmeier" Nothing 12345678 (AvsPersonId 12345678) mempty sumpfi2 = Set.singleton $ AvsDataPerson "Heribert" "Sumpfmeier" Nothing 12345678 (AvsPersonId 604387) mempty sumpfi3 = Set.singleton $ AvsDataPerson "Heribert" "Sumpfmeier" Nothing 12345678 (AvsPersonId 604591) mempty - in \case + in \case AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00001234"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson steffen AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00001234")} -> AvsResponsePerson steffen AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00009944"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson stephan @@ -106,7 +106,7 @@ mkAvsQuery _ _ _ = AvsQuery fakeStatus :: AvsQueryStatus -> AvsResponseStatus fakeStatus (AvsQueryStatus (Set.toList -> (api:_))) = AvsResponseStatus $ Set.singleton $ AvsStatusPerson api $ Set.fromList - [ AvsDataPersonCard True (Just $ fromGregorian 2026 5 1) Nothing AvsCardColorGelb (Set.fromList ['F','R','C']) Nothing Nothing Nothing (Just "Fraport AG") (AvsCardNo "6666") "4" + [ AvsDataPersonCard True (Just $ fromGregorian 2026 5 1) Nothing AvsCardColorGelb (Set.fromList ['F','R','C']) Nothing Nothing Nothing (Just "Fraport AG") (AvsCardNo "6666") "4" , AvsDataPersonCard False (Just $ fromGregorian 2025 6 2) Nothing AvsCardColorRot (Set.fromList ['F','A' ]) Nothing Nothing Nothing (Just "N*ICE Aircraft Services & Support GmbH") (AvsCardNo "7777") "4" , AvsDataPersonCard True (Just $ fromGregorian 2028 7 3) Nothing AvsCardColorBlau mempty Nothing Nothing Nothing (Just "Fraport Facility Services GmbH") (AvsCardNo "8888") "4" ] @@ -121,13 +121,13 @@ mkAvsQuery _ _ _ = AvsQuery | api == AvsPersonId 604591 = AvsResponseContact $ Set.singleton heribert | otherwise = AvsResponseContact mempty where - heribert = AvsDataContact api (AvsPersonInfo "123123123" "Heribert" "Sumpfmeier" (-1) Nothing (Just "sumpfi@tcs.ifi.lmu.de") Nothing (Just $ AvsInternalPersonalNo "57138")) + heribert = AvsDataContact api (AvsPersonInfo "123123123" "Heribert" "Sumpfmeier" (-1) Nothing (Just "sumpfi@tcs.ifi.lmu.de") Nothing (Just $ AvsInternalPersonalNo "57138")) (AvsFirmInfo "Fraport AG" 7 "Fraport" Nothing Nothing Nothing Nothing Nothing Nothing Nothing) - jost = AvsDataContact api (AvsPersonInfo "12345678" "Steffen" "Jost" 0 Nothing (Just "s.jost@fraport.de") (Just "069-69071706") Nothing) + jost = AvsDataContact api (AvsPersonInfo "12345678" "Steffen" "Jost" 0 Nothing (Just "s.jost@fraport.de") (Just "069-69071706") Nothing) (AvsFirmInfo "Fraport AG" 7 "Fraport" Nothing Nothing Nothing Nothing Nothing Nothing Nothing) - vaupel = AvsDataContact api (AvsPersonInfo "2" "Sarah" "Vaupel" 1 Nothing (Just "sarah.vaupel@uniworx.de") (Just "069-69071706") Nothing) + vaupel = AvsDataContact api (AvsPersonInfo "2" "Sarah" "Vaupel" 1 Nothing (Just "sarah.vaupel@uniworx.de") (Just "069-69071706") Nothing) (AvsFirmInfo "UniWorX GmbH" 9 "UniWorX" (Just "81929") (Just "München") (Just "Germany") (Just "Somestr. 111") (Just "uniworx@uniworx.de") Nothing Nothing) - barth = AvsDataContact api (AvsPersonInfo "4" "Stephan" "Barth" 2 Nothing (Just "stephan.barth@uniworx.de") (Just "069-69071706") Nothing) + barth = AvsDataContact api (AvsPersonInfo "4" "Stephan" "Barth" 2 Nothing (Just "stephan.barth@uniworx.de") (Just "069-69071706") Nothing) (AvsFirmInfo "UniWorX GmbH" 9 "UniWorX" Nothing Nothing Nothing Nothing Nothing (Just "sarah.vaupel@uniworx.de") Nothing) fakeContact _ = AvsResponseContact mempty #else @@ -141,17 +141,17 @@ mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery , avsQueryGetAllLicences = liftIO $ runClientM (rawQueryGetLicences avsQueryAllLicences) cliEnv } where - ( rawQueryPerson - :<|> rawQueryStatus + ( rawQueryPerson + :<|> rawQueryStatus :<|> rawQueryContact - :<|> rawQueryGetLicences + :<|> rawQueryGetLicences :<|> rawQuerySetLicences ) = client avsApi basicAuth catch404toEmpty :: Either ClientError AvsResponsePerson -> Either ClientError AvsResponsePerson catch404toEmpty (Left (FailureResponse (requestPath -> (base, _path)) (statusCode . responseStatusCode -> 404))) | baseUrl == base = Right $ AvsResponsePerson mempty -- WORKAROUND: AVS server erroneously returns 404 if no matching person could be found in its database! catch404toEmpty other = other -splitQuery :: (Wrapped a, Wrapped c, Unwrapped a ~ Set b, Semigroup (Unwrapped c)) +splitQuery :: (Wrapped a, Wrapped c, Unwrapped a ~ Set b, Semigroup (Unwrapped c)) => (a -> ClientM c) -> a -> ClientM c splitQuery rawQuery q | avsMaxQueryAtOnce >= Set.size s = rawQuery q @@ -162,7 +162,7 @@ splitQuery rawQuery q liftIO $ threadDelay avsMaxQueryDelay res2 <- splitQuery rawQuery $ view _Unwrapped' avsid2 return $ view _Unwrapped' (res1 ^. _Wrapped' <> res2 ^. _Wrapped') - where + where s = view _Wrapped' q #endif @@ -181,9 +181,9 @@ splitQuery rawQuery q -- cardMatch AvsDataPersonCard{..} = -- avsDataValid && (avsDataValidTo >= cutoff) && (licence `Set.member` avsDataCardAreas) --- | DEPRECTATED +-- -- DEPRECTATED -- getCompanyAddress :: AvsDataPersonCard -> (Maybe Text, Maybe Text, Maybe AvsDataPersonCard) --- getCompanyAddress card@AvsDataPersonCard{..} +-- getCompanyAddress card@AvsDataPersonCard{..} -- | Just street <- avsDataStreet -- , Just pcode <- avsDataPostalCode -- , Just city <- avsDataCity @@ -191,7 +191,7 @@ splitQuery rawQuery q -- | isJust avsDataFirm = (avsDataFirm, Nothing, Just card) -- | otherwise = (Nothing, Nothing, Nothing) --- -- | From a set of card, choose the one with the most complete postal address. +-- -- From a set of card, choose the one with the most complete postal address. -- -- Returns company, postal address and the associated card where the address was taken from -- guessLicenceAddress :: Set AvsDataPersonCard -> (Maybe Text, Maybe Text, Maybe AvsDataPersonCard) -- guessLicenceAddress cards diff --git a/src/Utils/Icon.hs b/src/Utils/Icon.hs index d5d2fc413..a45611062 100644 --- a/src/Utils/Icon.hs +++ b/src/Utils/Icon.hs @@ -40,7 +40,7 @@ data Icon | IconProblem | IconVisible | IconInvisible - -- | IconCourse -- not used, IconMenuCourse is currently only used + -- IconCourse -- not used, IconMenuCourse is currently only used | IconCourseFavouriteManual | IconCourseFavouriteAutomatic | IconCourseFavouriteOff | IconEnrolTrue | IconEnrolFalse @@ -110,7 +110,7 @@ data Icon | IconAt | IconSupervisor | IconSupervisorForeign - -- | IconWaitingForUser + -- IconWaitingForUser | IconExpired | IconLocked | IconUnlocked @@ -118,8 +118,8 @@ data Icon | IconCompany | IconEdit | IconUserEdit - -- | IconMagic -- indicates automatic updates - + -- IconMagic -- indicates automatic updates + deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic) deriving anyclass (Universe, Finite, NFData) @@ -183,7 +183,7 @@ iconText = \case IconMenuCorrections -> "check" IconMenuExams -> "poll-h" IconMenuAdmin -> "screwdriver" - IconMenuLms -> "tasks" -- "user-graduate" "laptop" + IconMenuLms -> "tasks" -- "user-graduate" "laptop" IconMenuQualification -> "graduation-cap" -- "award" "diploma" "file-certificate" IconPageActionPrimaryExpand -> "bars" IconPageActionSecondary -> "ellipsis-h" @@ -230,7 +230,7 @@ icon ic = [shamlet| $newline never |] - + -- Create an icon from font-awesome with fixed width iconFixed :: Icon -> Markup iconFixed ic = [shamlet|