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