mirror of
https://code.sup39.dev/repos/Wqawg
synced 2025-03-20 04:46:22 +09:00
139 lines
4.3 KiB
Haskell
139 lines
4.3 KiB
Haskell
{- This file is part of Vervis.
|
|
-
|
|
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
|
-
|
|
- ♡ Copying is an act of love. Please copy, reuse and share.
|
|
-
|
|
- The author(s) have dedicated all copyright and related and neighboring
|
|
- rights to this software to the public domain worldwide. This software is
|
|
- distributed without any warranty.
|
|
-
|
|
- You should have received a copy of the CC0 Public Domain Dedication along
|
|
- with this software. If not, see
|
|
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|
-}
|
|
|
|
module Vervis.Form.Ticket
|
|
( NewTicket (..)
|
|
, newTicketForm
|
|
, editTicketContentForm
|
|
, assignTicketForm
|
|
, claimRequestForm
|
|
, ticketFilterForm
|
|
, ticketDepForm
|
|
)
|
|
where
|
|
|
|
import Prelude
|
|
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import Control.Monad.Trans.Class (lift)
|
|
import Data.Maybe (catMaybes)
|
|
import Data.Text (Text)
|
|
import Data.Time.Calendar (Day (..))
|
|
import Data.Time.Clock (getCurrentTime, UTCTime (..))
|
|
import Database.Persist
|
|
import Yesod.Form
|
|
import Yesod.Persist.Core (runDB)
|
|
|
|
import qualified Data.Text as T (snoc)
|
|
|
|
import Vervis.Field.Ticket
|
|
import Vervis.Foundation (App, Form, Handler)
|
|
import Vervis.Model
|
|
import Vervis.Model.Workflow
|
|
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
|
|
, ntTParams :: [(WorkflowFieldId, Text)]
|
|
}
|
|
|
|
tfieldSettings :: Text -> Bool -> FieldSettings App
|
|
tfieldSettings name req =
|
|
fieldSettingsLabel $
|
|
if req
|
|
then name `T.snoc` '*'
|
|
else name
|
|
|
|
tfield :: Entity WorkflowField -> AForm Handler (Maybe (WorkflowFieldId, Text))
|
|
tfield (Entity fid f) =
|
|
let sets = tfieldSettings (workflowFieldName f) (workflowFieldRequired f)
|
|
in fmap (fid, ) <$>
|
|
if workflowFieldRequired f
|
|
then Just <$> areq textField sets Nothing
|
|
else aopt textField sets Nothing
|
|
|
|
newTicketForm :: WorkflowId -> Form NewTicket
|
|
newTicketForm wid html = do
|
|
tfs <-
|
|
lift $ runDB $
|
|
selectList
|
|
[WorkflowFieldWorkflow ==. wid, WorkflowFieldType ==. WFTText]
|
|
[]
|
|
flip renderDivs html $ NewTicket
|
|
<$> areq textField "Title*" Nothing
|
|
<*> ( maybe "" unTextarea <$>
|
|
aopt textareaField "Description (Markdown)" Nothing
|
|
)
|
|
<*> (catMaybes <$> traverse tfield tfs)
|
|
|
|
editTicketContentAForm :: Ticket -> AForm Handler Ticket
|
|
editTicketContentAForm ticket = Ticket
|
|
<$> pure (ticketProject ticket)
|
|
<*> pure (ticketNumber ticket)
|
|
<*> pure (ticketCreated ticket)
|
|
<*> pure (ticketCreator ticket)
|
|
<*> areq textField "Title*" (Just $ ticketTitle ticket)
|
|
<*> ( maybe "" unTextarea <$>
|
|
aopt
|
|
textareaField
|
|
"Description (Markdown)"
|
|
(Just $ Just $ Textarea $ ticketDesc ticket)
|
|
)
|
|
<*> pure (ticketAssignee ticket)
|
|
<*> pure (ticketDone ticket)
|
|
<*> pure (ticketClosed ticket)
|
|
<*> pure (ticketCloser ticket)
|
|
<*> pure (ticketDiscuss ticket)
|
|
|
|
editTicketContentForm :: Ticket -> Form Ticket
|
|
editTicketContentForm t = renderDivs $ editTicketContentAForm t
|
|
|
|
assignTicketAForm :: PersonId -> ProjectId -> AForm Handler PersonId
|
|
assignTicketAForm pid jid =
|
|
areq (selectAssigneeFromProject pid jid) "Assignee*" Nothing
|
|
|
|
assignTicketForm :: PersonId -> ProjectId -> Form PersonId
|
|
assignTicketForm pid jid = renderDivs $ assignTicketAForm pid jid
|
|
|
|
claimRequestAForm :: AForm Handler Text
|
|
claimRequestAForm = unTextarea <$> areq textareaField "Message*" Nothing
|
|
|
|
claimRequestForm :: Form Text
|
|
claimRequestForm = renderDivs claimRequestAForm
|
|
|
|
ticketFilterAForm :: AForm Handler TicketFilter
|
|
ticketFilterAForm = TicketFilter
|
|
<$> areq (selectFieldList status) "Status*" (Just Nothing)
|
|
where
|
|
status :: [(Text, Maybe Bool)]
|
|
status = [("Open", Just False), ("Closed", Just True), ("All", Nothing)]
|
|
|
|
ticketFilterForm :: Form TicketFilter
|
|
ticketFilterForm = renderDivs ticketFilterAForm
|
|
|
|
ticketDepAForm :: ProjectId -> TicketId -> AForm Handler TicketId
|
|
ticketDepAForm jid tid = areq (selectTicketDep jid tid) "Dependency" Nothing
|
|
|
|
ticketDepForm :: ProjectId -> TicketId -> Form TicketId
|
|
ticketDepForm jid tid = renderDivs $ ticketDepAForm jid tid
|