Skip to content

Commit

Permalink
Fix appoinntment and request cards
Browse files Browse the repository at this point in the history
  • Loading branch information
@ciukstar
ciukstar committed Oct 7, 2023
1 parent 33a81de commit a142759
Show file tree
Hide file tree
Showing 33 changed files with 448 additions and 431 deletions.
121 changes: 39 additions & 82 deletions src/Admin/Services.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -238,51 +238,7 @@ formExpert sid role extra = do
, fsAttrs = [("class","mdc-text-field__input"),("min","0"),("max","5")]
} (roleRating . entityVal <$> role)
let r = Role <$> emplR <*> FormSuccess sid <*> nameR <*> ratingR
let w = [whamlet|
#{extra}
<div.form-field>
<div.mdc-select.mdc-select--filled.mdc-select--required data-mdc-auto-init=MDCSelect
:isJust (fvErrors emplV):.mdc-select--invalid>
^{fvInput emplV}
<div.mdc-select__anchor role=button aria-aspopup=listbox aria-expanded=false aria-required=true>
<span.mdc-select__ripple>
<span.mdc-floating-label>#{fvLabel emplV}
<span.mdc-select__selected-text-container>
<span.mdc-select__selected-text>
<span.mdc-select__dropdown-icon>
<svg.mdc-select__dropdown-icon-graphic viewBox="7 10 10 5" focusable=false>
<polygon.mdc-select__dropdown-icon-inactive stroke=none fill-rule=evenodd points="7 10 12 15 17 10">
<polygon.mdc-select__dropdown-icon-active stroke=none fill-rule=evenodd points="7 15 12 10 17 15">
<span.mdc-line-ripple>

<div.mdc-select__menu.mdc-menu.mdc-menu-surface.mdc-menu-surface--fullwidth>
<ul.mdc-deprecated-list role=listbox>
$forall Entity eid (Staff ename _ _ _ _ _) <- staff
<li.mdc-deprecated-list-item role=option data-value=#{fromSqlKey eid} aria-selected=false>
<span.mdc-deprecated-list-item__ripple>
<span.mdc-deprecated-list-item__text>
#{ename}

$maybe errs <- fvErrors emplV
<div.mdc-select-helper-text.mdc-select-helper-text--validation-msg>
#{errs}

$forall v <- [nameV,ratingV]
<div.form-field>
<label.mdc-text-field.mdc-text-field--filled data-mdc-auto-init=MDCTextField
:isJust (fvErrors v):.mdc-text-field--invalid
:isJust (fvErrors v):.mdc-text-field--with-trailing-icon>
<span.mdc-text-field__ripple>
<span.mdc-floating-label>#{fvLabel v}
^{fvInput v}
$maybe _ <- fvErrors v
<i.mdc-text-field__icon.mdc-text-field__icon--trailing.material-symbols-outlined>error
<span.mdc-line-ripple>
$maybe errs <- fvErrors v
<div.mdc-text-field-helper-line>
<div.mdc-text-field-helper-text.mdc-text-field-helper-text--validation-msg aria-hidden=true>
#{errs}
|]
let w = $(widgetFile "admin/services/expert/form")
return (r,w)
where

Expand Down Expand Up @@ -347,17 +303,17 @@ getAdmServicesSearchR = do

postAdmPriceDeleteR :: OfferId -> Services -> Handler Html
postAdmPriceDeleteR pid sids = do
scrollY <- (("scrollY",) <$>) <$> runInputGet (iopt textField "scrollY")
open <- (("open",) <$>) <$> runInputGet (iopt textField "open")
y <- (("y",) <$>) <$> runInputGet (iopt textField "y")
o <- (("o",) <$>) <$> runInputGet (iopt textField "o")
runDB $ delete pid
addMessageI "info" MsgRecordDeleted
redirect (AdminR $ AdmServicesR sids,catMaybes [scrollY,open])
redirect (AdminR $ AdmServicesR sids,catMaybes [y,o])


