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 -- import Language.Haskell.TH.Syntax
-- --
-- deriving instance Lift (EntityField User typ) -- possible -- deriving instance Lift (EntityField User typ) -- possible
-- --
-- Lift instances for lenses are not possible: -- Lift instances for lenses are not possible:
-- type Getting r s a = (a -> Const r a) -> s -> Const r s -- type Getting r s a = (a -> Const r a) -> s -> Const r s
-- deriving instance Lift (Getting typ AvsPersonInfo typ) -- deriving instance Lift (Getting typ AvsPersonInfo typ)
@ -50,15 +50,15 @@ class MkCheckUpdate a where
mkCheckUpdate :: a -> CheckUpdate (MCU_Rec a) (MCU_Raw a) mkCheckUpdate :: a -> CheckUpdate (MCU_Rec a) (MCU_Raw a)
data CU_AvsPersonInfo_User data CU_AvsPersonInfo_User
= CU_API_UserFirstName = CU_API_UserFirstName
| CU_API_UserSurname | CU_API_UserSurname
| CU_API_UserDisplayName | CU_API_UserDisplayName
| CU_API_UserBirthday | CU_API_UserBirthday
| CU_API_UserMobile | CU_API_UserMobile
| CU_API_UserMatrikelnummer | CU_API_UserMatrikelnummer
| CU_API_UserCompanyPersonalNumber | CU_API_UserCompanyPersonalNumber
| CU_API_UserLdapPrimaryKey | CU_API_UserLdapPrimaryKey
-- | CU_API_UserDisplayEmail -- use _avsContactPrimaryEmailAddress instead -- CU_API_UserDisplayEmail -- use _avsContactPrimaryEmailAddress instead
deriving (Show, Eq) deriving (Show, Eq)
instance MkCheckUpdate CU_AvsPersonInfo_User where instance MkCheckUpdate CU_AvsPersonInfo_User where
@ -87,7 +87,7 @@ instance MkCheckUpdate CU_AvsDataContcat_User where
data CU_AvsFirmInfo_User data CU_AvsFirmInfo_User
= CU_AFI_UserPostAddress = CU_AFI_UserPostAddress
-- | CU_AFI_UserDisplayEmail -- use _avsContactPrimaryEmailAddress instead -- CU_AFI_UserDisplayEmail -- use _avsContactPrimaryEmailAddress instead
deriving (Show, Eq) deriving (Show, Eq)
instance MkCheckUpdate CU_AvsFirmInfo_User where 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! -- NOTE: Ensure that the lenses between CU_UserAvs_User and CU_AvsPersonInfo_User/CU_AvsFirmInfo_User agree!
data CU_UserAvs_User data CU_UserAvs_User
= CU_UA_UserPinPassword = CU_UA_UserPinPassword
-- | CU_UA_UserPostAddress -- use _avsContactPrimaryPostAddress instead -- CU_UA_UserPostAddress -- use _avsContactPrimaryPostAddress instead
| CU_UA_UserFirstName | CU_UA_UserFirstName
| CU_UA_UserSurname | CU_UA_UserSurname
| CU_UA_UserDisplayName | CU_UA_UserDisplayName
| CU_UA_UserBirthday | CU_UA_UserBirthday
| CU_UA_UserMobile | CU_UA_UserMobile
| CU_UA_UserMatrikelnummer | CU_UA_UserMatrikelnummer
| CU_UA_UserCompanyPersonalNumber | CU_UA_UserCompanyPersonalNumber
| CU_UA_UserLdapPrimaryKey | CU_UA_UserLdapPrimaryKey
-- | CU_UA_UserDisplayEmail -- use _avsContactPrimaryEmailAddress instead -- CU_UA_UserDisplayEmail -- use _avsContactPrimaryEmailAddress instead
deriving (Show, Eq) deriving (Show, Eq)
instance MkCheckUpdate CU_UserAvs_User where instance MkCheckUpdate CU_UserAvs_User where
type MCU_Rec CU_UserAvs_User = User type MCU_Rec CU_UserAvs_User = User
type MCU_Raw CU_UserAvs_User = UserAvs type MCU_Raw CU_UserAvs_User = UserAvs
mkCheckUpdate CU_UA_UserPinPassword = CheckUpdateOpt UserPinPassword $ _userAvsLastCardNo . _Just . to avsFullCardNo2pin . re _Just 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_UserFirstName = CheckUpdateOpt UserFirstName $ _userAvsLastPersonInfo . _Just . _avsInfoFirstName
mkCheckUpdate CU_UA_UserSurname = CheckUpdateOpt UserSurname $ _userAvsLastPersonInfo . _Just . _avsInfoLastName mkCheckUpdate CU_UA_UserSurname = CheckUpdateOpt UserSurname $ _userAvsLastPersonInfo . _Just . _avsInfoLastName
mkCheckUpdate CU_UA_UserDisplayName = CheckUpdateOpt UserDisplayName $ _userAvsLastPersonInfo . _Just . _avsInfoDisplayName mkCheckUpdate CU_UA_UserDisplayName = CheckUpdateOpt UserDisplayName $ _userAvsLastPersonInfo . _Just . _avsInfoDisplayName

