diff --git a/Foundation.hs b/Foundation.hs index 878b1d6..c75b415 100755 --- a/Foundation.hs +++ b/Foundation.hs @@ -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 diff --git a/Handler/Avatar.hs b/Handler/Avatar.hs index 2937339..f37ead0 100755 --- a/Handler/Avatar.hs +++ b/Handler/Avatar.hs @@ -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 diff --git a/Handler/Buy.hs b/Handler/Buy.hs index 4df18b1..502f72d 100755 --- a/Handler/Buy.hs +++ b/Handler/Buy.hs @@ -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) diff --git a/Handler/CashCheck.hs b/Handler/CashCheck.hs index bb99550..90022f4 100755 --- a/Handler/CashCheck.hs +++ b/Handler/CashCheck.hs @@ -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) diff --git a/Handler/Common.hs b/Handler/Common.hs index e708b8f..228b650 100755 --- a/Handler/Common.hs +++ b/Handler/Common.hs @@ -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 - + |] , fieldEnctype = UrlEncoded } diff --git a/Handler/Modify.hs b/Handler/Modify.hs index 2936011..0eeb1bb 100755 --- a/Handler/Modify.hs +++ b/Handler/Modify.hs @@ -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 diff --git a/Handler/NewUser.hs b/Handler/NewUser.hs index 41b8b6a..d7bbbdc 100755 --- a/Handler/NewUser.hs +++ b/Handler/NewUser.hs @@ -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] diff --git a/Handler/Payout.hs b/Handler/Payout.hs index 8cc043a..0f1757d 100755 --- a/Handler/Payout.hs +++ b/Handler/Payout.hs @@ -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) diff --git a/Handler/Restock.hs b/Handler/Restock.hs index 6a82f4c..e583f55 100755 --- a/Handler/Restock.hs +++ b/Handler/Restock.hs @@ -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 diff --git a/Handler/Select.hs b/Handler/Select.hs index c124c14..c22efa5 100755 --- a/Handler/Select.hs +++ b/Handler/Select.hs @@ -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) diff --git a/Handler/Summary.hs b/Handler/Summary.hs index d3d7e97..245ff8c 100755 --- a/Handler/Summary.hs +++ b/Handler/Summary.hs @@ -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 diff --git a/Handler/Supplier.hs b/Handler/Supplier.hs index f26aa3f..5e00f8d 100755 --- a/Handler/Supplier.hs +++ b/Handler/Supplier.hs @@ -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 diff --git a/Handler/Transfer.hs b/Handler/Transfer.hs index eb348fe..3ebd7cd 100755 --- a/Handler/Transfer.hs +++ b/Handler/Transfer.hs @@ -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 diff --git a/Import/NoFoundation.hs b/Import/NoFoundation.hs index 9776eac..f3d9744 100755 --- a/Import/NoFoundation.hs +++ b/Import/NoFoundation.hs @@ -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 diff --git a/static/css/main.css b/static/css/main.css index e64cab6..5461044 100755 --- a/static/css/main.css +++ b/static/css/main.css @@ -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 { diff --git a/templates/buy.hamlet b/templates/buy.hamlet index e2d0166..eedef11 100755 --- a/templates/buy.hamlet +++ b/templates/buy.hamlet @@ -11,7 +11,6 @@ $doctype 5
^{buyWidget} -
- - - +
+