vervis/src/Vervis/Form/Ticket.hs

{- 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
    , editTicketForm
    , ticketFilterForm
    )
where

import Prelude

import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Class (lift)
import Data.Text (Text)
import Data.Time.Calendar (Day (..))
import Data.Time.Clock (getCurrentTime, UTCTime (..))
import Yesod.Form

import Vervis.Foundation (Form, Handler)
import Vervis.Model
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
    }

newTicketAForm :: AForm Handler NewTicket
newTicketAForm = NewTicket
    <$> areq textField "Title*" Nothing
    <*> ( maybe "" unTextarea <$>
          aopt textareaField "Description (Markdown)" Nothing
        )

newTicketForm :: Form NewTicket
newTicketForm = renderDivs newTicketAForm

editTicketAForm :: Ticket -> PersonId -> AForm Handler Ticket
editTicketAForm ticket pid = fmap fixDone $ 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)
        )
    <*> areq checkBoxField "Done*" (Just $ ticketDone ticket)
    <*> now
    <*> pure (ticketCloser ticket)
    <*> pure (ticketDiscuss ticket)
    where
    fixDone result = case (ticketDone ticket, ticketDone result) of
        (True,  True)  -> result { ticketClosed = ticketClosed ticket }
        (False, False) -> result { ticketClosed = ticketClosed ticket }
        (False, True)  -> result { ticketCloser = pid }
        (True,  False) -> result { ticketClosed = defTime
                                 , ticketCloser = ticketCreator ticket
                                 }

editTicketForm :: Ticket -> PersonId -> Form Ticket
editTicketForm t p = renderDivs $ editTicketAForm t p

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