From f7432e515c1777ded0cdf5673776b080e617a40c Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Mon, 3 Jun 2019 12:45:02 +0000 Subject: [PATCH] Add ticketDescription DB entity field, containing pandoc-rendered HTML --- config/models | 25 ++++++++++--------- migrations/2019_06_03.model | 18 ++++++++++++++ src/Vervis/Form/Ticket.hs | 11 ++++++--- src/Vervis/Handler/Ticket.hs | 46 +++++++++++++++++++++++------------ src/Vervis/Migration.hs | 16 +++++++++++- src/Vervis/Migration/Model.hs | 5 ++++ 6 files changed, 89 insertions(+), 32 deletions(-) create mode 100644 migrations/2019_06_03.model diff --git a/config/models b/config/models index b81060d..59d0ed2 100644 --- a/config/models +++ b/config/models @@ -278,18 +278,19 @@ TicketParamEnum UniqueTicketParamEnum ticket field value Ticket - project ProjectId - number Int - created UTCTime - creator PersonId - title Text - desc Text -- Assume this is Pandoc Markdown - assignee PersonId Maybe - status TicketStatus - closed UTCTime - closer PersonId - discuss DiscussionId - followers FollowerSetId + project ProjectId + number Int + created UTCTime + creator PersonId + title Text + source Text -- Pandoc Markdown + description Text -- HTML + assignee PersonId Maybe + status TicketStatus + closed UTCTime + closer PersonId + discuss DiscussionId + followers FollowerSetId UniqueTicket project number UniqueTicketDiscussion discuss diff --git a/migrations/2019_06_03.model b/migrations/2019_06_03.model new file mode 100644 index 0000000..c735b14 --- /dev/null +++ b/migrations/2019_06_03.model @@ -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 diff --git a/src/Vervis/Form/Ticket.hs b/src/Vervis/Form/Ticket.hs index 9b46a0e..67f8199 100644 --- a/src/Vervis/Form/Ticket.hs +++ b/src/Vervis/Form/Ticket.hs @@ -37,7 +37,7 @@ import Database.Persist import Yesod.Form import Yesod.Persist.Core (runDB) -import qualified Data.Text as T (snoc) +import qualified Data.Text as T import Vervis.Field.Ticket import Vervis.Foundation (App, Form, Handler) @@ -112,7 +112,7 @@ newTicketForm wid html = do return (tfs, efs) flip renderDivs html $ NewTicket <$> areq textField "Title*" Nothing - <*> ( maybe "" unTextarea <$> + <*> ( maybe "" (T.filter (/= '\r') . unTextarea) <$> aopt textareaField "Description (Markdown)" Nothing ) <*> (catMaybes <$> traverse tfield tfs) @@ -125,12 +125,15 @@ editTicketContentAForm ticket = Ticket <*> pure (ticketCreated ticket) <*> pure (ticketCreator ticket) <*> areq textField "Title*" (Just $ ticketTitle ticket) - <*> ( maybe "" unTextarea <$> + <*> ( maybe "" (T.filter (/= '\r') . unTextarea) <$> aopt textareaField "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 (ticketStatus ticket) <*> pure (ticketClosed ticket) diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index a93cd18..c174553 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -103,7 +103,7 @@ import Vervis.Model import Vervis.Model.Ident import Vervis.Model.Ticket import Vervis.Model.Workflow -import Vervis.Render (renderSourceT) +import Vervis.Render import Vervis.Settings import Vervis.Style import Vervis.Ticket @@ -143,23 +143,31 @@ postTicketsR shar proj = do FormSuccess nt -> do author <- requireAuthId 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 update pid [ProjectNextTicket +=. 1] did <- insert Discussion fsid <- insert FollowerSet let ticket = Ticket - { ticketProject = pid - , ticketNumber = projectNextTicket project - , ticketCreated = now - , ticketCreator = author - , ticketTitle = ntTitle nt - , ticketSource = ntDesc nt - , ticketAssignee = Nothing - , ticketStatus = TSNew - , ticketClosed = UTCTime (ModifiedJulianDay 0) 0 - , ticketCloser = author - , ticketDiscuss = did - , ticketFollowers = fsid + { ticketProject = pid + , ticketNumber = projectNextTicket project + , ticketCreated = now + , ticketCreator = author + , ticketTitle = ntTitle nt + , ticketSource = source + , ticketDescription = descHtml + , ticketAssignee = Nothing + , ticketStatus = TSNew + , ticketClosed = UTCTime (ModifiedJulianDay 0) 0 + , ticketCloser = author + , ticketDiscuss = did + , ticketFollowers = fsid } tid <- insert ticket let mktparam (fid, v) = TicketParamText @@ -253,7 +261,8 @@ getTicketR shar proj num = do , deps, rdeps ) encodeHid <- getEncodeKeyHashid - let desc = renderSourceT Markdown $ T.filter (/= '\r') $ ticketSource ticket + let desc :: Widget + desc = toWidget $ preEscapedToMarkup $ ticketDescription ticket discuss = discussionW (return $ ticketDiscuss ticket) @@ -280,8 +289,15 @@ putTicketR shar proj num = do runFormPost $ editTicketContentForm tid ticket wid case result of 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 - replace tid ticket' + replace tid ticket'' let (tdel, tins, tupd) = partitionMaybePairs tparams deleteWhere [TicketParamTextId <-. tdel] let mktparam (fid, v) = TicketParamText diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index b49ec0e..74e8785 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -504,7 +504,7 @@ changes hLocal ctx = msgs <- selectList ([] :: [Filter Message201906]) [] for_ msgs $ \ (Entity mid 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 Right content -> update mid @@ -513,6 +513,20 @@ changes hLocal ctx = ] -- 88 , 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)) diff --git a/src/Vervis/Migration/Model.hs b/src/Vervis/Migration/Model.hs index 289d091..7b8cf23 100644 --- a/src/Vervis/Migration/Model.hs +++ b/src/Vervis/Migration/Model.hs @@ -55,6 +55,8 @@ module Vervis.Migration.Model , RemoteMessage201905Generic (..) , Message201906Generic (..) , Message201906 + , Ticket201906Generic (..) + , Ticket201906 ) where @@ -141,3 +143,6 @@ makeEntitiesMigration "201905" makeEntitiesMigration "201906" $(modelFile "migrations/2019_06_02.model") + +makeEntitiesMigration "201906" + $(modelFile "migrations/2019_06_03.model")