diff --git a/src/Handler/MailCenter.hs b/src/Handler/MailCenter.hs index c6abfa015..021860b76 100644 --- a/src/Handler/MailCenter.hs +++ b/src/Handler/MailCenter.hs @@ -96,7 +96,7 @@ mkMCTable = do , sortable Nothing (i18nCell MsgCommSubject) $ \(view resultMail -> Entity k v) -> let subject = v ^? _sentMailHeaders . _mailHeaders' . _mailHeader' "Subject" linkWgt = maybe (msg2widget MsgUtilEMail) text2widget subject - in anchorCellM (MailPlainR <$> encrypt k) linkWgt + in anchorCellM (MailHtmlR <$> encrypt k) linkWgt -- , sortable Nothing (i18nCell MsgCommContent) $ \(view $ resultMail . _entityKey -> k) -> anchorCellM (MailHtmlR <$> encrypt k) (text2widget "html") -- , sortable Nothing (i18nCell MsgCommSubject) $ \(preview $ resultMail . _entityVal . _sentMailHeaders . _mailHeaders' . _mailHeader' "Subject" -> h) -> cellMaybe textCell h ] @@ -219,10 +219,13 @@ handleMailShow hdr prefTypes cusm = do
^{part2widget pt}
|]
- -- Include for Debugging:
- -- ^{jsonWidget (sm ^. _sentMailHeaders)}
- -- ^{jsonWidget (sentMailContentContent cn)}
-
+ -- Include for Debugging:
+ --
+ -- ^{jsonWidget (sm ^. _sentMailHeaders)}
+ --
+ -- ^{jsonWidget (sentMailContentContent cn)} -- content fields needs decoding of base64 to make sense here
selectAlternative :: [ContentType] -> Alternatives -> Maybe Part
selectAlternative (fmap decodeUtf8 -> prefTypes) allAlts = aux prefTypes allAlts
@@ -255,8 +258,8 @@ part2widget Part{partContent=PartContent (LB.toStrict -> pc), partType=pt, partD
|]
where
showBody
- | pt == decodeUtf8 typePlain = toWidget $ preEscapedToHtml $ plaintextToHtml $ decodeUtf8 pc
- | pt == decodeUtf8 typeHtml = toWidget $ preEscapedToHtml $ decodeUtf8 pc -- preEscapedToHtml :: ToMarkup a => a -> Html
+ | pt == decodeUtf8 typePlain = toWidget $ preEscapedToHtml $ plainTextToHtml $ decodeUtf8 pc
+ | pt == decodeUtf8 typeHtml = toWidget $ preEscapedToHtml $ plainHtmlToHtml $ decodeUtf8 pc -- preEscapedToHtml :: ToMarkup a => a -> Html
| pt == decodeUtf8 typeJson =
let jw :: Aeson.Value -> Widget = jsonWidget
in either str2widget jw $ Aeson.eitherDecodeStrict' pc
diff --git a/src/Model/Types/Markup.hs b/src/Model/Types/Markup.hs
index a250927c4..836530d75 100644
--- a/src/Model/Types/Markup.hs
+++ b/src/Model/Types/Markup.hs
@@ -9,7 +9,7 @@ module Model.Types.Markup
, markdownToStoredMarkup
, esqueletoMarkupOutput
, I18nStoredMarkup
- , markupIsSmallish
+ , markupIsSmallish
, html2textlines
, isSimilarMarkup
) where
@@ -53,7 +53,7 @@ data StoredMarkup = StoredMarkup
deriving anyclass (Binary, Hashable, NFData)
isSimilarMarkup :: StoredMarkup -> StoredMarkup -> Bool
-isSimilarMarkup StoredMarkup{markupInputFormat=af, markupInput=ai}
+isSimilarMarkup StoredMarkup{markupInputFormat=af, markupInput=ai}
StoredMarkup{markupInputFormat=bf, markupInput=bi}
= af==bf && ai == bi
@@ -74,7 +74,7 @@ plaintextToStoredMarkup :: Textual t => t -> StoredMarkup
plaintextToStoredMarkup (repack -> t) = StoredMarkup
{ markupInputFormat = MarkupPlaintext
, markupInput = t
- , markupOutput = plaintextToHtml $ LT.toStrict t
+ , markupOutput = plainTextToHtml $ LT.toStrict t
}
preEscapedToStoredMarkup :: Textual t => t -> StoredMarkup
preEscapedToStoredMarkup (repack -> t) = StoredMarkup
@@ -86,8 +86,8 @@ markdownToStoredMarkup :: Textual t => t -> StoredMarkup
markdownToStoredMarkup (repack -> t) = StoredMarkup
{ markupInputFormat = MarkupMarkdown
, markupInput = t
- , markupOutput = plaintextToHtml $ LT.toStrict t
- }
+ , markupOutput = plainTextToHtml $ LT.toStrict t
+ }
esqueletoMarkupOutput :: E.SqlExpr (E.Value StoredMarkup) -> E.SqlExpr (E.Value Html)
diff --git a/src/Utils/Pandoc.hs b/src/Utils/Pandoc.hs
index ad7582377..d2030d2a3 100644
--- a/src/Utils/Pandoc.hs
+++ b/src/Utils/Pandoc.hs
@@ -19,11 +19,16 @@ import qualified Text.Pandoc as P
markdownToHtml :: Html -> Either P.PandocError Html
markdownToHtml html = P.runPure $ P.writeHtml5 htmlWriterOptions =<< P.readMarkdown markdownReaderOptions (toStrict $ renderHtml html)
-plaintextToHtml :: Text -> Html
-plaintextToHtml text = fromRight (toMarkup text) $ P.runPure $
+plainTextToHtml :: Text -> Html
+plainTextToHtml text = fromRight (toMarkup text) $ P.runPure $
P.writeHtml5 htmlWriterOptions =<< P.readMarkdown markdownReaderOptions text
-- Line below does not work as intended, also see Handler.Utils.Pandoc.plaintextToMarkdownWith which uses this code
- -- where pandoc = P.Pandoc mempty [P.Plain [P.Str text]]
+ -- where pandoc = P.Pandoc mempty [P.Plain [P.Str text]]
+
+plainHtmlToHtml :: Text -> Html
+plainHtmlToHtml text = fromRight (toMarkup text) $ P.runPure $
+ P.writeHtml5 htmlWriterOptions =<< P.readHtml markdownReaderOptions text
+
htmlReaderOptions, markdownReaderOptions :: P.ReaderOptions
Debugging
+ --