Include custom ticket enum fields in new ticket form
This commit is contained in:
parent
6457bf5607
commit
19c18b031e
2 changed files with 44 additions and 9 deletions
|
@ -28,7 +28,7 @@ import Prelude
|
|||
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
import Data.Maybe (catMaybes)
|
||||
import Data.Maybe (catMaybes, mapMaybe)
|
||||
import Data.Text (Text)
|
||||
import Data.Time.Calendar (Day (..))
|
||||
import Data.Time.Clock (getCurrentTime, UTCTime (..))
|
||||
|
@ -56,10 +56,11 @@ data NewTicket = NewTicket
|
|||
{ ntTitle :: Text
|
||||
, ntDesc :: Text
|
||||
, ntTParams :: [(WorkflowFieldId, Text)]
|
||||
, ntEParams :: [(WorkflowFieldId, WorkflowFieldEnumCtorId)]
|
||||
}
|
||||
|
||||
tfieldSettings :: Text -> Bool -> FieldSettings App
|
||||
tfieldSettings name req =
|
||||
fieldSettings :: Text -> Bool -> FieldSettings App
|
||||
fieldSettings name req =
|
||||
fieldSettingsLabel $
|
||||
if req
|
||||
then name `T.snoc` '*'
|
||||
|
@ -67,28 +68,56 @@ tfieldSettings name req =
|
|||
|
||||
tfield :: Entity WorkflowField -> AForm Handler (Maybe (WorkflowFieldId, Text))
|
||||
tfield (Entity fid f) =
|
||||
let sets = tfieldSettings (workflowFieldName f) (workflowFieldRequired f)
|
||||
let sets = fieldSettings (workflowFieldName f) (workflowFieldRequired f)
|
||||
in fmap (fid, ) <$>
|
||||
if workflowFieldRequired f
|
||||
then Just <$> areq textField sets Nothing
|
||||
else aopt textField sets Nothing
|
||||
|
||||
efield
|
||||
:: Entity WorkflowField
|
||||
-> Maybe (AForm Handler (Maybe (WorkflowFieldId, WorkflowFieldEnumCtorId)))
|
||||
efield (Entity fid f) =
|
||||
case workflowFieldEnm f of
|
||||
Nothing -> Nothing
|
||||
Just eid -> Just $
|
||||
let sets =
|
||||
fieldSettings
|
||||
(workflowFieldName f)
|
||||
(workflowFieldRequired f)
|
||||
sel =
|
||||
selectField $
|
||||
optionsPersistKey
|
||||
[WorkflowFieldEnumCtorEnum ==. eid]
|
||||
[]
|
||||
workflowFieldEnumCtorName
|
||||
in fmap (fid, ) <$>
|
||||
if workflowFieldRequired f
|
||||
then Just <$> areq sel sets Nothing
|
||||
else aopt sel sets Nothing
|
||||
|
||||
newTicketForm :: WorkflowId -> Form NewTicket
|
||||
newTicketForm wid html = do
|
||||
tfs <-
|
||||
lift $ runDB $
|
||||
selectList
|
||||
(tfs, efs) <- lift $ runDB $ do
|
||||
tfs <- selectList
|
||||
[ WorkflowFieldWorkflow ==. wid
|
||||
, WorkflowFieldType ==. WFTText
|
||||
, WorkflowFieldEnm ==. Nothing
|
||||
]
|
||||
[]
|
||||
efs <- selectList
|
||||
[ WorkflowFieldWorkflow ==. wid
|
||||
, WorkflowFieldType ==. WFTEnum
|
||||
]
|
||||
[]
|
||||
return (tfs, efs)
|
||||
flip renderDivs html $ NewTicket
|
||||
<$> areq textField "Title*" Nothing
|
||||
<*> ( maybe "" unTextarea <$>
|
||||
aopt textareaField "Description (Markdown)" Nothing
|
||||
)
|
||||
<*> (catMaybes <$> traverse tfield tfs)
|
||||
<*> (fmap catMaybes $ sequenceA $ mapMaybe efield efs)
|
||||
|
||||
editTicketContentAForm :: Ticket -> AForm Handler Ticket
|
||||
editTicketContentAForm ticket = Ticket
|
||||
|
|
|
@ -149,12 +149,18 @@ postTicketsR shar proj = do
|
|||
, ticketDiscuss = did
|
||||
}
|
||||
tid <- insert ticket
|
||||
let mkparam (fid, v) = TicketParamText
|
||||
let mktparam (fid, v) = TicketParamText
|
||||
{ ticketParamTextTicket = tid
|
||||
, ticketParamTextField = fid
|
||||
, ticketParamTextValue = v
|
||||
}
|
||||
insertMany_ $ map mkparam $ ntTParams nt
|
||||
insertMany_ $ map mktparam $ ntTParams nt
|
||||
let mkeparam (fid, v) = TicketParamEnum
|
||||
{ ticketParamEnumTicket = tid
|
||||
, ticketParamEnumField = fid
|
||||
, ticketParamEnumValue = v
|
||||
}
|
||||
insertMany_ $ map mkeparam $ ntEParams nt
|
||||
return $ ticketNumber ticket
|
||||
setMessage "Ticket created."
|
||||
redirect $ TicketR shar proj tnum
|
||||
|
|
Loading…
Reference in a new issue