fixed volume display

Handler/Common.hs

@@ -58,6 +58,21 @@ currencyField = Field
     showVal = either id (pack . showA)
     showA x = show ((fromIntegral x :: Double) / 100)
 
+volumeField :: (RenderMessage (HandlerSite m) FormMessage, Show a, Monad m, Integral a) => Field m a
+volumeField = Field
+  { fieldParse = parseHelper $ \rawVals ->
+      case R.double (prependZero rawVals) of
+        Right (a, "") -> Right $ floor $ 1000 * a
+        _             -> Left $ MsgInvalidNumber rawVals
+  , fieldView = \theId name attr val req -> toWidget [hamlet|$newline never
+      <input id=#{theId} name=#{name} *{attr} type="number" step=0.01 min=0 :req:required="required" value=#{showVal val}>
+      |]
+  , fieldEnctype = UrlEncoded
+  }
+  where
+    showVal = either id (pack . showA)
+    showA x = show ((fromIntegral x :: Double) / 1000)
+
 amountField :: (RenderMessage (HandlerSite m) FormMessage, Show a, Monad m, Integral a) => Field m a
 amountField = Field
   { fieldParse = parseHelper $ \s ->

Handler/Modify.hs

@@ -46,7 +46,7 @@ modifyForm bev = renderDivs $ Beverage
   <*> areq currencyField (fieldSettingsLabel MsgPrice) (Just $ beveragePrice bev)
   <*> areq amountField (fieldSettingsLabel MsgCurrentStock) (Just $ beverageAmount bev)
   <*> areq amountField (fieldSettingsLabel MsgAnnouncedStock) (Just $ beverageAlertAmount bev)
-  <*> areq currencyField (fieldSettingsLabel MsgVolume) (Just $ beverageMl bev)
+  <*> areq volumeField (fieldSettingsLabel MsgVolume) (Just $ beverageMl bev)
   <*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) (Just $ beverageAvatar bev)
   where
     avatars = do

Handler/Restock.hs

@@ -72,7 +72,7 @@ newArticleForm = renderDivs $ Beverage
   <*> areq currencyField (fieldSettingsLabel MsgPrice) (Just 100)
   <*> areq amountField (fieldSettingsLabel MsgAmount) (Just 0)
   <*> areq amountField (fieldSettingsLabel MsgAmountWarning) (Just 0)
-  <*> areq currencyField (fieldSettingsLabel MsgVolume) (Just 500)
+  <*> areq volumeField (fieldSettingsLabel MsgVolume) (Just 500)
   <*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) Nothing
   where
     avatars = do