make code reusable

This commit is contained in:
nek0 2019-10-14 20:11:45 +02:00
parent 787b02e8b5
commit fe06fc8880

View file

@ -77,14 +77,42 @@ userOverviewPage l10n locale method ud pos = scaffold l10n locale (initPage $
$ H.toHtml $ translate "Logout" $ H.toHtml $ translate "Logout"
case method of case method of
MT.PrimaryPass -> MT.PrimaryPass ->
userSettingsPointer userSettingsPointer l10n locale
MT.SecondaryPass -> MT.SecondaryPass ->
productList productList pos
MT.ChallengeResponse -> do MT.ChallengeResponse -> do
userSettingsPointer userSettingsPointer l10n locale
productList productList pos
where where
translate = localize l10n locale . gettext translate = localize l10n locale . gettext
userSettingsPointer
:: L10n
-> Locale
-> H.Html
userSettingsPointer l10n locale =
H.a H.! HA.href ("/" <> (fromString $ show $ linkURI $ userManageLink)) $
H.toHtml $ translate "Manage user settings"
where
translate = localize l10n locale . gettext
productList
:: [MT.ProductShortOverview]
-> H.Html
productList pos =
H.p $
H.ul H.! HA.class_ "product_list" $
mapM_
(\(MT.ProductShortOverview pid ident _ _ _ avatarid) -> do
H.li H.! HA.class_ "product" H.!?
(isJust avatarid
, productBgStyle (fromString $ show $ fromJust avatarid)
) $
H.a H.! HA.href ("#" <> fromString (show pid)) $
H.toHtml ident
)
pos
where
productBgStyle aid = HA.style $ mconcat productBgStyle aid = HA.style $ mconcat
[ "background-image: url(#" <> aid <> ");" -- FILLME [ "background-image: url(#" <> aid <> ");" -- FILLME
, "backgronud-color: blue;" , "backgronud-color: blue;"
@ -94,22 +122,6 @@ userOverviewPage l10n locale method ud pos = scaffold l10n locale (initPage $
, " 1px 0 1px black," , " 1px 0 1px black,"
, " 0 -1px 1px black;" , " 0 -1px 1px black;"
] ]
userSettingsPointer =
H.a H.! HA.href ("/" <> (fromString $ show $ linkURI $ userManageLink)) $
H.toHtml $ translate "Manage user settings"
productList =
H.p $
H.ul H.! HA.class_ "product_list" $
mapM_
(\(MT.ProductShortOverview pid ident _ _ _ avatarid) -> do
H.li H.! HA.class_ "product" H.!?
(isJust avatarid
, productBgStyle (fromString $ show $ fromJust avatarid)
) $
H.a H.! HA.href ("#" <> fromString (show pid)) $
H.toHtml ident
)
pos
userNewPage userNewPage
:: L10n :: L10n