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 1efac8a0ff
31 changed files with 204 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") $(widgetFile "copyright")
pc <- widgetToPageContent $ do pc <- widgetToPageContent $ do
$(combineStylesheets 'StaticR $(combineStylesheets 'StaticR
[ css_bootstrap_css [ css_bootstrap_min_css
, css_main_css , css_main_css
]) ])
$(combineScripts 'StaticR $(combineScripts 'StaticR

33
Handler/Avatar.hs
View file

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

23
Handler/Buy.hs
View file

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

13
Handler/CashCheck.hs
View file

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

10
Handler/Common.hs
View file

@ -17,6 +17,7 @@
module Handler.Common where module Handler.Common where
import Data.FileEmbed (embedFile) import Data.FileEmbed (embedFile)
import Yesod.Form.Bootstrap3
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.List as L import qualified Data.List as L
import qualified Data.Text.Lazy.Encoding as E import qualified Data.Text.Lazy.Encoding as E
@ -39,6 +40,13 @@ getRobotsR :: Handler TypedContent
getRobotsR = return $ TypedContent typePlain getRobotsR = return $ TypedContent typePlain
$ toContent $(embedFile "config/robots.txt") $ 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 :: Eq a => a -> [a] -> [a]
removeItem _ [] = [] removeItem _ [] = []
removeItem x (y:ys) removeItem x (y:ys)
@ -163,7 +171,7 @@ amountField = Field
Right (a, "") -> Right a Right (a, "") -> Right a
_ -> Left $ MsgInvalidInteger s _ -> Left $ MsgInvalidInteger s
, fieldView = \theId name attr val req -> toWidget [hamlet|$newline never , 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 , fieldEnctype = UrlEncoded
} }

37
Handler/Modify.hs
View file

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

38
Handler/NewUser.hs
View file

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

15
Handler/Payout.hs
View file

