chore: fix tests & hlint
This commit is contained in:
parent
b39ba8b268
commit
96b8478610
@ -69,7 +69,7 @@ mkSchoolForm :: Maybe SchoolId -> Maybe SchoolForm -> Form SchoolForm
|
||||
mkSchoolForm mSsh template = renderAForm FormStandard $ SchoolForm
|
||||
<$> maybe (\f fs -> areq f fs (sfShorthand <$> template)) (\ssh f fs -> aforced f fs (unSchoolKey ssh)) mSsh ciField (fslI MsgSchoolShort)
|
||||
<*> areq ciField (fslI MsgSchoolName) (sfName <$> template)
|
||||
<*> (Set.fromList . mapMaybe (fmap CI.mk . assertM' (not . Text.null) . Text.strip) <$> massInputListA (textField & addDatalist ldapOrgs) (const $ "") (const Nothing) ("ldap-organisations" :: Text) (fslI MsgSchoolLdapOrganisations & setTooltip MsgSchoolLdapOrganisationsTip) False (fmap CI.original . Set.toList . sfOrgUnits <$> template))
|
||||
<*> (Set.fromList . mapMaybe (fmap CI.mk . assertM' (not . Text.null) . Text.strip) <$> massInputListA (textField & addDatalist ldapOrgs) (const "") (const Nothing) ("ldap-organisations" :: Text) (fslI MsgSchoolLdapOrganisations & setTooltip MsgSchoolLdapOrganisationsTip) False (fmap CI.original . Set.toList . sfOrgUnits <$> template))
|
||||
where
|
||||
ldapOrgs :: WidgetT UniWorX IO (Set (CI Text))
|
||||
ldapOrgs = liftHandlerT . runDB $
|
||||
|
||||
@ -44,7 +44,7 @@ _SchoolId :: Iso' SchoolId SchoolShorthand
|
||||
_SchoolId = iso unSchoolKey SchoolKey
|
||||
|
||||
_Maybe :: Iso' (Maybe ()) Bool
|
||||
_Maybe = iso (maybe False $ const True) (bool Nothing (Just ()))
|
||||
_Maybe = iso (is _Just) (bool Nothing (Just ()))
|
||||
|
||||
|
||||
-----------------------------------
|
||||
|
||||
@ -106,6 +106,8 @@ fillDb = do
|
||||
, userWarningDays = userDefaultWarningDays
|
||||
, userMailLanguages = MailLanguages ["en"]
|
||||
, userNotificationSettings = def
|
||||
, userCreated = now
|
||||
, userLastLdapSynchronisation = Nothing
|
||||
}
|
||||
fhamann <- insert User
|
||||
{ userIdent = "felix.hamann@campus.lmu.de"
|
||||
@ -127,6 +129,8 @@ fillDb = do
|
||||
, userWarningDays = userDefaultWarningDays
|
||||
, userMailLanguages = MailLanguages ["de"]
|
||||
, userNotificationSettings = def
|
||||
, userCreated = now
|
||||
, userLastLdapSynchronisation = Nothing
|
||||
}
|
||||
jost <- insert User
|
||||
{ userIdent = "jost@tcs.ifi.lmu.de"
|
||||
@ -148,6 +152,8 @@ fillDb = do
|
||||
, userWarningDays = userDefaultWarningDays
|
||||
, userMailLanguages = MailLanguages ["de"]
|
||||
, userNotificationSettings = def
|
||||
, userCreated = now
|
||||
, userLastLdapSynchronisation = Nothing
|
||||
}
|
||||
maxMuster <- insert User
|
||||
{ userIdent = "max@campus.lmu.de"
|
||||
@ -169,6 +175,8 @@ fillDb = do
|
||||
, userWarningDays = userDefaultWarningDays
|
||||
, userMailLanguages = MailLanguages ["de"]
|
||||
, userNotificationSettings = def
|
||||
, userCreated = now
|
||||
, userLastLdapSynchronisation = Nothing
|
||||
}
|
||||
tinaTester <- insert $ User
|
||||
{ userIdent = "tester@campus.lmu.de"
|
||||
@ -190,6 +198,8 @@ fillDb = do
|
||||
, userWarningDays = userDefaultWarningDays
|
||||
, userMailLanguages = MailLanguages ["de"]
|
||||
, userNotificationSettings = def
|
||||
, userCreated = now
|
||||
, userLastLdapSynchronisation = Nothing
|
||||
}
|
||||
svaupel <- insert User
|
||||
{ userIdent = "vaupel.sarah@campus.lmu.de"
|
||||
@ -211,6 +221,8 @@ fillDb = do
|
||||
, userWarningDays = userDefaultWarningDays
|
||||
, userMailLanguages = MailLanguages ["de"]
|
||||
, userNotificationSettings = def
|
||||
, userCreated = now
|
||||
, userLastLdapSynchronisation = Nothing
|
||||
}
|
||||
void . repsert (TermKey summer2017) $ Term
|
||||
{ termName = summer2017
|
||||
|
||||
@ -102,6 +102,9 @@ instance Arbitrary User where
|
||||
userMailLanguages <- arbitrary
|
||||
userNotificationSettings <- arbitrary
|
||||
|
||||
userCreated <- arbitrary
|
||||
userLastLdapSynchronisation <- arbitrary
|
||||
|
||||
return User{..}
|
||||
shrink = genericShrink
|
||||
|
||||
|
||||
@ -108,6 +108,7 @@ authenticateAs (Entity _ User{..}) = do
|
||||
createUser :: (User -> User) -> YesodExample UniWorX (Entity User)
|
||||
createUser adjUser = do
|
||||
UserDefaultConf{..} <- appUserDefaults . view appSettings <$> getTestYesod
|
||||
now <- liftIO getCurrentTime
|
||||
let
|
||||
userMatrikelnummer = Nothing
|
||||
userAuthentication = AuthLDAP
|
||||
@ -128,6 +129,8 @@ createUser adjUser = do
|
||||
userWarningDays = userDefaultWarningDays
|
||||
userMailLanguages = def
|
||||
userNotificationSettings = def
|
||||
userCreated = now
|
||||
userLastLdapSynchronisation = Nothing
|
||||
runDB . insertEntity $ adjUser User{..}
|
||||
|
||||
lawsCheckHspec :: Typeable a => Proxy a -> [Proxy a -> Laws] -> Spec
|
||||
|
||||
Loading…
Reference in New Issue
Block a user