diff --git a/README.fr.md b/README.fr.md index ab85c4b..be9682d 100644 --- a/README.fr.md +++ b/README.fr.md @@ -29,6 +29,8 @@ La page « À propos de nous » est personnalisable depuis l'onglet [« À propo La page « Contacts » est personnalisable depuis l'onglet [« Contactez-nous »](https://salonfr-w3cpovaqka-de.a.run.app/admin/contact/business/1) du menu [« Entreprise »](https://salonfr-w3cpovaqka-de.a.run.app/admin/business) du groupe « Données ». +La page [« Accueil »](https://salon-w3cpovaqka-de.a.run.app) est personnalisable depuis l'onglet [« Marque »](https://salon-w3cpovaqka-de.a.run.app/admin/business/1/brand) du menu [« Entreprise »](https://salon-w3cpovaqka-de.a.run.app/admin/business) du groupe « Données ». + Actuellement, l'application ne prend en charge qu'une seule entreprise. Un support multi-métiers est prévu pour les futures versions de l'application. ## Utilisateur diff --git a/README.md b/README.md index 3ef9562..10e3174 100644 --- a/README.md +++ b/README.md @@ -29,6 +29,8 @@ The "About Us" page can be customized from the ["About Us"](https://salon-w3cpov The "Contacts" page can be customized from the ["Contact Us"](https://salon-w3cpovaqka-de.a.run.app/admin/contact/business/1) tab in the menu ["Business"](https://salon-w3cpovaqka-de.a.run.app/admin/business) in the group "Data". +The [“Home”](https://salon-w3cpovaqka-de.a.run.app) page is customizable from the [“Brand”](https://salon-w3cpovaqka-de.a.run.app/admin/business/1/brand) tab of the [“Business”](https://salon-w3cpovaqka-de.a.run.app/admin/business) menu in the “Data” group. + Currently, the app only supports one business. Multi-business support is planned for future versions of the application. ## User diff --git a/README.ro.md b/README.ro.md index a6a4db1..d559482 100644 --- a/README.ro.md +++ b/README.ro.md @@ -29,6 +29,8 @@ Pagina „Despre noi” poate fi personalizată din fila [„Despre noi”](http Pagina „Contacte” poate fi personalizată din fila [„Contactați-ne”](https://salonro-w3cpovaqka-de.a.run.app/admin/contact/business/1) din meniul [„Afacere”](https://salonro-w3cpovaqka-de.a.run.app/admin/business) din grupul „Date”. +Pagina [„Acasă”](https://salon-w3cpovaqka-de.a.run.app) este personalizabilă din fila [„Marca”](https://salon-w3cpovaqka-de.a.run.app/admin/business/1/brand) din meniul [„Afacere”](https://salon-w3cpovaqka-de.a.run.app/admin/business) din grupul „Date”. + În prezent, aplicația acceptă o singură afacere. Asistența multi-business este planificată pentru versiunile viitoare ale aplicației. ## Utilizator diff --git a/README.ru.md b/README.ru.md index 6019e2d..101e35f 100644 --- a/README.ru.md +++ b/README.ru.md @@ -29,6 +29,8 @@ Страницу «Контакты» можно настроить на вкладке [«Контакты»](https://salonru-w3cpovaqka-de.a.run.app/admin/contact/business/1) в меню [«Бизнес»](https://salonru-w3cpovaqka-de.a.run.app/admin/business) в группе «Данные». +[«Главная»](https://salon-w3cpovaqka-de.a.run.app) страница настраивается на вкладке [«Бренд»](https://salon-w3cpovaqka-de.a.run.app/admin/business/1/brand) меню [«Организация»](https://salon-w3cpovaqka-de.a.run.app/admin/business) в группе «Данные». + В настоящее время приложение поддерживает только один бизнес. Поддержка нескольких организаций планируется в будущих версиях приложения. ## Пользователь diff --git a/config/models.persistentmodels b/config/models.persistentmodels index 3f59ab7..c519dd0 100644 --- a/config/models.persistentmodels +++ b/config/models.persistentmodels @@ -99,6 +99,7 @@ User deriving Typeable Brand + business BusinessId OnDeleteCascade mark ByteString Maybe markMime Text Maybe markWidth Text Maybe diff --git a/config/routes.yesodroutes b/config/routes.yesodroutes index f783cba..82ce5d5 100644 --- a/config/routes.yesodroutes +++ b/config/routes.yesodroutes @@ -59,7 +59,7 @@ /aov StatsAovR GET /admin AdminR: - + /delete/contact/business/#BusinessId/#ContactUsId BusinessContactDeleteR POST /form/contact/business/#BusinessId/#ContactUsId BusinessContactEditR GET POST /form/contact/business/#BusinessId BusinessContactCreateR GET @@ -86,12 +86,12 @@ /business/create BusinessCreateR GET /business BusinessR GET POST - /brand/#BrandId/ico BrandIcoR GET - /brand/#BrandId/mark BrandMarkR GET - /brand/delete BrandDeleteR POST - /brand/#BrandId/edit BrandEditR GET POST - /brand/create BrandCreateR GET - /brand BrandR GET POST + /business/#BusinessId/brand/#BrandId/ico BrandIcoR GET + /business/#BusinessId/brand/#BrandId/mark BrandMarkR GET + /business/#BusinessId/brand/#BrandId/delete BrandDeleteR POST + /business/#BusinessId/brand/#BrandId/edit BrandEditR GET POST + /business/#BusinessId/brand/create BrandCreateR GET + /business/#BusinessId/brand BrandR GET POST /delete/experts/#RoleId/+Services AdmExpertDeleteR POST diff --git a/messages/en.msg b/messages/en.msg index 07fbaaa..30d2a2c 100644 --- a/messages/en.msg +++ b/messages/en.msg @@ -346,6 +346,10 @@ Doc0065 hrefContactUs@Text hrefBusiness@Text: The "Contacts" page can be customi Doc0066 hrefBusiness@Text: The "Contacts" page can be customized from the "Contact Us" tab in the menu "Business" in the group "Data". +Doc0067 hrefHome@Text hrefBrand@Text hrefBusiness@Text: The “Home” page is customizable from the “Brand” tab of the “Business” menu in the “Data” group. + +Doc0068 hrefHome@Text hrefBusiness@Text: The “Home” page is customizable from the “Brand” tab of the “Business” menu in the “Data” group. + Doc007: Currently, the app only supports one business. Multi-business support is planned for future versions of the application. Doc008 href@Text: Application users, including clients, employees and administrators, can be registered through the "Registration" form. diff --git a/messages/fr.msg b/messages/fr.msg index 72d4db7..3f20b26 100644 --- a/messages/fr.msg +++ b/messages/fr.msg @@ -346,6 +346,10 @@ Doc0065 hrefContactUs hrefBusiness: La page « Contacts » est personnalisable d Doc0066 hrefBusiness: La page « Contacts » est personnalisable depuis l'onglet « Contactez-nous » du menu « Entreprise » du groupe « Données ». +Doc0067 hrefHome hrefBrand hrefBusiness: La page « Accueil » est personnalisable depuis l'onglet « Marque » du menu « Entreprise » du groupe « Données ». + +Doc0068 hrefHome hrefBusiness: La page « Accueil » est personnalisable depuis l'onglet « Marque » du menu « Entreprise » du groupe « Données ». + Doc007: Actuellement, l'application ne prend en charge qu'une seule entreprise. Un support multi-métiers est prévu pour les futures versions de l'application. Doc008 href: Les utilisateurs de l'application, y compris les clients, les employés et les administrateurs, peuvent être enregistrés via le formulaire « Inscription ». diff --git a/messages/ro.msg b/messages/ro.msg index 64354c9..acf4ad3 100644 --- a/messages/ro.msg +++ b/messages/ro.msg @@ -346,6 +346,10 @@ Doc0065 hrefContactUs hrefBusiness: Pagina „Contacte” poate fi personalizat Doc0066 hrefBusiness: Pagina „Contacte” poate fi personalizată din fila „Contactați-ne” din meniul „Afacere” din grupul „Date”. +Doc0067 hrefHome hrefBrand hrefBusiness: Pagina „Acasă” este personalizabilă din fila „Marca” din meniul „Afacere” din grupul „Date”. + +Doc0068 hrefHome hrefBusiness: Pagina „Acasă” este personalizabilă din fila „Marca” din meniul „Afacere” din grupul „Date”. + Doc007: În prezent, aplicația acceptă o singură afacere. Asistența multi-business este planificată pentru versiunile viitoare ale aplicației. Doc008 href: Utilizatorii aplicației, inclusiv clienți, angajați și administratori, pot fi înregistrați prin intermediul formularului „Înregistrare”. diff --git a/messages/ru.msg b/messages/ru.msg index c975d2d..5aa71ed 100644 --- a/messages/ru.msg +++ b/messages/ru.msg @@ -338,13 +338,17 @@ Doc0061 hrefSchedule hrefBusiness: Дополнительно в разделе Doc0062 hrefBusiness: Дополнительно в разделе «Организация» на вкладке «График» можно добавить график работы организации на каждый день. -Doc0063 hrefAboutUs hrefBusiness: Страницу «О нас» можно настроить на вкладке «О нас» в меню «Бизнес» в группе «Данные». +Doc0063 hrefAboutUs hrefBusiness: Страницу «О нас» можно настроить на вкладке «О нас» в меню «Организация» в группе «Данные». -Doc0064 hrefBusiness: Страницу «О нас» можно настроить на вкладке «О нас» в меню «Бизнес» в группе «Данные». +Doc0064 hrefBusiness: Страницу «О нас» можно настроить на вкладке «О нас» в меню «Организация» в группе «Данные». -Doc0065 hrefContactUs hrefBusiness: Страницу «Контакты» можно настроить на вкладке «Контакты» в меню «Бизнес» в группе «Данные». +Doc0065 hrefContactUs hrefBusiness: Страницу «Контакты» можно настроить на вкладке «Контакты» в меню «Организация» в группе «Данные». -Doc0066 hrefBusiness: Страницу «Контакты» можно настроить на вкладке «Контакты» в меню «Бизнес» в группе «Данные». +Doc0066 hrefBusiness: Страницу «Контакты» можно настроить на вкладке «Контакты» в меню «Организация» в группе «Данные». + +Doc0067 hrefHome hrefBrand hrefBusiness: «Главная» страница настраивается на вкладке «Бренд» меню «Организация» в группе «Данные». + +Doc0068 hrefHome hrefBusiness: «Главная» страница настраивается на вкладке «Бренд» меню «Организация» в группе «Данные». Doc007: В настоящее время приложение поддерживает только один бизнес. Поддержка нескольких организаций планируется в будущих версиях приложения. diff --git a/src/Admin/Brand.hs b/src/Admin/Brand.hs deleted file mode 100644 index 1ed6c92..0000000 --- a/src/Admin/Brand.hs +++ /dev/null @@ -1,232 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TupleSections #-} - -module Admin.Brand - ( getBrandR - , postBrandR - , getBrandEditR - , postBrandEditR - , postBrandDeleteR - , getBrandMarkR - , getBrandIcoR - , getBrandCreateR - ) where - -import Control.Monad (void) -import Data.Maybe (isNothing) -import Text.Hamlet (Html) -import Data.Text.Encoding (encodeUtf8) -import Yesod.Auth (maybeAuth, Route (LoginR)) -import Yesod.Core - ( Yesod(defaultLayout), setTitleI, TypedContent (TypedContent) - , preEscapedToMarkup, getMessages, FileInfo (fileContentType), redirect - , SomeMessage (SomeMessage), setUltDestCurrent, fileSourceByteString - , typeSvg, ToContent (toContent), emptyContent, addMessageI - ) -import Yesod.Form.Fields (unTextarea, fileField, textField, textareaField) -import Yesod.Form.Functions (generateFormPost, mopt, runFormPost) -import Yesod.Form.Types - ( MForm, FormResult (FormSuccess) - , FieldView (fvLabel, fvInput, fvId) - , FieldSettings (FieldSettings, fsLabel, fsTooltip, fsId, fsName, fsAttrs) - ) -import Settings (widgetFile) - -import Yesod.Persist.Core (YesodPersist(runDB)) -import Database.Persist (Entity (Entity, entityVal), PersistStoreWrite (insert_)) -import Database.Esqueleto.Experimental - (selectOne, from, table, delete, val, where_ - , (^.), (==.), (=.), set, update - ) - -import Foundation - ( Handler, Widget - , Route (ProfileR, AdminR, AuthR, PhotoPlaceholderR, AccountPhotoR, StaticR) - , AdminR (BrandR, BrandCreateR, BrandEditR, BrandDeleteR, BrandMarkR, BrandIcoR) - , AppMessage - ( MsgBrand, MsgYesDelete, MsgPleaseConfirm, MsgPhoto, MsgBack - , MsgDeleteAreYouSure, MsgSave, MsgCancel, MsgBrandMark - , MsgNoBrandYet, MsgBrandName, MsgBrandStrapline, MsgFavicon, MsgMore - , MsgRecordAdded, MsgRecordEdited, MsgRecordDeleted, MsgNavigationMenu - , MsgLogin, MsgUserProfile, MsgEdit, MsgDel, MsgMarkWidth, MsgMarkHeight - ) - ) - -import Model - ( BrandId - , Brand - (Brand, brandName, brandStrapline, brandMore, brandMark, brandIco - , brandMarkMime, brandIcoMime, brandMarkHeight, brandMarkWidth - ) - , EntityField - ( BrandId, BrandMark, BrandMarkWidth, BrandMarkHeight, BrandName - , BrandStrapline, BrandMore, BrandMarkMime, BrandIco, BrandIcoMime - ) - ) - -import Settings.StaticFiles (img_add_photo_alternate_FILL0_wght400_GRAD0_opsz48_svg) - -import Menu (menu) - - -getBrandIcoR :: BrandId -> Handler TypedContent -getBrandIcoR bid = do - brand <- runDB $ selectOne $ do - x <- from $ table @Brand - where_ $ x ^. BrandId ==. val bid - return x - return $ case brand of - Just (Entity _ (Brand _ _ _ _ _ _ (Just bs) (Just mime) _)) -> TypedContent (encodeUtf8 mime) (toContent bs) - _ -> TypedContent typeSvg emptyContent - - -getBrandMarkR :: BrandId -> Handler TypedContent -getBrandMarkR bid = do - brand <- runDB $ selectOne $ do - x <- from $ table @Brand - where_ $ x ^. BrandId ==. val bid - return x - return $ case brand of - Just (Entity _ (Brand (Just bs) (Just mime) _ _ _ _ _ _ _)) -> TypedContent (encodeUtf8 mime) (toContent bs) - _ -> TypedContent typeSvg emptyContent - - -postBrandDeleteR :: Handler Html -postBrandDeleteR = do - runDB $ delete $ void $ from (table @Brand) - addMessageI "info" MsgRecordDeleted - redirect $ AdminR BrandR - - -postBrandEditR :: BrandId -> Handler Html -postBrandEditR bid = do - ((fr,fw),et) <- runFormPost $ formBrand Nothing - case fr of - FormSuccess (r,mmark,mico) -> do - (mark,markMime) <- (,fileContentType <$> mmark) <$> mapM fileSourceByteString mmark - (ico,icoMime) <- (,fileContentType <$> mico) <$> mapM fileSourceByteString mico - runDB $ update $ \x -> do - set x [ BrandMarkWidth =. val (brandMarkWidth r) - , BrandMarkHeight =. val (brandMarkHeight r) - , BrandName =. val (brandName r) - , BrandStrapline =. val (brandStrapline r) - , BrandMore =. val (brandMore r) - ] - where_ $ x ^. BrandId ==. val bid - case mark of - Just x -> runDB $ update $ \y -> do - set y [ BrandMark =. val (Just x), BrandMarkMime =. val markMime ] - where_ $ y ^. BrandId ==. val bid - Nothing -> return () - case ico of - Just x -> runDB $ update $ \y -> do - set y [ BrandIco =. val (Just x), BrandIcoMime =. val icoMime ] - where_ $ y ^. BrandId ==. val bid - Nothing -> return () - addMessageI "info" MsgRecordEdited - redirect $ AdminR BrandR - _ -> defaultLayout $ do - setTitleI MsgBrand - $(widgetFile "admin/brand/edit") - - -getBrandEditR :: BrandId -> Handler Html -getBrandEditR bid = do - brand <- runDB $ selectOne $ do - x <- from $ table @Brand - where_ $ x ^. BrandId ==. val bid - return x - (fw,et) <- generateFormPost $ formBrand brand - defaultLayout $ do - setTitleI MsgBrand - $(widgetFile "admin/brand/edit") - - -postBrandR :: Handler Html -postBrandR = do - ((fr,fw),et) <- runFormPost $ formBrand Nothing - case fr of - FormSuccess (r,mmark,mico) -> do - (mark,markMime) <- (,fileContentType <$> mmark) <$> mapM fileSourceByteString mmark - (ico,icoMime) <- (,fileContentType <$> mico) <$> mapM fileSourceByteString mico - runDB $ insert_ $ Brand { brandMark = mark - , brandMarkMime = markMime - , brandMarkWidth = brandMarkWidth r - , brandMarkHeight = brandMarkHeight r - , brandName = brandName r - , brandStrapline = brandStrapline r - , brandIco = ico - , brandIcoMime = icoMime - , brandMore = brandMore r - } - addMessageI "info" MsgRecordAdded - redirect $ AdminR BrandR - _ -> defaultLayout $ do - setTitleI MsgBrand - $(widgetFile "admin/brand/create") - - -getBrandCreateR :: Handler Html -getBrandCreateR = do - (fw,et) <- generateFormPost $ formBrand Nothing - defaultLayout $ do - setTitleI MsgBrand - $(widgetFile "admin/brand/create") - - -formBrand :: Maybe (Entity Brand) -> Html -> MForm Handler (FormResult (Brand,Maybe FileInfo, Maybe FileInfo),Widget) -formBrand brand extra = do - (markR,markV) <- mopt fileField FieldSettings - { fsLabel = SomeMessage MsgBrandMark - , fsTooltip = Nothing, fsId = Nothing, fsName = Nothing - , fsAttrs = [("style","display:none"),("accept","image/*")] - } Nothing - (widthR,widthV) <- mopt textField FieldSettings - { fsLabel = SomeMessage MsgMarkWidth - , fsTooltip = Nothing, fsId = Nothing, fsName = Nothing - , fsAttrs = [("class","mdc-text-field__input")] - } (brandMarkWidth . entityVal <$> brand) - (heightR,heightV) <- mopt textField FieldSettings - { fsLabel = SomeMessage MsgMarkHeight - , fsTooltip = Nothing, fsId = Nothing, fsName = Nothing - , fsAttrs = [("class","mdc-text-field__input")] - } (brandMarkHeight . entityVal <$> brand) - (nameR,nameV) <- mopt textareaField FieldSettings - { fsLabel = SomeMessage MsgBrandName - , fsTooltip = Nothing, fsId = Nothing, fsName = Nothing - , fsAttrs = [("class","mdc-text-field__input")] - } (brandName . entityVal <$> brand) - (strapR,strapV) <- mopt textareaField FieldSettings - { fsLabel = SomeMessage MsgBrandStrapline - , fsTooltip = Nothing, fsId = Nothing, fsName = Nothing - , fsAttrs = [("class","mdc-text-field__input")] - } (brandStrapline . entityVal <$> brand) - (icoR,icoV) <- mopt fileField FieldSettings - { fsLabel = SomeMessage MsgFavicon - , fsTooltip = Nothing, fsId = Nothing, fsName = Nothing - , fsAttrs = [("style","display:none"),("accept","image/ico,.ico")] - } Nothing - (moreR,moreV) <- mopt textareaField FieldSettings - { fsLabel = SomeMessage MsgMore - , fsTooltip = Nothing, fsId = Nothing, fsName = Nothing - , fsAttrs = [("class","mdc-text-field__input")] - } (brandMore . entityVal <$> brand) - let r = (,,) <$> - (Brand Nothing Nothing <$> widthR <*> heightR <*> nameR <*> strapR <*> pure Nothing <*> pure Nothing <*> moreR) - <*> markR <*> icoR - let w = $(widgetFile "admin/brand/form") - return (r,w) - - -getBrandR :: Handler Html -getBrandR = do - user <- maybeAuth - brand <- runDB $ selectOne $ from $ table @Brand - msgs <- getMessages - setUltDestCurrent - defaultLayout $ do - setTitleI MsgBrand - $(widgetFile "admin/brand/brand") diff --git a/src/Admin/Business.hs b/src/Admin/Business.hs index 05e4288..7623c42 100644 --- a/src/Admin/Business.hs +++ b/src/Admin/Business.hs @@ -3,6 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TupleSections #-} module Admin.Business ( getBusinessR @@ -38,6 +39,14 @@ module Admin.Business , getBusinessContactEditR , postBusinessContactEditR , postBusinessContactDeleteR + , getBrandR + , postBrandR + , getBrandEditR + , postBrandEditR + , postBrandDeleteR + , getBrandMarkR + , getBrandIcoR + , getBrandCreateR ) where import Control.Applicative ((<|>)) @@ -48,6 +57,7 @@ import Data.Fixed (mod') import qualified Data.Map.Lazy as M (Map, fromListWith, lookup, toList, fromList) import Data.Maybe (isNothing, isJust, fromMaybe) import Data.Text (Text, pack, unpack, intercalate) +import Data.Text.Encoding (encodeUtf8) import Data.Time.Clock ( NominalDiffTime, getCurrentTime, utctDay, secondsToNominalDiffTime ) import Data.Time.Calendar @@ -68,6 +78,9 @@ import Yesod.Auth (maybeAuth, Route (LoginR)) import Yesod.Core ( Yesod(defaultLayout), getMessages, SomeMessage (SomeMessage) , redirect, addMessageI, newIdent, addScriptRemote, addStylesheetRemote + , FileInfo (fileContentType), TypedContent (TypedContent), typeSvg + , emptyContent, ToContent (toContent), fileSourceByteString + , preEscapedToMarkup ) import Yesod.Core.Handler ( setUltDestCurrent, getCurrentRoute, getYesod, languages @@ -76,7 +89,7 @@ import Yesod.Core.Widget (setTitleI, whamlet, toWidget) import Yesod.Form.Input (runInputGet, iopt) import Yesod.Form.Fields ( textField, emailField, textareaField, intField, dayField, timeField - , hiddenField, htmlField, checkBoxField, doubleField + , hiddenField, htmlField, checkBoxField, doubleField, unTextarea, fileField ) import Yesod.Form.Functions ( generateFormPost, mreq, mopt, runFormPost, checkM, check ) @@ -99,7 +112,7 @@ import Database.Esqueleto.Experimental import Foundation ( Handler, Widget - , Route (ProfileR, AccountPhotoR, PhotoPlaceholderR, AuthR, AdminR) + , Route (ProfileR, AccountPhotoR, PhotoPlaceholderR, AuthR, AdminR, StaticR) , AdminR ( BusinessR, BusinessCreateR, BusinessEditR, BusinessDeleteR , BusinessHoursR, BusinessHoursCreateR, BusinessTimeSlotR @@ -111,6 +124,7 @@ import Foundation , BusinessAboutDeleteR , BusinessContactR, BusinessContactCreateR, BusinessContactEditR , BusinessContactDeleteR + , BrandR, BrandCreateR, BrandMarkR, BrandDeleteR, BrandEditR, BrandIcoR ) , AppMessage ( MsgBusiness, MsgPhoto, MsgNoBusinessYet, MsgTheName, MsgAddress, MsgAdd @@ -127,7 +141,9 @@ import Foundation , MsgAlreadyExists, MsgInvalidFormData, MsgWorkSchedule, MsgShowSchedule , MsgShowMap, MsgLongitude, MsgLatitude, MsgMonday, MsgTuesday, MsgWednesday , MsgThursday, MsgFriday, MsgSaturday, MsgSunday, MsgNoBusinessHoursFound - , MsgShowAddress, MsgAddress, MsgNoBusinessAddressFound + , MsgShowAddress, MsgAddress, MsgNoBusinessAddressFound, MsgBrand, MsgNoBrandYet + , MsgBrandMark, MsgMarkWidth, MsgMarkHeight, MsgBrandName, MsgBrandStrapline + , MsgFavicon, MsgMore ) ) @@ -153,17 +169,199 @@ import Model , BusinessEmail, BusinessId, BusinessTzo, BusinessTz, BusinessCurrency , BusinessHoursId, BusinessHoursDay, BusinessHoursOpen, BusinessHoursClose , BusinessHoursDayType, AboutUsBusiness, AboutUsId, ContactUsBusiness - , ContactUsId + , ContactUsId, BrandId, BrandBusiness, BrandMarkWidth, BrandMarkHeight + , BrandName, BrandStrapline, BrandMore, BrandMark, BrandMarkMime, BrandIco + , BrandIcoMime ) , DayType (Weekday, Weekend, Holiday) , SortOrder (SortOrderAsc, SortOrderDesc) , mbat + , Brand + ( Brand, brandBusiness, brandMark, brandMarkMime, brandMarkWidth, brandMarkHeight + , brandName, brandStrapline, brandIco, brandIcoMime, brandMore + ) + , BrandId ) - + import Settings (widgetFile) +import Settings.StaticFiles (img_add_photo_alternate_FILL0_wght400_GRAD0_opsz48_svg) import Menu (menu) +getBrandIcoR :: BusinessId -> BrandId -> Handler TypedContent +getBrandIcoR bid rid = do + brand <- runDB $ selectOne $ do + x <- from $ table @Brand + where_ $ x ^. BrandBusiness ==. val bid + where_ $ x ^. BrandId ==. val rid + return x + return $ case brand of + Just (Entity _ (Brand _ _ _ _ _ _ _ (Just bs) (Just mime) _)) -> TypedContent (encodeUtf8 mime) (toContent bs) + _ -> TypedContent typeSvg emptyContent + + +getBrandMarkR :: BusinessId -> BrandId -> Handler TypedContent +getBrandMarkR bid rid = do + brand <- runDB $ selectOne $ do + x <- from $ table @Brand + where_ $ x ^. BrandBusiness ==. val bid + where_ $ x ^. BrandId ==. val rid + return x + return $ case brand of + Just (Entity _ (Brand _ (Just bs) (Just mime) _ _ _ _ _ _ _)) -> TypedContent (encodeUtf8 mime) (toContent bs) + _ -> TypedContent typeSvg emptyContent + + +postBrandDeleteR :: BusinessId -> BrandId -> Handler Html +postBrandDeleteR bid rid = do + runDB $ delete $ void $ do + x <- from (table @Brand) + where_ $ x ^. BrandId ==. val rid + addMessageI "info" MsgRecordDeleted + redirect $ AdminR $ BrandR bid + + +postBrandEditR :: BusinessId -> BrandId -> Handler Html +postBrandEditR bid rid = do + ((fr,fw),et) <- runFormPost $ formBrand bid Nothing + case fr of + FormSuccess (r,mmark,mico) -> do + (mark,markMime) <- (,fileContentType <$> mmark) <$> mapM fileSourceByteString mmark + (ico,icoMime) <- (,fileContentType <$> mico) <$> mapM fileSourceByteString mico + runDB $ update $ \x -> do + set x [ BrandMarkWidth =. val (brandMarkWidth r) + , BrandMarkHeight =. val (brandMarkHeight r) + , BrandName =. val (brandName r) + , BrandStrapline =. val (brandStrapline r) + , BrandMore =. val (brandMore r) + ] + where_ $ x ^. BrandId ==. val rid + case mark of + Just x -> runDB $ update $ \y -> do + set y [ BrandMark =. val (Just x), BrandMarkMime =. val markMime ] + where_ $ y ^. BrandId ==. val rid + Nothing -> return () + case ico of + Just x -> runDB $ update $ \y -> do + set y [ BrandIco =. val (Just x), BrandIcoMime =. val icoMime ] + where_ $ y ^. BrandId ==. val rid + Nothing -> return () + addMessageI "info" MsgRecordEdited + redirect $ AdminR $ BrandR bid + _ -> defaultLayout $ do + setTitleI MsgBrand + $(widgetFile "admin/business/brand/edit") + + +getBrandEditR :: BusinessId -> BrandId -> Handler Html +getBrandEditR bid rid = do + brand <- runDB $ selectOne $ do + x <- from $ table @Brand + where_ $ x ^. BrandId ==. val rid + return x + (fw,et) <- generateFormPost $ formBrand bid brand + defaultLayout $ do + setTitleI MsgBrand + $(widgetFile "admin/business/brand/edit") + + +postBrandR :: BusinessId -> Handler Html +postBrandR bid = do + ((fr,fw),et) <- runFormPost $ formBrand bid Nothing + case fr of + FormSuccess (r,mmark,mico) -> do + (mark,markMime) <- (,fileContentType <$> mmark) <$> mapM fileSourceByteString mmark + (ico,icoMime) <- (,fileContentType <$> mico) <$> mapM fileSourceByteString mico + runDB $ insert_ $ Brand { brandBusiness = bid + , brandMark = mark + , brandMarkMime = markMime + , brandMarkWidth = brandMarkWidth r + , brandMarkHeight = brandMarkHeight r + , brandName = brandName r + , brandStrapline = brandStrapline r + , brandIco = ico + , brandIcoMime = icoMime + , brandMore = brandMore r + } + addMessageI "info" MsgRecordAdded + redirect $ AdminR $ BrandR bid + _ -> defaultLayout $ do + setTitleI MsgBrand + $(widgetFile "admin/business/brand/create") + + +getBrandCreateR :: BusinessId -> Handler Html +getBrandCreateR bid = do + (fw,et) <- generateFormPost $ formBrand bid Nothing + defaultLayout $ do + setTitleI MsgBrand + $(widgetFile "admin/business/brand/create") + + +formBrand :: BusinessId -> Maybe (Entity Brand) + -> Html -> MForm Handler (FormResult (Brand,Maybe FileInfo, Maybe FileInfo),Widget) +formBrand bid brand extra = do + (markR,markV) <- mopt fileField FieldSettings + { fsLabel = SomeMessage MsgBrandMark + , fsTooltip = Nothing, fsId = Nothing, fsName = Nothing + , fsAttrs = [("style","display:none"),("accept","image/*")] + } Nothing + (widthR,widthV) <- mopt textField FieldSettings + { fsLabel = SomeMessage MsgMarkWidth + , fsTooltip = Nothing, fsId = Nothing, fsName = Nothing + , fsAttrs = [("class","mdc-text-field__input")] + } (brandMarkWidth . entityVal <$> brand) + (heightR,heightV) <- mopt textField FieldSettings + { fsLabel = SomeMessage MsgMarkHeight + , fsTooltip = Nothing, fsId = Nothing, fsName = Nothing + , fsAttrs = [("class","mdc-text-field__input")] + } (brandMarkHeight . entityVal <$> brand) + (nameR,nameV) <- mopt textareaField FieldSettings + { fsLabel = SomeMessage MsgBrandName + , fsTooltip = Nothing, fsId = Nothing, fsName = Nothing + , fsAttrs = [("class","mdc-text-field__input")] + } (brandName . entityVal <$> brand) + (strapR,strapV) <- mopt textareaField FieldSettings + { fsLabel = SomeMessage MsgBrandStrapline + , fsTooltip = Nothing, fsId = Nothing, fsName = Nothing + , fsAttrs = [("class","mdc-text-field__input")] + } (brandStrapline . entityVal <$> brand) + (icoR,icoV) <- mopt fileField FieldSettings + { fsLabel = SomeMessage MsgFavicon + , fsTooltip = Nothing, fsId = Nothing, fsName = Nothing + , fsAttrs = [("style","display:none"),("accept","image/ico,.ico")] + } Nothing + (moreR,moreV) <- mopt textareaField FieldSettings + { fsLabel = SomeMessage MsgMore + , fsTooltip = Nothing, fsId = Nothing, fsName = Nothing + , fsAttrs = [("class","mdc-text-field__input")] + } (brandMore . entityVal <$> brand) + let r = (,,) <$> + ( Brand bid Nothing Nothing + <$> widthR + <*> heightR + <*> nameR + <*> strapR + <*> pure Nothing + <*> pure Nothing + <*> moreR + ) <*> markR <*> icoR + let w = $(widgetFile "admin/business/brand/form") + return (r,w) + + +getBrandR :: BusinessId -> Handler Html +getBrandR bid = do + user <- maybeAuth + brand <- runDB $ selectOne $ from $ table @Brand + msgs <- getMessages + setUltDestCurrent + curr <- getCurrentRoute + defaultLayout $ do + setTitleI MsgBrand + $(widgetFile "admin/business/brand/brand") + + postBusinessContactDeleteR :: BusinessId -> ContactUsId -> Handler Html postBusinessContactDeleteR bid xid = do ((fr,_),_) <- runFormPost formDelete diff --git a/src/Application.hs b/src/Application.hs index 2f11f72..d16c15d 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -109,13 +109,10 @@ import Admin.Business , getBusinessAboutEditR, postBusinessAboutEditR, postBusinessAboutDeleteR , getBusinessContactR, postBusinessContactR, getBusinessContactCreateR , getBusinessContactEditR, postBusinessContactEditR, postBusinessContactDeleteR + , getBrandR, getBrandMarkR, getBrandIcoR, postBrandR, getBrandEditR + , postBrandEditR, postBrandDeleteR, getBrandCreateR ) -import Admin.Brand - ( getBrandR, getBrandMarkR, getBrandIcoR, postBrandR, getBrandEditR - , postBrandEditR, postBrandDeleteR, getBrandCreateR - ) - import Admin.Users ( getUsersR , getUserCreateFormR diff --git a/src/Foundation.hs b/src/Foundation.hs index 87dbf35..ad79d61 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -196,12 +196,12 @@ instance Yesod App where isAuthorized (AdminR (EmplCalendarSlotCreateR {})) _ = return Authorized - isAuthorized (AdminR BrandR) _ = return Authorized - isAuthorized (AdminR BrandDeleteR) _ = return Authorized - isAuthorized (AdminR (BrandEditR _)) _ = return Authorized - isAuthorized (AdminR (BrandMarkR _)) _ = return Authorized - isAuthorized (AdminR (BrandIcoR _)) _ = return Authorized - isAuthorized (AdminR BrandCreateR) _ = return Authorized + isAuthorized (AdminR (BrandR _)) _ = return Authorized + isAuthorized (AdminR (BrandDeleteR _ _)) _ = return Authorized + isAuthorized (AdminR (BrandEditR _ _)) _ = return Authorized + isAuthorized (AdminR (BrandMarkR _ _)) _ = return Authorized + isAuthorized (AdminR (BrandIcoR _ _)) _ = return Authorized + isAuthorized (AdminR (BrandCreateR _)) _ = return Authorized isAuthorized (AdminR BusinessR) _ = return Authorized isAuthorized (AdminR BusinessCreateR) _ = return Authorized diff --git a/src/Handler/Resources.hs b/src/Handler/Resources.hs index 6d1e02b..84af50b 100644 --- a/src/Handler/Resources.hs +++ b/src/Handler/Resources.hs @@ -22,7 +22,7 @@ import Foundation ) , AdminR ( AdmServicesR, BusinessR, UsersR, BusinessAboutR, BusinessContactR - , BusinessHoursR + , BusinessHoursR, BrandR ) , AppMessage ( MsgDocumentation, MsgPhoto, MsgNavigationMenu, MsgLogin, MsgUserProfile @@ -30,7 +30,7 @@ import Foundation , MsgBasicEntities, MsgBusiness, MsgUser , MsgAppName, MsgOverview, MsgDoc001, MsgDoc002, MsgDoc003, MsgDoc004 , MsgDoc005, MsgDoc0061, MsgDoc0062, MsgDoc0063, MsgDoc0064 - , MsgDoc0065, MsgDoc0066 + , MsgDoc0065, MsgDoc0066, MsgDoc0067, MsgDoc0068 , MsgDoc007, MsgDoc008, MsgDoc009 ) ) diff --git a/src/Menu.hs b/src/Menu.hs index 27dbd14..6739fda 100644 --- a/src/Menu.hs +++ b/src/Menu.hs @@ -32,11 +32,10 @@ import Foundation , BusinessContactR ) , AppMessage - ( MsgSourceCode, MsgDocumentation, MsgBrand, MsgContactUs, MsgAboutUs - , MsgMyAppointments, MsgServices, MsgBookAppointment, MsgWelcome, MsgSalon - , MsgUsers, MsgStaff, MsgData, MsgResources, MsgRequests - , MsgBusiness, MsgClose, MsgAnalytics, MsgWorkload, MsgCustomerRanking - , MsgServiceRanking + ( MsgSourceCode, MsgDocumentation, MsgContactUs, MsgAboutUs, MsgSalon + , MsgMyAppointments, MsgServices, MsgBookAppointment, MsgWelcome, MsgUsers + , MsgStaff, MsgData, MsgResources, MsgRequests, MsgBusiness, MsgClose + , MsgAnalytics, MsgWorkload, MsgCustomerRanking, MsgServiceRanking ) ) diff --git a/static/img/Salon-ERD.svg b/static/img/Salon-ERD.svg index d3e4fee..e122e1d 100644 --- a/static/img/Salon-ERD.svg +++ b/static/img/Salon-ERD.svg @@ -1,7 +1,7 @@ -rolebrandbusinessscheduleday_typebusiness_hourshtmlabout_uscustomergroupPowered ByVisual Paradigm Community Edition - - - delete - - - - edit - - - - - _{MsgPleaseConfirm} - _{MsgDeleteAreYouSure} - - - - _{MsgCancel} -
- - - _{MsgYesDelete} - - - $maybe Entity uid _ <- user - - - -
_{MsgPhoto} - $nothing - - - - login - - - $maybe Entity bid (Brand mark _ width height name strap _ _ more) <- brand - $maybe _ <- mark -
- $case (width,height) - $of (Just w,Just h) - _{MsgBrandMark} - $of (Just w,Nothing) - _{MsgBrandMark} - $of (Nothing,Just h) - _{MsgBrandMark} - $of (Nothing,Nothing) - _{MsgBrandMark} -
- $maybe name <- name - #{preEscapedToMarkup $ unTextarea name} - $maybe strap <- strap - #{preEscapedToMarkup $ unTextarea strap} - $nothing -
-
- $maybe name <- name - #{preEscapedToMarkup $ unTextarea name} - $maybe strap <- strap - #{preEscapedToMarkup $ unTextarea strap} - $maybe more <- more - #{preEscapedToMarkup $ unTextarea more} - $nothing -
- ∅ -
- _{MsgNoBrandYet}. - - - - - add - - -$forall (_,msg) <- msgs - - - #{msg} - - - - - close diff --git a/templates/admin/business/about/about.hamlet b/templates/admin/business/about/about.hamlet index 72ed5d5..92c0063 100644 --- a/templates/admin/business/about/about.hamlet +++ b/templates/admin/business/about/about.hamlet @@ -92,7 +92,17 @@ - + + + + + _{MsgBrand} + + + + diff --git a/templates/admin/business/brand/brand.cassius b/templates/admin/business/brand/brand.cassius new file mode 100644 index 0000000..30b9cf8 --- /dev/null +++ b/templates/admin/business/brand/brand.cassius @@ -0,0 +1,15 @@ + +header + .mdc-tab-bar + .mdc-tab + height: 64px + .mdc-tab.mdc-tab--active + .mdc-tab__text-label + color: var(--mdc-theme-on-primary) + .mdc-tab-indicator.mdc-tab-indicator--active + .mdc-tab-indicator__content--underline + border-color: var(--mdc-theme-on-primary) + +@media (max-width: 599px) + header .mdc-tab-bar .mdc-tab + height: 56px \ No newline at end of file diff --git a/templates/admin/business/brand/brand.hamlet b/templates/admin/business/brand/brand.hamlet new file mode 100644 index 0000000..f269cc9 --- /dev/null +++ b/templates/admin/business/brand/brand.hamlet @@ -0,0 +1,155 @@ + +^{menu} + + + + + + + menu + _{MsgBusiness} + + + $maybe Entity rid _ <- brand + + + + delete + + + + edit + + + + + _{MsgPleaseConfirm} + _{MsgDeleteAreYouSure} + + + + _{MsgCancel} +
+ + + _{MsgYesDelete} + + + $maybe Entity uid _ <- user + + + + _{MsgPhoto} + $nothing + + + + login + + + + + + + + + _{MsgDetails} + + + + + + + + _{MsgWorkSchedule} + + + + + + + + _{MsgAboutUs} + + + + + + + + _{MsgContactUs} + + + + + + + + _{MsgBrand} + + + + + + + + $maybe Entity rid (Brand bid mark _ width height name strap _ _ more) <- brand + $maybe _ <- mark +
+ $case (width,height) + $of (Just w,Just h) + _{MsgBrandMark} + $of (Just w,Nothing) + _{MsgBrandMark} + $of (Nothing,Just h) + _{MsgBrandMark} + $of (Nothing,Nothing) + _{MsgBrandMark} +
+ $maybe name <- name + #{preEscapedToMarkup $ unTextarea name} + $maybe strap <- strap + #{preEscapedToMarkup $ unTextarea strap} + $nothing +
+
+ $maybe name <- name + #{preEscapedToMarkup $ unTextarea name} + $maybe strap <- strap + #{preEscapedToMarkup $ unTextarea strap} + $maybe more <- more + #{preEscapedToMarkup $ unTextarea more} + $nothing +
+ ∅ +
+ _{MsgNoBrandYet}. + + + + + add + + +$forall (_,msg) <- msgs + + + #{msg} + + + + + close diff --git a/templates/admin/brand/brand.julius b/templates/admin/business/brand/brand.julius similarity index 100% rename from templates/admin/brand/brand.julius rename to templates/admin/business/brand/brand.julius diff --git a/templates/admin/brand/create.cassius b/templates/admin/business/brand/create.cassius similarity index 87% rename from templates/admin/brand/create.cassius rename to templates/admin/business/brand/create.cassius index 6a82e7e..5816525 100644 --- a/templates/admin/brand/create.cassius +++ b/templates/admin/business/brand/create.cassius @@ -1,5 +1,5 @@ main - margin: 0 1rem + margin: 0 1rem 1rem 1rem form div.form-field display: flex @@ -18,7 +18,7 @@ main #figureMark text-align: center .mdc-text-field__input - caret-color: var(--theme-accent) + caret-color: var(--mdc-theme-on-primary) div.form-actions display: flex flex-direction: row diff --git a/templates/admin/brand/create.hamlet b/templates/admin/business/brand/create.hamlet similarity index 80% rename from templates/admin/brand/create.hamlet rename to templates/admin/business/brand/create.hamlet index af8e539..205c69e 100644 --- a/templates/admin/brand/create.hamlet +++ b/templates/admin/business/brand/create.hamlet @@ -1,17 +1,17 @@ - + arrow_back _{MsgBrand} - + ^{fw} - + _{MsgCancel} diff --git a/templates/admin/brand/edit.cassius b/templates/admin/business/brand/edit.cassius similarity index 87% rename from templates/admin/brand/edit.cassius rename to templates/admin/business/brand/edit.cassius index 6a82e7e..5816525 100644 --- a/templates/admin/brand/edit.cassius +++ b/templates/admin/business/brand/edit.cassius @@ -1,5 +1,5 @@ main - margin: 0 1rem + margin: 0 1rem 1rem 1rem form div.form-field display: flex @@ -18,7 +18,7 @@ main #figureMark text-align: center .mdc-text-field__input - caret-color: var(--theme-accent) + caret-color: var(--mdc-theme-on-primary) div.form-actions display: flex flex-direction: row diff --git a/templates/admin/brand/edit.hamlet b/templates/admin/business/brand/edit.hamlet similarity index 79% rename from templates/admin/brand/edit.hamlet rename to templates/admin/business/brand/edit.hamlet index 9c4ab31..f1e6df0 100644 --- a/templates/admin/brand/edit.hamlet +++ b/templates/admin/business/brand/edit.hamlet @@ -1,17 +1,17 @@ - + arrow_back _{MsgBrand} - + ^{fw} - + _{MsgCancel} diff --git a/templates/admin/brand/form.cassius b/templates/admin/business/brand/form.cassius similarity index 100% rename from templates/admin/brand/form.cassius rename to templates/admin/business/brand/form.cassius diff --git a/templates/admin/brand/form.hamlet b/templates/admin/business/brand/form.hamlet similarity index 83% rename from templates/admin/brand/form.hamlet rename to templates/admin/business/brand/form.hamlet index e178127..6980d4b 100644 --- a/templates/admin/brand/form.hamlet +++ b/templates/admin/business/brand/form.hamlet @@ -2,8 +2,8 @@