getAdmPriceEditR :: OfferId -> Services -> Handler Html
getAdmPriceEditR pid (Services sids) = do
scrollY <- (("scrollY",) <$>) <$> runInputGet (iopt textField "scrollY")
open <- (("open",) <$>) <$> runInputGet (iopt textField "open")
y <- (("y",) <$>) <$> runInputGet (iopt textField "y")
o <- (("o",) <$>) <$> runInputGet (iopt textField "o")
price <- runDB $ selectOne $ do
x <- from $ table @Offer
where_ $ x ^. OfferId ==. val pid
Expand All @@ -370,8 +326,8 @@ getAdmPriceEditR pid (Services sids) = do

postAdmPriceR :: OfferId -> Services -> Handler Html
postAdmPriceR pid (Services sids) = do
scrollY <- (("scrollY",) <$>) <$> runInputGet (iopt textField "scrollY")
open <- (("open",) <$>) <$> runInputGet (iopt textField "open")
y <- (("y",) <$>) <$> runInputGet (iopt textField "y")
o <- (("o",) <$>) <$> runInputGet (iopt textField "o")
price <- runDB $ selectOne $ do
x <- from $ table @Offer
where_ $ x ^. OfferId ==. val pid
Expand All @@ -382,7 +338,7 @@ postAdmPriceR pid (Services sids) = do
runDB $ replace pid r
addMessageI "info" MsgRecordEdited
redirect ( AdminR $ AdmPriceR pid (Services sids)
, catMaybes [scrollY,open,Just ("pid",pack $ show $ fromSqlKey pid)]
, catMaybes [y,o,Just ("pid",pack $ show $ fromSqlKey pid)]
)
_ -> defaultLayout $ do
setTitleI MsgPrice
Expand All @@ -391,8 +347,8 @@ postAdmPriceR pid (Services sids) = do

getAdmPriceR :: OfferId -> Services -> Handler Html
getAdmPriceR pid sids = do
scrollY <- (("scrollY",) <$>) <$> runInputGet (iopt textField "scrollY")
open <- (("open",) <$>) <$> runInputGet (iopt textField "open")
y <- (("y",) <$>) <$> runInputGet (iopt textField "y")
o <- (("o",) <$>) <$> runInputGet (iopt textField "o")
price <- runDB $ selectOne $ do
x <- from $ table @Offer
where_ $ x ^. OfferId ==. val pid
Expand All @@ -405,15 +361,15 @@ getAdmPriceR pid sids = do

postAdmOfferR :: Services -> Handler Html
postAdmOfferR (Services sids) = do
scrollY <- (("scrollY",) <$>) <$> runInputGet (iopt textField "scrollY")
open <- (("open",) <$>) <$> runInputGet (iopt textField "open")
y <- (("y",) <$>) <$> runInputGet (iopt textField "y")
o <- (("o",) <$>) <$> runInputGet (iopt textField "o")
((fr,widget),enctype) <- runFormPost $ formOffer (last sids) Nothing
case fr of
FormSuccess r -> do
pid <- runDB $ insert r
addMessageI "info" MsgRecordAdded
redirect ( AdminR $ AdmServicesR (Services sids)
, catMaybes [scrollY,open,Just ("pid",pack $ show $ fromSqlKey pid)]
, catMaybes [y,o,Just ("pid",pack $ show $ fromSqlKey pid)]
)
_ -> defaultLayout $ do
setTitleI MsgPrice
Expand All @@ -422,8 +378,8 @@ postAdmOfferR (Services sids) = do

getAdmOfferCreateR :: Services -> Handler Html
getAdmOfferCreateR (Services sids) = do
scrollY <- (("scrollY",) <$>) <$> runInputGet (iopt textField "scrollY")
open <- (("open",) <$>) <$> runInputGet (iopt textField "open")
y <- (("y",) <$>) <$> runInputGet (iopt textField "y")
o <- (("o",) <$>) <$> runInputGet (iopt textField "o")
(widget,enctype) <- generateFormPost $ formOffer (last sids) Nothing
defaultLayout $ do
setTitleI MsgOffer
Expand Down Expand Up @@ -525,10 +481,10 @@ getAdmServiceImageR sid = do

