Display custom enum fields in ticket page
This commit is contained in:
fr33domlover
parent
1d0d4f697d
commit
6457bf5607
7 changed files with 104 additions and 39 deletions
|
|
@ -167,8 +167,9 @@ WorkflowField
|
|||
workflow WorkflowId
|
||||
ident FldIdent
|
||||
name Text
|
||||
desc Text Maybe
|
||||
desc Text Maybe
|
||||
type WorkflowFieldType
|
||||
enm WorkflowFieldEnumId Maybe
|
||||
required Bool
|
||||
-- filter TicketStatusFilterId
|
||||
|
||||
|
|
@ -196,6 +197,13 @@ TicketParamText
|
|||
|
||||
UniqueTicketParamText ticket field
|
||||
|
||||
TicketParamEnum
|
||||
ticket TicketId
|
||||
field WorkflowFieldId
|
||||
value WorkflowFieldEnumCtorId
|
||||
|
||||
UniqueTicketParamEnum ticket field value
|
||||
|
||||
Ticket
|
||||
project ProjectId
|
||||
number Int
|
||||
|
|
|
|||
|
|
@ -78,7 +78,10 @@ newTicketForm wid html = do
|
|||
tfs <-
|
||||
lift $ runDB $
|
||||
selectList
|
||||
[WorkflowFieldWorkflow ==. wid, WorkflowFieldType ==. WFTText]
|
||||
[ WorkflowFieldWorkflow ==. wid
|
||||
, WorkflowFieldType ==. WFTText
|
||||
, WorkflowFieldEnm ==. Nothing
|
||||
]
|
||||
[]
|
||||
flip renderDivs html $ NewTicket
|
||||
<$> areq textField "Title*" Nothing
|
||||
|
|
|
|||
|
|
@ -63,8 +63,8 @@ import Data.Time.Calendar (Day (..))
|
|||
import Data.Time.Clock (UTCTime (..), getCurrentTime)
|
||||
import Data.Time.Format (formatTime, defaultTimeLocale)
|
||||
import Data.Traversable (for)
|
||||
import Database.Esqueleto hiding ((==.), (=.), (+=.), update, delete)
|
||||
import Database.Persist
|
||||
import Database.Esqueleto hiding ((=.), (+=.), update, delete)
|
||||
import Database.Persist hiding ((==.))
|
||||
import Text.Blaze.Html (Html, toHtml)
|
||||
import Yesod.Auth (requireAuthId, maybeAuthId)
|
||||
import Yesod.Core (defaultLayout)
|
||||
|
|
@ -105,10 +105,10 @@ getTicketsR shar proj = do
|
|||
error $ "Ticket filter form failed: " ++ show l
|
||||
rows <- runDB $ select $ from $ \ (sharer, project, ticket) -> do
|
||||
where_ $ filterTickets tf ticket $
|
||||
sharer ^. SharerIdent E.==. val shar &&.
|
||||
project ^. ProjectSharer E.==. sharer ^. SharerId &&.
|
||||
project ^. ProjectIdent E.==. val proj &&.
|
||||
ticket ^. TicketProject E.==. project ^. ProjectId
|
||||
sharer ^. SharerIdent ==. val shar &&.
|
||||
project ^. ProjectSharer ==. sharer ^. SharerId &&.
|
||||
project ^. ProjectIdent ==. val proj &&.
|
||||
ticket ^. TicketProject ==. project ^. ProjectId
|
||||
orderBy [asc $ ticket ^. TicketNumber]
|
||||
return
|
||||
( ticket ^. TicketNumber
|
||||
|
|
@ -187,7 +187,8 @@ getTicketNewR shar proj = do
|
|||
getTicketR :: ShrIdent -> PrjIdent -> Int -> Handler Html
|
||||
getTicketR shar proj num = do
|
||||
mpid <- maybeAuthId
|
||||
(wshr, wfl, author, massignee, closer, ticket, tparams, deps, rdeps) <-
|
||||
( wshr, wfl,
|
||||
author, massignee, closer, ticket, tparams, eparams, deps, rdeps) <-
|
||||
runDB $ do
|
||||
(jid, wshr, wid, wfl) <- do
|
||||
Entity s sharer <- getBy404 $ UniqueSharer shar
|
||||
|
|
@ -217,31 +218,52 @@ getTicketR shar proj num = do
|
|||
person <- get404 $ ticketCloser ticket
|
||||
get404 $ personIdent person
|
||||
else return author
|
||||
tparams <- select $ from $ \ (f `LeftOuterJoin` p) -> do
|
||||
tparams <- select $ from $ \ (p `RightOuterJoin` f) -> do
|
||||
on $
|
||||
just (f ^. WorkflowFieldId) E.==. p ?. TicketParamTextField
|
||||
p ?. TicketParamTextField ==. just (f ^. WorkflowFieldId)
|
||||
&&.
|
||||
p ?. TicketParamTextTicket E.==. just (val tid)
|
||||
p ?. TicketParamTextTicket ==. just (val tid)
|
||||
where_ $
|
||||
f ^. WorkflowFieldWorkflow E.==. val wid &&.
|
||||
f ^. WorkflowFieldType E.==. val WFTText
|
||||
f ^. WorkflowFieldWorkflow ==. val wid &&.
|
||||
f ^. WorkflowFieldType ==. val WFTText &&.
|
||||
isNothing (f ^. WorkflowFieldEnm)
|
||||
return
|
||||
( f ^. WorkflowFieldIdent
|
||||
, f ^. WorkflowFieldName
|
||||
, f ^. WorkflowFieldRequired
|
||||
, p ?. TicketParamTextValue
|
||||
)
|
||||
eparams <- select $ from $ \ (p `InnerJoin` c `InnerJoin` e `RightOuterJoin` f) -> do
|
||||
on $
|
||||
f ^. WorkflowFieldWorkflow ==. val wid &&.
|
||||
f ^. WorkflowFieldType ==. val WFTEnum &&.
|
||||
f ^. WorkflowFieldEnm ==. e ?. WorkflowFieldEnumId &&.
|
||||
p ?. TicketParamEnumField ==. just (f ^. WorkflowFieldId)
|
||||
on $
|
||||
e ?. WorkflowFieldEnumWorkflow ==. just (val wid) &&.
|
||||
c ?. WorkflowFieldEnumCtorEnum ==. e ?. WorkflowFieldEnumId
|
||||
on $
|
||||
p ?. TicketParamEnumTicket ==. just (val tid) &&.
|
||||
p ?. TicketParamEnumValue ==. c ?. WorkflowFieldEnumCtorId
|
||||
return
|
||||
( f ^. WorkflowFieldIdent
|
||||
, f ^. WorkflowFieldName
|
||||
, f ^. WorkflowFieldRequired
|
||||
, e ?. WorkflowFieldEnumIdent
|
||||
, c ?. WorkflowFieldEnumCtorName
|
||||
)
|
||||
deps <- select $ from $ \ (dep `InnerJoin` t) -> do
|
||||
on $ dep ^. TicketDependencyChild E.==. t ^. TicketId
|
||||
where_ $ dep ^. TicketDependencyParent E.==. val tid
|
||||
on $ dep ^. TicketDependencyChild ==. t ^. TicketId
|
||||
where_ $ dep ^. TicketDependencyParent ==. val tid
|
||||
return t
|
||||
rdeps <- select $ from $ \ (dep `InnerJoin` t) -> do
|
||||
on $ dep ^. TicketDependencyParent E.==. t ^. TicketId
|
||||
where_ $ dep ^. TicketDependencyChild E.==. val tid
|
||||
on $ dep ^. TicketDependencyParent ==. t ^. TicketId
|
||||
where_ $ dep ^. TicketDependencyChild ==. val tid
|
||||
return t
|
||||
return
|
||||
( wshr, wfl
|
||||
, author, massignee, closer, ticket, tparams, deps, rdeps
|
||||
, author, massignee, closer, ticket, tparams, eparams
|
||||
, deps, rdeps
|
||||
)
|
||||
let desc = renderSourceT Markdown $ T.filter (/= '\r') $ ticketDesc ticket
|
||||
discuss =
|
||||
|
|
@ -249,6 +271,7 @@ getTicketR shar proj num = do
|
|||
(return $ ticketDiscuss ticket)
|
||||
(TicketTopReplyR shar proj num)
|
||||
(TicketReplyR shar proj num)
|
||||
error' = error :: String -> String
|
||||
defaultLayout $(widgetFile "ticket/one")
|
||||
|
||||
putTicketR :: ShrIdent -> PrjIdent -> Int -> Handler Html
|
||||
|
|
@ -467,10 +490,10 @@ getClaimRequestsPersonR = do
|
|||
pid <- requireAuthId
|
||||
rqs <- runDB $ select $ from $
|
||||
\ (tcr `InnerJoin` ticket `InnerJoin` project `InnerJoin` sharer) -> do
|
||||
on $ project ^. ProjectSharer E.==. sharer ^. SharerId
|
||||
on $ ticket ^. TicketProject E.==. project ^. ProjectId
|
||||
on $ tcr ^. TicketClaimRequestTicket E.==. ticket ^. TicketId
|
||||
where_ $ tcr ^. TicketClaimRequestPerson E.==. val pid
|
||||
on $ project ^. ProjectSharer ==. sharer ^. SharerId
|
||||
on $ ticket ^. TicketProject ==. project ^. ProjectId
|
||||
on $ tcr ^. TicketClaimRequestTicket ==. ticket ^. TicketId
|
||||
where_ $ tcr ^. TicketClaimRequestPerson ==. val pid
|
||||
orderBy [desc $ tcr ^. TicketClaimRequestCreated]
|
||||
return
|
||||
( sharer ^. SharerIdent
|
||||
|
|
@ -493,10 +516,10 @@ getClaimRequestsProjectR shr prj = do
|
|||
person `InnerJoin`
|
||||
sharer
|
||||
) -> do
|
||||
on $ person ^. PersonIdent E.==. sharer ^. SharerId
|
||||
on $ tcr ^. TicketClaimRequestPerson E.==. person ^. PersonId
|
||||
on $ tcr ^. TicketClaimRequestTicket E.==. ticket ^. TicketId
|
||||
where_ $ ticket ^. TicketProject E.==. val jid
|
||||
on $ person ^. PersonIdent ==. sharer ^. SharerId
|
||||
on $ tcr ^. TicketClaimRequestPerson ==. person ^. PersonId
|
||||
on $ tcr ^. TicketClaimRequestTicket ==. ticket ^. TicketId
|
||||
where_ $ ticket ^. TicketProject ==. val jid
|
||||
orderBy [desc $ tcr ^. TicketClaimRequestCreated]
|
||||
return
|
||||
( sharer
|
||||
|
|
@ -514,9 +537,9 @@ getClaimRequestsTicketR shr prj num = do
|
|||
Entity jid _ <- getBy404 $ UniqueProject prj sid
|
||||
Entity tid _ <- getBy404 $ UniqueTicket jid num
|
||||
select $ from $ \ (tcr `InnerJoin` person `InnerJoin` sharer) -> do
|
||||
on $ person ^. PersonIdent E.==. sharer ^. SharerId
|
||||
on $ tcr ^. TicketClaimRequestPerson E.==. person ^. PersonId
|
||||
where_ $ tcr ^. TicketClaimRequestTicket E.==. val tid
|
||||
on $ person ^. PersonIdent ==. sharer ^. SharerId
|
||||
on $ tcr ^. TicketClaimRequestPerson ==. person ^. PersonId
|
||||
where_ $ tcr ^. TicketClaimRequestTicket ==. val tid
|
||||
orderBy [desc $ tcr ^. TicketClaimRequestCreated]
|
||||
return (sharer, tcr)
|
||||
defaultLayout $(widgetFile "ticket/claim-request/list")
|
||||
|
|
@ -620,10 +643,10 @@ getTicketDeps forward shr prj num = do
|
|||
person `InnerJoin`
|
||||
sharer
|
||||
) -> do
|
||||
on $ person ^. PersonIdent E.==. sharer ^. SharerId
|
||||
on $ ticket ^. TicketCreator E.==. person ^. PersonId
|
||||
on $ td ^. to' E.==. ticket ^. TicketId
|
||||
where_ $ td ^. from' E.==. val tid
|
||||
on $ person ^. PersonIdent ==. sharer ^. SharerId
|
||||
on $ ticket ^. TicketCreator ==. person ^. PersonId
|
||||
on $ td ^. to' ==. ticket ^. TicketId
|
||||
where_ $ td ^. from' ==. val tid
|
||||
orderBy [asc $ ticket ^. TicketNumber]
|
||||
return
|
||||
( ticket ^. TicketNumber
|
||||
|
|
|
|||
|
|
@ -56,12 +56,13 @@ import Yesod.Core (defaultLayout)
|
|||
import Yesod.Core.Handler (redirect, setMessage, lookupPostParam, notFound)
|
||||
import Yesod.Form.Functions (runFormPost)
|
||||
import Yesod.Form.Types (FormResult (..))
|
||||
import Yesod.Persist.Core (runDB, getBy404)
|
||||
import Yesod.Persist.Core (runDB, get404, getBy404)
|
||||
|
||||
import Vervis.Form.Workflow
|
||||
import Vervis.Foundation
|
||||
import Vervis.Model
|
||||
import Vervis.Model.Ident
|
||||
import Vervis.Model.Workflow
|
||||
import Vervis.Settings
|
||||
import Vervis.Widget.Sharer
|
||||
|
||||
|
|
@ -149,6 +150,7 @@ postWorkflowFieldsR shr wfl = do
|
|||
, workflowFieldName = nfName nf
|
||||
, workflowFieldDesc = nfDesc nf
|
||||
, workflowFieldType = nfType nf
|
||||
, workflowFieldEnm = Nothing
|
||||
, workflowFieldRequired = nfReq nf
|
||||
}
|
||||
runDB $ insert_ field
|
||||
|
|
@ -172,11 +174,18 @@ getWorkflowFieldNewR shr wfl = do
|
|||
|
||||
getWorkflowFieldR :: ShrIdent -> WflIdent -> FldIdent -> Handler Html
|
||||
getWorkflowFieldR shr wfl fld = do
|
||||
f <- runDB $ do
|
||||
(f, e) <- runDB $ do
|
||||
Entity sid _ <- getBy404 $ UniqueSharer shr
|
||||
Entity wid _ <- getBy404 $ UniqueWorkflow sid wfl
|
||||
Entity _ f <- getBy404 $ UniqueWorkflowField wid fld
|
||||
return f
|
||||
let typ = workflowFieldType f
|
||||
menum = workflowFieldEnm f
|
||||
e <- case (typ, menum) of
|
||||
(WFTEnum, Just eid) -> Right <$> get404 eid
|
||||
(WFTEnum, Nothing) -> error "enum field doesn't specify enum"
|
||||
(_, Just _) -> error "non-enum field specifies enum"
|
||||
(_, Nothing) -> return $ Left typ
|
||||
return (f, e)
|
||||
defaultLayout $(widgetFile "workflow/field/one")
|
||||
|
||||
deleteWorkflowFieldR :: ShrIdent -> WflIdent -> FldIdent -> Handler Html
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@ import Prelude
|
|||
|
||||
import Database.Persist.TH
|
||||
|
||||
data WorkflowFieldType = WFTText
|
||||
data WorkflowFieldType = WFTText | WFTEnum
|
||||
deriving (Eq, Show, Read, Bounded, Enum)
|
||||
|
||||
derivePersistField "WorkflowFieldType"
|
||||
|
|
|
|||
|
|
@ -115,6 +115,22 @@ $if not $ ticketDone ticket
|
|||
NO VALUE FOR REQUIRED FIELD
|
||||
$else
|
||||
(none)
|
||||
$forall (Value fld, Value name, Value req, Value me, Value mc) <- eparams
|
||||
<li>
|
||||
<a href=@{WorkflowFieldR wshr wfl fld}>
|
||||
#{name}
|
||||
:
|
||||
$case (me, mc)
|
||||
$of (Just e, Just c)
|
||||
<a href=@{WorkflowEnumCtorsR wshr wfl e}>
|
||||
#{c}
|
||||
$of (Nothing, Nothing)
|
||||
$if req
|
||||
NO VALUE FOR REQUIRED FIELD
|
||||
$else
|
||||
(none)
|
||||
$of _
|
||||
#{error' "Impossible!"}
|
||||
|
||||
<h3>Discussion
|
||||
|
||||
|
|
|
|||
|
|
@ -23,6 +23,12 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|||
<li>
|
||||
Description: #{fromMaybe "(none)" $ workflowFieldDesc f}
|
||||
<li>
|
||||
Type: #{show $ workflowFieldType f}
|
||||
Type:
|
||||
$case e
|
||||
$of Left typ
|
||||
#{show typ}
|
||||
$of Right enum
|
||||
<a href=@{WorkflowEnumR shr wfl $ workflowFieldEnumIdent enum}>
|
||||
#{workflowFieldEnumName enum}
|
||||
<li>
|
||||
Required: #{workflowFieldRequired f}
|
||||
|
|
|
|||
Loading…
Reference in a new issue