$userbox()$
- $tabs$
+ $tabs$
$content()$
$footer()$
diff --git a/gitit.cabal b/gitit.cabal
--- a/gitit.cabal
+++ b/gitit.cabal
@@ -1,6 +1,6 @@
cabal-version: 2.0
name: gitit
-version: 0.15.1.2
+version: 0.16
build-type: Simple
synopsis: Wiki using happstack, git or darcs, and pandoc.
description: Gitit is a wiki backed by a git, darcs, or mercurial
@@ -54,7 +54,7 @@
data/static/js/uploadForm.js, data/static/js/jquery-ui-combined-1.6rc2.min.js,
data/static/js/jquery.hotkeys-0.7.9.min.js,
data/static/js/preview.js, data/static/js/search.js,
- data/static/js/MathMLinHTML.js, data/static/js/footnotes.js,
+ data/static/js/footnotes.js,
data/static/robots.txt,
data/s5/default/blank.gif,
data/s5/default/bodybg.gif,
@@ -97,7 +97,7 @@
Source-repository head
type: git
- location: git://github.com/jgm/gitit.git
+ location: https://github.com/jgm/gitit.git
Flag plugins
description: Compile in support for plugins. This will increase the size of
@@ -115,7 +115,7 @@
Network.Gitit.Util, Network.Gitit.Server
Network.Gitit.Cache, Network.Gitit.State,
Network.Gitit.Handlers,
- Network.Gitit.Plugins, Network.Gitit.Rpxnow,
+ Network.Gitit.Plugins,
Network.Gitit.Page, Network.Gitit.Feed,
Network.Gitit.Compat.Except,
Paths_gitit
@@ -134,7 +134,7 @@
mtl,
old-time,
temporary,
- pandoc >= 2.9 && < 2.20 || >= 3.0 && < 3.2,
+ pandoc >= 2.9 && < 2.20 || >= 3.0 && < 3.11,
pandoc-types >= 1.20 && < 1.24,
skylighting >= 0.8.2.3 && < 0.15,
bytestring,
@@ -147,8 +147,8 @@
old-locale,
time,
recaptcha >= 0.1,
- filestore >= 0.6.5 && < 0.7,
- zlib >= 0.5 && < 0.7,
+ filestore >= 0.6.5.1 && < 0.7,
+ zlib >= 0.5 && < 0.8,
url >= 2.1,
happstack-server >= 7.5 && < 7.10,
base64-bytestring >= 0.1,
@@ -158,18 +158,18 @@
xml-types >= 0.3,
xss-sanitize >= 0.3 && < 0.4,
tagsoup >= 0.13 && < 0.15,
- blaze-html >= 0.4 && < 0.10,
+ blaze-html >= 0.5 && < 0.10,
json >= 0.4 && < 0.12,
uri-bytestring >= 0.2.3.3,
split,
- hoauth2 >= 2.3.0 && < 2.11,
- xml-conduit >= 1.5 && < 1.10,
+ hoauth2 >= 2.3.0 && < 2.16,
+ xml-conduit >= 1.5 && < 1.11,
http-conduit >= 2.1.6 && < 2.4,
- http-client-tls >= 0.2.2 && < 0.4,
- aeson >= 0.7 && < 2.3,
+ http-client-tls >= 0.2.2 && < 0.5,
+ aeson >= 0.7 && < 2.4,
uuid >= 1.3 && < 1.4,
network-uri >= 2.6,
- network >= 2.6 && < 3.2,
+ network >= 2.6 && < 3.3,
network-bsd >= 2.8.1 && < 2.9,
doctemplates >= 0.7.1
if flag(plugins)
@@ -184,7 +184,7 @@
Executable gitit
hs-source-dirs: .
main-is: gitit.hs
- build-depends: base >= 4.9 && < 5,
+ build-depends: base >= 4.15 && < 5,
gitit,
mtl,
hslogger,
@@ -195,6 +195,7 @@
network-uri >= 2.6,
network >= 2.6
other-modules: Paths_gitit
+ autogen-modules: Paths_gitit
default-extensions: CPP
default-language: Haskell2010
ghc-options: -Wall -threaded -fno-warn-unused-do-bind
diff --git a/gitit.hs b/gitit.hs
--- a/gitit.hs
+++ b/gitit.hs
@@ -105,7 +105,7 @@
-- start the server
simpleHTTPWithSocket sock serverConf $ msum [ wiki conf
- , dir "_reloadTemplates" reloadTemplates
+ , dir "_reloadTemplates" (reloadTemplates conf)
]
data ExitOpt
diff --git a/src/Network/Gitit.hs b/src/Network/Gitit.hs
--- a/src/Network/Gitit.hs
+++ b/src/Network/Gitit.hs
@@ -210,9 +210,9 @@
]
-- | Recompiles the gitit templates.
-reloadTemplates :: ServerPart Response
-reloadTemplates = do
- liftIO recompilePageTemplate
+reloadTemplates :: Config -> ServerPart Response
+reloadTemplates cfg = do
+ liftIO $ recompilePageTemplate cfg
ok $ toResponse "Page templates have been recompiled."
-- | Converts a gitit Handler into a standard happstack ServerPart.
diff --git a/src/Network/Gitit/Authentication.hs b/src/Network/Gitit/Authentication.hs
--- a/src/Network/Gitit/Authentication.hs
+++ b/src/Network/Gitit/Authentication.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
{-
Copyright (C) 2009 John MacFarlane
,
Henry Laxen
@@ -24,7 +25,6 @@
module Network.Gitit.Authentication ( loginUserForm
, formAuthHandlers
, httpAuthHandlers
- , rpxAuthHandlers
, githubAuthHandlers) where
import Network.Gitit.State
@@ -35,24 +35,28 @@
import Network.Gitit.Util
import Network.Gitit.Authentication.Github
import Network.Captcha.ReCaptcha (captchaFields, validateCaptcha)
-import Text.XHtml hiding ( (), dir, method, password, rev )
-import qualified Text.XHtml as X ( password )
import System.Process (readProcessWithExitCode)
-import Control.Monad (unless, liftM, mplus)
+import Control.Monad (unless, liftM)
import Control.Monad.Trans (liftIO)
import System.Exit
import System.Log.Logger (logM, Priority(..))
import Data.Char (isAlphaNum, isAlpha)
import qualified Data.Map as M
import Data.List (stripPrefix)
-import Data.Maybe (isJust, fromJust, isNothing, fromMaybe)
+import Data.Maybe (isJust, fromJust, fromMaybe)
import Network.URL (exportURL, add_param, importURL)
import Network.BSD (getHostName)
import qualified Text.StringTemplate as T
-import Network.HTTP (urlEncodeVars, urlDecode, urlEncode)
+import Network.HTTP (urlEncodeVars)
import Codec.Binary.UTF8.String (encodeString)
+import Text.Blaze.Html.Renderer.String as Blaze ( renderHtml )
+import Text.Blaze.Html5 hiding (i, search, u, s, contents, source, html, title, map)
+import qualified Text.Blaze.Html5 as Html5 hiding (search)
+import qualified Text.Blaze.Html5.Attributes as Html5.Attr hiding (dir, span)
+import Text.Blaze.Html5.Attributes
+import Data.String (IsString(fromString))
+import qualified Text.XHtml as XHTML
import Data.ByteString.UTF8 (toString)
-import Network.Gitit.Rpxnow as R
-- | Replace each occurrence of one sublist in a list with another.
-- Vendored in from pandoc 2.11.4 as 2.12 removed this function.
@@ -86,15 +90,33 @@
pPassword = pword,
pEmail = email }
+
+gui :: AttributeValue -> Html -> Html
+gui act = Html5.form ! Html5.Attr.action act ! Html5.Attr.method "post"
+
+
+textfieldInput :: AttributeValue -> AttributeValue -> Html
+textfieldInput nameAndId val = input ! type_ "text" ! Html5.Attr.id nameAndId ! name nameAndId ! value val
+textfieldInput' :: AttributeValue -> Html
+textfieldInput' nameAndId = input ! type_ "text" ! Html5.Attr.id nameAndId ! name nameAndId
+passwordInput :: AttributeValue -> Html
+passwordInput nameAndId = input ! type_ "password" ! Html5.Attr.id nameAndId ! name nameAndId
+submitInput :: AttributeValue -> AttributeValue -> Html
+submitInput nameAndId val = input ! type_ "submit" ! Html5.Attr.id nameAndId ! name nameAndId ! value val
+
+intTabindex :: Int -> Attribute
+intTabindex i = Html5.Attr.tabindex (fromString $ show i)
+
resetPasswordRequestForm :: Params -> Handler
resetPasswordRequestForm _ = do
- let passwordForm = gui "" ! [identifier "resetPassword"] << fieldset <<
- [ label ! [thefor "username"] << "Username: "
- , textfield "username" ! [size "20", intAttr "tabindex" 1], stringToHtml " "
- , submit "resetPassword" "Reset Password" ! [intAttr "tabindex" 2]]
+ let passwordForm = gui "" ! Html5.Attr.id "resetPassword" $ fieldset $ mconcat
+ [ Html5.label ! Html5.Attr.for "username" $ "Username: "
+ , textfieldInput' "username" ! size "20" ! intTabindex 1
+ , " "
+ , submitInput "resetPassword" "Reset Password" ! intTabindex 2]
cfg <- getConfig
let contents = if null (mailCommand cfg)
- then p << "Sorry, password reset not available."
+ then p $ "Sorry, password reset not available."
else passwordForm
formattedPage defaultPageLayout{
pgShowPageTools = False,
@@ -115,11 +137,11 @@
if null errors
then do
let response =
- p << [ stringToHtml "An email has been sent to "
- , bold $ stringToHtml . uEmail $ fromJust mbUser
+ p $ mconcat
+ [ "An email has been sent to "
+ , strong $ fromString . uEmail $ fromJust mbUser
, br
- , stringToHtml
- "Please click on the enclosed link to reset your password."
+ , "Please click on the enclosed link to reset your password."
]
sendReregisterEmail (fromJust mbUser)
formattedPage defaultPageLayout{
@@ -175,7 +197,7 @@
(True, True) -> []
(True, False) -> ["Your reset code is invalid"]
(False, _) -> ["User " ++
- renderHtmlFragment (stringToHtml uname) ++
+ renderHtml (fromString uname) ++
" is not known"]
if null errors
then postValidate (fromJust user)
@@ -230,54 +252,61 @@
"" -> getReferer
x -> return x
let accessQ = case mbUser of
- Just _ -> noHtml
+ Just _ -> mempty
Nothing -> case accessQuestion cfg of
- Nothing -> noHtml
- Just (prompt, _) -> label ! [thefor "accessCode"] << prompt +++ br +++
- X.password "accessCode" ! [size "15", intAttr "tabindex" 1]
- +++ br
+ Nothing -> mempty
+ Just (prompt, _) -> mconcat
+ [ Html5.label ! Html5.Attr.for "accessCode" $ fromString prompt
+ , br
+ , passwordInput "accessCode" ! size "15" ! intTabindex 1
+ , br
+ ]
let captcha = if useRecaptcha cfg
then captchaFields (recaptchaPublicKey cfg) Nothing
- else noHtml
+ else mempty
let initField field = case mbUser of
Nothing -> ""
Just user -> field user
let userNameField = case mbUser of
- Nothing -> label ! [thefor "username"] <<
- "Username (at least 3 letters or digits):"
- +++ br +++
- textfield "username" ! [size "20", intAttr "tabindex" 2] +++ br
- Just user -> label ! [thefor "username"] <<
- ("Username (cannot be changed): " ++ uUsername user)
- +++ br
+ Nothing -> mconcat
+ [ Html5.label ! Html5.Attr.for "username" $ "Username (at least 3 letters or digits):"
+ , br
+ , textfieldInput' "username" ! size "20" ! intTabindex 2
+ , br
+ ]
+ Just user -> Html5.label ! Html5.Attr.for "username" $
+ (fromString $ "Username (cannot be changed): " ++ uUsername user)
+ <> br
let submitField = case mbUser of
- Nothing -> submit "register" "Register"
- Just _ -> submit "resetPassword" "Reset Password"
+ Nothing -> submitInput "register" "Register"
+ Just _ -> submitInput "resetPassword" "Reset Password"
- return $ gui "" ! [identifier "loginForm"] << fieldset <<
+ return $ gui "" ! Html5.Attr.id "loginForm" $ fieldset $ mconcat
[ accessQ
, userNameField
- , label ! [thefor "email"] << "Email (optional, will not be displayed on the Wiki):"
+ , Html5.label ! Html5.Attr.for "email" $ "Email (optional, will not be displayed on the Wiki):"
, br
- , textfield "email" ! [size "20", intAttr "tabindex" 3, value (initField uEmail)]
- , br ! [theclass "req"]
- , textfield "full_name_1" ! [size "20", theclass "req"]
+ , textfieldInput "email" (fromString $ initField uEmail) ! size "20" ! intTabindex 3
+ , br ! class_ "req"
+ , textfieldInput' "full_name_1" ! size "20" ! class_ "req"
, br
- , label ! [thefor "password"]
- << ("Password (at least 6 characters," ++
+ , Html5.label ! Html5.Attr.for "password"
+ $ fromString ("Password (at least 6 characters," ++
" including at least one non-letter):")
, br
- , X.password "password" ! [size "20", intAttr "tabindex" 4]
- , stringToHtml " "
+ , passwordInput "password" ! size "20" ! intTabindex 4
+ , " "
, br
- , label ! [thefor "password2"] << "Confirm Password:"
+ , Html5.label ! Html5.Attr.for "password2" $ "Confirm Password:"
, br
- , X.password "password2" ! [size "20", intAttr "tabindex" 5]
- , stringToHtml " "
+ , passwordInput "password2" ! size "20" ! intTabindex 5
+ , " "
, br
- , captcha
- , textfield "destination" ! [thestyle "display: none;", value dest]
- , submitField ! [intAttr "tabindex" 6]]
+ -- Workaround, as ReCaptcha does not work with BlazeHtml
+ , preEscapedToHtml (XHTML.renderHtmlFragment captcha)
+ , textfieldInput "destination" (fromString dest) ! Html5.Attr.style "display: none;"
+ , submitField ! intTabindex 6
+ ]
sharedValidation :: ValidationType
@@ -349,27 +378,29 @@
loginForm dest = do
cfg <- getConfig
base' <- getWikiBase
- return $ gui (base' ++ "/_login") ! [identifier "loginForm"] <<
- fieldset <<
- [ label ! [thefor "username"] << "Username "
- , textfield "username" ! [size "15", intAttr "tabindex" 1]
- , stringToHtml " "
- , label ! [thefor "password"] << "Password "
- , X.password "password" ! [size "15", intAttr "tabindex" 2]
- , stringToHtml " "
- , textfield "destination" ! [thestyle "display: none;", value dest]
- , submit "login" "Login" ! [intAttr "tabindex" 3]
- ] +++
+ return $ gui (fromString $ base' ++ "/_login") ! Html5.Attr.id "loginForm" $
+ (fieldset $ mconcat
+ [ Html5.label ! Html5.Attr.for "username" $ "Username "
+ , textfieldInput' "username" ! size "15" ! intTabindex 1
+ , " "
+ , Html5.label ! Html5.Attr.for "password" $ "Password "
+ , passwordInput "password" ! size "15" ! intTabindex 2
+ , " "
+ , textfieldInput "destination" (fromString dest) ! Html5.Attr.style "display: none;"
+ , submitInput "login" "Login" ! intTabindex 3
+ ]) <>
(if disableRegistration cfg
- then noHtml
- else p << [ stringToHtml "If you do not have an account, "
- , anchor ! [href $ base' ++ "/_register?" ++
- urlEncodeVars [("destination", encodeString dest)]] << "click here to get one."
- ]) +++
+ then mempty
+ else p $ mconcat
+ [ "If you do not have an account, "
+ , a ! href (fromString $ base' ++ "/_register?" ++
+ urlEncodeVars [("destination", encodeString dest)]) $ "click here to get one."
+ ]) <>
(if null (mailCommand cfg)
- then noHtml
- else p << [ stringToHtml "If you forgot your password, "
- , anchor ! [href $ base' ++ "/_resetPassword"] <<
+ then mempty
+ else p $ mconcat
+ [ "If you forgot your password, "
+ , a ! href (fromString $ base' ++ "/_resetPassword") $
"click here to get a new one."
])
@@ -396,8 +427,7 @@
then do
key <- newSession (sessionData uname)
addCookie (MaxAge $ sessionTimeout cfg) (mkSessionCookie key)
- seeOther (encUrl destination) $ toResponse $ p << ("Welcome, " ++
- renderHtmlFragment (stringToHtml uname))
+ seeOther (encUrl destination) $ toResponse $ p $ (fromString $ "Welcome, " ++ uname)
else
withMessages ["Invalid username or password."] loginUserForm
@@ -412,7 +442,7 @@
delSession k
expireCookie "sid"
Nothing -> return ()
- seeOther (encUrl dest) $ toResponse "You have been logged out."
+ seeOther (encUrl dest) $ toResponse ("You have been logged out." :: String)
registerUserForm :: Handler
registerUserForm = registerForm >>=
@@ -424,8 +454,8 @@
regAuthHandlers :: [Handler]
regAuthHandlers =
- [ dir "_register" $ method GET >> registerUserForm
- , dir "_register" $ method POST >> withData registerUser
+ [ Network.Gitit.Server.dir "_register" $ Network.Gitit.Server.method GET >> registerUserForm
+ , Network.Gitit.Server.dir "_register" $ Network.Gitit.Server.method POST >> withData registerUser
]
formAuthHandlers :: Bool -> [Handler]
@@ -433,14 +463,14 @@
(if disableReg
then []
else regAuthHandlers) ++
- [ dir "_login" $ method GET >> loginUserForm
- , dir "_login" $ method POST >> withData loginUser
- , dir "_logout" $ method GET >> withData logoutUser
- , dir "_resetPassword" $ method GET >> withData resetPasswordRequestForm
- , dir "_resetPassword" $ method POST >> withData resetPasswordRequest
- , dir "_doResetPassword" $ method GET >> withData resetPassword
- , dir "_doResetPassword" $ method POST >> withData doResetPassword
- , dir "_user" currentUser
+ [ Network.Gitit.Server.dir "_login" $ Network.Gitit.Server.method GET >> loginUserForm
+ , Network.Gitit.Server.dir "_login" $ Network.Gitit.Server.method POST >> withData loginUser
+ , Network.Gitit.Server.dir "_logout" $ Network.Gitit.Server.method GET >> withData logoutUser
+ , Network.Gitit.Server.dir "_resetPassword" $ Network.Gitit.Server.method GET >> withData resetPasswordRequestForm
+ , Network.Gitit.Server.dir "_resetPassword" $ Network.Gitit.Server.method POST >> withData resetPasswordRequest
+ , Network.Gitit.Server.dir "_doResetPassword" $ Network.Gitit.Server.method GET >> withData resetPassword
+ , Network.Gitit.Server.dir "_doResetPassword" $ Network.Gitit.Server.method POST >> withData doResetPassword
+ , Network.Gitit.Server.dir "_user" currentUser
]
loginUserHTTP :: Params -> Handler
@@ -454,9 +484,9 @@
httpAuthHandlers :: [Handler]
httpAuthHandlers =
- [ dir "_logout" logoutUserHTTP
- , dir "_login" $ withData loginUserHTTP
- , dir "_user" currentUser ]
+ [ Network.Gitit.Server.dir "_logout" logoutUserHTTP
+ , Network.Gitit.Server.dir "_login" $ withData loginUserHTTP
+ , Network.Gitit.Server.dir "_user" currentUser ]
oauthGithubCallback :: GithubConfig
-> GithubCallbackPars -- ^ Authentication code gained after authorization
@@ -492,15 +522,15 @@
githubAuthHandlers :: GithubConfig
-> [Handler]
githubAuthHandlers ghConfig =
- [ dir "_logout" $ withData logoutUser
- , dir "_login" $ withData $ loginGithubUser $ oAuth2 ghConfig
- , dir "_loginFailure" $ githubLoginFailure
- , dir "_githubCallback" $ withData $ oauthGithubCallback ghConfig
- , dir "_user" currentUser ]
+ [ Network.Gitit.Server.dir "_logout" $ withData logoutUser
+ , Network.Gitit.Server.dir "_login" $ withData $ loginGithubUser $ oAuth2 ghConfig
+ , Network.Gitit.Server.dir "_loginFailure" $ githubLoginFailure
+ , Network.Gitit.Server.dir "_githubCallback" $ withData $ oauthGithubCallback ghConfig
+ , Network.Gitit.Server.dir "_user" currentUser ]
githubLoginFailure :: Handler
githubLoginFailure = withData $ \params ->
- formattedPage (pageLayout (pMessages params)) noHtml >>= forbidden
+ formattedPage (pageLayout (pMessages params)) mempty >>= forbidden
where
pageLayout msgs =
defaultPageLayout{ pgShowPageTools = False,
@@ -508,65 +538,6 @@
pgTitle = "Login failure",
pgMessages = msgs
}
-
--- Login using RPX (see RPX development docs at https://rpxnow.com/docs)
-loginRPXUser :: RPars -- ^ The parameters passed by the RPX callback call (after authentication has taken place
- -> Handler
-loginRPXUser params = do
- cfg <- getConfig
- ref <- getReferer
- let mtoken = rToken params
- if isNothing mtoken
- then do
- let url = baseUrl cfg ++ "/_login?destination=" ++
- fromMaybe ref (rDestination params)
- if null (rpxDomain cfg)
- then error "rpx-domain is not set."
- else do
- let rpx = "https://" ++ rpxDomain cfg ++
- ".rpxnow.com/openid/v2/signin?token_url=" ++
- urlEncode url
- see rpx
- else do -- We got an answer from RPX, this might also return an exception.
- uid' :: Either String R.Identifier <- liftIO $
- R.authenticate (rpxKey cfg) $ fromJust mtoken
- uid <- case uid' of
- Right u -> return u
- Left err -> error err
- liftIO $ logM "gitit.loginRPXUser" DEBUG $ "uid:" ++ show uid
- -- We need to get an unique identifier for the user
- -- The 'identifier' is always present but can be rather cryptic
- -- The 'verifiedEmail' is also unique and is a more readable choice
- -- so we use it if present.
- let userId = R.userIdentifier uid
- let email = prop "verifiedEmail" uid
- user <- liftIO $ mkUser (fromMaybe userId email) (fromMaybe "" email) "none"
- updateGititState $ \s -> s { users = M.insert userId user (users s) }
- key <- newSession (sessionData userId)
- addCookie (MaxAge $ sessionTimeout cfg) (mkSessionCookie key)
- see $ fromJust $ rDestination params
- where
- prop pname info = lookup pname $ R.userData info
- see url = seeOther (encUrl url) $ toResponse noHtml
-
--- The parameters passed by the RPX callback call.
-data RPars = RPars { rToken :: Maybe String
- , rDestination :: Maybe String }
- deriving Show
-
-instance FromData RPars where
- fromData = do
- vtoken <- liftM Just (look "token") `mplus` return Nothing
- vDestination <- liftM (Just . urlDecode) (look "destination") `mplus`
- return Nothing
- return RPars { rToken = vtoken
- , rDestination = vDestination }
-
-rpxAuthHandlers :: [Handler]
-rpxAuthHandlers =
- [ dir "_logout" $ method GET >> withData logoutUser
- , dir "_login" $ withData loginRPXUser
- , dir "_user" currentUser ]
-- | Returns username of logged in user or null string if nobody logged in.
currentUser :: Handler
diff --git a/src/Network/Gitit/Authentication/Github.hs b/src/Network/Gitit/Authentication/Github.hs
--- a/src/Network/Gitit/Authentication/Github.hs
+++ b/src/Network/Gitit/Authentication/Github.hs
@@ -16,7 +16,11 @@
import qualified Data.ByteString.Lazy as BSL
import qualified URI.ByteString as URI
import Network.HTTP.Conduit
+#if MIN_VERSION_hoauth2(2,15,0)
+import Network.OAuth2
+#else
import Network.OAuth.OAuth2
+#endif
import Control.Monad (liftM, mplus, mzero)
import Data.Maybe
import Data.Aeson
diff --git a/src/Network/Gitit/Config.hs b/src/Network/Gitit/Config.hs
--- a/src/Network/Gitit/Config.hs
+++ b/src/Network/Gitit/Config.hs
@@ -28,7 +28,7 @@
import Network.Gitit.Types
import Network.Gitit.Server (mimeTypes)
import Network.Gitit.Framework
-import Network.Gitit.Authentication (formAuthHandlers, rpxAuthHandlers, httpAuthHandlers, githubAuthHandlers)
+import Network.Gitit.Authentication (formAuthHandlers, httpAuthHandlers, githubAuthHandlers)
import Network.Gitit.Util (parsePageType, readFileUTF8)
import System.Log.Logger (logM, Priority(..))
import System.IO (hPutStrLn, stderr)
@@ -42,7 +42,11 @@
import System.FilePath (())
import Text.Pandoc hiding (ERROR, WARNING, MathJax, MathML, WebTeX, getDataFileName)
import qualified Control.Exception as E
+#if MIN_VERSION_hoauth2(2,15,0)
+import Network.OAuth2 (OAuth2(..))
+#else
import Network.OAuth.OAuth2 (OAuth2(..))
+#endif
import URI.ByteString (parseURI, laxURIParserOptions)
import qualified Data.ByteString.Char8 as BS
import Network.Gitit.Compat.Except
@@ -162,8 +166,6 @@
cfUseRecaptcha <- get "DEFAULT" "use-recaptcha" >>= readBool
cfRecaptchaPublicKey <- get "DEFAULT" "recaptcha-public-key"
cfRecaptchaPrivateKey <- get "DEFAULT" "recaptcha-private-key"
- cfRPXDomain <- get "DEFAULT" "rpx-domain"
- cfRPXKey <- get "DEFAULT" "rpx-key"
cfCompressResponses <- get "DEFAULT" "compress-responses" >>= readBool
cfUseCache <- get "DEFAULT" "use-cache" >>= readBool
cfCacheDir <- get "DEFAULT" "cache-dir"
@@ -195,8 +197,6 @@
"darcs" -> pure Darcs
"mercurial" -> pure Mercurial
x -> throwError $ "Unknown repository type: " ++ x
- when (authMethod == "rpx" && cfRPXDomain == "") $
- liftIO $ logM "gitit" WARNING "rpx-domain is not set"
ghConfig <- extractGithubConfig cfgmap
@@ -219,7 +219,6 @@
"form" -> withUserFromSession
"github" -> withUserFromSession
"http" -> withUserFromHTTPAuth
- "rpx" -> withUserFromSession
_ -> id
, requireAuthentication = case map toLower cfRequireAuthentication of
"none" -> Never
@@ -231,7 +230,6 @@
"form" -> msum $ formAuthHandlers cfDisableRegistration
"github" -> msum $ githubAuthHandlers ghConfig
"http" -> msum httpAuthHandlers
- "rpx" -> msum rpxAuthHandlers
_ -> mzero
, userFile = cfUserFile
, sessionTimeout = cfSessionTimeout * 60 -- convert minutes -> seconds
@@ -264,8 +262,6 @@
, useRecaptcha = cfUseRecaptcha
, recaptchaPublicKey = cfRecaptchaPublicKey
, recaptchaPrivateKey = cfRecaptchaPrivateKey
- , rpxDomain = cfRPXDomain
- , rpxKey = cfRPXKey
, compressResponses = cfCompressResponses
, useCache = cfUseCache
, cacheDir = cfCacheDir
diff --git a/src/Network/Gitit/ContentTransformer.hs b/src/Network/Gitit/ContentTransformer.hs
--- a/src/Network/Gitit/ContentTransformer.hs
+++ b/src/Network/Gitit/ContentTransformer.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
{-
Copyright (C) 2009 John MacFarlane ,
Anton van Straaten
@@ -76,7 +77,6 @@
import Data.Foldable (traverse_)
import Data.List (stripPrefix)
import Data.Maybe (isNothing, mapMaybe)
-import Data.Semigroup ((<>))
import Network.Gitit.Cache (lookupCache, cacheContents)
import Network.Gitit.Framework hiding (uriPath)
import Network.Gitit.Layout
@@ -93,13 +93,6 @@
import Text.HTML.SanitizeXSS (sanitizeBalance)
import Skylighting hiding (Context)
import Text.Pandoc hiding (MathML, WebTeX, MathJax)
-import Text.XHtml hiding ( (), dir, method, password, rev )
-import Text.XHtml.Strict (stringToHtmlString)
-#if MIN_VERSION_blaze_html(0,5,0)
-import Text.Blaze.Html.Renderer.String as Blaze ( renderHtml )
-#else
-import Text.Blaze.Renderer.String as Blaze ( renderHtml )
-#endif
import URI.ByteString (Query(Query), URIRef(uriPath), laxURIParserOptions,
parseURI, uriQuery)
import qualified Data.Text as T
@@ -108,6 +101,12 @@
import qualified Data.ByteString.Lazy as L (toChunks, fromChunks)
import qualified Data.FileStore as FS
import qualified Text.Pandoc as Pandoc
+import Data.String (IsString(fromString))
+import Text.Blaze.Html.Renderer.String as Blaze ( renderHtml )
+import Text.Blaze.Html5 hiding (u, s, contents, source, html, title, map)
+import Text.Blaze.Html5.Attributes hiding (id)
+import qualified Text.Blaze.Html5 as Html5
+import qualified Text.Blaze.Html5.Attributes as Html5.Attr
--
-- ContentTransformer runners
@@ -199,7 +198,7 @@
contentsToPage >>=
pageToWikiPandoc >>=
pandocToHtml >>=
- return . toResponse . renderHtmlFragment
+ return . toResponse . renderHtml
-- | Applies pre-commit plugins to raw page source, possibly
-- modifying it.
@@ -336,6 +335,8 @@
, ctxMeta = pageMeta page' }
either (liftIO . E.throwIO) return $ readerFor (pageFormat page') (pageLHS page') (pageText page')
+data WasRedirect = WasRedirect | WasNoRedirect
+
-- | Detects if the page is a redirect page and handles accordingly. The exact
-- behaviour is as follows:
--
@@ -362,7 +363,7 @@
-- the redirect parameter set to @\"yes\"@.
--
-- 2. If the @redirect@ parameter is set to \"yes\", then redirect to the
--- destination specificed in the metadata. This uses a client-side (meta
+-- destination specified in the metadata. This uses a client-side (meta
-- refresh + javascript backup) redirect to make sure the referer is set to
-- this URL.
--
@@ -378,56 +379,51 @@
where
addMessage message = modifyContext $ \context -> context
{ ctxLayout = (ctxLayout context)
- { pgMessages = pgMessages (ctxLayout context) ++ [message]
+ { pgMessages = pgMessages (ctxLayout context) ++ [renderHtml message]
}
}
redirectedFrom source = do
(url, html) <- processSource source
- return $ concat
- [ "Redirected from "
- , html
- , ""
+ return $ mconcat
+ [ "Redirected from ",
+ a ! href (url WasNoRedirect) ! title "Go to original page" $ html
]
doubleRedirect source destination = do
(url, html) <- processSource source
(url', html') <- processDestination destination
- return $ concat
- [ "This page normally redirects to "
- , html'
- , ", but as you were already redirected from "
- , html
- , ""
+ return $ mconcat
+ [ "This page normally redirects to "
+ , a ! href (fromString $ url' WasRedirect) ! title "Continue to destination" $ html'
+ , ", but as you were already redirected from "
+ , a ! href (url WasNoRedirect) ! title "Go to original page" $ html
, ", this was stopped to prevent a double-redirect."
]
cancelledRedirect destination = do
(url', html') <- processDestination destination
- return $ concat
- [ "This page redirects to "
- , html'
- , "."
+ return $ mconcat
+ [ "This page redirects to "
+ , a ! href (fromString $ url' WasRedirect) ! title "Continue to destination" $ html'
]
processSource source = do
base' <- getWikiBase
- let url = stringToHtmlString $ base' ++ urlForPage source
- let html = stringToHtmlString source
+ let url redir = fromString @AttributeValue $
+ base' ++ urlForPage source ++ case redir of
+ WasNoRedirect -> "?redirect=no"
+ WasRedirect -> ""
+ let html = fromString @Html source
return (url, html)
processDestination destination = do
base' <- getWikiBase
let (page', fragment) = break (== '#') destination
- let url = stringToHtmlString $ concat
+ let url redir = concat
[ base'
, urlForPage page'
, fragment
- ]
- let html = stringToHtmlString page'
+
+ ] ++ case redir of
+ WasNoRedirect -> "?redirect=no"
+ WasRedirect -> ""
+ let html = fromString @Html page'
return (url, html)
getSource = do
cfg <- lift getConfig
@@ -465,26 +461,25 @@
, urlForPage (pageName page)
, "?redirect=yes"
]
- lift $ seeOther url' $ withBody $ concat
- [ "307 Redirect"
- , "You are being redirected.
"
+ lift $ seeOther url' $ withBody $ renderHtml $ docTypeHtml $ mconcat
+ [ Html5.head $ Html5.title "307 Redirect"
+ , Html5.body $ p $ mconcat [
+ "You are being",
+ a ! href (fromString url') $ "redirected."
+ ]
]
Just True -> fmap Left $ do
(url', html') <- processDestination destination
- lift $ ok $ withBody $ concat
- [ "Redirecting to "
- , html'
- , "Redirecting to "
- , html'
- , "...
"
+ lift $ ok $ withBody $ renderHtml $ docTypeHtml $ mconcat
+ [ Html5.head $ mconcat
+ [ Html5.title $ "Redirecting to" <> html'
+ , meta ! httpEquiv "refresh" ! content (fromString $ "0; url=" <> url' WasRedirect)
+ , script ! type_ "text/javascript" $ fromString $ "window.location=\"" <> url' WasRedirect <> "\""
+ ],
+ Html5.body $ p $ mconcat
+ [ "Redirecting to "
+ , a ! href (fromString $ url' WasRedirect) $ html'
+ ]
]
Just False -> do
cancelledRedirect destination >>= addMessage
@@ -509,7 +504,7 @@
case res of
Right t -> return t
Left e -> throwError $ PandocTemplateError $ T.pack e
- return $ primHtml $ T.unpack .
+ return $ preEscapedToHtml @T.Text .
(if xssSanitize cfg then sanitizeBalance else id) $
either E.throw id . runPure $ writeHtml5String def{
writerTemplate = Just compiledTemplate
@@ -520,7 +515,11 @@
MathJax u -> Pandoc.MathJax $ T.pack u
RawTeX -> Pandoc.PlainMath
, writerTableOfContents = toc
+#if MIN_VERSION_pandoc(3,8,0)
+ , writerHighlightMethod = Skylighting pygments
+#else
, writerHighlightStyle = Just pygments
+#endif
, writerExtensions = if bird
then enableExtension Ext_literate_haskell
$ writerExtensions def
@@ -542,8 +541,7 @@
, traceOutput = False} l
$ T.pack $ filter (/='\r') source of
Left e -> fail (show e)
- Right r -> return $ primHtml $ Blaze.renderHtml
- $ formatHtmlBlock formatOpts r
+ Right r -> return $ formatHtmlBlock formatOpts r
--
-- Plugin combinators
@@ -607,11 +605,11 @@
wikiDivify c = do
categories <- liftM ctxCategories get
base' <- lift getWikiBase
- let categoryLink ctg = li (anchor ! [href $ base' ++ "/_category/" ++ ctg] << ctg)
+ let categoryLink ctg = li (a ! href (fromString $ base' ++ "/_category/" ++ ctg) $ fromString ctg)
let htmlCategories = if null categories
- then noHtml
- else thediv ! [identifier "categoryList"] << ulist << map categoryLink categories
- return $ thediv ! [identifier "wikipage"] << [c, htmlCategories]
+ then mempty
+ else Html5.div ! Html5.Attr.id "categoryList" $ ul $ foldMap categoryLink categories
+ return $ Html5.div ! Html5.Attr.id "wikipage" $ c <> htmlCategories
-- | Adds page title to a Pandoc document.
addPageTitleToPandoc :: String -> Pandoc -> ContentTransformer Pandoc
@@ -629,7 +627,7 @@
conf <- lift getConfig
updateLayout $ \l ->
case mathMethod conf of
- MathML -> addScripts l ["MathMLinHTML.js"]
+ MathML -> l
WebTeX _ -> l
MathJax u -> addScripts l [u]
RawTeX -> l
diff --git a/src/Network/Gitit/Handlers.hs b/src/Network/Gitit/Handlers.hs
--- a/src/Network/Gitit/Handlers.hs
+++ b/src/Network/Gitit/Handlers.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings #-}
{-
Copyright (C) 2008-9 John MacFarlane
@@ -65,8 +66,6 @@
import qualified Control.Exception as E
import System.FilePath
import Network.Gitit.State
-import Text.XHtml hiding ( (), dir, method, password, rev )
-import qualified Text.XHtml as X ( method )
import Data.List (intercalate, intersperse, delete, nub, sortBy, find, isPrefixOf, inits, sort, (\\))
import Data.List.Split (wordsBy)
import Data.Maybe (fromMaybe, mapMaybe, isJust, catMaybes)
@@ -81,6 +80,13 @@
import Data.Time.Clock (diffUTCTime, UTCTime(..))
import Data.FileStore
import System.Log.Logger (logM, Priority(..))
+import Text.Blaze.Html.Renderer.String as Blaze ( renderHtml )
+import Text.Blaze.Html5 hiding (b, search, u, s, contents, source, html, title, map)
+import Text.Blaze.Html5.Attributes hiding (span, id)
+import qualified Text.Blaze.Html5 as Html5 hiding (search)
+import qualified Text.Blaze.Html5.Attributes as Html5.Attr hiding (span)
+import Data.String (IsString(fromString))
+import Prelude hiding (span)
handleAny :: Handler
handleAny = withData $ \(params :: Params) -> uriRest $ \uri ->
@@ -94,7 +100,7 @@
case res of
Right contents -> ignoreFilters >> -- don't compress
(ok $ setContentType mimetype $
- (toResponse noHtml) {rsBody = contents})
+ (toResponse (renderHtml mempty)) {rsBody = contents})
-- ugly hack
Left NotFound -> mzero
Left e -> error (show e)
@@ -121,14 +127,14 @@
let newPage = pages !!
(truncate (secs * 1000000) `mod` length pages)
seeOther (base' ++ urlForPage newPage) $ toResponse $
- p << "Redirecting to a random page"
+ renderHtml $ p $ "Redirecting to a random page"
discussPage :: Handler
discussPage = do
page <- getPage
base' <- getWikiBase
seeOther (base' ++ urlForPage (if isDiscussPage page then page else ('@':page))) $
- toResponse "Redirecting to discussion page"
+ toResponse ("Redirecting to discussion page" :: String)
createPage :: Handler
createPage = do
@@ -140,42 +146,56 @@
pgPageName = page
, pgTabs = []
, pgTitle = "Create " ++ page ++ "?"
- } $
- (p << stringToHtml
- ("There is no page named '" ++ page ++ "'. You can:"))
- +++
- (unordList $
- [ anchor !
- [href $ base' ++ "/_edit" ++ urlForPage page] <<
- ("Create the page '" ++ page ++ "'")
- , anchor !
- [href $ base' ++ "/_search?" ++
- (urlEncodeVars [("patterns", page)])] <<
- ("Search for pages containing the text '" ++
- page ++ "'")])
+ }
+ $ p $ mconcat
+ [ fromString
+ $ "There is no page named '" ++ page ++ "'. You can:"
+ , (ul $ mconcat
+ [ li $ a !
+ href (fromString $ base' ++ "/_edit" ++ urlForPage page)
+ $ fromString ("Create the page '" ++ page ++ "'")
+ , li $ a !
+ href (fromString $ base' ++ "/_search?" ++
+ (urlEncodeVars [("patterns", page)]))
+ $ fromString ("Search for pages containing the text '" ++
+ page ++ "'")])
+ ]
+fileInput :: AttributeValue -> AttributeValue -> Html
+fileInput nameAndId val = input ! type_ "file" ! Html5.Attr.id nameAndId ! name nameAndId ! value val
+textfieldInput :: AttributeValue -> AttributeValue -> Html
+textfieldInput nameAndId val = input ! type_ "text" ! Html5.Attr.id nameAndId ! name nameAndId ! value val
+checkboxInput :: AttributeValue -> AttributeValue -> Html
+checkboxInput nameAndId val = input ! type_ "checkbox" ! Html5.Attr.id nameAndId ! name nameAndId ! value val
+submitInput :: AttributeValue -> AttributeValue -> Html
+submitInput nameAndId val = input ! type_ "submit" ! Html5.Attr.id nameAndId ! name nameAndId ! value val
+
uploadForm :: Handler
uploadForm = withData $ \(params :: Params) -> do
let origPath = pFilename params
let wikiname = pWikiname params `orIfNull` takeFileName origPath
let logMsg = pLogMsg params
- let upForm = form ! [X.method "post", enctype "multipart/form-data"] <<
- fieldset <<
- [ p << [label ! [thefor "file"] << "File to upload:"
+ let upForm = Html5.form ! Html5.Attr.method "post" ! enctype "multipart/form-data"
+ $ fieldset $ mconcat
+ [ p $ mconcat
+ [ Html5.label ! for "file" $ "File to upload:"
, br
- , afile "file" ! [value origPath] ]
- , p << [ label ! [thefor "wikiname"] << "Name on wiki, including extension"
- , noscript << " (leave blank to use the same filename)"
- , stringToHtml ":"
+ , fileInput "file" (fromString origPath) ]
+ , p $ mconcat
+ [ Html5.label ! for "wikiname" $ "Name on wiki, including extension"
+ , noscript $ " (leave blank to use the same filename)"
+ , ":"
, br
- , textfield "wikiname" ! [value wikiname]
- , primHtmlChar "nbsp"
- , checkbox "overwrite" "yes"
- , label ! [thefor "overwrite"] << "Overwrite existing file" ]
- , p << [ label ! [thefor "logMsg"] << "Description of content or changes:"
+ , textfieldInput "wikiname" (fromString wikiname)
+ , preEscapedString " "
+ , checkboxInput "overwrite" "yes"
+ , Html5.label ! for "overwrite" $ "Overwrite existing file"
+ ]
+ , p $ mconcat
+ [ Html5.label ! for "logMsg" $ "Description of content or changes:"
, br
- , textfield "logMsg" ! [size "60", value logMsg]
- , submit "upload" "Upload" ]
+ , textfieldInput "logMsg" (fromString logMsg) ! size "60"
+ , submitInput "upload" "Upload" ]
]
formattedPage defaultPageLayout{
pgMessages = pMessages params,
@@ -227,13 +247,13 @@
fileContents <- liftIO $ B.readFile filePath
let len = B.length fileContents
liftIO $ save fs wikiname (Author user email) logMsg fileContents
- let contents = thediv <<
- [ h2 << ("Uploaded " ++ show len ++ " bytes")
+ let contents = Html5.div $ mconcat
+ [ h2 $ fromString ("Uploaded " ++ show len ++ " bytes")
, if takeExtension wikiname `elem` imageExtensions
- then p << "To add this image to a page, use:" +++
- pre << ("![alt text](/" ++ wikiname ++ ")")
- else p << "To link to this resource from a page, use:" +++
- pre << ("[link label](/" ++ wikiname ++ ")") ]
+ then (p $ "To add this image to a page, use:") <>
+ (pre $ fromString ("![alt text](/" ++ wikiname ++ ")"))
+ else (p $ "To link to this resource from a page, use:") <>
+ (pre $ fromString ("[link label](/" ++ wikiname ++ ")")) ]
formattedPage defaultPageLayout{
pgMessages = pMessages params,
pgShowPageTools = False,
@@ -255,10 +275,10 @@
base' <- getWikiBase
case findPage exactMatch of
Just m -> seeOther (base' ++ urlForPage m) $ toResponse
- "Redirecting to exact match"
+ ("Redirecting to exact match" :: String)
Nothing -> case findPage insensitiveMatch of
Just m -> seeOther (base' ++ urlForPage m) $ toResponse
- "Redirecting to case-insensitive match"
+ ("Redirecting to case-insensitive match" :: String)
Nothing -> case findPage prefixMatch of
Just m -> seeOther (base' ++ urlForPage m) $
toResponse $ "Redirecting" ++
@@ -297,22 +317,23 @@
then 100
else 0
let preamble = if null patterns
- then h3 << ["Please enter a search term."]
- else h3 << [ stringToHtml (show (length matches) ++ " matches found for ")
- , thespan ! [identifier "pattern"] << unwords patterns]
+ then h3 $ "Please enter a search term."
+ else h3 $ mconcat
+ [ fromString (show (length matches) ++ " matches found for ")
+ , Html5.span ! Html5.Attr.id "pattern" $ fromString $ unwords patterns ]
base' <- getWikiBase
- let toMatchListItem (file, contents) = li <<
- [ anchor ! [href $ base' ++ urlForPage (dropExtension file)] << dropExtension file
- , stringToHtml (" (" ++ show (length contents) ++ " matching lines)")
- , stringToHtml " "
- , anchor ! [href "#", theclass "showmatch",
- thestyle "display: none;"] << if length contents > 0
+ let toMatchListItem (file, contents) = li $ mconcat
+ [ a ! href (fromString $ base' ++ urlForPage (dropExtension file)) $ fromString $ dropExtension file
+ , fromString (" (" ++ show (length contents) ++ " matching lines)")
+ , " "
+ , a ! href "#" ! class_ "showmatch" !
+ Html5.Attr.style "display: none;" $ if length contents > 0
then "[show matches]"
else ""
- , pre ! [theclass "matches"] << unlines contents]
- let htmlMatches = preamble +++
- olist << map toMatchListItem
- (reverse $ sortBy (comparing relevance) matches)
+ , pre ! class_ "matches" $ fromString $ unlines contents]
+ let htmlMatches = preamble <>
+ (ol $ foldMap toMatchListItem
+ (reverse $ sortBy (comparing relevance) matches))
formattedPage defaultPageLayout{
pgMessages = pMessages params,
pgShowPageTools = False,
@@ -332,47 +353,51 @@
file <- getPage
showHistory file file params
+intDataAttribute :: Tag -> Int -> Attribute
+intDataAttribute tag = dataAttribute tag . fromString . show
+
showHistory :: String -> String -> Params -> Handler
showHistory file page params = do
fs <- getFileStore
hist <- liftIO $ history fs [file] (TimeRange Nothing Nothing)
(Just $ pLimit params)
base' <- getWikiBase
- let versionToHtml rev pos = li ! [theclass "difflink", intAttr "order" pos,
- strAttr "revision" (revId rev),
- strAttr "diffurl" (base' ++ "/_diff/" ++ page)] <<
- [ thespan ! [theclass "date"] << (show $ revDateTime rev)
- , stringToHtml " ("
- , thespan ! [theclass "author"] << anchor ! [href $ base' ++ "/_activity?" ++
- urlEncodeVars [("forUser", authorName $ revAuthor rev)]] <<
- (authorName $ revAuthor rev)
- , stringToHtml "): "
- , anchor ! [href (base' ++ urlForPage page ++ "?revision=" ++ revId rev)] <<
- thespan ! [theclass "subject"] << revDescription rev
- , noscript <<
- ([ stringToHtml " [compare with "
- , anchor ! [href $ base' ++ "/_diff" ++ urlForPage page ++ "?to=" ++ revId rev] <<
+ let versionToHtml rev pos = li ! class_ "difflink" ! intDataAttribute "order" pos !
+ dataAttribute "revision" (fromString $ revId rev) !
+ dataAttribute "diffurl" (fromString $ base' ++ "/_diff/" ++ page)
+ $ mconcat
+ [ span ! class_ "date" $ (fromString $ show $ revDateTime rev)
+ , " ("
+ , span ! class_ "author" $ a ! href (fromString $ base' ++ "/_activity?" ++
+ urlEncodeVars [("forUser", authorName $ revAuthor rev)]) $
+ fromString (authorName $ revAuthor rev)
+ , "): "
+ , a ! href (fromString $ base' ++ urlForPage page ++ "?revision=" ++ revId rev) $
+ span ! class_ "subject" $ fromString $ revDescription rev
+ , noscript $ mconcat
+ ([ " [compare with "
+ , a ! href (fromString $ base' ++ "/_diff" ++ urlForPage page ++ "?to=" ++ revId rev) $
"previous" ] ++
(if pos /= 1
- then [ primHtmlChar "nbsp"
- , primHtmlChar "bull"
- , primHtmlChar "nbsp"
- , anchor ! [href $ base' ++ "/_diff" ++ urlForPage page ++ "?from=" ++
- revId rev] << "current"
+ then [ preEscapedString " "
+ , preEscapedString "•"
+ , preEscapedString " "
+ , a ! href (fromString $ base' ++ "/_diff" ++ urlForPage page ++ "?from=" ++
+ revId rev) $ "current"
]
else []) ++
- [stringToHtml "]"])
+ ["]"])
]
let contents = if null hist
- then noHtml
- else ulist ! [theclass "history"] <<
+ then mempty
+ else ul ! class_ "history" $ mconcat $
zipWith versionToHtml hist
[length hist, (length hist - 1)..1]
let more = if length hist == pLimit params
- then anchor ! [href $ base' ++ "/_history" ++ urlForPage page
- ++ "?limit=" ++ show (pLimit params + 100)] <<
+ then a ! href (fromString $ base' ++ "/_history" ++ urlForPage page
+ ++ "?limit=" ++ show (pLimit params + 100)) $
"Show more..."
- else noHtml
+ else mempty
let tabs = if file == page -- source file, not wiki page
then [ViewTab,HistoryTab]
else pgTabs defaultPageLayout
@@ -383,7 +408,7 @@
pgTabs = tabs,
pgSelectedTab = HistoryTab,
pgTitle = ("Changes to " ++ page)
- } $ contents +++ more
+ } $ contents <> more
showActivity :: Handler
showActivity = withData $ \(params :: Params) -> do
@@ -406,31 +431,31 @@
fileFromChange (Deleted f) = f
base' <- getWikiBase
let fileAnchor revis file = if takeExtension file == "." ++ (defaultExtension cfg)
- then anchor ! [href $ base' ++ "/_diff" ++ urlForPage (dropExtension file) ++ "?to=" ++ revis] << dropExtension file
- else anchor ! [href $ base' ++ urlForPage file ++ "?revision=" ++ revis] << file
- let filesFor changes revis = intersperse (stringToHtml " ") $
+ then a ! href (fromString $ base' ++ "/_diff" ++ urlForPage (dropExtension file) ++ "?to=" ++ revis) $ fromString $ dropExtension file
+ else a ! href (fromString $ base' ++ urlForPage file ++ "?revision=" ++ revis) $ fromString file
+ let filesFor changes revis = intersperse " " $
map (fileAnchor revis . fileFromChange) changes
- let heading = h1 << ("Recent changes by " ++ fromMaybe "all users" forUser)
- let revToListItem rev = li <<
- [ thespan ! [theclass "date"] << (show $ revDateTime rev)
- , stringToHtml " ("
- , thespan ! [theclass "author"] <<
- anchor ! [href $ base' ++ "/_activity?" ++
- urlEncodeVars [("forUser", authorName $ revAuthor rev)]] <<
- (authorName $ revAuthor rev)
- , stringToHtml "): "
- , thespan ! [theclass "subject"] << revDescription rev
- , stringToHtml " ("
- , thespan ! [theclass "files"] << filesFor (revChanges rev) (revId rev)
- , stringToHtml ")"
+ let heading = h1 $ fromString ("Recent changes by " ++ fromMaybe "all users" forUser)
+ let revToListItem rev = li $ mconcat
+ [ span ! class_ "date" $ fromString $ (show $ revDateTime rev)
+ , " ("
+ , span ! class_ "author" $
+ a ! href (fromString $ base' ++ "/_activity?" ++
+ urlEncodeVars [("forUser", authorName $ revAuthor rev)]) $
+ fromString (authorName $ revAuthor rev)
+ , "): "
+ , span ! class_ "subject" $ fromString $ revDescription rev
+ , " ("
+ , span ! class_ "files" $ mconcat $ filesFor (revChanges rev) (revId rev)
+ , ")"
]
- let contents = ulist ! [theclass "history"] << map revToListItem hist'
+ let contents = ul ! class_ "history" $ foldMap revToListItem hist'
formattedPage defaultPageLayout{
pgMessages = pMessages params,
pgShowPageTools = False,
pgTabs = [],
pgTitle = "Recent changes"
- } (heading +++ contents)
+ } (heading <> contents)
showPageDiff :: Handler
showPageDiff = withData $ \(params :: Params) -> do
@@ -484,17 +509,20 @@
-> IO Html
getDiff fs file from to = do
rawDiff <- diff fs file from to
- let diffLineToHtml (Both xs _) = thespan << unlines xs
- diffLineToHtml (First xs) = thespan ! [theclass "deleted"] << unlines xs
- diffLineToHtml (Second xs) = thespan ! [theclass "added"] << unlines xs
- return $ h2 ! [theclass "revision"] <<
- ("Changes from " ++ fromMaybe "beginning" from ++
- " to " ++ fromMaybe "current" to) +++
- pre ! [theclass "diff"] << map diffLineToHtml rawDiff
+ let diffLineToHtml (Both xs _) = span $ fromString $ unlines xs
+ diffLineToHtml (First xs) = span ! class_ "deleted" $ fromString $ unlines xs
+ diffLineToHtml (Second xs) = span ! class_ "added" $ fromString $ unlines xs
+ return $ h2 ! class_ "revision" $
+ (fromString $ "Changes from " ++ fromMaybe "beginning" from ++
+ " to " ++ fromMaybe "current" to) <>
+ (pre ! class_ "diff" $ foldMap diffLineToHtml rawDiff)
editPage :: Handler
editPage = withData editPage'
+gui :: AttributeValue -> Html -> Html
+gui act = Html5.form ! action act ! Html5.Attr.method "post"
+
editPage' :: Params -> Handler
editPage' params = do
let rev = pRevision params -- if this is set, we're doing a revert
@@ -521,37 +549,36 @@
let messages = pMessages params
let logMsg = pLogMsg params
let sha1Box = case mbRev of
- Just r -> textfield "sha1" ! [thestyle "display: none",
- value r]
- Nothing -> noHtml
- let readonly = if isJust (pRevision params)
+ Just r -> textfieldInput "sha1" (fromString r) ! Html5.Attr.style "display: none"
+ Nothing -> mempty
+ let readonly' = if isJust (pRevision params)
-- disable editing of text box if it's a revert
- then [strAttr "readonly" "yes",
- strAttr "style" "color: gray"]
- else []
+ then (Html5.Attr.readonly "readonly")
+ <> Html5.Attr.style "color: gray"
+ else mempty
base' <- getWikiBase
- let editForm = gui (base' ++ urlForPage page) ! [identifier "editform"] <<
+ let editForm = gui (fromString $ base' ++ urlForPage page) ! Html5.Attr.id "editform"
+ $ mconcat
[ sha1Box
- , textarea ! (readonly ++ [cols "80", name "editedText",
- identifier "editedText"]) << raw
+ , textarea ! readonly' ! cols "80" ! name "editedText" !
+ Html5.Attr.id "editedText" $ fromString raw
, br
- , label ! [thefor "logMsg"] << "Description of changes:"
+ , Html5.label ! for "logMsg" $ "Description of changes:"
, br
- , textfield "logMsg" ! (readonly ++ [value (logMsg `orIfNull` defaultSummary cfg) ])
- , submit "update" "Save"
- , primHtmlChar "nbsp"
- , submit "cancel" "Discard"
- , primHtmlChar "nbsp"
- , input ! [thetype "button", theclass "editButton",
- identifier "previewButton",
- strAttr "onClick" "updatePreviewPane();",
- strAttr "style" "display: none;",
- value "Preview" ]
- , thediv ! [ identifier "previewpane" ] << noHtml
+ , textfieldInput "logMsg" (fromString $ logMsg `orIfNull` defaultSummary cfg) ! readonly'
+ , submitInput "update" "Save"
+ , preEscapedString " "
+ , submitInput "cancel" "Discard"
+ , preEscapedString " "
+ , input ! type_ "button" ! class_ "editButton"
+ ! Html5.Attr.id "previewButton"
+ ! onclick "updatePreviewPane();"
+ ! Html5.Attr.style "display: none;"
+ ! value "Preview"
+ , Html5.div ! Html5.Attr.id "previewpane" $ mempty
]
let pgScripts' = ["preview.js"]
let pgScripts'' = case mathMethod cfg of
- MathML -> "MathMLinHTML.js" : pgScripts'
MathJax url -> url : pgScripts'
_ -> pgScripts'
formattedPage defaultPageLayout{
@@ -583,17 +610,17 @@
Left NotFound -> return ""
Left e -> fail (show e)
Left e -> fail (show e)
- let confirmForm = gui "" <<
- [ p << "Are you sure you want to delete this page?"
- , input ! [thetype "text", name "filetodelete",
- strAttr "style" "display: none;", value fileToDelete]
- , submit "confirm" "Yes, delete it!"
- , stringToHtml " "
- , submit "cancel" "No, keep it!"
+ let confirmForm = gui "" $ mconcat
+ [ p $ "Are you sure you want to delete this page?"
+ , input ! type_ "text" ! name "filetodelete"
+ ! Html5.Attr.style "display: none;" ! value (fromString fileToDelete)
+ , submitInput "confirm" "Yes, delete it!"
+ , " "
+ , submitInput "cancel" "No, keep it!"
, br ]
formattedPage defaultPageLayout{ pgTitle = "Delete " ++ page ++ "?" } $
if null fileToDelete
- then ulist ! [theclass "messages"] << li <<
+ then ul ! class_ "messages" $ li $
"There is no file or page by that name."
else confirmForm
@@ -613,8 +640,8 @@
then do
fs <- getFileStore
liftIO $ Data.FileStore.delete fs file author descrip
- seeOther (base' ++ "/") $ toResponse $ p << "File deleted"
- else seeOther (base' ++ urlForPage page) $ toResponse $ p << "Not deleted"
+ seeOther (base' ++ "/") $ toResponse $ p $ "File deleted"
+ else seeOther (base' ++ urlForPage page) $ toResponse $ p $ "Not deleted"
updatePage :: Handler
updatePage = withData $ \(params :: Params) -> do
@@ -650,7 +677,7 @@
then return (Right ())
else E.throwIO e)
case modifyRes of
- Right () -> seeOther (base' ++ urlForPage page) $ toResponse $ p << "Page updated"
+ Right () -> seeOther (base' ++ urlForPage page) $ toResponse $ p $ "Page updated"
Left (MergeInfo mergedWithRev conflicts mergedText) -> do
let mergeMsg = "The page has been edited since you checked it out. " ++
"Changes from revision " ++ revId mergedWithRev ++
@@ -686,25 +713,25 @@
fileListToHtml :: String -> String -> String -> [Resource] -> Html
fileListToHtml base' prefix ext files =
let fileLink (FSFile f) | takeExtension f == "." ++ ext =
- li ! [theclass "page" ] <<
- anchor ! [href $ base' ++ urlForPage (prefix ++ dropExtension f)] <<
- dropExtension f
- fileLink (FSFile f) = li ! [theclass "upload"] << concatHtml
- [ anchor ! [href $ base' ++ urlForPage (prefix ++ f)] << f
- , anchor ! [href $ base' ++ "_delete" ++ urlForPage (prefix ++ f)] << "(delete)"
+ li ! class_ "page" $
+ a ! href (fromString $ base' ++ urlForPage (prefix ++ dropExtension f)) $
+ fromString $ dropExtension f
+ fileLink (FSFile f) = li ! class_ "upload" $ mconcat
+ [ a ! href (fromString $ base' ++ urlForPage (prefix ++ f)) $ fromString f
+ , a ! href (fromString $ base' ++ "_delete" ++ urlForPage (prefix ++ f)) $ "(delete)"
]
fileLink (FSDirectory f) =
- li ! [theclass "folder"] <<
- anchor ! [href $ base' ++ urlForPage (prefix ++ f) ++ "/"] << f
+ li ! class_ "folder" $
+ a ! href (fromString $ base' ++ urlForPage (prefix ++ f) ++ "/") $ fromString f
updirs = drop 1 $ inits $ splitPath $ '/' : prefix
uplink = foldr (\d accum ->
- concatHtml [ anchor ! [theclass "updir",
- href $ if length d <= 1
+ mconcat [ a ! class_ "updir" !
+ href (fromString $ if length d <= 1
then base' ++ "/_index"
else base' ++
- urlForPage (joinPath $ drop 1 d)] <<
- lastNote "fileListToHtml" d, accum]) noHtml updirs
- in uplink +++ ulist ! [theclass "index"] << map fileLink files
+ urlForPage (joinPath $ drop 1 d)) $
+ fromString $ lastNote "fileListToHtml" d, accum]) mempty updirs
+ in uplink <> (ul ! class_ "index" $ foldMap fileLink files)
-- NOTE: The current implementation of categoryPage does not go via the
-- filestore abstraction. That is bad, but can only be fixed if we add
@@ -725,22 +752,22 @@
then Just (f, categories \\ pcategories)
else Nothing
base' <- getWikiBase
- let toMatchListItem file = li <<
- [ anchor ! [href $ base' ++ urlForPage (dropExtension file)] << dropExtension file ]
- let toRemoveListItem cat = li <<
- [ anchor ! [href $ base' ++
+ let toMatchListItem file = li $
+ a ! href (fromString $ base' ++ urlForPage (dropExtension file)) $ fromString $ dropExtension file
+ let toRemoveListItem cat = li $
+ a ! href (fromString $ base' ++
(if null (tail pcategories)
then "/_categories"
- else "/_category" ++ urlForPage (intercalate "," $ Data.List.delete cat pcategories)) ]
- << ("-" ++ cat) ]
- let toAddListItem cat = li <<
- [ anchor ! [href $ base' ++
- "/_category" ++ urlForPage (path' ++ "," ++ cat) ]
- << ("+" ++ cat) ]
- let matchList = ulist << map toMatchListItem (fst $ unzip matches) +++
- thediv ! [ identifier "categoryList" ] <<
- ulist << (++) (map toAddListItem (nub $ concat $ snd $ unzip matches))
- (map toRemoveListItem pcategories)
+ else "/_category" ++ urlForPage (intercalate "," $ Data.List.delete cat pcategories)))
+ $ fromString ("-" ++ cat)
+ let toAddListItem cat = li $
+ a ! href (fromString $ base' ++
+ "/_category" ++ urlForPage (path' ++ "," ++ cat))
+ $ fromString ("+" ++ cat)
+ let matchList = ul $ foldMap toMatchListItem (fst $ unzip matches) <>
+ (Html5.div ! Html5.Attr.id "categoryList" $
+ ul $ mconcat $ (++) (map toAddListItem (nub $ concat $ snd $ unzip matches))
+ (map toRemoveListItem pcategories))
formattedPage defaultPageLayout{
pgPageName = categoryDescription,
pgShowPageTools = False,
@@ -758,9 +785,9 @@
categories <- liftIO $ liftM (nub . sort . concat) $ forM pages $ \f ->
readCategories (repoPath f)
base' <- getWikiBase
- let toCatLink ctg = li <<
- [ anchor ! [href $ base' ++ "/_category" ++ urlForPage ctg] << ctg ]
- let htmlMatches = ulist << map toCatLink categories
+ let toCatLink ctg = li $
+ a ! href (fromString $ base' ++ "/_category" ++ urlForPage ctg) $ (fromString ctg)
+ let htmlMatches = ul $ foldMap toCatLink categories
formattedPage defaultPageLayout{
pgPageName = "Categories",
pgShowPageTools = False,
diff --git a/src/Network/Gitit/Initialize.hs b/src/Network/Gitit/Initialize.hs
--- a/src/Network/Gitit/Initialize.hs
+++ b/src/Network/Gitit/Initialize.hs
@@ -63,15 +63,13 @@
updateGititState $ \s -> s { sessions = Sessions M.empty
, users = users'
- , templatesPath = templatesDir conf
, renderPage = defaultRenderPage templ
, plugins = plugins' }
-- | Recompile the page template.
-recompilePageTemplate :: IO ()
-recompilePageTemplate = do
- tempsDir <- queryGititState templatesPath
- ct <- compilePageTemplate tempsDir
+recompilePageTemplate :: Config -> IO ()
+recompilePageTemplate cfg = do
+ ct <- compilePageTemplate (templatesDir cfg)
updateGititState $ \st -> st{renderPage = defaultRenderPage ct}
--- | Compile a master page template named @page.st@ in the directory specified.
diff --git a/src/Network/Gitit/Layout.hs b/src/Network/Gitit/Layout.hs
--- a/src/Network/Gitit/Layout.hs
+++ b/src/Network/Gitit/Layout.hs
@@ -1,4 +1,6 @@
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
{-
Copyright (C) 2009 John MacFarlane
@@ -33,9 +35,11 @@
import Network.Gitit.Types
import Network.HTTP (urlEncodeVars)
import qualified Text.StringTemplate as T
-import Text.XHtml hiding ( (), dir, method, password, rev )
-import Text.XHtml.Strict ( stringToHtmlString )
import Data.Maybe (isNothing)
+import Text.Blaze.Html5 hiding (s, article, map)
+import Text.Blaze.Html5.Attributes hiding (id)
+import Data.String (IsString(fromString))
+import Text.Blaze.Html.Renderer.String (renderHtml)
defaultPageLayout :: PageLayout
defaultPageLayout = PageLayout
@@ -78,19 +82,19 @@
_ -> base' ++ "/js/" ++ x
scripts = ["jquery-1.2.6.min.js", "jquery-ui-combined-1.6rc2.min.js", "footnotes.js"] ++ pgScripts layout
- scriptLink x = script ! [src (prefixedScript x),
- thetype "text/javascript"] << noHtml
- javascriptlinks = renderHtmlFragment $ concatHtml $ map scriptLink scripts
+ scriptLink x = script ! src (fromString $ prefixedScript x) !
+ type_ "text/javascript" $ mempty
+ javascriptlinks = renderHtml $ mconcat $ map scriptLink scripts
article = if isDiscussPage page then drop 1 page else page
discussion = '@':article
tabli tab = if tab == pgSelectedTab layout
- then li ! [theclass "selected"]
+ then li ! class_ "selected"
else li
tabs' = [x | x <- pgTabs layout,
not (x == EditTab && page `elem` noEdit cfg)]
- tabs = ulist ! [theclass "tabs"] << map (linkForTab tabli base' page rev) tabs'
- setStrAttr attr = T.setAttribute attr . stringToHtmlString
- setBoolAttr attr test = if test then T.setAttribute attr "true" else id
+ tabs = (ul ! class_ "tabs") $ foldMap (linkForTab tabli base' page rev) tabs'
+ setStrAttr attr = T.setAttribute attr . renderHtml . fromString @Html
+ setBoolAttr attr test = if test then T.setAttribute attr ("true"::[Char]) else id
in T.setAttribute "base" base' .
T.setAttribute "feed" (pgLinkToFeed layout) .
setStrAttr "wikititle" (wikiTitle cfg) .
@@ -111,10 +115,10 @@
setBoolAttr "printable" (pgPrintable layout) .
maybe id (T.setAttribute "revision") rev .
(if null (pgTabs layout) then id else T.setAttribute "tabs"
- (renderHtmlFragment tabs)) .
+ (renderHtml tabs)) .
(\f x xs -> if null xs then x else f xs) (T.setAttribute "messages") id (pgMessages layout) .
T.setAttribute "usecache" (useCache cfg) .
- T.setAttribute "content" (renderHtmlFragment htmlContents) .
+ T.setAttribute "content" (renderHtml htmlContents) .
setBoolAttr "wikiupload" ( uploadsAllowed cfg) $
templ
@@ -123,32 +127,32 @@
linkForTab :: (Tab -> Html -> Html) -> String -> String -> Maybe String -> Tab -> Html
linkForTab tabli base' page _ HistoryTab =
- tabli HistoryTab << anchor ! [href $ base' ++ "/_history" ++ urlForPage page] << "history"
+ tabli HistoryTab $ a ! href (fromString $ base' ++ "/_history" ++ urlForPage page) $ "history"
linkForTab tabli _ _ _ DiffTab =
- tabli DiffTab << anchor ! [href ""] << "diff"
+ tabli DiffTab $ a ! href "" $ "diff"
linkForTab tabli base' page rev ViewTab =
let origPage s = if isDiscussPage s
then drop 1 s
else s
in if isDiscussPage page
- then tabli DiscussTab << anchor !
- [href $ base' ++ urlForPage (origPage page)] << "page"
- else tabli ViewTab << anchor !
- [href $ base' ++ urlForPage page ++
+ then tabli DiscussTab $ a !
+ href (fromString $ base' ++ urlForPage (origPage page)) $ "page"
+ else tabli ViewTab $ a !
+ href (fromString $ base' ++ urlForPage page ++
case rev of
Just r -> "?revision=" ++ r
- Nothing -> ""] << "view"
+ Nothing -> "") $ "view"
linkForTab tabli base' page _ DiscussTab =
- tabli (if isDiscussPage page then ViewTab else DiscussTab) <<
- anchor ! [href $ base' ++ if isDiscussPage page then "" else "/_discuss" ++
- urlForPage page] << "discuss"
+ tabli (if isDiscussPage page then ViewTab else DiscussTab) $
+ a ! href (fromString $ base' ++ if isDiscussPage page then "" else "/_discuss" ++
+ urlForPage page) $ "discuss"
linkForTab tabli base' page rev EditTab =
- tabli EditTab << anchor !
- [href $ base' ++ "/_edit" ++ urlForPage page ++
+ tabli EditTab $ a !
+ href (fromString $ base' ++ "/_edit" ++ urlForPage page ++
case rev of
Just r -> "?revision=" ++ r ++ "&" ++
urlEncodeVars [("logMsg", "Revert to " ++ r)]
- Nothing -> ""] << if isNothing rev
+ Nothing -> "") $ if isNothing rev
then "edit"
else "revert"
diff --git a/src/Network/Gitit/Rpxnow.hs b/src/Network/Gitit/Rpxnow.hs
deleted file mode 100644
--- a/src/Network/Gitit/Rpxnow.hs
+++ /dev/null
@@ -1,75 +0,0 @@
--- Modified from Michael Snoyman's BSD3 authenticate-0.0.1
--- and http-wget-0.0.1.
--- Facilitates authentication with "http://rpxnow.com/".
-
-module Network.Gitit.Rpxnow
- ( Identifier (..)
- , authenticate
- ) where
-
-import Text.JSON
-import Data.Maybe (isJust, fromJust)
-import System.Process
-import System.Exit
-import System.IO
-import Network.HTTP (urlEncodeVars)
-
--- | Make a post request with parameters to the URL and return a response.
-curl :: String -- ^ URL
- -> [(String, String)] -- ^ Post parameters
- -> IO (Either String String) -- ^ Response body
-curl url params = do
- (Nothing, Just hout, Just herr, phandle) <- createProcess $ (proc "curl"
- [url, "-d", urlEncodeVars params]
- ) { std_out = CreatePipe, std_err = CreatePipe }
- exitCode <- waitForProcess phandle
- case exitCode of
- ExitSuccess -> hGetContents hout >>= return . Right
- _ -> hGetContents herr >>= return . Left
-
-
-
--- | Information received from Rpxnow after a valid login.
-data Identifier = Identifier
- { userIdentifier :: String
- , userData :: [(String, String)]
- }
- deriving Show
-
--- | Attempt to log a user in.
-authenticate :: String -- ^ API key given by RPXNOW.
- -> String -- ^ Token passed by client.
- -> IO (Either String Identifier)
-authenticate apiKey token = do
- body <- curl
- "https://rpxnow.com/api/v2/auth_info"
- [ ("apiKey", apiKey)
- , ("token", token)
- ]
- case body of
- Left s -> return $ Left $ "Unable to connect to rpxnow: " ++ s
- Right b ->
- case decode b >>= getObject of
- Error s -> return $ Left $ "Not a valid JSON response: " ++ s
- Ok o ->
- case valFromObj "stat" o of
- Error _ -> return $ Left "Missing 'stat' field"
- Ok "ok" -> return $ resultToEither $ parseProfile o
- Ok stat -> return $ Left $ "Login not accepted: " ++ stat
-
-parseProfile :: JSObject JSValue -> Result Identifier
-parseProfile v = do
- profile <- valFromObj "profile" v >>= getObject
- ident <- valFromObj "identifier" profile
- let pairs = fromJSObject profile
- pairs' = filter (\(k, _) -> k /= "identifier") pairs
- pairs'' = map fromJust . filter isJust . map takeString $ pairs'
- return $ Identifier ident pairs''
-
-takeString :: (String, JSValue) -> Maybe (String, String)
-takeString (k, JSString v) = Just (k, fromJSString v)
-takeString _ = Nothing
-
-getObject :: JSValue -> Result (JSObject JSValue)
-getObject (JSObject o) = return o
-getObject _ = fail "Not an object"
diff --git a/src/Network/Gitit/State.hs b/src/Network/Gitit/State.hs
--- a/src/Network/Gitit/State.hs
+++ b/src/Network/Gitit/State.hs
@@ -39,7 +39,6 @@
gititstate :: IORef GititState
gititstate = unsafePerformIO $ newIORef GititState { sessions = undefined
, users = undefined
- , templatesPath = undefined
, renderPage = undefined
, plugins = undefined }
diff --git a/src/Network/Gitit/Types.hs b/src/Network/Gitit/Types.hs
--- a/src/Network/Gitit/Types.hs
+++ b/src/Network/Gitit/Types.hs
@@ -70,7 +70,6 @@
import Control.Monad (liftM, mplus)
import System.Log.Logger (Priority(..))
import Text.Pandoc.Definition (Pandoc)
-import Text.XHtml (Html)
import qualified Data.Map as M
import Data.Text (Text)
import Data.List (intersect)
@@ -84,7 +83,12 @@
import Network.Gitit.Server
import Text.HTML.TagSoup.Entity (lookupEntity)
import Data.Char (isSpace)
+#if MIN_VERSION_hoauth2(2,15,0)
+import Network.OAuth2
+#else
import Network.OAuth.OAuth2
+#endif
+import Text.Blaze.Html (Html)
data PageType = Markdown
| CommonMark
@@ -175,9 +179,6 @@
useRecaptcha :: Bool,
recaptchaPublicKey :: String,
recaptchaPrivateKey :: String,
- -- | RPX domain and key
- rpxDomain :: String,
- rpxKey :: String,
-- | Should responses be compressed?
compressResponses :: Bool,
-- | Should responses be cached?
@@ -263,7 +264,6 @@
data GititState = GititState {
sessions :: Sessions SessionData,
users :: M.Map String User,
- templatesPath :: FilePath,
renderPage :: PageLayout -> Html -> Handler,
plugins :: [Plugin]
}