diff --git a/Foundation.hs b/Foundation.hs index c75b415..f56228e 100755 --- a/Foundation.hs +++ b/Foundation.hs @@ -19,10 +19,8 @@ import Import.NoFoundation import Database.Persist.Sql (ConnectionPool, runSqlPool) import Text.Hamlet (hamletFile) import Text.Jasmine (minifym) -import Yesod.Auth.BrowserId (authBrowserId) import Yesod.Default.Util (addStaticContentExternal) import Yesod.Core.Types (Logger) -import Settings.StaticFiles --snip import qualified Data.Text as T import Network.Wai as Wai @@ -71,6 +69,7 @@ instance HasHttpManager App where mkMessage "App" "messages" "de" +renderMessage' :: (RenderMessage (HandlerSite m) message, MonadHandler m) => message -> m Text renderMessage' e = do m <- getYesod l <- languages diff --git a/Handler/Avatar.hs b/Handler/Avatar.hs index f37ead0..3a3e87f 100755 --- a/Handler/Avatar.hs +++ b/Handler/Avatar.hs @@ -18,7 +18,6 @@ module Handler.Avatar where import Import import Handler.Common import Data.Conduit.Binary -import qualified Data.Text as T import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.ByteString.Base64 @@ -45,8 +44,8 @@ postNewAvatarR = do case res of FormSuccess na -> do raw <- runResourceT $ fileSource (avatarNewFile na) $$ sinkLbs - (thumb, hash) <- generateThumb $ B.concat $ L.toChunks raw - runDB $ insert_ $ Avatar (avatarNewIdent na) thumb hash + (thumb, hash') <- generateThumb $ B.concat $ L.toChunks raw + runDB $ insert_ $ Avatar (avatarNewIdent na) thumb hash' setMessageI MsgAvatarUploadSuccessfull redirect HomeR _ -> do @@ -114,11 +113,11 @@ updateAvatar aId (AvatarMod ident Nothing) = runDB $ update aId [AvatarIdent =. ident] updateAvatar aId (AvatarMod ident (Just fi)) = do raw <- runResourceT $ fileSource fi $$ sinkLbs - (thumb, hash) <- generateThumb $ B.concat $ L.toChunks raw + (thumb, hash') <- generateThumb $ B.concat $ L.toChunks raw runDB $ update aId [ AvatarIdent =. ident , AvatarData =. thumb - , AvatarHash =. hash + , AvatarHash =. hash' ] generateThumb :: ByteString -> Handler (ByteString, ByteString) diff --git a/Handler/Buy.hs b/Handler/Buy.hs index 502f72d..3527681 100755 --- a/Handler/Buy.hs +++ b/Handler/Buy.hs @@ -17,14 +17,13 @@ module Handler.Buy where import Import import Handler.Common -import Text.Blaze.Internal import Text.Shakespeare.Text getBuyR :: UserId -> BeverageId -> Handler Html getBuyR uId bId = do mTup <- checkData uId bId case mTup of - Just (user, bev) -> do + Just (_, bev) -> do master <- getYesod (buyWidget, enctype) <- generateFormPost $ renderBootstrap3 BootstrapBasicForm diff --git a/Handler/Common.hs b/Handler/Common.hs index 228b650..7b7a449 100755 --- a/Handler/Common.hs +++ b/Handler/Common.hs @@ -19,6 +19,7 @@ module Handler.Common where import Data.FileEmbed (embedFile) import Yesod.Form.Bootstrap3 import qualified Data.Text as T +import qualified Data.Text.Lazy as TL import qualified Data.List as L import qualified Data.Text.Lazy.Encoding as E import qualified Data.Text.Read as R @@ -40,7 +41,7 @@ getRobotsR :: Handler TypedContent getRobotsR = return $ TypedContent typePlain $ toContent $(embedFile "config/robots.txt") --- msgToBSSubmit :: T.Text -> BootstrapSubmit T.Text +msgToBSSubmit :: AppMessage -> BootstrapSubmit AppMessage msgToBSSubmit t = BootstrapSubmit { bsValue = t , bsClasses = "btn-default" @@ -105,6 +106,7 @@ volumeField = Field showVal = either id (pack . showA) showA x = show ((fromIntegral x :: Double) / 1000) +barcodeField :: (RenderMessage (HandlerSite m) FormMessage, Monad m) => Field m [Text] barcodeField = Field { fieldParse = parseHelper $ Right . removeItem "" . L.nub . T.splitOn ", " , fieldView = \theId name attrs val isReq -> toWidget [hamlet|$newline never @@ -185,7 +187,7 @@ checkAlert bId = do if beverageAmount bev < beverageAlertAmount bev then do master <- getYesod - let to = appEmail $ appSettings master + let to = appEmail $ appSettings master liftIO $ sendMail to "Niedriger Bestand" [stext| Hallo, @@ -200,9 +202,9 @@ der Matemat else return () -- do nothing ---sendMail :: MonadIO m => Text -> Text -> Text -> m () +sendMail :: MonadIO m => Text -> Text -> TL.Text -> m () sendMail to subject body = - renderSendMail + liftIO $ renderSendMail Mail { mailFrom = Address Nothing "noreply" , mailTo = [Address Nothing to] diff --git a/Handler/Home.hs b/Handler/Home.hs index c936a27..7ec6ce1 100755 --- a/Handler/Home.hs +++ b/Handler/Home.hs @@ -47,7 +47,7 @@ getUserReactivateR :: UserId -> Handler Html getUserReactivateR uId = do mUser <- runDB $ get uId case mUser of - Just user -> do + Just _ -> do time <- liftIO getCurrentTime let secs = R.read $ formatTime defaultTimeLocale "%s" time runDB $ update uId [UserTimestamp =. secs] diff --git a/Handler/Journal.hs b/Handler/Journal.hs index 3f37efb..dbfc52d 100755 --- a/Handler/Journal.hs +++ b/Handler/Journal.hs @@ -41,7 +41,7 @@ merge [] (c:cs) = (Right $ entityVal c) : merge [] cs merge (t:ts) [] = (Left $ entityVal t) : merge ts [] merge (t:ts) (c:cs) | transactionTime (entityVal t) < cashCheckTime (entityVal c) = (Left $ entityVal t) : merge ts (c:cs) - | transactionTime (entityVal t) > cashCheckTime (entityVal c) = (Right $ entityVal c) : merge (t:ts) cs + | otherwise = (Right $ entityVal c) : merge (t:ts) cs getJournalPageR :: Int -> Handler Html getJournalPageR p = do diff --git a/Handler/Modify.hs b/Handler/Modify.hs index 0eeb1bb..ab991e5 100755 --- a/Handler/Modify.hs +++ b/Handler/Modify.hs @@ -110,7 +110,7 @@ getDeleteBeverageR :: BeverageId -> Handler Html getDeleteBeverageR bId = do mBev <- runDB $ get bId case mBev of - Just bev -> do + Just _ -> do runDB $ delete bId setMessageI MsgItemDeleted redirect HomeR diff --git a/Handler/Supplier.hs b/Handler/Supplier.hs index 5e00f8d..fcba778 100755 --- a/Handler/Supplier.hs +++ b/Handler/Supplier.hs @@ -3,7 +3,6 @@ module Handler.Supplier where import Import import Handler.Common import Data.Maybe -import qualified Data.Text as T getSupplierR :: Handler Html getSupplierR = do @@ -104,7 +103,6 @@ modifySupplierForm sup = SupConf <*> aopt (selectField avatars) (bfs MsgSelectAvatar) (Just $ supplierAvatar sup) <* bootstrapSubmit (msgToBSSubmit MsgSubmit) where - master = getYesod avatars = do ents <- runDB $ selectList [] [Asc AvatarIdent] optionsPairs $ map (\ent -> ((avatarIdent $ entityVal ent), entityKey ent)) ents diff --git a/Handler/SupplierActions.hs b/Handler/SupplierActions.hs index 4f64f82..de78dcd 100755 --- a/Handler/SupplierActions.hs +++ b/Handler/SupplierActions.hs @@ -3,6 +3,7 @@ module Handler.SupplierActions where import Import import Handler.Common import qualified Data.Text as T +import Text.Blaze getSupplierActionsR :: SupplierId -> Handler Html getSupplierActionsR sId = do @@ -69,6 +70,7 @@ getSupplierDigestR sId = do redirect SupplierR -- tableLayout :: Widget -> WidgetT site0 IO () +tableLayout :: WidgetT App IO () -> HandlerT App IO Markup tableLayout widget = do cont <- widgetToPageContent $ do $(combineStylesheets 'StaticR @@ -102,7 +104,7 @@ getDeleteSupplierR :: SupplierId -> Handler Html getDeleteSupplierR sId = do mSup <- runDB $ get sId case mSup of - Just sup -> do + Just _ -> do a <- runDB $ selectList [BeverageSupplier ==. (Just sId)] [] if null a then do diff --git a/config/favicon.ico b/config/favicon.ico old mode 100755 new mode 100644 index 9dd5f35..bba52f3 Binary files a/config/favicon.ico and b/config/favicon.ico differ