postAdmServiceDeleteR :: Services -> Handler Html
postAdmServiceDeleteR (Services sids) = do
scrollY <- fromMaybe "0" <$> runInputGet (iopt textField "scrollY")
y <- fromMaybe "0" <$> runInputGet (iopt textField "y")
runDB $ delete (last sids)
addMessageI "info" MsgRecordDeleted
redirect (AdminR $ AdmServicesR (Services (init sids)),[("scrollY",scrollY)])
redirect (AdminR $ AdmServicesR (Services (init sids)),[("y",y)])


postAdmServiceR :: Services -> Handler Html
Expand All @@ -539,7 +495,7 @@ postAdmServiceR (Services sids) = do
where_ $ x ^. ServiceId ==. val (last sids)
return (x,t)
((fr,widget),enctype) <- runFormPost $ formService (fst <$> service) Nothing (snd =<< service)
scrollY <- fromMaybe "0" <$> runInputGet (iopt textField "scrollY")
y <- fromMaybe "0" <$> runInputGet (iopt textField "y")
case fr of
FormSuccess (s,mfi,ma) -> do
_ <- runDB $ replace (last sids) s
Expand All @@ -553,9 +509,9 @@ postAdmServiceR (Services sids) = do
_ <- runDB $ upsert
(Thumbnail (last sids) bs (fileContentType fi) ma)
[ThumbnailPhoto P.=. bs, ThumbnailMime P.=. fileContentType fi, ThumbnailAttribution P.=. ma]
redirect (AdminR $ AdmServicesR (Services sids),[("scrollY",scrollY)])
redirect (AdminR $ AdmServicesR (Services sids),[("y",y)])
Nothing -> redirect ( AdminR $ AdmServicesR (Services sids)
, [("sid",pack $ show $ fromSqlKey $ last sids),("scrollY",scrollY)]
, [("sid",pack $ show $ fromSqlKey $ last sids),("y",y)]
)
_ -> defaultLayout $ do
setTitleI MsgService
Expand All @@ -564,7 +520,7 @@ postAdmServiceR (Services sids) = do

getAdmServiceEditFormR :: Services -> Handler Html
getAdmServiceEditFormR (Services sids) = do
scrollY <- fromMaybe "0" <$> runInputGet (iopt textField "scrollY")
y <- fromMaybe "0" <$> runInputGet (iopt textField "y")
service <- runDB $ selectOne $ do
x :& t <- from $ table @Service `leftJoin` table @Thumbnail
`on` (\(x :& t) -> just (x ^. ServiceId) ==. t ?. ThumbnailService)
Expand All @@ -578,8 +534,8 @@ getAdmServiceEditFormR (Services sids) = do

getAdmServiceCreateFormR :: Services -> Handler Html
getAdmServiceCreateFormR (Services sids) = do
scrollY <- (("scrollY",) <$>) <$> runInputGet (iopt textField "scrollY")
open <- (("open",) <$>) <$> runInputGet (iopt textField "open")
y <- (("y",) <$>) <$> runInputGet (iopt textField "y")
o <- (("o",) <$>) <$> runInputGet (iopt textField "o")
(widget,enctype) <- generateFormPost $ formService Nothing (LS.last sids) Nothing
defaultLayout $ do
setTitleI MsgService
Expand All @@ -588,8 +544,8 @@ getAdmServiceCreateFormR (Services sids) = do

postAdmServicesR :: Services -> Handler Html
postAdmServicesR (Services sids) = do
scrollY <- (("scrollY",) <$>) <$> runInputGet (iopt textField "scrollY")
open <- (("open",) <$>) <$> runInputGet (iopt textField "open")
y <- (("y",) <$>) <$> runInputGet (iopt textField "y")
o <- (("o",) <$>) <$> runInputGet (iopt textField "o")
((fr,widget),enctype) <- runFormPost $ formService Nothing (LS.last sids) Nothing
case fr of
FormSuccess (s,mfi,a) -> do
Expand All @@ -605,7 +561,7 @@ postAdmServicesR (Services sids) = do
}
Nothing -> return ()
redirect ( AdminR $ AdmServicesR (Services sids)
, catMaybes [Just ("sid",pack $ show $ fromSqlKey sid),scrollY,open]
, catMaybes [Just ("sid",pack $ show $ fromSqlKey sid),y,o]
)
_ -> defaultLayout $ do
setTitleI MsgService
Expand All @@ -614,9 +570,8 @@ postAdmServicesR (Services sids) = do

