Ticket content edit form lets you edit custom ticket params
This commit is contained in:
fr33domlover
parent
d7be2f04b2
commit
941bd0ea03
5 changed files with 304 additions and 72 deletions
|
|
@ -26,6 +26,7 @@ where
|
|||
|
||||
import Prelude
|
||||
|
||||
import Control.Applicative (liftA2, liftA3)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
import Data.Maybe (catMaybes, mapMaybe)
|
||||
|
|
@ -42,16 +43,11 @@ import Vervis.Field.Ticket
|
|||
import Vervis.Foundation (App, Form, Handler)
|
||||
import Vervis.Model
|
||||
import Vervis.Model.Workflow
|
||||
import Vervis.Ticket
|
||||
import Vervis.TicketFilter (TicketFilter (..))
|
||||
|
||||
--TODO use custom fields to ensure uniqueness or other constraints?
|
||||
|
||||
defTime :: UTCTime
|
||||
defTime = UTCTime (ModifiedJulianDay 0) 0
|
||||
|
||||
now :: AForm Handler UTCTime
|
||||
now = lift $ liftIO getCurrentTime
|
||||
|
||||
data NewTicket = NewTicket
|
||||
{ ntTitle :: Text
|
||||
, ntDesc :: Text
|
||||
|
|
@ -138,8 +134,66 @@ editTicketContentAForm ticket = Ticket
|
|||
<*> pure (ticketCloser ticket)
|
||||
<*> pure (ticketDiscuss ticket)
|
||||
|
||||
editTicketContentForm :: Ticket -> Form Ticket
|
||||
editTicketContentForm t = renderDivs $ editTicketContentAForm t
|
||||
tEditField
|
||||
:: TicketTextParam
|
||||
-> AForm Handler (Maybe TicketParamTextId, Maybe (WorkflowFieldId, Text))
|
||||
tEditField (TicketTextParam (WorkflowFieldSummary fid _ name req _) mv) =
|
||||
let sets = fieldSettings name req
|
||||
in (ttpvId <$> mv, ) . fmap (fid, ) <$>
|
||||
if req
|
||||
then Just <$> areq textField sets (ttpvVal <$> mv)
|
||||
else aopt textField sets (Just . ttpvVal <$> mv)
|
||||
|
||||
eEditField
|
||||
:: TicketEnumParam
|
||||
-> AForm
|
||||
Handler
|
||||
( Maybe TicketParamEnumId
|
||||
, Maybe (WorkflowFieldId, WorkflowFieldEnumCtorId)
|
||||
)
|
||||
eEditField (TicketEnumParam (WorkflowFieldSummary fid _ name req _) e mv) =
|
||||
let sets = fieldSettings name req
|
||||
sel =
|
||||
selectField $
|
||||
optionsPersistKey
|
||||
[WorkflowFieldEnumCtorEnum ==. wesId e]
|
||||
[]
|
||||
workflowFieldEnumCtorName
|
||||
in (tepvId <$> mv, ) . fmap (fid, ) <$>
|
||||
if req
|
||||
then Just <$> areq sel sets (tepvVal <$> mv)
|
||||
else aopt sel sets (Just . tepvVal <$> mv)
|
||||
|
||||
editTicketContentForm
|
||||
:: TicketId
|
||||
-> Ticket
|
||||
-> WorkflowId
|
||||
-> Form
|
||||
( Ticket
|
||||
, [ ( Maybe TicketParamTextId
|
||||
, Maybe (WorkflowFieldId, Text)
|
||||
)
|
||||
]
|
||||
, [ ( Maybe TicketParamEnumId
|
||||
, Maybe (WorkflowFieldId, WorkflowFieldEnumCtorId)
|
||||
)
|
||||
]
|
||||
)
|
||||
editTicketContentForm tid t wid html = do
|
||||
(tfs, efs) <-
|
||||
lift $ runDB $
|
||||
liftA2 (,)
|
||||
( filter (not . wfsConstant . ttpField) <$>
|
||||
getTicketTextParams tid wid
|
||||
)
|
||||
( filter (not . wfsConstant . tepField) <$>
|
||||
getTicketEnumParams tid wid
|
||||
)
|
||||
flip renderDivs html $
|
||||
liftA3 (,,)
|
||||
(editTicketContentAForm t)
|
||||
(traverse tEditField tfs)
|
||||
(traverse eEditField efs)
|
||||
|
||||
assignTicketAForm :: PersonId -> ProjectId -> AForm Handler PersonId
|
||||
assignTicketAForm pid jid =
|
||||
|
|
|
|||
|
|
@ -56,6 +56,7 @@ import Control.Applicative (liftA2)
|
|||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Logger (logWarn)
|
||||
import Data.Default.Class (def)
|
||||
import Data.Foldable (traverse_)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Text (Text)
|
||||
|
|
@ -76,6 +77,7 @@ import Yesod.Persist.Core (runDB, get404, getBy404)
|
|||
import qualified Data.Text as T (filter, intercalate, pack)
|
||||
import qualified Database.Esqueleto as E ((==.))
|
||||
|
||||
import Data.Maybe.Local (partitionMaybePairs)
|
||||
import Database.Persist.Sql.Graph.TransitiveReduction (trrFix)
|
||||
import Vervis.Form.Ticket
|
||||
import Vervis.Foundation
|
||||
|
|
@ -224,40 +226,8 @@ getTicketR shar proj num = do
|
|||
person <- get404 $ ticketCloser ticket
|
||||
get404 $ personIdent person
|
||||
else return author
|
||||
tparams <- select $ from $ \ (p `RightOuterJoin` f) -> do
|
||||
on $
|
||||
p ?. TicketParamTextField ==. just (f ^. WorkflowFieldId)
|
||||
&&.
|
||||
p ?. TicketParamTextTicket ==. just (val tid)
|
||||
where_ $
|
||||
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
|
||||
)
|
||||
tparams <- getTicketTextParams tid wid
|
||||
eparams <- getTicketEnumParams tid wid
|
||||
deps <- select $ from $ \ (dep `InnerJoin` t) -> do
|
||||
on $ dep ^. TicketDependencyChild ==. t ^. TicketId
|
||||
where_ $ dep ^. TicketDependencyParent ==. val tid
|
||||
|
|
@ -277,19 +247,47 @@ 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
|
||||
putTicketR shar proj num = do
|
||||
Entity tid ticket <- runDB $ do
|
||||
(tid, ticket, wid) <- runDB $ do
|
||||
Entity sid _sharer <- getBy404 $ UniqueSharer shar
|
||||
Entity pid _project <- getBy404 $ UniqueProject proj sid
|
||||
getBy404 $ UniqueTicket pid num
|
||||
((result, widget), enctype) <- runFormPost $ editTicketContentForm ticket
|
||||
Entity pid project <- getBy404 $ UniqueProject proj sid
|
||||
Entity tid ticket <- getBy404 $ UniqueTicket pid num
|
||||
return (tid, ticket, projectWorkflow project)
|
||||
((result, widget), enctype) <-
|
||||
runFormPost $ editTicketContentForm tid ticket wid
|
||||
case result of
|
||||
FormSuccess ticket' -> do
|
||||
runDB $ replace tid ticket'
|
||||
FormSuccess (ticket', tparams, eparams) -> do
|
||||
runDB $ do
|
||||
replace tid ticket'
|
||||
let (tdel, tins, tupd) = partitionMaybePairs tparams
|
||||
deleteWhere [TicketParamTextId <-. tdel]
|
||||
let mktparam (fid, v) = TicketParamText
|
||||
{ ticketParamTextTicket = tid
|
||||
, ticketParamTextField = fid
|
||||
, ticketParamTextValue = v
|
||||
}
|
||||
insertMany_ $ map mktparam tins
|
||||
traverse_
|
||||
(\ (aid, (_fid, v)) ->
|
||||
update aid [TicketParamTextValue =. v]
|
||||
)
|
||||
tupd
|
||||
let (edel, eins, eupd) = partitionMaybePairs eparams
|
||||
deleteWhere [TicketParamEnumId <-. edel]
|
||||
let mkeparam (fid, v) = TicketParamEnum
|
||||
{ ticketParamEnumTicket = tid
|
||||
, ticketParamEnumField = fid
|
||||
, ticketParamEnumValue = v
|
||||
}
|
||||
insertMany_ $ map mkeparam eins
|
||||
traverse_
|
||||
(\ (aid, (_fid, v)) ->
|
||||
update aid [TicketParamEnumValue =. v]
|
||||
)
|
||||
eupd
|
||||
setMessage "Ticket updated."
|
||||
redirect $ TicketR shar proj num
|
||||
FormMissing -> do
|
||||
|
|
@ -315,11 +313,13 @@ postTicketR shar proj num = do
|
|||
|
||||
getTicketEditR :: ShrIdent -> PrjIdent -> Int -> Handler Html
|
||||
getTicketEditR shar proj num = do
|
||||
Entity _tid ticket <- runDB $ do
|
||||
(tid, ticket, wid) <- runDB $ do
|
||||
Entity sid _sharer <- getBy404 $ UniqueSharer shar
|
||||
Entity pid _project <- getBy404 $ UniqueProject proj sid
|
||||
getBy404 $ UniqueTicket pid num
|
||||
((_result, widget), enctype) <- runFormPost $ editTicketContentForm ticket
|
||||
Entity pid project <- getBy404 $ UniqueProject proj sid
|
||||
Entity tid ticket <- getBy404 $ UniqueTicket pid num
|
||||
return (tid, ticket, projectWorkflow project)
|
||||
((_result, widget), enctype) <-
|
||||
runFormPost $ editTicketContentForm tid ticket wid
|
||||
defaultLayout $(widgetFile "ticket/edit")
|
||||
|
||||
postTicketCloseR :: ShrIdent -> PrjIdent -> Int -> Handler Html
|
||||
|
|
|
|||
|
|
@ -16,16 +16,27 @@
|
|||
module Vervis.Ticket
|
||||
( getTicketSummaries
|
||||
, getTicketDepEdges
|
||||
, WorkflowFieldSummary (..)
|
||||
, TicketTextParamValue (..)
|
||||
, TicketTextParam (..)
|
||||
, getTicketTextParams
|
||||
, WorkflowEnumSummary (..)
|
||||
, TicketEnumParamValue (..)
|
||||
, TicketEnumParam (..)
|
||||
, getTicketEnumParams
|
||||
)
|
||||
where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Control.Arrow ((***))
|
||||
import Data.Text (Text)
|
||||
import Database.Esqueleto
|
||||
|
||||
import Vervis.Foundation (AppDB)
|
||||
import Vervis.Model
|
||||
import Vervis.Model.Ident
|
||||
import Vervis.Model.Workflow
|
||||
import Vervis.Widget.Ticket (TicketSummary (..))
|
||||
|
||||
-- | Get summaries of all the tickets in the given project.
|
||||
|
|
@ -69,3 +80,172 @@ getTicketDepEdges jid =
|
|||
t2 ^. TicketProject ==. val jid
|
||||
orderBy [asc $ t1 ^. TicketNumber, asc $ t2 ^. TicketNumber]
|
||||
return (t1 ^. TicketNumber, t2 ^. TicketNumber)
|
||||
|
||||
data WorkflowFieldSummary = WorkflowFieldSummary
|
||||
{ wfsId :: WorkflowFieldId
|
||||
, wfsIdent :: FldIdent
|
||||
, wfsName :: Text
|
||||
, wfsRequired :: Bool
|
||||
, wfsConstant :: Bool
|
||||
}
|
||||
|
||||
data TicketTextParamValue = TicketTextParamValue
|
||||
{ ttpvId :: TicketParamTextId
|
||||
, ttpvVal :: Text
|
||||
}
|
||||
|
||||
data TicketTextParam = TicketTextParam
|
||||
{ ttpField :: WorkflowFieldSummary
|
||||
, ttpValue :: Maybe TicketTextParamValue
|
||||
}
|
||||
|
||||
toTParam
|
||||
:: ( Value WorkflowFieldId
|
||||
, Value FldIdent
|
||||
, Value Text
|
||||
, Value Bool
|
||||
, Value Bool
|
||||
, Value (Maybe TicketParamTextId)
|
||||
, Value (Maybe Text)
|
||||
)
|
||||
-> TicketTextParam
|
||||
toTParam
|
||||
( Value fid
|
||||
, Value fld
|
||||
, Value name
|
||||
, Value req
|
||||
, Value con
|
||||
, Value mp
|
||||
, Value mt
|
||||
) =
|
||||
TicketTextParam
|
||||
{ ttpField = WorkflowFieldSummary
|
||||
{ wfsId = fid
|
||||
, wfsIdent = fld
|
||||
, wfsName = name
|
||||
, wfsRequired = req
|
||||
, wfsConstant = con
|
||||
}
|
||||
, ttpValue =
|
||||
case (mp, mt) of
|
||||
(Just p, Just t) ->
|
||||
Just TicketTextParamValue
|
||||
{ ttpvId = p
|
||||
, ttpvVal = t
|
||||
}
|
||||
(Nothing, Nothing) -> Nothing
|
||||
_ -> error "Impossible"
|
||||
}
|
||||
|
||||
getTicketTextParams :: TicketId -> WorkflowId -> AppDB [TicketTextParam]
|
||||
getTicketTextParams tid wid = fmap (map toTParam) $
|
||||
select $ from $ \ (p `RightOuterJoin` f) -> do
|
||||
on $
|
||||
p ?. TicketParamTextField ==. just (f ^. WorkflowFieldId) &&.
|
||||
p ?. TicketParamTextTicket ==. just (val tid)
|
||||
where_ $
|
||||
f ^. WorkflowFieldWorkflow ==. val wid &&.
|
||||
f ^. WorkflowFieldType ==. val WFTText &&.
|
||||
isNothing (f ^. WorkflowFieldEnm)
|
||||
return
|
||||
( f ^. WorkflowFieldId
|
||||
, f ^. WorkflowFieldIdent
|
||||
, f ^. WorkflowFieldName
|
||||
, f ^. WorkflowFieldRequired
|
||||
, f ^. WorkflowFieldConstant
|
||||
, p ?. TicketParamTextId
|
||||
, p ?. TicketParamTextValue
|
||||
)
|
||||
|
||||
data WorkflowEnumSummary = WorkflowEnumSummary
|
||||
{ wesId :: WorkflowFieldEnumId
|
||||
, wesIdent :: EnmIdent
|
||||
}
|
||||
|
||||
data TicketEnumParamValue = TicketEnumParamValue
|
||||
{ tepvId :: TicketParamEnumId
|
||||
, tepvVal :: WorkflowFieldEnumCtorId
|
||||
, tepvName :: Text
|
||||
}
|
||||
|
||||
data TicketEnumParam = TicketEnumParam
|
||||
{ tepField :: WorkflowFieldSummary
|
||||
, tepEnum :: WorkflowEnumSummary
|
||||
, tepValue :: Maybe TicketEnumParamValue
|
||||
}
|
||||
|
||||
toEParam
|
||||
:: ( Value WorkflowFieldId
|
||||
, Value FldIdent
|
||||
, Value Text
|
||||
, Value Bool
|
||||
, Value Bool
|
||||
, Value WorkflowFieldEnumId
|
||||
, Value EnmIdent
|
||||
, Value (Maybe TicketParamEnumId)
|
||||
, Value (Maybe WorkflowFieldEnumCtorId)
|
||||
, Value (Maybe Text)
|
||||
)
|
||||
-> TicketEnumParam
|
||||
toEParam
|
||||
( Value fid
|
||||
, Value fld
|
||||
, Value name
|
||||
, Value req
|
||||
, Value con
|
||||
, Value i
|
||||
, Value e
|
||||
, Value mp
|
||||
, Value mc
|
||||
, Value mt
|
||||
) =
|
||||
TicketEnumParam
|
||||
{ tepField = WorkflowFieldSummary
|
||||
{ wfsId = fid
|
||||
, wfsIdent = fld
|
||||
, wfsName = name
|
||||
, wfsRequired = req
|
||||
, wfsConstant = con
|
||||
}
|
||||
, tepEnum = WorkflowEnumSummary
|
||||
{ wesId = i
|
||||
, wesIdent = e
|
||||
}
|
||||
, tepValue =
|
||||
case (mp, mc, mt) of
|
||||
(Just p, Just c, Just t) ->
|
||||
Just TicketEnumParamValue
|
||||
{ tepvId = p
|
||||
, tepvVal = c
|
||||
, tepvName = t
|
||||
}
|
||||
(Nothing, Nothing, Nothing) -> Nothing
|
||||
_ -> error "Impossible"
|
||||
}
|
||||
|
||||
getTicketEnumParams :: TicketId -> WorkflowId -> AppDB [TicketEnumParam]
|
||||
getTicketEnumParams tid wid = fmap (map toEParam) $
|
||||
select $ from $ \ (p `InnerJoin` c `RightOuterJoin` f `InnerJoin` e) -> do
|
||||
on $
|
||||
e ^. WorkflowFieldEnumWorkflow ==. val wid &&.
|
||||
f ^. WorkflowFieldEnm ==. just (e ^. WorkflowFieldEnumId)
|
||||
on $
|
||||
f ^. WorkflowFieldWorkflow ==. val wid &&.
|
||||
f ^. WorkflowFieldType ==. val WFTEnum &&.
|
||||
p ?. TicketParamEnumField ==. just (f ^. WorkflowFieldId) &&.
|
||||
c ?. WorkflowFieldEnumCtorEnum ==. f ^. WorkflowFieldEnm
|
||||
on $
|
||||
p ?. TicketParamEnumTicket ==. just (val tid) &&.
|
||||
p ?. TicketParamEnumValue ==. c ?. WorkflowFieldEnumCtorId
|
||||
return
|
||||
( f ^. WorkflowFieldId
|
||||
, f ^. WorkflowFieldIdent
|
||||
, f ^. WorkflowFieldName
|
||||
, f ^. WorkflowFieldRequired
|
||||
, f ^. WorkflowFieldConstant
|
||||
, e ^. WorkflowFieldEnumId
|
||||
, e ^. WorkflowFieldEnumIdent
|
||||
, p ?. TicketParamEnumId
|
||||
, c ?. WorkflowFieldEnumCtorId
|
||||
, c ?. WorkflowFieldEnumCtorName
|
||||
)
|
||||
|
|
|
|||
|
|
@ -103,34 +103,31 @@ $if not $ ticketDone ticket
|
|||
<h3>Custom fields
|
||||
|
||||
<ul>
|
||||
$forall (Value fld, Value name, Value req, Value mvalue) <- tparams
|
||||
$forall TicketTextParam field mvalue <- tparams
|
||||
<li>
|
||||
<a href=@{WorkflowFieldR wshr wfl fld}>
|
||||
#{name}
|
||||
<a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}>
|
||||
#{wfsName field}
|
||||
:
|
||||
$maybe value <- mvalue
|
||||
#{value}
|
||||
#{ttpvVal value}
|
||||
$nothing
|
||||
$if req
|
||||
$if wfsRequired field
|
||||
NO VALUE FOR REQUIRED FIELD
|
||||
$else
|
||||
(none)
|
||||
$forall (Value fld, Value name, Value req, Value me, Value mc) <- eparams
|
||||
$forall TicketEnumParam field enum mvalue <- eparams
|
||||
<li>
|
||||
<a href=@{WorkflowFieldR wshr wfl fld}>
|
||||
#{name}
|
||||
<a href=@{WorkflowFieldR wshr wfl $ wfsIdent field}>
|
||||
#{wfsName field}
|
||||
:
|
||||
$case (me, mc)
|
||||
$of (Just e, Just c)
|
||||
<a href=@{WorkflowEnumCtorsR wshr wfl e}>
|
||||
#{c}
|
||||
$of (Nothing, Nothing)
|
||||
$if req
|
||||
$maybe value <- mvalue
|
||||
<a href=@{WorkflowEnumCtorsR wshr wfl $ wesIdent enum}>
|
||||
#{tepvName value}
|
||||
$nothing
|
||||
$if wfsRequired field
|
||||
NO VALUE FOR REQUIRED FIELD
|
||||
$else
|
||||
(none)
|
||||
$of _
|
||||
#{error' "Impossible!"}
|
||||
|
||||
<h3>Discussion
|
||||
|
||||
|
|
|
|||
|
|
@ -61,6 +61,7 @@ library
|
|||
Data.HashMap.Lazy.Local
|
||||
Data.Hourglass.Local
|
||||
Data.List.Local
|
||||
Data.Maybe.Local
|
||||
Data.Paginate.Local
|
||||
Data.Revision.Local
|
||||
Data.Text.UTF8.Local
|
||||
|
|
|
|||
Loading…
Reference in a new issue