@ -26,13 +26,15 @@ data Payment = Payment
getPayoutR :: Handler Html getPayoutR :: Handler Html
getPayoutR = do getPayoutR = do
(payoutWidget, enctype) <- generateFormPost payoutForm (payoutWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm payoutForm
defaultLayout $ defaultLayout $
$(widgetFile "payout") $(widgetFile "payout")
postPayoutR :: Handler Html postPayoutR :: Handler Html
postPayoutR = do postPayoutR = do
((res, _), _) <- runFormPost payoutForm ((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm payoutForm
case res of case res of
FormSuccess payment -> do FormSuccess payment -> do
msg <- renderMessage' $ MsgPayout $ paymentDesc payment msg <- renderMessage' $ MsgPayout $ paymentDesc payment
@ -43,7 +45,8 @@ postPayoutR = do
setMessageI MsgNotPaidOut setMessageI MsgNotPaidOut
redirect JournalR redirect JournalR
payoutForm :: Form Payment payoutForm :: AForm Handler Payment
payoutForm = renderDivs $ Payment payoutForm = Payment
<$> areq currencyField (fieldSettingsLabel MsgValue) Nothing <$> areq currencyField (bfs MsgValue) Nothing
<*> areq textField (fieldSettingsLabel MsgDescription) 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 mBev <- runDB $ get bId
case mBev of case mBev of
Just bev -> do Just bev -> do
(upstockWidget, enctype) <- generateFormPost upstockForm (upstockWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm upstockForm
defaultLayout $ defaultLayout $
$(widgetFile "upstock") $(widgetFile "upstock")
Nothing -> do Nothing -> do
@ -42,7 +43,8 @@ postUpstockR bId = do
mBev <- runDB $ get bId mBev <- runDB $ get bId
case mBev of case mBev of
Just _ -> do Just _ -> do
((res, _), _) <- runFormPost upstockForm ((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm upstockForm
case res of case res of
FormSuccess c -> FormSuccess c ->
if c > 0 if c > 0
@ -53,6 +55,7 @@ postUpstockR bId = do
else do else do
setMessageI MsgNotStockedUp setMessageI MsgNotStockedUp
redirect $ UpstockR bId redirect $ UpstockR bId
_ -> do _ -> do
setMessageI MsgStockupError setMessageI MsgStockupError
redirect $ UpstockR bId redirect $ UpstockR bId
@ -60,19 +63,21 @@ postUpstockR bId = do
setMessageI MsgItemUnknown setMessageI MsgItemUnknown
redirect HomeR redirect HomeR
upstockForm :: Form Int upstockForm :: AForm Handler Int
upstockForm = renderDivs upstockForm = areq amountField (bfs MsgAmountAdded) (Just 1)
$ areq amountField (fieldSettingsLabel MsgAmountAdded) (Just 1) <* bootstrapSubmit (msgToBSSubmit MsgFillup)
getNewArticleR :: Handler Html getNewArticleR :: Handler Html
getNewArticleR = do getNewArticleR = do
(newArticleWidget, enctype) <- generateFormPost newArticleForm (newArticleWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm newArticleForm
defaultLayout $ defaultLayout $
$(widgetFile "newArticle") $(widgetFile "newArticle")
postNewArticleR :: Handler Html postNewArticleR :: Handler Html
postNewArticleR = do postNewArticleR = do
((result, _), _) <- runFormPost newArticleForm ((result, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm newArticleForm
case result of case result of
FormSuccess bev -> do FormSuccess bev -> do
runDB $ insert_ bev runDB $ insert_ bev
@ -82,20 +87,21 @@ postNewArticleR = do
setMessageI MsgItemNotAdded setMessageI MsgItemNotAdded
redirect HomeR redirect HomeR
newArticleForm :: Form Beverage newArticleForm :: AForm Handler 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) 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 (fieldSettingsLabel MsgName) Nothing <$> areq textField (bfs MsgName) Nothing
<*> areq currencyField (fieldSettingsLabel MsgPrice) (Just 100) <*> areq currencyField (bfs MsgPrice) (Just 100)
<*> areq amountField (fieldSettingsLabel MsgAmount) (Just 0) <*> areq amountField (bfs MsgAmount) (Just 0)
<*> areq amountField (fieldSettingsLabel MsgAmountWarning) (Just 0) <*> areq amountField (bfs MsgAmountWarning) (Just 0)
<*> pure 0 <*> pure 0
<*> areq amountField (fieldSettingsLabel MsgMaxAmount) (Just 200) <*> areq amountField (bfs MsgMaxAmount) (Just 200)
<*> aopt amountField (fieldSettingsLabel MsgAmountPerCrate) (Just $ Just 20) <*> aopt amountField (bfs MsgAmountPerCrate) (Just $ Just 20)
<*> aopt currencyField (fieldSettingsLabel MsgPricePerCrate) Nothing <*> aopt currencyField (bfs MsgPricePerCrate) Nothing
<*> areq volumeField (fieldSettingsLabel MsgVolume) (Just 500) <*> areq volumeField (bfs MsgVolume) (Just 500)
<*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) Nothing <*> aopt (selectField avatars) (bfs MsgSelectAvatar) Nothing
<*> aopt (selectField sups) (fieldSettingsLabel MsgSelectSupplier) Nothing <*> aopt (selectField sups) (bfs MsgSelectSupplier) Nothing
<*> aopt textField (fieldSettingsLabel MsgArtNr) Nothing <*> aopt textField (bfs MsgArtNr) Nothing
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)
where where
avatars = optionsPersistKey [] [Asc AvatarIdent] avatarIdent avatars = optionsPersistKey [] [Asc AvatarIdent] avatarIdent
sups = optionsPersistKey [] [Asc SupplierIdent] supplierIdent sups = optionsPersistKey [] [Asc SupplierIdent] supplierIdent

12
Handler/Select.hs
View file

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

12
Handler/Summary.hs
View file

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

51
Handler/Supplier.hs
View file

@ -1,7 +1,9 @@
module Handler.Supplier where module Handler.Supplier where
import Import import Import
import Handler.Common
import Data.Maybe import Data.Maybe
import qualified Data.Text as T
getSupplierR :: Handler Html getSupplierR :: Handler Html
getSupplierR = do getSupplierR = do
@ -11,13 +13,15 @@ getSupplierR = do
getNewSupplierR :: Handler Html getNewSupplierR :: Handler Html
getNewSupplierR = do getNewSupplierR = do
(newSupplierWidget, enctype) <- generateFormPost newSupplierForm (newSupplierWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm newSupplierForm
defaultLayout $ defaultLayout $
$(widgetFile "newSupplier") $(widgetFile "newSupplier")
postNewSupplierR :: Handler Html postNewSupplierR :: Handler Html
postNewSupplierR = do postNewSupplierR = do
((res, _), _) <- runFormPost newSupplierForm ((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm newSupplierForm
case res of case res of
FormSuccess sup -> do FormSuccess sup -> do
runDB $ insert_ sup runDB $ insert_ sup
@ -27,14 +31,15 @@ postNewSupplierR = do
setMessageI MsgSupplierNotCreated setMessageI MsgSupplierNotCreated
redirect SupplierR redirect SupplierR
newSupplierForm :: Form Supplier newSupplierForm :: AForm Handler Supplier
newSupplierForm = renderDivs $ Supplier newSupplierForm = Supplier
<$> areq textField (fieldSettingsLabel MsgName) Nothing <$> areq textField (bfs MsgName) Nothing
<*> areq textareaField (fieldSettingsLabel MsgAddress) Nothing <*> areq textareaField (bfs MsgAddress) Nothing
<*> areq textField (fieldSettingsLabel MsgTelNr) Nothing <*> areq textField (bfs MsgTelNr) Nothing
<*> areq emailField (fieldSettingsLabel MsgEmail) Nothing <*> areq emailField (bfs MsgEmail) Nothing
<*> areq textField (fieldSettingsLabel MsgCustomerId) Nothing <*> areq textField (bfs MsgCustomerId) Nothing
<*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) Nothing <*> aopt (selectField avatars) (bfs MsgSelectAvatar) Nothing
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)
where where
avatars = do avatars = do
ents <- runDB $ selectList [] [Asc AvatarIdent] ents <- runDB $ selectList [] [Asc AvatarIdent]
@ -54,7 +59,9 @@ getModifySupplierR sId = do
mSup <- runDB $ get sId mSup <- runDB $ get sId
case mSup of case mSup of
Just sup -> do Just sup -> do
(modifySupplierWidget, enctype) <- generateFormPost $ modifySupplierForm sup (modifySupplierWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm
$ modifySupplierForm sup
defaultLayout $ defaultLayout $
$(widgetFile "modifySupplier") $(widgetFile "modifySupplier")
Nothing -> do Nothing -> do
@ -66,7 +73,9 @@ postModifySupplierR sId = do
mSup <- runDB $ get sId mSup <- runDB $ get sId
case mSup of case mSup of
Just sup -> do Just sup -> do
((res, _), _) <- runFormPost $ modifySupplierForm sup ((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm
$ modifySupplierForm sup
case res of case res of
FormSuccess msup -> do FormSuccess msup -> do
runDB $ update sId runDB $ update sId
@ -85,15 +94,17 @@ postModifySupplierR sId = do
setMessageI MsgSupplierUnknown setMessageI MsgSupplierUnknown
redirect SupplierR redirect SupplierR
modifySupplierForm :: Supplier -> Form SupConf modifySupplierForm :: Supplier -> AForm Handler SupConf
modifySupplierForm sup = renderDivs $ SupConf modifySupplierForm sup = SupConf
<$> areq textField (fieldSettingsLabel MsgName) (Just $ supplierIdent sup) <$> areq textField (bfs MsgName) (Just $ supplierIdent sup)
<*> areq textareaField (fieldSettingsLabel MsgAddress) (Just $ supplierAddress sup) <*> areq textareaField (bfs MsgAddress) (Just $ supplierAddress sup)
<*> areq textField (fieldSettingsLabel MsgTelNr) (Just $ supplierTel sup) <*> areq textField (bfs MsgTelNr) (Just $ supplierTel sup)
<*> areq textField (fieldSettingsLabel MsgEmail) (Just $ supplierEmail sup) <*> areq textField (bfs MsgEmail) (Just $ supplierEmail sup)
<*> areq textField (fieldSettingsLabel MsgCustomerId) (Just $ supplierCustomerId sup) <*> areq textField (bfs MsgCustomerId) (Just $ supplierCustomerId sup)
<*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) (Just $ supplierAvatar sup) <*> aopt (selectField avatars) (bfs MsgSelectAvatar) (Just $ supplierAvatar sup)
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)
where where
master = getYesod
avatars = do avatars = do
ents <- runDB $ selectList [] [Asc AvatarIdent] ents <- runDB $ selectList [] [Asc AvatarIdent]
optionsPairs $ map (\ent -> ((avatarIdent $ entityVal ent), entityKey ent)) ents 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 mRecpt <- runDB $ get to
case mRecpt of case mRecpt of
Just recpt -> do Just recpt -> do
(transferWidget, enctype) <- generateFormPost transferForm (transferWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm transferForm
currency <- appCurrency <$> appSettings <$> getYesod currency <- appCurrency <$> appSettings <$> getYesod
defaultLayout $ do defaultLayout $ do
$(widgetFile "transfer") $(widgetFile "transfer")
@ -59,7 +60,8 @@ postTransferR from to = do
mRecpt <- runDB $ get to mRecpt <- runDB $ get to
case mRecpt of case mRecpt of
Just recpt -> do Just recpt -> do
((res, _), _) <- runFormPost transferForm ((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm transferForm
case res of case res of
FormSuccess amount -> do FormSuccess amount -> do
if amount < 0 if amount < 0
@ -83,9 +85,9 @@ postTransferR from to = do
setMessageI MsgUserUnknown setMessageI MsgUserUnknown
redirect HomeR redirect HomeR
transferForm :: Form Int transferForm :: AForm Handler Int
transferForm = renderDivs transferForm = areq currencyField (bfs MsgValue) (Just 0)
$ areq currencyField (fieldSettingsLabel MsgValue) (Just 0) <* bootstrapSubmit (msgToBSSubmit MsgTransfer)
notify :: User -> User -> Int -> App -> IO () notify :: User -> User -> Int -> App -> IO ()
notify sender rcpt amount master = do 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.Auth as Import
import Yesod.Core.Types as Import (loggerSet) import Yesod.Core.Types as Import (loggerSet)
import Yesod.Default.Config2 as Import import Yesod.Default.Config2 as Import
import Yesod.Form.Bootstrap3 as Import

12
static/css/main.css
View file

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

7
templates/buy.hamlet
View file

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

7
templates/buyCash.hamlet
View file

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

2
templates/cashCheck.hamlet
View file

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

2
templates/modify.hamlet
View file

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

2
templates/modifyAvatar.hamlet
View file

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

2
templates/modifySupplier.hamlet
View file

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

2
templates/modifyUser.hamlet
View file

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

2
templates/newArticle.hamlet
View file

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

2
templates/newAvatar.hamlet
View file

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

2
templates/newSupplier.hamlet
View file

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

2
templates/newUser.hamlet
View file

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

2
templates/payout.hamlet
View file

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

3
templates/recharge.hamlet
View file

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

2
templates/upstock.hamlet
View file

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