getAdmServicesR :: Services -> Handler Html
getAdmServicesR (Services sids) = do
stati <- reqGetParams <$> getRequest
open <- runInputGet (iopt textField "open")
scrollY <- fromMaybe "0" <$> runInputGet (iopt textField "scrollY")
o <- runInputGet (iopt textField "o")
y <- fromMaybe "0" <$> runInputGet (iopt textField "y")
mpid <- (toSqlKey <$>) <$> runInputGet (iopt intField "pid")
msid <- (toSqlKey <$>) <$> runInputGet (iopt intField "sid")
user <- maybeAuth
Expand All @@ -634,27 +589,29 @@ getAdmServicesR (Services sids) = do
orderBy [asc (x ^. OfferId)]
return x
Nothing -> return []

experts <- case service of
Just (Entity sid _,_) -> runDB $ select $ do
r :& e <- from $ table @Role
`innerJoin` table @Staff `on` (\(r :& e) -> r ^. RoleStaff ==. e ^. StaffId)
where_ $ r ^. RoleService ==. val sid
return (r,e)
Nothing -> return []

services <- (second (join . unValue) <$>) <$> runDB ( select $ do
x :& t <- from $ table @Service `leftJoin` table @Thumbnail
`on` (\(x :& t) -> just (x ^. ServiceId) ==. t ?. ThumbnailService)
s :& t <- from $ table @Service `leftJoin` table @Thumbnail
`on` (\(s :& t) -> just (s ^. ServiceId) ==. t ?. ThumbnailService)
case sids of
[] -> where_ $ isNothing $ x ^. ServiceGroup
(last -> y) -> where_ $ x ^. ServiceGroup ==. just (val y)
orderBy [asc (x ^. ServiceId)]
return (x,t ?. ThumbnailAttribution) )
[] -> where_ $ isNothing $ s ^. ServiceGroup
(last -> x) -> where_ $ s ^. ServiceGroup ==. just (val x)
orderBy [asc (s ^. ServiceId)]
return (s,t ?. ThumbnailAttribution) )
setUltDestCurrent
msgs <- getMessages
app <- getYesod
langs <- languages
btnDelete <- newIdent
dlgDelete <- newIdent
detailsDescription <- newIdent
detailsOffer <- newIdent
detailsExperts <- newIdent
Expand Down
5 changes: 3 additions & 2 deletions src/Admin/Staff.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,7 @@ import Yesod.Core
, typeSvg, addMessageI, redirect, FileInfo (fileContentType)
, SomeMessage (SomeMessage), fileSourceByteString
, MonadTrans (lift), whamlet, getRequest
, YesodRequest (reqGetParams)
, YesodRequest (reqGetParams), newIdent
)
import Yesod.Core.Widget (setTitleI)
import Yesod.Auth (maybeAuth, Route (LoginR))
Expand Down Expand Up @@ -308,7 +308,7 @@ $forall v <- [fnameV,emailV]
return (r,w)
where
resolveSelected adminR = case adminR of FormSuccess x -> x ; _ -> False

uniqueNameField = checkM uniqueName textField