28
src/Jobs/Types.hs
View File

@ -102,13 +102,13 @@ data Job
, jIteration :: Natural , jIteration :: Natural
, jSynchAfter :: Maybe Day , jSynchAfter :: Maybe Day
} }
-- | JobSynchroniseAvsUser { jUser :: UserId -- JobSynchroniseAvsUser { jUser :: UserId
-- , jSynchAfter :: Maybe Day -- , jSynchAfter :: Maybe Day
-- } -- }
-- | JobSynchroniseAvsId { jAvsId :: AvsPersonId -- JobSynchroniseAvsId { jAvsId :: AvsPersonId
-- , jSynchAfter :: Maybe Day -- , jSynchAfter :: Maybe Day
-- } -- }
| JobSynchroniseAvsQueue | JobSynchroniseAvsQueue
| JobChangeUserDisplayEmail { jUser :: UserId | JobChangeUserDisplayEmail { jUser :: UserId
, jDisplayEmail :: UserEmail , 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 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 typesCustom = iso Set.toList Set.fromList . traverse . typesCustom @JobChildren
classifyJob :: Job -> String classifyJob :: Job -> String
classifyJob job = unpack tag classifyJob job = unpack tag
@ -225,7 +225,7 @@ data JobCtlPrewarmSource
deriving anyclass (Hashable, NFData) deriving anyclass (Hashable, NFData)
makeLenses_ ''JobCtlPrewarmSource makeLenses_ ''JobCtlPrewarmSource
deriveJSON defaultOptions deriveJSON defaultOptions
{ constructorTagModifier = camelToPathPiece' 3 { constructorTagModifier = camelToPathPiece' 3
, fieldLabelModifier = camelToPathPiece' 1 , fieldLabelModifier = camelToPathPiece' 1
@ -276,7 +276,7 @@ data JobHandler site
= JobHandlerAtomic (YesodJobDB site ()) = JobHandlerAtomic (YesodJobDB site ())
| JobHandlerException (HandlerFor site ()) | JobHandlerException (HandlerFor site ())
| forall a. JobHandlerAtomicWithFinalizer (YesodJobDB site a) (a -> 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 makePrisms ''JobHandler
@ -338,7 +338,7 @@ prioritiseJob _ = JobPrioBatch
data JobNoQueueSame = JobNoQueueSame | JobNoQueueSameTag data JobNoQueueSame = JobNoQueueSame | JobNoQueueSameTag
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic) deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic)
deriving anyclass (Universe, Finite) deriving anyclass (Universe, Finite)
jobNoQueueSame :: Job -> Maybe JobNoQueueSame jobNoQueueSame :: Job -> Maybe JobNoQueueSame
jobNoQueueSame = \case jobNoQueueSame = \case
JobSendNotification{jNotification} -> notifyNoQueueSame jNotification JobSendNotification{jNotification} -> notifyNoQueueSame jNotification
@ -352,29 +352,29 @@ jobNoQueueSame = \case
JobSynchroniseAvs{} -> Just JobNoQueueSame JobSynchroniseAvs{} -> Just JobNoQueueSame
-- JobSynchroniseAvsUser{} -> Just JobNoQueueSame -- JobSynchroniseAvsUser{} -> Just JobNoQueueSame
-- JobSynchroniseAvsId{} -> Just JobNoQueueSame -- JobSynchroniseAvsId{} -> Just JobNoQueueSame
JobSynchroniseAvsQueue{} -> Just JobNoQueueSame JobSynchroniseAvsQueue{} -> Just JobNoQueueSame
JobChangeUserDisplayEmail{} -> Just JobNoQueueSame JobChangeUserDisplayEmail{} -> Just JobNoQueueSame
JobPruneSessionFiles{} -> Just JobNoQueueSameTag JobPruneSessionFiles{} -> Just JobNoQueueSameTag
JobPruneUnreferencedFiles{} -> Just JobNoQueueSameTag JobPruneUnreferencedFiles{} -> Just JobNoQueueSameTag
JobInjectFiles{} -> Just JobNoQueueSameTag JobInjectFiles{} -> Just JobNoQueueSameTag
JobPruneFallbackPersonalisedSheetFilesKeys{} -> Just JobNoQueueSameTag JobPruneFallbackPersonalisedSheetFilesKeys{} -> Just JobNoQueueSameTag
JobRechunkFiles{} -> Just JobNoQueueSameTag JobRechunkFiles{} -> Just JobNoQueueSameTag
JobDetectMissingFiles{} -> Just JobNoQueueSameTag JobDetectMissingFiles{} -> Just JobNoQueueSameTag
JobLmsQualificationsEnqueue -> Just JobNoQueueSame JobLmsQualificationsEnqueue -> Just JobNoQueueSame
JobLmsEnqueue {} -> Just JobNoQueueSame JobLmsEnqueue {} -> Just JobNoQueueSame
JobLmsEnqueueUser {} -> Just JobNoQueueSame JobLmsEnqueueUser {} -> Just JobNoQueueSame
JobLmsQualificationsDequeue -> Just JobNoQueueSame JobLmsQualificationsDequeue -> Just JobNoQueueSame
JobLmsDequeue {} -> Just JobNoQueueSame JobLmsDequeue {} -> Just JobNoQueueSame
JobLmsReports {} -> Just JobNoQueueSame JobLmsReports {} -> Just JobNoQueueSame
JobPrintAck {} -> Just JobNoQueueSame JobPrintAck {} -> Just JobNoQueueSame
JobPrintAckAgain {} -> Just JobNoQueueSame JobPrintAckAgain {} -> Just JobNoQueueSame
_ -> Nothing _ -> Nothing
notifyNoQueueSame :: Notification -> Maybe JobNoQueueSame 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 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 NotificationQualificationExpiry{} -> Just JobNoQueueSame -- do not send multiple expiry messages to the same person at once
NotificationQualificationExpired{} -> Just JobNoQueueSame NotificationQualificationExpired{} -> Just JobNoQueueSame
_ -> Nothing _ -> Nothing
jobMovable :: JobCtl -> Bool jobMovable :: JobCtl -> Bool
@ -389,7 +389,7 @@ makePrisms ''JobQueue
jqInsert' :: TimeSpec -> JobCtl -> JobQueue -> JobQueue jqInsert' :: TimeSpec -> JobCtl -> JobQueue -> JobQueue
jqInsert' cTime job = force . over _JobQueue $ PQ.insertBehind (prioritiseJob job, Down cTime) job jqInsert' cTime job = force . over _JobQueue $ PQ.insertBehind (prioritiseJob job, Down cTime) job
jqInsert :: JobCtl -> JobQueue -> STM JobQueue jqInsert :: JobCtl -> JobQueue -> STM JobQueue
jqInsert job queue = do jqInsert job queue = do
cTime <- unsafeIOToSTM $ getTime Monotonic cTime <- unsafeIOToSTM $ getTime Monotonic

30
src/Utils/Avs.hs
View File

@ -84,7 +84,7 @@ mkAvsQuery _ _ _ = AvsQuery
} }
where where
fakePerson :: AvsQueryPerson -> AvsResponsePerson fakePerson :: AvsQueryPerson -> AvsResponsePerson
fakePerson = fakePerson =
let let
sarah = Set.singleton $ AvsDataPerson "Sarah" "Vaupel" Nothing 2 (AvsPersonId 2) mempty sarah = Set.singleton $ AvsDataPerson "Sarah" "Vaupel" Nothing 2 (AvsPersonId 2) mempty
stephan = Set.singleton $ AvsDataPerson "Stephan" "Barth" Nothing 4 (AvsPersonId 4) 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 sumpfi1 = Set.singleton $ AvsDataPerson "Heribert" "Sumpfmeier" Nothing 12345678 (AvsPersonId 12345678) mempty
sumpfi2 = Set.singleton $ AvsDataPerson "Heribert" "Sumpfmeier" Nothing 12345678 (AvsPersonId 604387) mempty sumpfi2 = Set.singleton $ AvsDataPerson "Heribert" "Sumpfmeier" Nothing 12345678 (AvsPersonId 604387) mempty
sumpfi3 = Set.singleton $ AvsDataPerson "Heribert" "Sumpfmeier" Nothing 12345678 (AvsPersonId 604591) 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"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson steffen
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00001234")} -> AvsResponsePerson steffen AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00001234")} -> AvsResponsePerson steffen
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00009944"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson stephan AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00009944"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson stephan
@ -106,7 +106,7 @@ mkAvsQuery _ _ _ = AvsQuery
fakeStatus :: AvsQueryStatus -> AvsResponseStatus fakeStatus :: AvsQueryStatus -> AvsResponseStatus
fakeStatus (AvsQueryStatus (Set.toList -> (api:_))) = AvsResponseStatus $ Set.singleton $ AvsStatusPerson api $ Set.fromList 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 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" , 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 | api == AvsPersonId 604591 = AvsResponseContact $ Set.singleton heribert
| otherwise = AvsResponseContact mempty | otherwise = AvsResponseContact mempty
where 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) (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) (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) (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) (AvsFirmInfo "UniWorX GmbH" 9 "UniWorX" Nothing Nothing Nothing Nothing Nothing (Just "sarah.vaupel@uniworx.de") Nothing)
fakeContact _ = AvsResponseContact mempty fakeContact _ = AvsResponseContact mempty
#else #else
@ -141,17 +141,17 @@ mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery
, avsQueryGetAllLicences = liftIO $ runClientM (rawQueryGetLicences avsQueryAllLicences) cliEnv , avsQueryGetAllLicences = liftIO $ runClientM (rawQueryGetLicences avsQueryAllLicences) cliEnv
} }
where where
( rawQueryPerson ( rawQueryPerson
:<|> rawQueryStatus :<|> rawQueryStatus
:<|> rawQueryContact :<|> rawQueryContact
:<|> rawQueryGetLicences :<|> rawQueryGetLicences
:<|> rawQuerySetLicences ) = client avsApi basicAuth :<|> rawQuerySetLicences ) = client avsApi basicAuth
catch404toEmpty :: Either ClientError AvsResponsePerson -> Either ClientError AvsResponsePerson catch404toEmpty :: Either ClientError AvsResponsePerson -> Either ClientError AvsResponsePerson
catch404toEmpty (Left (FailureResponse (requestPath -> (base, _path)) (statusCode . responseStatusCode -> 404))) 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! | baseUrl == base = Right $ AvsResponsePerson mempty -- WORKAROUND: AVS server erroneously returns 404 if no matching person could be found in its database!
catch404toEmpty other = other 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 => (a -> ClientM c) -> a -> ClientM c
splitQuery rawQuery q splitQuery rawQuery q
| avsMaxQueryAtOnce >= Set.size s = rawQuery q | avsMaxQueryAtOnce >= Set.size s = rawQuery q
@ -162,7 +162,7 @@ splitQuery rawQuery q
liftIO $ threadDelay avsMaxQueryDelay liftIO $ threadDelay avsMaxQueryDelay
res2 <- splitQuery rawQuery $ view _Unwrapped' avsid2 res2 <- splitQuery rawQuery $ view _Unwrapped' avsid2
return $ view _Unwrapped' (res1 ^. _Wrapped' <> res2 ^. _Wrapped') return $ view _Unwrapped' (res1 ^. _Wrapped' <> res2 ^. _Wrapped')
where where
s = view _Wrapped' q s = view _Wrapped' q
#endif #endif
@ -181,9 +181,9 @@ splitQuery rawQuery q
-- cardMatch AvsDataPersonCard{..} = -- cardMatch AvsDataPersonCard{..} =
-- avsDataValid && (avsDataValidTo >= cutoff) && (licence `Set.member` avsDataCardAreas) -- avsDataValid && (avsDataValidTo >= cutoff) && (licence `Set.member` avsDataCardAreas)
-- | DEPRECTATED -- -- DEPRECTATED
-- getCompanyAddress :: AvsDataPersonCard -> (Maybe Text, Maybe Text, Maybe AvsDataPersonCard) -- getCompanyAddress :: AvsDataPersonCard -> (Maybe Text, Maybe Text, Maybe AvsDataPersonCard)
-- getCompanyAddress card@AvsDataPersonCard{..} -- getCompanyAddress card@AvsDataPersonCard{..}
-- | Just street <- avsDataStreet -- | Just street <- avsDataStreet
-- , Just pcode <- avsDataPostalCode -- , Just pcode <- avsDataPostalCode
-- , Just city <- avsDataCity -- , Just city <- avsDataCity
@ -191,7 +191,7 @@ splitQuery rawQuery q
-- | isJust avsDataFirm = (avsDataFirm, Nothing, Just card) -- | isJust avsDataFirm = (avsDataFirm, Nothing, Just card)
-- | otherwise = (Nothing, Nothing, Nothing) -- | 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 -- -- Returns company, postal address and the associated card where the address was taken from
-- guessLicenceAddress :: Set AvsDataPersonCard -> (Maybe Text, Maybe Text, Maybe AvsDataPersonCard) -- guessLicenceAddress :: Set AvsDataPersonCard -> (Maybe Text, Maybe Text, Maybe AvsDataPersonCard)
-- guessLicenceAddress cards -- guessLicenceAddress cards

