-- | Common handler functions. module Handler.Common where import Data.FileEmbed (embedFile) import qualified Data.Text as T import qualified Data.Text.Lazy.Encoding as E import qualified Data.Text.Read as R import Yesod.Form.Functions import Text.Shakespeare.Text import Network.Mail.Mime import Import -- These handlers embed files in the executable at compile time to avoid a -- runtime dependency, and for efficiency. getFaviconR :: Handler TypedContent getFaviconR = return $ TypedContent "image/x-icon" $ toContent $(embedFile "config/favicon.ico") getRobotsR :: Handler TypedContent getRobotsR = return $ TypedContent typePlain $ toContent $(embedFile "config/robots.txt") updateCashier :: Int -> Text -> Handler () updateCashier amount desc = do mCashier <- runDB $ selectFirst [] [Asc CashierId] trans <- liftIO $ (\time -> return $ Transaction desc amount time) =<< getCurrentTime case mCashier of Just entCash -> do runDB $ update (entityKey entCash) [CashierBalance +=. amount] runDB $ insert_ trans Nothing -> do runDB $ insert_ $ Cashier amount runDB $ insert_ trans getCashierBalance :: Handler Int getCashierBalance = do mCashier <- runDB $ selectFirst [] [Asc CashierId] case mCashier of Just cashier -> do return $ cashierBalance $ entityVal cashier Nothing -> do return 0 currencyField :: (RenderMessage (HandlerSite m) FormMessage, Show a, Monad m, Integral a) => Field m a currencyField = Field { fieldParse = parseHelper $ \rawVals -> case R.double (prependZero rawVals) of Right (a, "") -> Right $ floor $ 100 * a _ -> Left $ MsgInvalidNumber rawVals , fieldView = \theId name attr val req -> toWidget [hamlet|$newline never