Skip to content

Commit 2ba762c

Browse files
Profpatschjgm
Profpatsch
authored and
jgm
committed
Move everything from xhtml to blaze & HTML5
This is a rather mechanical translation from the old `xhtml` library to the more modern `blaze` library. We use HTML5 everywhere, thus we also change the `DOCTYPE`. Pandoc needs to be configured to return HTML5 as well, but it looks like every use of the html writer already uses `writeHtml5String`. So I guess we are good?
1 parent ffda00a commit 2ba762c

File tree

9 files changed

+405
-344
lines changed

9 files changed

+405
-344
lines changed

‎README.markdown

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -567,7 +567,7 @@ Now add the following lines to the apache configuration file for the
567567
SetOutputFilter proxy-html
568568
ProxyPassReverse /
569569
ProxyHTMLURLMap / /wiki/
570-
ProxyHTMLDocType "<!DOCTYPE html PUBLIC '-//W3C//DTD XHTML 1.0 Strict//EN' 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>" XHTML
570+
ProxyHTMLDocType html5
571571
RequestHeader unset Accept-Encoding
572572
</Location>
573573

‎data/markup.HTML

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
# Markup
22

3-
The syntax for wiki pages is standard XHTML. All tags must be
3+
The syntax for wiki pages is standard HTML 5. All tags must be
44
properly closed.
55

66
## Wiki links

‎data/markupHelp/HTML

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,6 @@ external</a>,
4545
</dl>
4646
~~~~~~~~
4747

