diff --git a/src/Control/Buy.hs b/src/Control/Buy.hs index 87786f0..205a722 100644 --- a/src/Control/Buy.hs +++ b/src/Control/Buy.hs @@ -66,7 +66,7 @@ buyControl mcookie uid pds forceBuy = (\acc ( MT.PurchaseDetail _ amount , MT.ProductShortOverview _ _ price _ _ _) -> - acc + (max 0 amount) * price + acc + max 0 amount * price ) 0 ziptup @@ -154,7 +154,7 @@ purchaseControl mcookie uid pds forceBuy = do else throwError $ addMessage (translate l10n loc "Please choose your product(s)") - $ (redirect303 $ userOverviewLink uid Nothing) + (redirect303 $ userOverviewLink uid Nothing) where logoutAndRedirectHome message backend token = do void $ liftIO $ runClientM @@ -238,10 +238,10 @@ cashBuyPurchaseControl mcookie {-forceBuy-} pds = do <> formatMoney price <> ". " <> translate l10n loc - ("But there seems to be something missing: ") + "But there seems to be something missing: " <> mconcat (reverse $ foldl (\acc (MT.ProductShortOverview psoid ident _ _ _ _) -> - if psoid `elem` fst (unzip missIds) + if psoid `elem` map fst missIds then (fromString (show $ fromJust $ lookup psoid missIds) <> " x " @@ -259,6 +259,6 @@ cashBuyPurchaseControl mcookie {-forceBuy-} pds = do else throwError $ addMessage (translate l10n loc "Please choose your product(s)") - $ (redirect303 $ cashBuyLink Nothing) + (redirect303 $ cashBuyLink Nothing) where translate l10n locale = localize l10n locale . gettext diff --git a/src/Control/Journal.hs b/src/Control/Journal.hs index d7cf909..4c1fc8e 100644 --- a/src/Control/Journal.hs +++ b/src/Control/Journal.hs @@ -15,7 +15,7 @@ import Data.String import qualified Data.Text as T import Data.Text.I18n -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, maybe) import Network.HTTP.Types.Status (Status(..)) @@ -37,17 +37,14 @@ journalControl -> Maybe Word -> UserHandler JournalPage journalControl mcookie mpage = do - let (token, muser) = parseTokenAndUser mcookie - loc = localeFromCookie mcookie - l10n <- asks rsL10n - backend <- asks rsBackend + (token, muser, loc, l10n, backend) <- controlInit mcookie case muser of Just user -> do eresult <- liftIO $ runClientM (journalShow (mkAuthenticatedRequest token authenticateReq) (Just 50) - (Just $ 50 * fromMaybe 0 (fromIntegral <$> mpage)) + (Just $ 50 * maybe 0 fromIntegral mpage) ) backend case eresult of @@ -74,9 +71,7 @@ journalGetCheckControl :: Maybe T.Text -> UserHandler JournalCheckPage journalGetCheckControl mcookie = do - let (token, muser) = parseTokenAndUser mcookie - loc = localeFromCookie mcookie - l10n <- asks rsL10n + (token, muser, loc, l10n, _) <- controlInit mcookie return $ journalCheckPage l10n loc mcookie journalPostCheckControl @@ -84,10 +79,7 @@ journalPostCheckControl -> CashCheck -> UserHandler JournalPage journalPostCheckControl mcookie (CashCheck floatAmount) = do - let (token, muser) = parseTokenAndUser mcookie - loc = localeFromCookie mcookie - l10n <- asks rsL10n - backend <- asks rsBackend + (token, muser, loc, l10n, backend) <- controlInit mcookie case muser of Just user -> do eresult <- liftIO $ runClientM @@ -105,7 +97,7 @@ journalPostCheckControl mcookie (CashCheck floatAmount) = do FailureResponse _ resp -> if statusCode (responseStatusCode resp) == 401 then - redirectOverAuth Nothing (Just $ journalGetCheckLink) Nothing + redirectOverAuth Nothing (Just journalGetCheckLink) Nothing else throwError $ addMessage (fromString $ show err) $ diff --git a/src/Control/User.hs b/src/Control/User.hs index 33eae08..7733d1c 100644 --- a/src/Control/User.hs +++ b/src/Control/User.hs @@ -91,7 +91,7 @@ userOverviewControl mcookie uid mRefine = do runClientM (userGet (mkAuthenticatedRequest token authenticateReq)) backend - eproducts <- case fmap toEnum (fmap read mMethod) of + eproducts <- case fmap (toEnum . read) mMethod of Just MT.PrimaryPass -> return (Right []) Just MT.SecondaryPass -> getProducts Just MT.ChallengeResponse -> getProducts @@ -161,10 +161,10 @@ userPostRechargeControl mcookie uid (UserRecharge amount) = do then case eresult of Right _ -> throwError $ - (addMessage $ translate l10n loc "Recharge Successful") $ + addMessage (translate l10n loc "Recharge Successful") $ redirect303 (userOverviewLink uid Nothing) Left err -> throwError $ - (addMessage $ translate l10n loc ("An error occured. " <> + addMessage (translate l10n loc ("An error occured. " <> fromString (show err))) $ redirect303 (userRechargeLink uid) else diff --git a/src/Types/Orphans.hs b/src/Types/Orphans.hs index ad35bdf..830dfd5 100644 --- a/src/Types/Orphans.hs +++ b/src/Types/Orphans.hs @@ -26,7 +26,7 @@ instance MimeUnrender HTML [MT.PurchaseDetail] instance FromForm [MT.PurchaseDetail] where fromForm form = let kvs = toListStable form - ks = fst (unzip kvs) + ks = map fst kvs kpids = filter ("productSelect" `T.isPrefixOf`) ks prods = filter ((`notElem` kpids) . fst) kvs stripPid = snd . T.breakOnEnd "-" diff --git a/src/Util.hs b/src/Util.hs index 157d04e..7b3483b 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -32,6 +32,8 @@ import Text.Printf (printf) import Network.HTTP.Types.Status +import Control.Monad.Reader (asks) + -- imports from "mateamt" import qualified "mateamt" Types as MT @@ -50,7 +52,7 @@ formatMoney amount = pre <> t <> "," <> c t = fromString $ reverse (intercalate "." $ chunksOf 3 $ reverse $ fst sp) c = fromString $ snd sp sp = tail <$> - break (== '.') (printf "%.2f" (abs $ (fromIntegral amount / 100) :: Float)) + break (== '.') (printf "%.2f" (abs (fromIntegral amount / 100) :: Float)) redirect303 :: Link @@ -183,3 +185,13 @@ productBgStyle aid = HA.style $ mconcat , " 1px 0 1px black," , " 0 -1px 1px black;" ] + +controlInit + :: Maybe T.Text + -> UserHandler (String, Maybe String, Locale, L10n, ClientEnv) +controlInit mcookie = do + let (token, muser) = parseTokenAndUser mcookie + loc = localeFromCookie mcookie + l10n <- asks rsL10n + backend <- asks rsBackend + return (token, muser, loc, l10n, backend) diff --git a/src/View/Buy.hs b/src/View/Buy.hs index 761c7e3..72eecf2 100644 --- a/src/View/Buy.hs +++ b/src/View/Buy.hs @@ -77,7 +77,7 @@ buyConfirmPage l10n locale uid ziptups total forceBuy mcookie = ) H.toHtml ident H.input - H.! HA.id ("product-amount-" <> (fromString (show pid))) + H.! HA.id ("product-amount-" <> fromString (show pid)) H.! HA.class_ "form-control" H.! HA.name ("productAmount-" <> fromString (show pid)) H.! HA.type_ "number" @@ -90,7 +90,7 @@ buyConfirmPage l10n locale uid ziptups total forceBuy mcookie = $ H.toHtml $ " @ " <> formatMoney price <> "€" -- TODO: ask for currency symbol H.input - H.! HA.id ("product-total-" <> (fromString (show pid))) + H.! HA.id ("product-total-" <> fromString (show pid)) H.! HA.class_ "form-control" H.! HA.name ("productTotal-" <> fromString (show pid)) H.! HA.type_ "text" diff --git a/src/View/Journal.hs b/src/View/Journal.hs index 6c1bba2..1d0f396 100644 --- a/src/View/Journal.hs +++ b/src/View/Journal.hs @@ -82,7 +82,7 @@ journalPage l10n loc mcookie mpage entries = H.! HA.type_ "submit" H.! HA.formmethod "get" H.! HA.formaction - ("/" <> fromString (show $ linkURI $ journalGetCheckLink)) + ("/" <> fromString (show $ linkURI journalGetCheckLink)) $ H.toHtml $ translate "Perform cash check" where translate = localize l10n loc . gettext diff --git a/src/View/User.hs b/src/View/User.hs index 1985607..4a9c290 100644 --- a/src/View/User.hs +++ b/src/View/User.hs @@ -105,7 +105,7 @@ userOverviewPage l10n locale method ud pos mcookie = $ H.toHtml $ translate "Recharge Credit" H.form H.! HA.method "post" - H.! HA.action ("/" <> (fromString $ show $ linkURI $ + H.! HA.action ("/" <> fromString (show $ linkURI $ buyLink (MT.userDetailsId ud) False) ) H.! HA.enctype "application/x-www-form-urlencoded" $