forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Vervis.Handler.Ticket: Import esqueleto qualified

Browse source
This commit is contained in:
fr33domlover 2019-05-25 22:04:06 +00:00
parent 3af54ef300
commit ae1e10cab2
4 changed files with 53 additions and 54 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

101
src/Vervis/Handler/Ticket.hs
View file

@ -68,8 +68,7 @@ import Data.Time.Calendar (Day (..))
import Data.Time.Clock (UTCTime (..), getCurrentTime) import Data.Time.Clock (UTCTime (..), getCurrentTime)
import Data.Time.Format (formatTime, defaultTimeLocale) import Data.Time.Format (formatTime, defaultTimeLocale)
import Data.Traversable (for) import Data.Traversable (for)
import Database.Esqueleto hiding ((=.), (+=.), update, delete) import Database.Persist
import Database.Persist hiding ((==.))
import Network.HTTP.Types (StdMethod (DELETE, POST)) import Network.HTTP.Types (StdMethod (DELETE, POST))
import Text.Blaze.Html (Html, toHtml) import Text.Blaze.Html (Html, toHtml)
import Yesod.Auth (requireAuthId, maybeAuthId) import Yesod.Auth (requireAuthId, maybeAuthId)
@ -80,7 +79,7 @@ import Yesod.Form.Types (FormResult (..))
import Yesod.Persist.Core (runDB, get404, getBy404) import Yesod.Persist.Core (runDB, get404, getBy404)
import qualified Data.Text as T (filter, intercalate, pack) import qualified Data.Text as T (filter, intercalate, pack)
import qualified Database.Esqueleto as E ((==.)) import qualified Database.Esqueleto as E
import Database.Persist.Sql.Graph.TransitiveReduction (trrFix) import Database.Persist.Sql.Graph.TransitiveReduction (trrFix)
import Yesod.Hashids import Yesod.Hashids
@ -121,7 +120,7 @@ getTicketsR shr prj = do
Entity jid _ <- getBy404 $ UniqueProject prj sid Entity jid _ <- getBy404 $ UniqueProject prj sid
getTicketSummaries getTicketSummaries
(filterTickets tf) (filterTickets tf)
(Just $ \ t -> [asc $ t ^. TicketNumber]) (Just $ \ t -> [E.asc $ t E.^. TicketNumber])
jid jid
defaultLayout $(widgetFile "ticket/list") defaultLayout $(widgetFile "ticket/list")
@ -232,13 +231,13 @@ getTicketR shar proj num = do
_ -> return author _ -> return author
tparams <- getTicketTextParams tid wid tparams <- getTicketTextParams tid wid
eparams <- getTicketEnumParams tid wid eparams <- getTicketEnumParams tid wid
deps <- select $ from $ \ (dep `InnerJoin` t) -> do deps <- E.select $ E.from $ \ (dep `E.InnerJoin` t) -> do
on $ dep ^. TicketDependencyChild ==. t ^. TicketId E.on $ dep E.^. TicketDependencyChild E.==. t E.^. TicketId
where_ $ dep ^. TicketDependencyParent ==. val tid E.where_ $ dep E.^. TicketDependencyParent E.==. E.val tid
return t return t
rdeps <- select $ from $ \ (dep `InnerJoin` t) -> do rdeps <- E.select $ E.from $ \ (dep `E.InnerJoin` t) -> do
on $ dep ^. TicketDependencyParent ==. t ^. TicketId E.on $ dep E.^. TicketDependencyParent E.==. t E.^. TicketId
where_ $ dep ^. TicketDependencyChild ==. val tid E.where_ $ dep E.^. TicketDependencyChild E.==. E.val tid
return t return t
return return
( wshr, wfl ( wshr, wfl
@ -538,19 +537,19 @@ postTicketUnassignR shr prj num = do
getClaimRequestsPersonR :: Handler Html getClaimRequestsPersonR :: Handler Html
getClaimRequestsPersonR = do getClaimRequestsPersonR = do
pid <- requireAuthId pid <- requireAuthId
rqs <- runDB $ select $ from $ rqs <- runDB $ E.select $ E.from $
\ (tcr `InnerJoin` ticket `InnerJoin` project `InnerJoin` sharer) -> do \ (tcr `E.InnerJoin` ticket `E.InnerJoin` project `E.InnerJoin` sharer) -> do
on $ project ^. ProjectSharer ==. sharer ^. SharerId E.on $ project E.^. ProjectSharer E.==. sharer E.^. SharerId
on $ ticket ^. TicketProject ==. project ^. ProjectId E.on $ ticket E.^. TicketProject E.==. project E.^. ProjectId
on $ tcr ^. TicketClaimRequestTicket ==. ticket ^. TicketId E.on $ tcr E.^. TicketClaimRequestTicket E.==. ticket E.^. TicketId
where_ $ tcr ^. TicketClaimRequestPerson ==. val pid E.where_ $ tcr E.^. TicketClaimRequestPerson E.==. E.val pid
orderBy [desc $ tcr ^. TicketClaimRequestCreated] E.orderBy [E.desc $ tcr E.^. TicketClaimRequestCreated]
return return
( sharer ^. SharerIdent ( sharer E.^. SharerIdent
, project ^. ProjectIdent , project E.^. ProjectIdent
, ticket ^. TicketNumber , ticket E.^. TicketNumber
, ticket ^. TicketTitle , ticket E.^. TicketTitle
, tcr ^. TicketClaimRequestCreated , tcr E.^. TicketClaimRequestCreated
) )
defaultLayout $(widgetFile "person/claim-requests") defaultLayout $(widgetFile "person/claim-requests")
@ -560,22 +559,22 @@ getClaimRequestsProjectR shr prj = do
rqs <- runDB $ do rqs <- runDB $ do
Entity sid _ <- getBy404 $ UniqueSharer shr Entity sid _ <- getBy404 $ UniqueSharer shr
Entity jid _ <- getBy404 $ UniqueProject prj sid Entity jid _ <- getBy404 $ UniqueProject prj sid
select $ from $ E.select $ E.from $
\ ( tcr `InnerJoin` \ ( tcr `E.InnerJoin`
ticket `InnerJoin` ticket `E.InnerJoin`
person `InnerJoin` person `E.InnerJoin`
sharer sharer
) -> do ) -> do
on $ person ^. PersonIdent ==. sharer ^. SharerId E.on $ person E.^. PersonIdent E.==. sharer E.^. SharerId
on $ tcr ^. TicketClaimRequestPerson ==. person ^. PersonId E.on $ tcr E.^. TicketClaimRequestPerson E.==. person E.^. PersonId
on $ tcr ^. TicketClaimRequestTicket ==. ticket ^. TicketId E.on $ tcr E.^. TicketClaimRequestTicket E.==. ticket E.^. TicketId
where_ $ ticket ^. TicketProject ==. val jid E.where_ $ ticket E.^. TicketProject E.==. E.val jid
orderBy [desc $ tcr ^. TicketClaimRequestCreated] E.orderBy [E.desc $ tcr E.^. TicketClaimRequestCreated]
return return
( sharer ( sharer
, ticket ^. TicketNumber , ticket E.^. TicketNumber
, ticket ^. TicketTitle , ticket E.^. TicketTitle
, tcr ^. TicketClaimRequestCreated , tcr E.^. TicketClaimRequestCreated
) )
defaultLayout $(widgetFile "project/claim-request/list") defaultLayout $(widgetFile "project/claim-request/list")
@ -586,11 +585,11 @@ getClaimRequestsTicketR shr prj num = do
Entity sid _ <- getBy404 $ UniqueSharer shr Entity sid _ <- getBy404 $ UniqueSharer shr
Entity jid _ <- getBy404 $ UniqueProject prj sid Entity jid _ <- getBy404 $ UniqueProject prj sid
Entity tid _ <- getBy404 $ UniqueTicket jid num Entity tid _ <- getBy404 $ UniqueTicket jid num
select $ from $ \ (tcr `InnerJoin` person `InnerJoin` sharer) -> do E.select $ E.from $ \ (tcr `E.InnerJoin` person `E.InnerJoin` sharer) -> do
on $ person ^. PersonIdent ==. sharer ^. SharerId E.on $ person E.^. PersonIdent E.==. sharer E.^. SharerId
on $ tcr ^. TicketClaimRequestPerson ==. person ^. PersonId E.on $ tcr E.^. TicketClaimRequestPerson E.==. person E.^. PersonId
where_ $ tcr ^. TicketClaimRequestTicket ==. val tid E.where_ $ tcr E.^. TicketClaimRequestTicket E.==. E.val tid
orderBy [desc $ tcr ^. TicketClaimRequestCreated] E.orderBy [E.desc $ tcr E.^. TicketClaimRequestCreated]
return (sharer, tcr) return (sharer, tcr)
defaultLayout $(widgetFile "ticket/claim-request/list") defaultLayout $(widgetFile "ticket/claim-request/list")
@ -699,22 +698,22 @@ getTicketDeps forward shr prj num = do
Entity sid _ <- getBy404 $ UniqueSharer shr Entity sid _ <- getBy404 $ UniqueSharer shr
Entity jid _ <- getBy404 $ UniqueProject prj sid Entity jid _ <- getBy404 $ UniqueProject prj sid
Entity tid _ <- getBy404 $ UniqueTicket jid num Entity tid _ <- getBy404 $ UniqueTicket jid num
select $ from $ E.select $ E.from $
\ ( td `InnerJoin` \ ( td `E.InnerJoin`
ticket `InnerJoin` ticket `E.InnerJoin`
person `InnerJoin` person `E.InnerJoin`
sharer sharer
) -> do ) -> do
on $ person ^. PersonIdent ==. sharer ^. SharerId E.on $ person E.^. PersonIdent E.==. sharer E.^. SharerId
on $ ticket ^. TicketCreator ==. person ^. PersonId E.on $ ticket E.^. TicketCreator E.==. person E.^. PersonId
on $ td ^. to' ==. ticket ^. TicketId E.on $ td E.^. to' E.==. ticket E.^. TicketId
where_ $ td ^. from' ==. val tid E.where_ $ td E.^. from' E.==. E.val tid
orderBy [asc $ ticket ^. TicketNumber] E.orderBy [E.asc $ ticket E.^. TicketNumber]
return return
( ticket ^. TicketNumber ( ticket E.^. TicketNumber
, sharer , sharer
, ticket ^. TicketTitle , ticket E.^. TicketTitle
, ticket ^. TicketStatus , ticket E.^. TicketStatus
) )
defaultLayout $(widgetFile "ticket/dep/list") defaultLayout $(widgetFile "ticket/dep/list")

2
templates/person/claim-requests.hamlet
View file

@ -18,7 +18,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<th># <th>#
<th>Title <th>Title
<th>Created on <th>Created on
$forall (Value shr, Value prj, Value num, Value title, Value time) <- rqs $forall (E.Value shr, E.Value prj, E.Value num, E.Value title, E.Value time) <- rqs
<tr> <tr>
<td> <td>
<a href=@{SharerR shr}>#{shr2text shr} <a href=@{SharerR shr}>#{shr2text shr}

2
templates/project/claim-request/list.hamlet
View file

@ -18,7 +18,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<th>Opened by <th>Opened by
<th># <th>#
<th>Title <th>Title
$forall (Entity _ sharer, Value num, Value title, Value time) <- rqs $forall (Entity _ sharer, E.Value num, E.Value title, E.Value time) <- rqs
<tr> <tr>
<td> <td>
#{showDate time} #{showDate time}

2
templates/ticket/dep/list.hamlet
View file

@ -20,7 +20,7 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<th>Status <th>Status
$if forward $if forward
<th>Remove dependency <th>Remove dependency
$forall (Value number, Entity _ author, Value title, Value status) <- rows $forall (E.Value number, Entity _ author, E.Value title, E.Value status) <- rows
<tr> <tr>
<td> <td>
<a href=@{TicketR shr prj number}>#{number} <a href=@{TicketR shr prj number}>#{number}