Add ticketDescription DB entity field, containing pandoc-rendered HTML
This commit is contained in:
parent
17fe163c09
commit
f7432e515c
6 changed files with 89 additions and 32 deletions
|
@ -278,18 +278,19 @@ TicketParamEnum
|
||||||
UniqueTicketParamEnum ticket field value
|
UniqueTicketParamEnum ticket field value
|
||||||
|
|
||||||
Ticket
|
Ticket
|
||||||
project ProjectId
|
project ProjectId
|
||||||
number Int
|
number Int
|
||||||
created UTCTime
|
created UTCTime
|
||||||
creator PersonId
|
creator PersonId
|
||||||
title Text
|
title Text
|
||||||
desc Text -- Assume this is Pandoc Markdown
|
source Text -- Pandoc Markdown
|
||||||
assignee PersonId Maybe
|
description Text -- HTML
|
||||||
status TicketStatus
|
assignee PersonId Maybe
|
||||||
closed UTCTime
|
status TicketStatus
|
||||||
closer PersonId
|
closed UTCTime
|
||||||
discuss DiscussionId
|
closer PersonId
|
||||||
followers FollowerSetId
|
discuss DiscussionId
|
||||||
|
followers FollowerSetId
|
||||||
|
|
||||||
UniqueTicket project number
|
UniqueTicket project number
|
||||||
UniqueTicketDiscussion discuss
|
UniqueTicketDiscussion discuss
|
||||||
|
|
18
migrations/2019_06_03.model
Normal file
18
migrations/2019_06_03.model
Normal file
|
@ -0,0 +1,18 @@
|
||||||
|
Ticket
|
||||||
|
project Int64
|
||||||
|
number Int
|
||||||
|
created UTCTime
|
||||||
|
creator Int64
|
||||||
|
title Text
|
||||||
|
source Text -- Pandoc Markdown
|
||||||
|
description Text -- HTML
|
||||||
|
assignee Int64 Maybe
|
||||||
|
status Text
|
||||||
|
closed UTCTime
|
||||||
|
closer Int64
|
||||||
|
discuss Int64
|
||||||
|
followers Int64
|
||||||
|
|
||||||
|
UniqueTicket project number
|
||||||
|
UniqueTicketDiscussion discuss
|
||||||
|
UniqueTicketFollowers followers
|
|
@ -37,7 +37,7 @@ import Database.Persist
|
||||||
import Yesod.Form
|
import Yesod.Form
|
||||||
import Yesod.Persist.Core (runDB)
|
import Yesod.Persist.Core (runDB)
|
||||||
|
|
||||||
import qualified Data.Text as T (snoc)
|
import qualified Data.Text as T
|
||||||
|
|
||||||
import Vervis.Field.Ticket
|
import Vervis.Field.Ticket
|
||||||
import Vervis.Foundation (App, Form, Handler)
|
import Vervis.Foundation (App, Form, Handler)
|
||||||
|
@ -112,7 +112,7 @@ newTicketForm wid html = do
|
||||||
return (tfs, efs)
|
return (tfs, efs)
|
||||||
flip renderDivs html $ NewTicket
|
flip renderDivs html $ NewTicket
|
||||||
<$> areq textField "Title*" Nothing
|
<$> areq textField "Title*" Nothing
|
||||||
<*> ( maybe "" unTextarea <$>
|
<*> ( maybe "" (T.filter (/= '\r') . unTextarea) <$>
|
||||||
aopt textareaField "Description (Markdown)" Nothing
|
aopt textareaField "Description (Markdown)" Nothing
|
||||||
)
|
)
|
||||||
<*> (catMaybes <$> traverse tfield tfs)
|
<*> (catMaybes <$> traverse tfield tfs)
|
||||||
|
@ -125,12 +125,15 @@ editTicketContentAForm ticket = Ticket
|
||||||
<*> pure (ticketCreated ticket)
|
<*> pure (ticketCreated ticket)
|
||||||
<*> pure (ticketCreator ticket)
|
<*> pure (ticketCreator ticket)
|
||||||
<*> areq textField "Title*" (Just $ ticketTitle ticket)
|
<*> areq textField "Title*" (Just $ ticketTitle ticket)
|
||||||
<*> ( maybe "" unTextarea <$>
|
<*> ( maybe "" (T.filter (/= '\r') . unTextarea) <$>
|
||||||
aopt
|
aopt
|
||||||
textareaField
|
textareaField
|
||||||
"Description (Markdown)"
|
"Description (Markdown)"
|
||||||
(Just $ Just $ Textarea $ ticketSource ticket)
|
(Just $ Just $ Textarea $
|
||||||
|
T.intercalate "\r\n" $ T.lines $ ticketSource ticket
|
||||||
|
)
|
||||||
)
|
)
|
||||||
|
<*> pure (ticketDescription ticket)
|
||||||
<*> pure (ticketAssignee ticket)
|
<*> pure (ticketAssignee ticket)
|
||||||
<*> pure (ticketStatus ticket)
|
<*> pure (ticketStatus ticket)
|
||||||
<*> pure (ticketClosed ticket)
|
<*> pure (ticketClosed ticket)
|
||||||
|
|
|
@ -103,7 +103,7 @@ import Vervis.Model
|
||||||
import Vervis.Model.Ident
|
import Vervis.Model.Ident
|
||||||
import Vervis.Model.Ticket
|
import Vervis.Model.Ticket
|
||||||
import Vervis.Model.Workflow
|
import Vervis.Model.Workflow
|
||||||
import Vervis.Render (renderSourceT)
|
import Vervis.Render
|
||||||
import Vervis.Settings
|
import Vervis.Settings
|
||||||
import Vervis.Style
|
import Vervis.Style
|
||||||
import Vervis.Ticket
|
import Vervis.Ticket
|
||||||
|
@ -143,23 +143,31 @@ postTicketsR shar proj = do
|
||||||
FormSuccess nt -> do
|
FormSuccess nt -> do
|
||||||
author <- requireAuthId
|
author <- requireAuthId
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
|
let source = ntDesc nt
|
||||||
|
descHtml <-
|
||||||
|
case renderPandocMarkdown source of
|
||||||
|
Left err -> do
|
||||||
|
setMessage $ toHtml err
|
||||||
|
redirect $ TicketNewR shar proj
|
||||||
|
Right t -> return t
|
||||||
tnum <- runDB $ do
|
tnum <- runDB $ do
|
||||||
update pid [ProjectNextTicket +=. 1]
|
update pid [ProjectNextTicket +=. 1]
|
||||||
did <- insert Discussion
|
did <- insert Discussion
|
||||||
fsid <- insert FollowerSet
|
fsid <- insert FollowerSet
|
||||||
let ticket = Ticket
|
let ticket = Ticket
|
||||||
{ ticketProject = pid
|
{ ticketProject = pid
|
||||||
, ticketNumber = projectNextTicket project
|
, ticketNumber = projectNextTicket project
|
||||||
, ticketCreated = now
|
, ticketCreated = now
|
||||||
, ticketCreator = author
|
, ticketCreator = author
|
||||||
, ticketTitle = ntTitle nt
|
, ticketTitle = ntTitle nt
|
||||||
, ticketSource = ntDesc nt
|
, ticketSource = source
|
||||||
, ticketAssignee = Nothing
|
, ticketDescription = descHtml
|
||||||
, ticketStatus = TSNew
|
, ticketAssignee = Nothing
|
||||||
, ticketClosed = UTCTime (ModifiedJulianDay 0) 0
|
, ticketStatus = TSNew
|
||||||
, ticketCloser = author
|
, ticketClosed = UTCTime (ModifiedJulianDay 0) 0
|
||||||
, ticketDiscuss = did
|
, ticketCloser = author
|
||||||
, ticketFollowers = fsid
|
, ticketDiscuss = did
|
||||||
|
, ticketFollowers = fsid
|
||||||
}
|
}
|
||||||
tid <- insert ticket
|
tid <- insert ticket
|
||||||
let mktparam (fid, v) = TicketParamText
|
let mktparam (fid, v) = TicketParamText
|
||||||
|
@ -253,7 +261,8 @@ getTicketR shar proj num = do
|
||||||
, deps, rdeps
|
, deps, rdeps
|
||||||
)
|
)
|
||||||
encodeHid <- getEncodeKeyHashid
|
encodeHid <- getEncodeKeyHashid
|
||||||
let desc = renderSourceT Markdown $ T.filter (/= '\r') $ ticketSource ticket
|
let desc :: Widget
|
||||||
|
desc = toWidget $ preEscapedToMarkup $ ticketDescription ticket
|
||||||
discuss =
|
discuss =
|
||||||
discussionW
|
discussionW
|
||||||
(return $ ticketDiscuss ticket)
|
(return $ ticketDiscuss ticket)
|
||||||
|
@ -280,8 +289,15 @@ putTicketR shar proj num = do
|
||||||
runFormPost $ editTicketContentForm tid ticket wid
|
runFormPost $ editTicketContentForm tid ticket wid
|
||||||
case result of
|
case result of
|
||||||
FormSuccess (ticket', tparams, eparams) -> do
|
FormSuccess (ticket', tparams, eparams) -> do
|
||||||
|
newDescHtml <-
|
||||||
|
case renderPandocMarkdown $ ticketSource ticket' of
|
||||||
|
Left err -> do
|
||||||
|
setMessage $ toHtml err
|
||||||
|
redirect $ TicketEditR shar proj num
|
||||||
|
Right t -> return t
|
||||||
|
let ticket'' = ticket' { ticketDescription = newDescHtml }
|
||||||
runDB $ do
|
runDB $ do
|
||||||
replace tid ticket'
|
replace tid ticket''
|
||||||
let (tdel, tins, tupd) = partitionMaybePairs tparams
|
let (tdel, tins, tupd) = partitionMaybePairs tparams
|
||||||
deleteWhere [TicketParamTextId <-. tdel]
|
deleteWhere [TicketParamTextId <-. tdel]
|
||||||
let mktparam (fid, v) = TicketParamText
|
let mktparam (fid, v) = TicketParamText
|
||||||
|
|
|
@ -504,7 +504,7 @@ changes hLocal ctx =
|
||||||
msgs <- selectList ([] :: [Filter Message201906]) []
|
msgs <- selectList ([] :: [Filter Message201906]) []
|
||||||
for_ msgs $ \ (Entity mid m) ->
|
for_ msgs $ \ (Entity mid m) ->
|
||||||
let source = T.filter (/= '\r') $ message201906Source m
|
let source = T.filter (/= '\r') $ message201906Source m
|
||||||
in case renderPandocMarkdown $ message201906Source m of
|
in case renderPandocMarkdown source of
|
||||||
Left err -> liftIO $ throwIO $ userError $ T.unpack err
|
Left err -> liftIO $ throwIO $ userError $ T.unpack err
|
||||||
Right content ->
|
Right content ->
|
||||||
update mid
|
update mid
|
||||||
|
@ -513,6 +513,20 @@ changes hLocal ctx =
|
||||||
]
|
]
|
||||||
-- 88
|
-- 88
|
||||||
, renameField "Ticket" "desc" "source"
|
, renameField "Ticket" "desc" "source"
|
||||||
|
-- 89
|
||||||
|
, addFieldPrimRequired "Ticket" ("" :: Text) "description"
|
||||||
|
-- 90
|
||||||
|
, unchecked $ lift $ do
|
||||||
|
tickets <- selectList ([] :: [Filter Ticket201906]) []
|
||||||
|
for_ tickets $ \ (Entity tid t) ->
|
||||||
|
let source = T.filter (/= '\r') $ ticket201906Source t
|
||||||
|
in case renderPandocMarkdown source of
|
||||||
|
Left err -> liftIO $ throwIO $ userError $ T.unpack err
|
||||||
|
Right content ->
|
||||||
|
update tid
|
||||||
|
[ Ticket201906Source =. source
|
||||||
|
, Ticket201906Description =. content
|
||||||
|
]
|
||||||
]
|
]
|
||||||
|
|
||||||
migrateDB :: MonadIO m => Text -> HashidsContext -> ReaderT SqlBackend m (Either Text (Int, Int))
|
migrateDB :: MonadIO m => Text -> HashidsContext -> ReaderT SqlBackend m (Either Text (Int, Int))
|
||||||
|
|
|
@ -55,6 +55,8 @@ module Vervis.Migration.Model
|
||||||
, RemoteMessage201905Generic (..)
|
, RemoteMessage201905Generic (..)
|
||||||
, Message201906Generic (..)
|
, Message201906Generic (..)
|
||||||
, Message201906
|
, Message201906
|
||||||
|
, Ticket201906Generic (..)
|
||||||
|
, Ticket201906
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -141,3 +143,6 @@ makeEntitiesMigration "201905"
|
||||||
|
|
||||||
makeEntitiesMigration "201906"
|
makeEntitiesMigration "201906"
|
||||||
$(modelFile "migrations/2019_06_02.model")
|
$(modelFile "migrations/2019_06_02.model")
|
||||||
|
|
||||||
|
makeEntitiesMigration "201906"
|
||||||
|
$(modelFile "migrations/2019_06_03.model")
|
||||||
|
|
Loading…
Reference in a new issue