yammat/Handler/SupplierActions.hs

156 lines
4.7 KiB
Haskell
Raw Normal View History

2015-10-11 18:07:12 +00:00
module Handler.SupplierActions where
import Import
import Handler.Common
import qualified Data.Text as T
import Text.Blaze
2015-10-11 18:07:12 +00:00
getSupplierActionsR :: SupplierId -> Handler Html
getSupplierActionsR sId = do
mSup <- runDB $ get sId
case mSup of
Just sup ->
2018-09-04 16:06:12 +00:00
defaultLayout $ do
2018-09-04 16:16:03 +00:00
setTitleI (MsgSupplierActions (supplierIdent sup))
2015-10-11 18:07:12 +00:00
$(widgetFile "supplierActions")
Nothing -> do
setMessageI MsgSupplierUnknown
redirect SupplierR
data BevDigest = BevDigest
{ bdCrates :: Int
, bdTotal :: Int
, bdBev :: Beverage
}
getSupplierDigestR :: SupplierId -> Handler Html
getSupplierDigestR sId = do
mSup <- runDB $ get sId
case mSup of
Just sup -> do
master <- getYesod
2015-10-11 19:44:46 +00:00
bevs <- runDB $ selectList [BeverageSupplier ==. (Just sId)] [Asc BeverageIdent]
2015-10-11 18:07:12 +00:00
digests <- return $ map genBevDigest bevs
w <- return $ [whamlet|$newline always
2015-10-12 15:11:56 +00:00
<p>
#{supplierIdent sup}<br>
#{unTextarea $ supplierAddress sup}<br>
#{supplierTel sup}<br>
#{supplierEmail sup}<br>
<hr>
2015-10-12 15:11:56 +00:00
<p>
<b>
_{MsgCustomerId}: #{supplierCustomerId sup}
2017-01-21 16:20:15 +00:00
<p>&nbsp;
<table>
<thead>
<tr>
<th>
<span .transp>|
_{MsgArtNr}
<span .transp>|
<th>
_{MsgName}
<span .transp>|
<th>
_{MsgVolume}
<span .transp>|
<th>
_{MsgCrateCount}
<span .transp>|
<th>
_{MsgPricePerCrate}
<span .transp>|
<th>
_{MsgTotalValue}
<span .transp>|
<tr>
2017-01-21 20:59:30 +00:00
<th colspan="6" .transp>
|---:|---:|---:|---:|---:|---:|
$forall dig <- digests
$if bdCrates dig /= 0
2015-10-11 18:07:12 +00:00
<tr>
<td>
<span .transp>|
#{fromMaybe "" $ beverageArtNr $ bdBev dig}
<span .transp>|
<td>#{beverageIdent $ bdBev dig}
<span .transp>|
<td>#{formatIntVolume $ beverageMl $ bdBev dig}
<span .transp>|
<td>#{T.pack $ show $ bdCrates dig}
<span .transp>|
<td style="text-align: right;">#{formatIntCurrency $ fromMaybe 0 $ beveragePricePerCrate $ bdBev dig} #{appCurrency $ appSettings master}
<span .transp>|
<td style="text-align: right;">#{formatIntCurrency $ bdTotal dig} #{appCurrency $ appSettings master}
<span .transp>|
2015-10-12 15:11:56 +00:00
<tr>
<td colspan="3">
2017-01-21 16:20:15 +00:00
<span .transp>
|&nbsp;
2017-01-21 20:59:30 +00:00
|_{MsgTotalCrates}
2017-01-21 16:20:15 +00:00
<span .transp>
|&nbsp;
<span .transp>|
2015-10-12 15:11:56 +00:00
<td>#{T.pack $ show $ sum $ map bdCrates digests}
<span .transp>|
2015-10-12 15:11:56 +00:00
<td>_{MsgBuyValue}
<span .transp>|
<td style="text-align: right;">#{formatIntCurrency $ sum $ map bdTotal digests} #{appCurrency $ appSettings master}
<span .transp>|
2015-10-11 18:07:12 +00:00
|]
tableLayout w
Nothing -> do
setMessageI MsgSupplierUnknown
redirect SupplierR
-- tableLayout :: Widget -> WidgetT site0 IO ()
tableLayout :: WidgetT App IO () -> HandlerT App IO Markup
2015-10-11 18:07:12 +00:00
tableLayout widget = do
cont <- widgetToPageContent $ do
$(combineStylesheets 'StaticR
[ css_bootstrap_css
, css_main_css
])
widget
withUrlRenderer [hamlet|$newline never
$doctype 5
<html>
<head>
<meta charset="UTF-8">
^{pageHead cont}
<body>
^{pageBody cont}
|]
genBevDigest :: Entity Beverage -> BevDigest
genBevDigest bev =
BevDigest amount (amount * (fromMaybe 0 $ beveragePricePerCrate $ entityVal bev)) (entityVal bev)
where
amount =
if ((beverageMaxAmount (entityVal bev) - beverageAmount (entityVal bev)) `div` (fromMaybe 1 $ beveragePerCrate (entityVal bev))) < 0
then
0
else
((beverageMaxAmount (entityVal bev) - beverageAmount (entityVal bev)) `div` (fromMaybe 1 $ beveragePerCrate (entityVal bev)))
2015-10-11 18:07:12 +00:00
getDeleteSupplierR :: SupplierId -> Handler Html
getDeleteSupplierR sId = do
mSup <- runDB $ get sId
case mSup of
2015-12-06 20:14:58 +00:00
Just _ -> do
2015-10-11 18:07:12 +00:00
a <- runDB $ selectList [BeverageSupplier ==. (Just sId)] []
if null a
then do
runDB $ delete sId
setMessageI MsgSupplierDeleted
redirect SupplierR
else do
setMessageI MsgSupplierInUseError
redirect SupplierR
Nothing -> do
setMessageI MsgSupplierUnknown
redirect SupplierR