Merge pull request #83 from meoblast001/warnings-and-logo
Warnings and logo
This commit is contained in:
commit
f4406e5500
10 changed files with 18 additions and 19 deletions
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
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 |
Loading…
Reference in a new issue