Merge pull request #83 from meoblast001/warnings-and-logo

Warnings and logo
This commit is contained in:
rys ostrovid 2016-01-22 07:48:02 +01:00
commit f4406e5500
10 changed files with 18 additions and 19 deletions

View file

@ -19,10 +19,8 @@ import Import.NoFoundation
import Database.Persist.Sql (ConnectionPool, runSqlPool) import Database.Persist.Sql (ConnectionPool, runSqlPool)
import Text.Hamlet (hamletFile) import Text.Hamlet (hamletFile)
import Text.Jasmine (minifym) import Text.Jasmine (minifym)
import Yesod.Auth.BrowserId (authBrowserId)
import Yesod.Default.Util (addStaticContentExternal) import Yesod.Default.Util (addStaticContentExternal)
import Yesod.Core.Types (Logger) import Yesod.Core.Types (Logger)
import Settings.StaticFiles
--snip --snip
import qualified Data.Text as T import qualified Data.Text as T
import Network.Wai as Wai import Network.Wai as Wai
@ -71,6 +69,7 @@ instance HasHttpManager App where
mkMessage "App" "messages" "de" mkMessage "App" "messages" "de"
renderMessage' :: (RenderMessage (HandlerSite m) message, MonadHandler m) => message -> m Text
renderMessage' e = do renderMessage' e = do
m <- getYesod m <- getYesod
l <- languages l <- languages

View file

