chore: fix tests & hlint

This commit is contained in:
Gregor Kleen 2019-08-29 15:33:36 +02:00
parent b39ba8b268
commit 96b8478610
5 changed files with 20 additions and 2 deletions

View File

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

View File

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

View File

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

View File

@ -102,6 +102,9 @@ instance Arbitrary User where
userMailLanguages <- arbitrary
userNotificationSettings <- arbitrary
userCreated <- arbitrary
userLastLdapSynchronisation <- arbitrary
return User{..}
shrink = genericShrink

View File

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