nek0/matebeamter
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

linted

Browse source
This commit is contained in:
nek0 2019-12-12 03:41:22 +01:00
parent 28b98a6f9b
commit eed646a2f3
8 changed files with 32 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
src/Control/Buy.hs
View file

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

20
src/Control/Journal.hs
View file

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

6
src/Control/User.hs
View file

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

2
src/Types/Orphans.hs
View file

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

14
src/Util.hs
View file

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

4
src/View/Buy.hs
View file

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

2
src/View/Journal.hs
View file

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

2
src/View/User.hs
View file

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