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

introducing: Bootstrap3!!!

Browse source
This commit is contained in:
nek0 2015-10-22 23:57:27 +02:00
parent 1c2218f887
commit 079b357459
32 changed files with 209 additions and 160 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Foundation.hs
View file

@ -126,7 +126,7 @@ instance Yesod App where
$(widgetFile "copyright")
pc <- widgetToPageContent $ do
$(combineStylesheets 'StaticR
[ css_bootstrap_css
[ css_bootstrap_min_css
, css_main_css
])
$(combineScripts 'StaticR

33
Handler/Avatar.hs
View file

@ -16,6 +16,7 @@
module Handler.Avatar where
import Import
import Handler.Common
import Data.Conduit.Binary
import qualified Data.Text as T
import qualified Data.ByteString as B
@ -32,13 +33,15 @@ getAvatarR = do
getNewAvatarR :: Handler Html
getNewAvatarR = do
(newAvatarWidget, enctype) <- generateFormPost avatarNewForm
(newAvatarWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm $ avatarNewForm
defaultLayout $
$(widgetFile "newAvatar")
postNewAvatarR :: Handler Html
postNewAvatarR = do
((res, _), _) <- runFormPost avatarNewForm
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm avatarNewForm
case res of
FormSuccess na -> do
raw <- runResourceT $ fileSource (avatarNewFile na) $$ sinkLbs
@ -50,10 +53,11 @@ postNewAvatarR = do
setMessageI MsgErrorOccured
redirect NewAvatarR
avatarNewForm :: Form AvatarNew
avatarNewForm = renderDivs $ AvatarNew
<$> areq textField (fieldSettingsLabel MsgAvatarIdent) Nothing
<*> areq fileField (fieldSettingsLabel MsgAvatarFile) Nothing
avatarNewForm :: AForm Handler AvatarNew
avatarNewForm = AvatarNew
<$> areq textField (bfs MsgAvatarIdent) Nothing
<*> areq fileField (bfs MsgAvatarFile) Nothing
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)
data AvatarNew = AvatarNew
{ avatarNewIdent :: Text
@ -65,7 +69,9 @@ getModifyAvatarR aId = do
ma <- runDB $ get aId
case ma of
Just avatar -> do
(avatarModifyWidget, enctype) <- generateFormPost $ avatarModForm avatar
(avatarModifyWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm
$ avatarModForm avatar
defaultLayout $
$(widgetFile "modifyAvatar")
Nothing -> do
@ -77,7 +83,9 @@ postModifyAvatarR aId = do
ma <- runDB $ get aId
case ma of
Just avatar -> do
((res, _), _) <- runFormPost $ avatarModForm avatar
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm
$ avatarModForm avatar
case res of
FormSuccess md -> do
updateAvatar aId md
@ -90,10 +98,11 @@ postModifyAvatarR aId = do
setMessageI MsgAvatarUnknown
redirect HomeR
avatarModForm :: Avatar -> Form AvatarMod
avatarModForm a = renderDivs $ AvatarMod
<$> areq textField (fieldSettingsLabel MsgAvatarIdent) (Just $ avatarIdent a)
<*> aopt fileField (fieldSettingsLabel MsgAvatarFileChange) Nothing
avatarModForm :: Avatar -> AForm Handler AvatarMod
avatarModForm a = AvatarMod
<$> areq textField (bfs MsgAvatarIdent) (Just $ avatarIdent a)
<*> aopt fileField (bfs MsgAvatarFileChange) Nothing
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)
data AvatarMod = AvatarMod
{ avatarModIdent :: Text

23
Handler/Buy.hs
View file

@ -17,7 +17,6 @@ module Handler.Buy where
import Import
import Handler.Common
import qualified Data.Text as T
import Text.Blaze.Internal
import Text.Shakespeare.Text
@ -27,7 +26,9 @@ getBuyR uId bId = do
case mTup of
Just (user, bev) -> do
master <- getYesod
(buyWidget, enctype) <- generateFormPost buyForm
(buyWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm
$ buyForm
defaultLayout $
$(widgetFile "buy")
Nothing -> do
@ -39,7 +40,9 @@ postBuyR uId bId = do
mTup <- checkData uId bId
case mTup of
Just (user, bev) -> do
((res, _), _) <- runFormPost buyForm
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm
$ buyForm
case res of
FormSuccess quant -> do
if quant > beverageAmount bev
@ -91,7 +94,9 @@ getBuyCashR bId = do
case mBev of
Just bev -> do
master <- getYesod
(buyCashWidget, enctype) <- generateFormPost buyForm
(buyCashWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm
$ buyForm
defaultLayout $
$(widgetFile "buyCash")
Nothing -> do
@ -103,7 +108,9 @@ postBuyCashR bId = do
mBev <- runDB $ get bId
case mBev of
Just bev -> do
((res, _), _) <- runFormPost buyForm
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm
$ buyForm
case res of
FormSuccess quant -> do
if quant > beverageAmount bev
@ -137,6 +144,6 @@ checkData uId bId = do
Nothing -> return Nothing
Nothing -> return Nothing
buyForm :: Form Int
buyForm = renderDivs
$ areq amountField (fieldSettingsLabel MsgAmount) (Just 1)
buyForm :: AForm Handler Int
buyForm = areq amountField (bfs MsgAmount) (Just 1)
<* bootstrapSubmit (msgToBSSubmit MsgPurchase)

13
Handler/CashCheck.hs
View file

@ -20,13 +20,15 @@ import Handler.Common
getCashCheckR :: Handler Html
getCashCheckR = do
(cashCheckWidget, enctype) <- generateFormPost createCashCheckForm
(cashCheckWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm createCashCheckForm
defaultLayout $
$(widgetFile "cashCheck")
postCashCheckR :: Handler Html
postCashCheckR = do
((res, _), _) <- runFormPost createCashCheckForm
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm createCashCheckForm
case res of
FormSuccess c -> do
currentTime <- liftIO getCurrentTime
@ -38,7 +40,8 @@ postCashCheckR = do
setMessageI MsgCashCheckError
redirect CashCheckR
createCashCheckForm :: Form CashCheck
createCashCheckForm = renderDivs $ CashCheck
<$> areq currencyField (fieldSettingsLabel MsgCountedValue) Nothing
createCashCheckForm :: AForm Handler CashCheck
createCashCheckForm = CashCheck
<$> areq currencyField (bfs MsgCountedValue) Nothing
<*> lift (liftIO getCurrentTime)
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)

10
Handler/Common.hs
View file

@ -17,6 +17,7 @@
module Handler.Common where
import Data.FileEmbed (embedFile)
import Yesod.Form.Bootstrap3
import qualified Data.Text as T
import qualified Data.List as L
import qualified Data.Text.Lazy.Encoding as E
@ -39,6 +40,13 @@ getRobotsR :: Handler TypedContent
getRobotsR = return $ TypedContent typePlain
$ toContent $(embedFile "config/robots.txt")
-- msgToBSSubmit :: T.Text -> BootstrapSubmit T.Text
msgToBSSubmit t = BootstrapSubmit
{ bsValue = t
, bsClasses = "btn-default"
, bsAttrs = []
}
removeItem :: Eq a => a -> [a] -> [a]
removeItem _ [] = []
removeItem x (y:ys)
@ -163,7 +171,7 @@ amountField = Field
Right (a, "") -> Right a
_ -> Left $ MsgInvalidInteger s
, fieldView = \theId name attr val req -> toWidget [hamlet|$newline never
<input id="crement" id=#{theId} name=#{name} *{attr} type="number" step=1 min=0 :req:required="required" value="#{showVal val}">
<input #crement id=#{theId} name=#{name} *{attr} type="number" step=1 min=0 :req:required="required" value="#{showVal val}">
|]
, fieldEnctype = UrlEncoded
}

37
Handler/Modify.hs
View file

@ -27,7 +27,9 @@ getModifyR bId = do
_ <- handleGetParam p (Right bId)
rawbs <- runDB $ selectList [BarcodeBev ==. Just bId] []
let bs = map (barcodeCode . entityVal) rawbs
(modifyWidget, enctype) <- generateFormPost $ modifyForm bev bs
(modifyWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm
$ modifyForm bev bs
defaultLayout $
$(widgetFile "modify")
Nothing -> do
@ -41,7 +43,9 @@ postModifyR bId = do
Just bev -> do
rawbs <- runDB $ selectList [BarcodeBev ==. Just bId] []
let bs = map (barcodeCode . entityVal) rawbs
((res, _), _) <- runFormPost $ modifyForm bev bs
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm
$ modifyForm bev bs
case res of
FormSuccess nBev -> do
runDB $ update bId
@ -83,20 +87,21 @@ data ModBev = ModBev
, modBevArtNr :: Maybe Text
}
modifyForm :: Beverage -> [Text] -> Form ModBev
modifyForm bev bs = renderDivs $ ModBev
<$> areq textField (fieldSettingsLabel MsgName) (Just $ beverageIdent bev)
<*> areq currencyField (fieldSettingsLabel MsgPrice) (Just $ beveragePrice bev)
<*> areq amountField (fieldSettingsLabel MsgCurrentStock) (Just $ beverageAmount bev)
<*> areq amountField (fieldSettingsLabel MsgAnnouncedStock) (Just $ beverageAlertAmount bev)
<*> areq amountField (fieldSettingsLabel MsgMaxAmount) (Just $ beverageMaxAmount bev)
<*> areq volumeField (fieldSettingsLabel MsgVolume) (Just $ beverageMl bev)
<*> aopt amountField (fieldSettingsLabel MsgAmountPerCrate) (Just $ beveragePerCrate bev)
<*> aopt currencyField (fieldSettingsLabel MsgPricePerCrate) (Just $ beveragePricePerCrate bev)
<*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) (Just $ beverageAvatar bev)
<*> aopt barcodeField (fieldSettingsLabel MsgBarcodeField) (Just $ Just bs)
<*> aopt (selectField sups) (fieldSettingsLabel MsgSelectSupplier) (Just $ beverageSupplier bev)
<*> aopt textField (fieldSettingsLabel MsgArtNr) (Just $ beverageArtNr bev)
modifyForm :: Beverage -> [Text] -> AForm Handler ModBev
modifyForm bev bs = ModBev
<$> areq textField (bfs MsgName) (Just $ beverageIdent bev)
<*> areq currencyField (bfs MsgPrice) (Just $ beveragePrice bev)
<*> areq amountField (bfs MsgCurrentStock) (Just $ beverageAmount bev)
<*> areq amountField (bfs MsgAnnouncedStock) (Just $ beverageAlertAmount bev)
<*> areq amountField (bfs MsgMaxAmount) (Just $ beverageMaxAmount bev)
<*> areq volumeField (bfs MsgVolume) (Just $ beverageMl bev)
<*> aopt amountField (bfs MsgAmountPerCrate) (Just $ beveragePerCrate bev)
<*> aopt currencyField (bfs MsgPricePerCrate) (Just $ beveragePricePerCrate bev)
<*> aopt (selectField avatars) (bfs MsgSelectAvatar) (Just $ beverageAvatar bev)
<*> aopt barcodeField (bfs MsgBarcodeField) (Just $ Just bs)
<*> aopt (selectField sups) (bfs MsgSelectSupplier) (Just $ beverageSupplier bev)
<*> aopt textField (bfs MsgArtNr) (Just $ beverageArtNr bev)
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)
where
avatars = optionsPersistKey [] [Asc AvatarIdent] avatarIdent
sups = optionsPersistKey [] [Asc SupplierIdent] supplierIdent

38
Handler/NewUser.hs
View file

@ -24,7 +24,9 @@ getNewUserR :: Handler Html
getNewUserR = do
time <- liftIO getCurrentTime
let secs = read $ formatTime defaultTimeLocale "%s" time
(newUserWidget, enctype) <- generateFormPost $ newUserForm secs
(newUserWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm
$ newUserForm secs
defaultLayout $
$(widgetFile "newUser")
@ -32,7 +34,9 @@ postNewUserR :: Handler Html
postNewUserR = do
time <- liftIO getCurrentTime
let secs = read $ formatTime defaultTimeLocale "%s" time
((res, _), _) <- runFormPost $ newUserForm secs
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm
$ newUserForm secs
case res of
FormSuccess user -> do
runDB $ insert_ user
@ -42,13 +46,14 @@ postNewUserR = do
setMessageI MsgUserNotCreated
redirect NewUserR
newUserForm :: Int -> Form User
newUserForm secs = renderDivs $ User
<$> areq textField (fieldSettingsLabel MsgName) Nothing
newUserForm :: Int -> AForm Handler User
newUserForm secs = User
<$> areq textField (bfs MsgName) Nothing
<*> pure 0
<*> pure secs
<*> aopt emailField (fieldSettingsLabel MsgEmailNotify) Nothing
<*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) Nothing
<*> aopt emailField (bfs MsgEmailNotify) Nothing
<*> aopt (selectField avatars) (bfs MsgSelectAvatar) Nothing
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)
where
avatars = do
ents <- runDB $ selectList [] [Asc AvatarIdent]
@ -69,7 +74,9 @@ getModifyUserR uId = do
_ <- handleGetParam p (Left uId)
rawbs <- runDB $ selectList [BarcodeUser ==. Just uId] []
let bs = map (barcodeCode . entityVal) rawbs
(modifyUserWidget, enctype) <- generateFormPost $ modifyUserForm user bs
(modifyUserWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm
$ modifyUserForm user bs
defaultLayout $
$(widgetFile "modifyUser")
Nothing -> do
@ -83,7 +90,9 @@ postModifyUserR uId = do
Just user -> do
rawbs <- runDB $ selectList [BarcodeUser ==. Just uId] []
let bs = map (barcodeCode . entityVal) rawbs
((res, _), _) <- runFormPost $ modifyUserForm user bs
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm
$ modifyUserForm user bs
case res of
FormSuccess uc -> do
runDB $ update uId
@ -101,11 +110,12 @@ postModifyUserR uId = do
setMessageI MsgUserUnknown
redirect HomeR
modifyUserForm :: User -> [Text] -> Form UserConf
modifyUserForm user bs = renderDivs $ UserConf
<$> aopt emailField (fieldSettingsLabel MsgEmailNotify) (Just $ userEmail user)
<*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) (Just $ userAvatar user)
<*> aopt barcodeField (fieldSettingsLabel MsgBarcodeField) (Just $ Just bs)
modifyUserForm :: User -> [Text] -> AForm Handler UserConf
modifyUserForm user bs = UserConf
<$> aopt emailField (bfs MsgEmailNotify) (Just $ userEmail user)
<*> aopt (selectField avatars) (bfs MsgSelectAvatar) (Just $ userAvatar user)
<*> aopt barcodeField (bfs MsgBarcodeField) (Just $ Just bs)
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)
where
avatars = do
ents <- runDB $ selectList [] [Asc AvatarIdent]

15
Handler/Payout.hs
View file

@ -26,13 +26,15 @@ data Payment = Payment
getPayoutR :: Handler Html
getPayoutR = do
(payoutWidget, enctype) <- generateFormPost payoutForm
(payoutWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm payoutForm
defaultLayout $
$(widgetFile "payout")
postPayoutR :: Handler Html
postPayoutR = do
((res, _), _) <- runFormPost payoutForm
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm payoutForm
case res of
FormSuccess payment -> do
msg <- renderMessage' $ MsgPayout $ paymentDesc payment
@ -43,7 +45,8 @@ postPayoutR = do
setMessageI MsgNotPaidOut
redirect JournalR
payoutForm :: Form Payment
payoutForm = renderDivs $ Payment
<$> areq currencyField (fieldSettingsLabel MsgValue) Nothing
<*> areq textField (fieldSettingsLabel MsgDescription) Nothing
payoutForm :: AForm Handler Payment
payoutForm = Payment
<$> areq currencyField (bfs MsgValue) Nothing
<*> areq textField (bfs MsgDescription) Nothing
<* bootstrapSubmit (msgToBSSubmit MsgDoPayout)

46
Handler/Restock.hs
View file

@ -30,7 +30,8 @@ getUpstockR bId = do
mBev <- runDB $ get bId
case mBev of
Just bev -> do
(upstockWidget, enctype) <- generateFormPost upstockForm
(upstockWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm upstockForm
defaultLayout $
$(widgetFile "upstock")
Nothing -> do
@ -42,7 +43,8 @@ postUpstockR bId = do
mBev <- runDB $ get bId
case mBev of
Just _ -> do
((res, _), _) <- runFormPost upstockForm
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm upstockForm
case res of
FormSuccess c ->
if c > 0
@ -53,6 +55,7 @@ postUpstockR bId = do
else do
setMessageI MsgNotStockedUp
redirect $ UpstockR bId
_ -> do
setMessageI MsgStockupError
redirect $ UpstockR bId
@ -60,19 +63,21 @@ postUpstockR bId = do
setMessageI MsgItemUnknown
redirect HomeR
upstockForm :: Form Int
upstockForm = renderDivs
$ areq amountField (fieldSettingsLabel MsgAmountAdded) (Just 1)
upstockForm :: AForm Handler Int
upstockForm = areq amountField (bfs MsgAmountAdded) (Just 1)
<* bootstrapSubmit (msgToBSSubmit MsgFillup)
getNewArticleR :: Handler Html
getNewArticleR = do
(newArticleWidget, enctype) <- generateFormPost newArticleForm
(newArticleWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm newArticleForm
defaultLayout $
$(widgetFile "newArticle")
postNewArticleR :: Handler Html
postNewArticleR = do
((result, _), _) <- runFormPost newArticleForm
((result, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm newArticleForm
case result of
FormSuccess bev -> do
runDB $ insert_ bev
@ -82,20 +87,21 @@ postNewArticleR = do
setMessageI MsgItemNotAdded
redirect HomeR
newArticleForm :: Form Beverage
newArticleForm = renderDivs $ (\a b c d e f g h i j k l -> Beverage a b c d e i j k f g l h)
<$> areq textField (fieldSettingsLabel MsgName) Nothing
<*> areq currencyField (fieldSettingsLabel MsgPrice) (Just 100)
<*> areq amountField (fieldSettingsLabel MsgAmount) (Just 0)
<*> areq amountField (fieldSettingsLabel MsgAmountWarning) (Just 0)
newArticleForm :: AForm Handler Beverage
newArticleForm = (\a b c d e f g h i j k l -> Beverage a b c d e i j k f g l h)
<$> areq textField (bfs MsgName) Nothing
<*> areq currencyField (bfs MsgPrice) (Just 100)
<*> areq amountField (bfs MsgAmount) (Just 0)
<*> areq amountField (bfs MsgAmountWarning) (Just 0)
<*> pure 0
<*> areq amountField (fieldSettingsLabel MsgMaxAmount) (Just 200)
<*> aopt amountField (fieldSettingsLabel MsgAmountPerCrate) (Just $ Just 20)
<*> aopt currencyField (fieldSettingsLabel MsgPricePerCrate) Nothing
<*> areq volumeField (fieldSettingsLabel MsgVolume) (Just 500)
<*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) Nothing
<*> aopt (selectField sups) (fieldSettingsLabel MsgSelectSupplier) Nothing
<*> aopt textField (fieldSettingsLabel MsgArtNr) Nothing
<*> areq amountField (bfs MsgMaxAmount) (Just 200)
<*> aopt amountField (bfs MsgAmountPerCrate) (Just $ Just 20)
<*> aopt currencyField (bfs MsgPricePerCrate) Nothing
<*> areq volumeField (bfs MsgVolume) (Just 500)
<*> aopt (selectField avatars) (bfs MsgSelectAvatar) Nothing
<*> aopt (selectField sups) (bfs MsgSelectSupplier) Nothing
<*> aopt textField (bfs MsgArtNr) Nothing
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)
where
avatars = optionsPersistKey [] [Asc AvatarIdent] avatarIdent
sups = optionsPersistKey [] [Asc SupplierIdent] supplierIdent

12
Handler/Select.hs
View file

@ -45,7 +45,8 @@ getRechargeR uId = do
mUser <- runDB $ get uId
case mUser of
Just user -> do
(rechargeWidget, enctype) <- generateFormPost rechargeForm
(rechargeWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm rechargeForm
currency <- appCurrency <$> appSettings <$> getYesod
defaultLayout $
$(widgetFile "recharge")
@ -58,7 +59,8 @@ postRechargeR uId = do
mUser <- runDB $ get uId
case mUser of
Just user -> do
((res, _), _) <- runFormPost rechargeForm
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm rechargeForm
case res of
FormSuccess amount ->
if amount < 0
@ -79,6 +81,6 @@ postRechargeR uId = do
setMessageI MsgUserUnknown
redirect HomeR
rechargeForm :: Form Int
rechargeForm = renderDivs
$ areq currencyField (fieldSettingsLabel MsgValue) (Just 0)
rechargeForm :: AForm Handler Int
rechargeForm = areq currencyField (bfs MsgValue) (Just 0)
<* bootstrapSubmit (msgToBSSubmit MsgRecharge)

12
Handler/Summary.hs
View file

@ -102,13 +102,15 @@ getInventoryJsonR = do
getUploadInventoryJsonR :: Handler Html
getUploadInventoryJsonR = do
(uploadJsonWidget, enctype) <- generateFormPost uploadJsonForm
(uploadJsonWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm uploadJsonForm
defaultLayout $
$(widgetFile "uploadJson")
postUploadInventoryJsonR :: Handler Html
postUploadInventoryJsonR = do
((res, _), _) <- runFormPost uploadJsonForm
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm uploadJsonForm
case res of
FormSuccess file ->
if fileContentType file == "application/json"
@ -125,9 +127,9 @@ postUploadInventoryJsonR = do
setMessageI MsgErrorOccured
redirect UploadInventoryJsonR
uploadJsonForm :: Form FileInfo
uploadJsonForm = renderDivs
$ areq fileField (fieldSettingsLabel MsgSelectFile) Nothing
uploadJsonForm :: AForm Handler FileInfo
uploadJsonForm = areq fileField (bfs MsgSelectFile) Nothing
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)
insOrUpd :: BevStore -> Handler (Entity Beverage)
insOrUpd bev = do

51
Handler/Supplier.hs
View file

@ -1,7 +1,9 @@
module Handler.Supplier where
import Import
import Handler.Common
import Data.Maybe
import qualified Data.Text as T
getSupplierR :: Handler Html
getSupplierR = do
@ -11,13 +13,15 @@ getSupplierR = do
getNewSupplierR :: Handler Html
getNewSupplierR = do
(newSupplierWidget, enctype) <- generateFormPost newSupplierForm
(newSupplierWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm newSupplierForm
defaultLayout $
$(widgetFile "newSupplier")
postNewSupplierR :: Handler Html
postNewSupplierR = do
((res, _), _) <- runFormPost newSupplierForm
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm newSupplierForm
case res of
FormSuccess sup -> do
runDB $ insert_ sup
@ -27,14 +31,15 @@ postNewSupplierR = do
setMessageI MsgSupplierNotCreated
redirect SupplierR
newSupplierForm :: Form Supplier
newSupplierForm = renderDivs $ Supplier
<$> areq textField (fieldSettingsLabel MsgName) Nothing
<*> areq textareaField (fieldSettingsLabel MsgAddress) Nothing
<*> areq textField (fieldSettingsLabel MsgTelNr) Nothing
<*> areq emailField (fieldSettingsLabel MsgEmail) Nothing
<*> areq textField (fieldSettingsLabel MsgCustomerId) Nothing
<*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) Nothing
newSupplierForm :: AForm Handler Supplier
newSupplierForm = Supplier
<$> areq textField (bfs MsgName) Nothing
<*> areq textareaField (bfs MsgAddress) Nothing
<*> areq textField (bfs MsgTelNr) Nothing
<*> areq emailField (bfs MsgEmail) Nothing
<*> areq textField (bfs MsgCustomerId) Nothing
<*> aopt (selectField avatars) (bfs MsgSelectAvatar) Nothing
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)
where
avatars = do
ents <- runDB $ selectList [] [Asc AvatarIdent]
@ -54,7 +59,9 @@ getModifySupplierR sId = do
mSup <- runDB $ get sId
case mSup of
Just sup -> do
(modifySupplierWidget, enctype) <- generateFormPost $ modifySupplierForm sup
(modifySupplierWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm
$ modifySupplierForm sup
defaultLayout $
$(widgetFile "modifySupplier")
Nothing -> do
@ -66,7 +73,9 @@ postModifySupplierR sId = do
mSup <- runDB $ get sId
case mSup of
Just sup -> do
((res, _), _) <- runFormPost $ modifySupplierForm sup
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm
$ modifySupplierForm sup
case res of
FormSuccess msup -> do
runDB $ update sId
@ -85,15 +94,17 @@ postModifySupplierR sId = do
setMessageI MsgSupplierUnknown
redirect SupplierR
modifySupplierForm :: Supplier -> Form SupConf
modifySupplierForm sup = renderDivs $ SupConf
<$> areq textField (fieldSettingsLabel MsgName) (Just $ supplierIdent sup)
<*> areq textareaField (fieldSettingsLabel MsgAddress) (Just $ supplierAddress sup)
<*> areq textField (fieldSettingsLabel MsgTelNr) (Just $ supplierTel sup)
<*> areq textField (fieldSettingsLabel MsgEmail) (Just $ supplierEmail sup)
<*> areq textField (fieldSettingsLabel MsgCustomerId) (Just $ supplierCustomerId sup)
<*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) (Just $ supplierAvatar sup)
modifySupplierForm :: Supplier -> AForm Handler SupConf
modifySupplierForm sup = SupConf
<$> areq textField (bfs MsgName) (Just $ supplierIdent sup)
<*> areq textareaField (bfs MsgAddress) (Just $ supplierAddress sup)
<*> areq textField (bfs MsgTelNr) (Just $ supplierTel sup)
<*> areq textField (bfs MsgEmail) (Just $ supplierEmail sup)
<*> areq textField (bfs MsgCustomerId) (Just $ supplierCustomerId sup)
<*> aopt (selectField avatars) (bfs MsgSelectAvatar) (Just $ supplierAvatar sup)
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)
where
master = getYesod
avatars = do
ents <- runDB $ selectList [] [Asc AvatarIdent]
optionsPairs $ map (\ent -> ((avatarIdent $ entityVal ent), entityKey ent)) ents

12
Handler/Transfer.hs
View file

@ -40,7 +40,8 @@ getTransferR from to = do
mRecpt <- runDB $ get to
case mRecpt of
Just recpt -> do
(transferWidget, enctype) <- generateFormPost transferForm
(transferWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm transferForm
currency <- appCurrency <$> appSettings <$> getYesod
defaultLayout $ do
$(widgetFile "transfer")
@ -59,7 +60,8 @@ postTransferR from to = do
mRecpt <- runDB $ get to
case mRecpt of
Just recpt -> do
((res, _), _) <- runFormPost transferForm
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm transferForm
case res of
FormSuccess amount -> do
if amount < 0
@ -83,9 +85,9 @@ postTransferR from to = do
setMessageI MsgUserUnknown
redirect HomeR
transferForm :: Form Int
transferForm = renderDivs
$ areq currencyField (fieldSettingsLabel MsgValue) (Just 0)
transferForm :: AForm Handler Int
transferForm = areq currencyField (bfs MsgValue) (Just 0)
<* bootstrapSubmit (msgToBSSubmit MsgTransfer)
notify :: User -> User -> Int -> App -> IO ()
notify sender rcpt amount master = do

1
Import/NoFoundation.hs
View file

@ -24,3 +24,4 @@ import Settings.StaticFiles as Import
import Yesod.Auth as Import
import Yesod.Core.Types as Import (loggerSet)
import Yesod.Default.Config2 as Import
import Yesod.Form.Bootstrap3 as Import

5
static/css/bootstrap.min.css vendored Executable file
View file

File diff suppressed because one or more lines are too long

12
static/css/main.css
View file

@ -177,11 +177,15 @@ h1 {
-moz-animation-timing-function: linear;
}
input[type] {
font-size: 24.5px;
input[type], button {
font-size: 24.5px !important;
width: auto;
min-width: 5rem;
height: 5rem;
min-width: 9rem;
height: 9rem;
}
.plusbtn {
margin-left: 30px;
}
.container {

7
templates/buy.hamlet
View file

@ -11,7 +11,6 @@ $doctype 5
<form method=post enctype=#{enctype}>
^{buyWidget}
<div>
<input type=submit value="_{MsgPurchase}">
<input onclick="crmnt( document.getElementById('crement'), 1 )" value="_{MsgIncrement}" type="button">
<input onclick="crmnt( document.getElementById('crement'), -1 )" value="_{MsgDecrement}" type="button">
<div .plusbtn>
<button .btn .btn-default onclick="crmnt( document.getElementById('crement'), 1 )">_{MsgIncrement}
<button .btn .btn-default onclick="crmnt( document.getElementById('crement'), -1 )">_{MsgDecrement}

7
templates/buyCash.hamlet
View file

@ -11,7 +11,6 @@ $doctype 5
<form method=post enctype=#{enctype}>
^{buyCashWidget}
<div>
<input type=submit value="_{MsgPurchase}">
<input onclick="crmnt( document.getElementById('crement'), 1 )" value="_{MsgIncrement}" type="button">
<input onclick="crmnt( document.getElementById('crement'), -1 )" value="_{MsgDecrement}" type="button">
<div .plusbtn>
<button .btn .btn-default onclick="crmnt( document.getElementById('crement'), 1 )">_{MsgIncrement}
<button .btn .btn-default onclick="crmnt( document.getElementById('crement'), -1 )">_{MsgDecrement}

2
templates/cashCheck.hamlet
View file

@ -8,5 +8,3 @@ $doctype 5
<form method=post enctype=#{enctype}>
^{cashCheckWidget}
<div>
<input type=submit value="_{MsgSubmit}">

2
templates/modify.hamlet
View file

@ -4,8 +4,6 @@ $doctype 5
<form method=post enctype=#{enctype}>
^{modifyWidget}
<div>
<input type=submit value=_{MsgSubmit}>
<a href=@{DeleteBeverageR bId}>
_{MsgDeleteItem}

2
templates/modifyAvatar.hamlet
View file

@ -4,7 +4,5 @@ $doctype 5
<form method=post enctype=#{enctype}>
^{avatarModifyWidget}
<div>
<input type=submit value=_{MsgSubmit}>
<a href=@{AvatarDeleteR aId}>_{MsgDeleteAvatar}

2
templates/modifySupplier.hamlet
View file

@ -4,5 +4,3 @@ $doctype 5
<form method=post enctype=#{enctype}>
^{modifySupplierWidget}
<div>
<input type=submit value="_{MsgSubmit}">

2
templates/modifyUser.hamlet
View file

@ -4,8 +4,6 @@ $doctype 5
<form method=post enctype=#{enctype}>
^{modifyUserWidget}
<div>
<input type=submit value="_{MsgSubmit}">
<form action=@{ModifyUserR uId} method=GET>
<input type=hidden #barcodeInput name=barcode>

2
templates/newArticle.hamlet
View file

@ -4,5 +4,3 @@ $doctype 5
<form method=post enctype=#{enctype}>
^{newArticleWidget}
<div>
<input type=submit value="_{MsgSubmit}">

2
templates/newAvatar.hamlet
View file

@ -4,5 +4,3 @@ $doctype 5
<form method=post enctype=#{enctype}>
^{newAvatarWidget}
<div>
<input type=submit value=_{MsgSubmit}>

2
templates/newSupplier.hamlet
View file

@ -4,5 +4,3 @@ $doctype 5
<form method=post enctype=#{enctype}>
^{newSupplierWidget}
<div>
<input type=submit value="_{MsgSubmit}">

2
templates/newUser.hamlet
View file

@ -4,5 +4,3 @@ $doctype 5
<form method=post enctype=#{enctype}>
^{newUserWidget}
<div>
<input type=submit value="_{MsgSubmit}">

2
templates/payout.hamlet
View file

@ -6,5 +6,3 @@ $doctype 5
<form method=post enctype=#{enctype}>
^{payoutWidget}
<div>
<input type=submit value="_{MsgDoPayout}">

7
templates/recharge.hamlet
View file

@ -8,7 +8,6 @@ $doctype 5
<form method=post enctype=#{enctype}>
^{rechargeWidget}
<div>
<input type=submit value="_{MsgRecharge}">
<input onclick="crmnt( document.getElementById('hident2'), 5 )" value="_{MsgPlus5}" type="button">
<input onclick="crmnt( document.getElementById('hident2'), -5 )" value="_{MsgMinus5}" type="button">
<div .plusbtn>
<input onclick="crmnt( document.getElementById('hident2'), 5 )" value="_{MsgPlus5}" type="button">
<input onclick="crmnt( document.getElementById('hident2'), -5 )" value="_{MsgMinus5}" type="button">

2
templates/transfer.hamlet
View file

@ -8,7 +8,5 @@ $doctype 5
<form method=post enctype=#{enctype}>
^{transferWidget}
<div>
<input type=submit value="_{MsgTransfer}">
<input onclick="crmnt( document.getElementById('hident2'), 5 )" value="_{MsgPlus5}" type="button">
<input onclick="crmnt( document.getElementById('hident2'), -5 )" value="_{MsgMinus5}" type="button">

2
templates/uploadJson.hamlet
View file

@ -5,5 +5,3 @@ $doctype 5
<form method=post enctype=#{enctype}>
^{uploadJsonWidget}
<div>
<input type=submit value="_{MsgSubmit}">

2
templates/upstock.hamlet
View file

@ -7,7 +7,5 @@ $doctype 5
<form method=post enctype=#{enctype}>
^{upstockWidget}
<div>
<input type=submit value="_{MsgFillup}">
<input onclick="crmnt( document.getElementById('crement'), 1 )" value="_{MsgIncrement}" type="button">
<input onclick="crmnt( document.getElementById('crement'), -1 )" value="_{MsgDecrement}" type="button">