uniqueName :: Text -> Handler (Either AppMessage Text)
Expand Down Expand Up @@ -678,6 +678,7 @@ getAdmStaffR = do
return x ) )
msgs <- getMessages
setUltDestCurrent
fabAddStaff <- newIdent
defaultLayout $ do
setTitleI MsgStaff
$(widgetFile "admin/staff/staff")
Expand Down
56 changes: 37 additions & 19 deletions src/Demo/DemoDataEN.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,7 @@ import Model
, Contents (Contents, contentsSection, contentsContent)
, BookStatus (BookStatusRequest)
, Book (Book, bookUser, bookOffer, bookRole, bookDay, bookTime, bookTz, bookStatus)
, Business (Business, businessName, businessAddress, businessPhone, businessMobile, businessEmail)
, Business (Business, businessName, businessAddress, businessPhone, businessMobile, businessEmail), Hist (histBook, histLogtime, histDay, histTime, histTz, histStatus, Hist)
)
import Data.FileEmbed (embedFile)
import Demo.DemoPhotos
Expand All @@ -50,7 +50,7 @@ import Demo.DemoPhotos
populateEN :: MonadIO m => ReaderT SqlBackend m ()
populateEN = do

(today,time) <- liftIO $ getCurrentTime >>= \x -> return (utctDay x,timeToTimeOfDay (utctDayTime x))
(now,today,time) <- liftIO $ getCurrentTime >>= \x -> return (x ,utctDay x,timeToTimeOfDay (utctDayTime x))

insert_ $ Business { businessName = "Salon"
, businessAddress = "5331 Rexford Court, Montgomery AL 36116"
Expand Down Expand Up @@ -414,7 +414,7 @@ We will continue to offer the latest treatments, the most innovative techniques

r212 <- insert $ Role { roleStaff = e2
, roleService = s12
, roleName = "Barbers"
, roleName = "Hairdresser"
, roleRating = Just 3
}

Expand Down Expand Up @@ -532,8 +532,8 @@ We will continue to offer the latest treatments, the most innovative techniques

r51511 <- insert $ Role { roleStaff = e5
, roleService = s1511
, roleName = "Hairdresser"
, roleRating = Just 2
, roleName = "Barber"
, roleRating = Just 4
}

s1512 <- insert $ Service { serviceName = "Before Perm Conditioner"
Expand Down Expand Up @@ -1008,18 +1008,27 @@ We will continue to offer the latest treatments, the most innovative techniques
, userFullName = Just "Patty O’Furniture"
, userEmail = Just "[email protected]"
}

insert_ $ UserPhoto { userPhotoUser = c1
, userPhotoPhoto = $(embedFile "static/img/customer-women-1.avif")
, userPhotoMime = "image/avif"
}

insert_ $ Book { bookOffer = o131
, bookRole = Just r212
, bookUser = c1
, bookDay = addDays 1 today
, bookTime = time
, bookTz = utc
, bookStatus = BookStatusRequest
b1 <- insert $ Book { bookOffer = o131
, bookRole = Just r212
, bookUser = c1
, bookDay = addDays 1 today
, bookTime = time
, bookTz = utc
, bookStatus = BookStatusRequest
}

insert_ $ Hist { histBook = b1
, histLogtime = now
, histDay = addDays 1 today
, histTime = time
, histTz = utc
, histStatus = BookStatusRequest
}


Expand All @@ -1030,18 +1039,27 @@ We will continue to offer the latest treatments, the most innovative techniques
, userFullName = Just "Ray Sin"
, userEmail = Just "[email protected]"
}

insert_ $ UserPhoto { userPhotoUser = c2
, userPhotoPhoto = $(embedFile "static/img/customer-men-1.avif")
, userPhotoMime = "image/avif"
}

insert_ $ Book { bookOffer = o111
, bookRole = Just r51511
, bookUser = c2
, bookDay = addDays 2 today
, bookTime = time
, bookTz = utc
, bookStatus = BookStatusRequest
b2 <- insert $ Book { bookOffer = o111
, bookRole = Just r51511
, bookUser = c2
, bookDay = addDays 2 today
, bookTime = time
, bookTz = utc
, bookStatus = BookStatusRequest
}

insert_ $ Hist { histBook = b2
, histLogtime = now
, histDay = addDays 2 today
, histTime = time
, histTz = utc
, histStatus = BookStatusRequest
}

insert_ $ Book { bookOffer = o141
Expand Down
Loading

0 comments on commit a142759

Please sign in to comment.