@ -18,7 +18,6 @@ module Handler.Avatar where
import Import import Import
import Handler.Common import Handler.Common
import Data.Conduit.Binary import Data.Conduit.Binary
import qualified Data.Text as T
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import Data.ByteString.Base64 import Data.ByteString.Base64
@ -45,8 +44,8 @@ postNewAvatarR = do
case res of case res of
FormSuccess na -> do FormSuccess na -> do
raw <- runResourceT $ fileSource (avatarNewFile na) $$ sinkLbs raw <- runResourceT $ fileSource (avatarNewFile na) $$ sinkLbs
(thumb, hash) <- generateThumb $ B.concat $ L.toChunks raw (thumb, hash') <- generateThumb $ B.concat $ L.toChunks raw
runDB $ insert_ $ Avatar (avatarNewIdent na) thumb hash runDB $ insert_ $ Avatar (avatarNewIdent na) thumb hash'
setMessageI MsgAvatarUploadSuccessfull setMessageI MsgAvatarUploadSuccessfull
redirect HomeR redirect HomeR
_ -> do _ -> do
@ -114,11 +113,11 @@ updateAvatar aId (AvatarMod ident Nothing) =
runDB $ update aId [AvatarIdent =. ident] runDB $ update aId [AvatarIdent =. ident]
updateAvatar aId (AvatarMod ident (Just fi)) = do updateAvatar aId (AvatarMod ident (Just fi)) = do
raw <- runResourceT $ fileSource fi $$ sinkLbs raw <- runResourceT $ fileSource fi $$ sinkLbs
(thumb, hash) <- generateThumb $ B.concat $ L.toChunks raw (thumb, hash') <- generateThumb $ B.concat $ L.toChunks raw
runDB $ update aId runDB $ update aId
[ AvatarIdent =. ident [ AvatarIdent =. ident
, AvatarData =. thumb , AvatarData =. thumb
, AvatarHash =. hash , AvatarHash =. hash'
] ]
generateThumb :: ByteString -> Handler (ByteString, ByteString) generateThumb :: ByteString -> Handler (ByteString, ByteString)

View file

@ -17,14 +17,13 @@ module Handler.Buy where
import Import import Import
import Handler.Common import Handler.Common
import Text.Blaze.Internal
import Text.Shakespeare.Text import Text.Shakespeare.Text
getBuyR :: UserId -> BeverageId -> Handler Html getBuyR :: UserId -> BeverageId -> Handler Html
getBuyR uId bId = do getBuyR uId bId = do
mTup <- checkData uId bId mTup <- checkData uId bId
case mTup of case mTup of
Just (user, bev) -> do Just (_, bev) -> do
master <- getYesod master <- getYesod
(buyWidget, enctype) <- generateFormPost (buyWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm $ renderBootstrap3 BootstrapBasicForm

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,9 +202,9 @@ der Matemat
else else
return () -- do nothing return () -- do nothing
--sendMail :: MonadIO m => Text -> Text -> Text -> m () sendMail :: MonadIO m => Text -> Text -> TL.Text -> m ()
sendMail to subject body = sendMail to subject body =
renderSendMail liftIO $ renderSendMail
Mail Mail
{ mailFrom = Address Nothing "noreply" { mailFrom = Address Nothing "noreply"
, mailTo = [Address Nothing to] , mailTo = [Address Nothing to]

View file

@ -47,7 +47,7 @@ getUserReactivateR :: UserId -> Handler Html
getUserReactivateR uId = do getUserReactivateR uId = do
mUser <- runDB $ get uId mUser <- runDB $ get uId
case mUser of case mUser of
Just user -> do Just _ -> do
time <- liftIO getCurrentTime time <- liftIO getCurrentTime
let secs = R.read $ formatTime defaultTimeLocale "%s" time let secs = R.read $ formatTime defaultTimeLocale "%s" time
runDB $ update uId [UserTimestamp =. secs] runDB $ update uId [UserTimestamp =. secs]

View file

@ -41,7 +41,7 @@ merge [] (c:cs) = (Right $ entityVal c) : merge [] cs
merge (t:ts) [] = (Left $ entityVal t) : merge ts [] merge (t:ts) [] = (Left $ entityVal t) : merge ts []
merge (t:ts) (c:cs) merge (t:ts) (c:cs)
| transactionTime (entityVal t) < cashCheckTime (entityVal c) = (Left $ entityVal t) : merge 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 :: Int -> Handler Html
getJournalPageR p = do getJournalPageR p = do

View file

@ -110,7 +110,7 @@ getDeleteBeverageR :: BeverageId -> Handler Html
getDeleteBeverageR bId = do getDeleteBeverageR bId = do
mBev <- runDB $ get bId mBev <- runDB $ get bId
case mBev of case mBev of
Just bev -> do Just _ -> do
runDB $ delete bId runDB $ delete bId
setMessageI MsgItemDeleted setMessageI MsgItemDeleted
redirect HomeR redirect HomeR

View file

@ -3,7 +3,6 @@ module Handler.Supplier where
import Import import Import
import Handler.Common import Handler.Common
import Data.Maybe import Data.Maybe
import qualified Data.Text as T
getSupplierR :: Handler Html getSupplierR :: Handler Html
getSupplierR = do getSupplierR = do
@ -104,7 +103,6 @@ modifySupplierForm sup = SupConf
<*> aopt (selectField avatars) (bfs MsgSelectAvatar) (Just $ supplierAvatar sup) <*> aopt (selectField avatars) (bfs MsgSelectAvatar) (Just $ supplierAvatar sup)
<* bootstrapSubmit (msgToBSSubmit MsgSubmit) <* bootstrapSubmit (msgToBSSubmit MsgSubmit)
where where
master = getYesod
avatars = do avatars = do
ents <- runDB $ selectList [] [Asc AvatarIdent] ents <- runDB $ selectList [] [Asc AvatarIdent]
optionsPairs $ map (\ent -> ((avatarIdent $ entityVal ent), entityKey ent)) ents optionsPairs $ map (\ent -> ((avatarIdent $ entityVal ent), entityKey ent)) ents

View file

@ -3,6 +3,7 @@ module Handler.SupplierActions where
import Import import Import
import Handler.Common import Handler.Common
import qualified Data.Text as T import qualified Data.Text as T
import Text.Blaze
getSupplierActionsR :: SupplierId -> Handler Html getSupplierActionsR :: SupplierId -> Handler Html
getSupplierActionsR sId = do getSupplierActionsR sId = do
@ -69,6 +70,7 @@ getSupplierDigestR sId = do
redirect SupplierR redirect SupplierR
-- tableLayout :: Widget -> WidgetT site0 IO () -- tableLayout :: Widget -> WidgetT site0 IO ()
tableLayout :: WidgetT App IO () -> HandlerT App IO Markup
tableLayout widget = do tableLayout widget = do
cont <- widgetToPageContent $ do cont <- widgetToPageContent $ do
$(combineStylesheets 'StaticR $(combineStylesheets 'StaticR
@ -102,7 +104,7 @@ getDeleteSupplierR :: SupplierId -> Handler Html
getDeleteSupplierR sId = do getDeleteSupplierR sId = do
mSup <- runDB $ get sId mSup <- runDB $ get sId
case mSup of case mSup of
Just sup -> do Just _ -> do
a <- runDB $ selectList [BeverageSupplier ==. (Just sId)] [] a <- runDB $ selectList [BeverageSupplier ==. (Just sId)] []
if null a if null a
then do then do

BIN
config/favicon.ico Executable file → Normal file

Binary file not shown.

Before

Width:  |  Height:  |  Size: 1.3 KiB

After

Width:  |  Height:  |  Size: 318 B