Include custom ticket enum fields in new ticket form

This commit is contained in:
fr33domlover 2016-08-09 12:34:03 +00:00
parent 6457bf5607
commit 19c18b031e
2 changed files with 44 additions and 9 deletions

View file

@ -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

View file

@ -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