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 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

View file

@ -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)

View file

@ -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

View file

@ -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]

View file

@ -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]

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) (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

View file

@ -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

View file

@ -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

View file

@ -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

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