48-
For more: [xhtml tutorial](http://www.w3schools.com/Xhtml/),
48+
For more: [HTML tutorial](https://developer.mozilla.org/en-US/docs/Learn/HTML),
4949
[pandoc](http://pandoc.org/README.html).
5050

‎data/templates/page.st

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,5 @@
1-
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
2-
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
3-
<html xmlns="http://www.w3.org/1999/xhtml">
1+
<!DOCTYPE html>
2+
<html>
43
<head>
54
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
65
<meta name="viewport" content="width=device-width, initial-scale=1.0">

‎src/Network/Gitit/Authentication.hs

Lines changed: 121 additions & 89 deletions
Large diffs are not rendered by default.

‎src/Network/Gitit/ContentTransformer.hs

Lines changed: 55 additions & 57 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
{-# LANGUAGE CPP #-}
22
{-# LANGUAGE OverloadedStrings #-}
3+
{-# LANGUAGE TypeApplications #-}
34
{-
45
Copyright (C) 2009 John MacFarlane <[email protected]>,
56
Anton van Straaten <[email protected]>
@@ -76,7 +77,6 @@ import Control.Monad.Except (throwError)
7677
import Data.Foldable (traverse_)
7778
import Data.List (stripPrefix)
7879
import Data.Maybe (isNothing, mapMaybe)
79-
import Data.Semigroup ((<>))
8080
import Network.Gitit.Cache (lookupCache, cacheContents)
8181
import Network.Gitit.Framework hiding (uriPath)
8282
import Network.Gitit.Layout
@@ -93,9 +93,6 @@ import qualified Text.Pandoc.Builder as B
9393
import Text.HTML.SanitizeXSS (sanitizeBalance)
9494
import Skylighting hiding (Context)
9595
import Text.Pandoc hiding (MathML, WebTeX, MathJax)
96-
import Text.XHtml hiding ( (</>), dir, method, password, rev )
97-
import Text.XHtml.Strict (stringToHtmlString)
98-
import Text.Blaze.Html.Renderer.String as Blaze ( renderHtml )
9996
import URI.ByteString (Query(Query), URIRef(uriPath), laxURIParserOptions,
10097
parseURI, uriQuery)
10198
import qualified Data.Text as T
@@ -104,6 +101,12 @@ import qualified Data.ByteString.Char8 as SC (pack, unpack)
104101
import qualified Data.ByteString.Lazy as L (toChunks, fromChunks)
105102
import qualified Data.FileStore as FS
106103
import qualified Text.Pandoc as Pandoc
104+
import Data.String (IsString(fromString))
105+
import Text.Blaze.Html.Renderer.String as Blaze ( renderHtml )
106+
import Text.Blaze.Html5 hiding (u, s, contents, source, html, title, map)
107+
import Text.Blaze.Html5.Attributes hiding (id)
108+
import qualified Text.Blaze.Html5 as Html5
109+
import qualified Text.Blaze.Html5.Attributes as Html5.Attr
107110

108111
--
109112
-- ContentTransformer runners
@@ -195,7 +198,7 @@ preview = runPageTransformer $
195198
contentsToPage >>=
196199
pageToWikiPandoc >>=
197200
pandocToHtml >>=
198-
return . toResponse . renderHtmlFragment
201+
return . toResponse . renderHtml
199202

200203
-- | Applies pre-commit plugins to raw page source, possibly
201204
-- modifying it.
@@ -332,6 +335,8 @@ pageToPandoc page' = do
332335
, ctxMeta = pageMeta page' }
333336
either (liftIO . E.throwIO) return $ readerFor (pageFormat page') (pageLHS page') (pageText page')
334337

338+
data WasRedirect = WasRedirect | WasNoRedirect
339+
335340
-- | Detects if the page is a redirect page and handles accordingly. The exact
336341
-- behaviour is as follows:
337342
--
@@ -374,56 +379,51 @@ handleRedirects page = case lookup "redirect" (pageMeta page) of
374379
where
375380
addMessage message = modifyContext $ \context -> context
376381
{ ctxLayout = (ctxLayout context)
377-
{ pgMessages = pgMessages (ctxLayout context) ++ [message]
382+
{ pgMessages = pgMessages (ctxLayout context) ++ [renderHtml message]
378383
}
379384
}
380385
redirectedFrom source = do
381386
(url, html) <- processSource source
382-
return $ concat
383-
[ "Redirected from <a href=\""
384-
, url
385-
, "?redirect=no\" title=\"Go to original page\">"
386-
, html
387-
, "</a>"
387+
return $ mconcat
388+
[ "Redirected from ",
389+
a ! href (url WasNoRedirect) ! title "Go to original page" $ html
388390
]
389391
doubleRedirect source destination = do
390392
(url, html) <- processSource source
391393
(url', html') <- processDestination destination
392-
return $ concat
393-
[ "This page normally redirects to <a href=\""
394-
, url'
395-
, "\" title=\"Continue to destination\">"
396-
, html'
397-
, "</a>, but as you were already redirected from <a href=\""
398-
, url
399-
, "?redirect=no\" title=\"Go to original page\">"
400-
, html
401-
, "</a>"
394+
return $ mconcat
395+
[ "This page normally redirects to "
396+
, a ! href (fromString $ url' WasRedirect) ! title "Continue to destination" $ html'
397+
, ", but as you were already redirected from "
398+
, a ! href (url WasNoRedirect) ! title "Go to original page" $ html
402399
, ", this was stopped to prevent a double-redirect."
403400
]
404401
cancelledRedirect destination = do
405402
(url', html') <- processDestination destination
406-
return $ concat
407-
[ "This page redirects to <a href=\""
408-
, url'
409-
, "\" title=\"Continue to destination\">"
410-
, html'
411-
, "</a>."
403+
return $ mconcat
404+
[ "This page redirects to "
405+
, a ! href (fromString $ url' WasRedirect) ! title "Continue to destination" $ html'
412406
]
413407
processSource source = do
414408
base' <- getWikiBase
415-
let url = stringToHtmlString $ base' ++ urlForPage source
416-
let html = stringToHtmlString source
409+
let url redir = fromString @AttributeValue $
410+
base' ++ urlForPage source ++ case redir of
411+
WasNoRedirect -> "?redirect=no"
412+
WasRedirect -> ""
413+
let html = fromString @Html source
417414
return (url, html)
418415
processDestination destination = do
419416
base' <- getWikiBase
420417
let (page', fragment) = break (== '#') destination
421-
let url = stringToHtmlString $ concat
418+
let url redir = concat
422419
[ base'
423420
, urlForPage page'
424421
, fragment
425-
]
426-
let html = stringToHtmlString page'
422+
423+
] ++ case redir of
424+
WasNoRedirect -> "?redirect=no"
425+
WasRedirect -> ""
426+
let html = fromString @Html page'
427427
return (url, html)
428428
getSource = do
429429
cfg <- lift getConfig
@@ -461,26 +461,25 @@ handleRedirects page = case lookup "redirect" (pageMeta page) of
461461
, urlForPage (pageName page)
462462
, "?redirect=yes"
463463
]
464-
lift $ seeOther url' $ withBody $ concat
465-
[ "<!doctype html><html><head><title>307 Redirect"
466-
, "</title></head><body><p>You are being <a href=\""
467-
, stringToHtmlString url'
468-
, "\">redirected</a>.</body></p></html>"
464+
lift $ seeOther url' $ withBody $ renderHtml $ docTypeHtml $ mconcat
465+
[ Html5.head $ Html5.title "307 Redirect"
466+
, Html5.body $ p $ mconcat [
467+
"You are being",
468+
a ! href (fromString url') $ "redirected."
469+
]
469470
]
470471
Just True -> fmap Left $ do
471472
(url', html') <- processDestination destination
472-
lift $ ok $ withBody $ concat
473-
[ "<!doctype html><html><head><title>Redirecting to "
474-
, html'
475-
, "</title><meta http-equiv=\"refresh\" content=\"0; url="
476-
, url'
477-
, "\" /><script type=\"text/javascript\">window.location=\""
478-
, url'
479-
, "\"</script></head><body><p>Redirecting to <a href=\""
480-
, url'
481-
, "\">"
482-
, html'
483-
, "</a>...</p></body></html>"
473+
lift $ ok $ withBody $ renderHtml $ docTypeHtml $ mconcat
474+
[ Html5.head $ mconcat
475+
[ Html5.title $ "Redirecting to" <> html'
476+
, meta ! httpEquiv "refresh" ! content (fromString $ "0; url=" <> url' WasRedirect)
477+
, script ! type_ "text/javascript" $ fromString $ "window.location=\"" <> url' WasRedirect <> "\""
478+
],
479+
Html5.body $ p $ mconcat
480+
[ "Redirecting to "
481+
, a ! href (fromString $ url' WasRedirect) $ html'
482+
]
484483
]
485484
Just False -> do
486485
cancelledRedirect destination >>= addMessage
@@ -505,7 +504,7 @@ pandocToHtml pandocContents = do
505504
case res of
506505
Right t -> return t
507506
Left e -> throwError $ PandocTemplateError $ T.pack e
508-
return $ primHtml $ T.unpack .
507+
return $ preEscapedToHtml @T.Text .
509508
(if xssSanitize cfg then sanitizeBalance else id) $
510509
either E.throw id . runPure $ writeHtml5String def{
511510
writerTemplate = Just compiledTemplate
@@ -538,8 +537,7 @@ highlightSource (Just source) = do
538537
, traceOutput = False} l
539538
$ T.pack $ filter (/='\r') source of
540539
Left e -> fail (show e)
541-
Right r -> return $ primHtml $ Blaze.renderHtml
542-
$ formatHtmlBlock formatOpts r
540+
Right r -> return $ formatHtmlBlock formatOpts r
543541

544542
--
545543
-- Plugin combinators
@@ -603,11 +601,11 @@ wikiDivify :: Html -> ContentTransformer Html
603601
wikiDivify c = do
604602
categories <- liftM ctxCategories get
605603
base' <- lift getWikiBase
606-
let categoryLink ctg = li (anchor ! [href $ base' ++ "/_category/" ++ ctg] << ctg)
604+
let categoryLink ctg = li (a ! href (fromString $ base' ++ "/_category/" ++ ctg) $ fromString ctg)
607605
let htmlCategories = if null categories
608-
then noHtml
609-
else thediv ! [identifier "categoryList"] << ulist << map categoryLink categories
610-
return $ thediv ! [identifier "wikipage"] << [c, htmlCategories]
606+
then mempty
607+
else Html5.div ! Html5.Attr.id "categoryList" $ ul $ foldMap categoryLink categories
608+
return $ Html5.div ! Html5.Attr.id "wikipage" $ c <> htmlCategories
611609

612610
-- | Adds page title to a Pandoc document.
613611
addPageTitleToPandoc :: String -> Pandoc -> ContentTransformer Pandoc

0 commit comments

Comments
 (0)