Resolved warnings in Handler/Common.hs

This commit is contained in:
Braden Walters 2016-01-21 22:19:41 +01:00
parent 8398c1354e
commit 625c0cfd9b

View file

@ -19,6 +19,7 @@ module Handler.Common where
import Data.FileEmbed (embedFile) import Data.FileEmbed (embedFile)
import Yesod.Form.Bootstrap3 import Yesod.Form.Bootstrap3
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
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
import qualified Data.Text.Read as R import qualified Data.Text.Read as R
@ -40,7 +41,7 @@ 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 :: AppMessage -> BootstrapSubmit AppMessage
msgToBSSubmit t = BootstrapSubmit msgToBSSubmit t = BootstrapSubmit
{ bsValue = t { bsValue = t
, bsClasses = "btn-default" , bsClasses = "btn-default"
@ -105,6 +106,7 @@ volumeField = Field
showVal = either id (pack . showA) showVal = either id (pack . showA)
showA x = show ((fromIntegral x :: Double) / 1000) showA x = show ((fromIntegral x :: Double) / 1000)
barcodeField :: (RenderMessage (HandlerSite m) FormMessage, Monad m) => Field m [Text]
barcodeField = Field barcodeField = Field
{ fieldParse = parseHelper $ Right . removeItem "" . L.nub . T.splitOn ", " { fieldParse = parseHelper $ Right . removeItem "" . L.nub . T.splitOn ", "
, fieldView = \theId name attrs val isReq -> toWidget [hamlet|$newline never , fieldView = \theId name attrs val isReq -> toWidget [hamlet|$newline never
@ -185,7 +187,7 @@ checkAlert bId = do
if beverageAmount bev < beverageAlertAmount bev if beverageAmount bev < beverageAlertAmount bev
then do then do
master <- getYesod master <- getYesod
let to = appEmail $ appSettings master let to = appEmail $ appSettings master
liftIO $ sendMail to "Niedriger Bestand" liftIO $ sendMail to "Niedriger Bestand"
[stext| [stext|
Hallo, Hallo,
@ -200,7 +202,7 @@ der Matemat
else else
return () -- do nothing return () -- do nothing
--sendMail :: MonadIO m => Text -> Text -> Text -> m () sendMail :: Text -> Text -> TL.Text -> IO ()
sendMail to subject body = sendMail to subject body =
renderSendMail renderSendMail
Mail Mail