12
src/Utils/Icon.hs
View File

@ -40,7 +40,7 @@ data Icon
| IconProblem | IconProblem
| IconVisible | IconVisible
| IconInvisible | IconInvisible
-- | IconCourse -- not used, IconMenuCourse is currently only used -- IconCourse -- not used, IconMenuCourse is currently only used
| IconCourseFavouriteManual | IconCourseFavouriteAutomatic | IconCourseFavouriteOff | IconCourseFavouriteManual | IconCourseFavouriteAutomatic | IconCourseFavouriteOff
| IconEnrolTrue | IconEnrolTrue
| IconEnrolFalse | IconEnrolFalse
@ -110,7 +110,7 @@ data Icon
| IconAt | IconAt
| IconSupervisor | IconSupervisor
| IconSupervisorForeign | IconSupervisorForeign
-- | IconWaitingForUser -- IconWaitingForUser
| IconExpired | IconExpired
| IconLocked | IconLocked
| IconUnlocked | IconUnlocked
@ -118,8 +118,8 @@ data Icon
| IconCompany | IconCompany
| IconEdit | IconEdit
| IconUserEdit | IconUserEdit
-- | IconMagic -- indicates automatic updates -- IconMagic -- indicates automatic updates
deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic) deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic)
deriving anyclass (Universe, Finite, NFData) deriving anyclass (Universe, Finite, NFData)
@ -183,7 +183,7 @@ iconText = \case
IconMenuCorrections -> "check" IconMenuCorrections -> "check"
IconMenuExams -> "poll-h" IconMenuExams -> "poll-h"
IconMenuAdmin -> "screwdriver" IconMenuAdmin -> "screwdriver"
IconMenuLms -> "tasks" -- "user-graduate" "laptop" IconMenuLms -> "tasks" -- "user-graduate" "laptop"
IconMenuQualification -> "graduation-cap" -- "award" "diploma" "file-certificate" IconMenuQualification -> "graduation-cap" -- "award" "diploma" "file-certificate"
IconPageActionPrimaryExpand -> "bars" IconPageActionPrimaryExpand -> "bars"
IconPageActionSecondary -> "ellipsis-h" IconPageActionSecondary -> "ellipsis-h"
@ -230,7 +230,7 @@ icon ic = [shamlet|
$newline never $newline never
<i .fas .fa-#{iconText ic}> <i .fas .fa-#{iconText ic}>
|] |]
-- Create an icon from font-awesome with fixed width -- Create an icon from font-awesome with fixed width
iconFixed :: Icon -> Markup iconFixed :: Icon -> Markup
iconFixed ic = [shamlet| iconFixed ic = [shamlet|