fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(doc): fix erroneous unintentional haddock annotations

Browse Source
This commit is contained in:
Steffen Jost 2024-06-27 16:48:47 +02:00
parent e25a8569c5
commit 3dfc7f8c8b
4 changed files with 56 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
src/Handler/Utils/AvsUpdate.hs
View File

@ -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

28
src/Jobs/Types.hs
View File

@ -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

30
src/Utils/Avs.hs
View File

@ -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

12
src/Utils/Icon.hs
View File

@ -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
<i .fas .fa-#{iconText ic}>
|]
-- Create an icon from font-awesome with fixed width
iconFixed :: Icon -> Markup
iconFixed ic = [shamlet|