forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Include custom ticket enum fields in new ticket form

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

43
src/Vervis/Form/Ticket.hs
View file

@ -28,7 +28,7 @@ import Prelude
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes, mapMaybe)
import Data.Text (Text) import Data.Text (Text)
import Data.Time.Calendar (Day (..)) import Data.Time.Calendar (Day (..))
import Data.Time.Clock (getCurrentTime, UTCTime (..)) import Data.Time.Clock (getCurrentTime, UTCTime (..))
@ -56,10 +56,11 @@ data NewTicket = NewTicket
{ ntTitle :: Text { ntTitle :: Text
, ntDesc :: Text , ntDesc :: Text
, ntTParams :: [(WorkflowFieldId, Text)] , ntTParams :: [(WorkflowFieldId, Text)]
, ntEParams :: [(WorkflowFieldId, WorkflowFieldEnumCtorId)]
} }
tfieldSettings :: Text -> Bool -> FieldSettings App fieldSettings :: Text -> Bool -> FieldSettings App
tfieldSettings name req = fieldSettings name req =
fieldSettingsLabel $ fieldSettingsLabel $
if req if req
then name `T.snoc` '*' then name `T.snoc` '*'
@ -67,28 +68,56 @@ tfieldSettings name req =
tfield :: Entity WorkflowField -> AForm Handler (Maybe (WorkflowFieldId, Text)) tfield :: Entity WorkflowField -> AForm Handler (Maybe (WorkflowFieldId, Text))
tfield (Entity fid f) = tfield (Entity fid f) =
let sets = tfieldSettings (workflowFieldName f) (workflowFieldRequired f) let sets = fieldSettings (workflowFieldName f) (workflowFieldRequired f)
in fmap (fid, ) <$> in fmap (fid, ) <$>
if workflowFieldRequired f if workflowFieldRequired f
then Just <$> areq textField sets Nothing then Just <$> areq textField sets Nothing
else aopt 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 :: WorkflowId -> Form NewTicket
newTicketForm wid html = do newTicketForm wid html = do
tfs <- (tfs, efs) <- lift $ runDB $ do
lift $ runDB $ tfs <- selectList
selectList
[ WorkflowFieldWorkflow ==. wid [ WorkflowFieldWorkflow ==. wid
, WorkflowFieldType ==. WFTText , WorkflowFieldType ==. WFTText
, WorkflowFieldEnm ==. Nothing , WorkflowFieldEnm ==. Nothing
] ]
[] []
efs <- selectList
[ WorkflowFieldWorkflow ==. wid
, WorkflowFieldType ==. WFTEnum
]
[]
return (tfs, efs)
flip renderDivs html $ NewTicket flip renderDivs html $ NewTicket
<$> areq textField "Title*" Nothing <$> areq textField "Title*" Nothing
<*> ( maybe "" unTextarea <$> <*> ( maybe "" unTextarea <$>
aopt textareaField "Description (Markdown)" Nothing aopt textareaField "Description (Markdown)" Nothing
) )
<*> (catMaybes <$> traverse tfield tfs) <*> (catMaybes <$> traverse tfield tfs)
<*> (fmap catMaybes $ sequenceA $ mapMaybe efield efs)
editTicketContentAForm :: Ticket -> AForm Handler Ticket editTicketContentAForm :: Ticket -> AForm Handler Ticket
editTicketContentAForm ticket = Ticket editTicketContentAForm ticket = Ticket

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

@ -149,12 +149,18 @@ postTicketsR shar proj = do
, ticketDiscuss = did , ticketDiscuss = did
} }
tid <- insert ticket tid <- insert ticket
let mkparam (fid, v) = TicketParamText let mktparam (fid, v) = TicketParamText
{ ticketParamTextTicket = tid { ticketParamTextTicket = tid
, ticketParamTextField = fid , ticketParamTextField = fid
, ticketParamTextValue = v , 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 return $ ticketNumber ticket
setMessage "Ticket created." setMessage "Ticket created."
redirect $ TicketR shar proj tnum redirect $ TicketR shar proj tnum