{-# LANGUAGE FlexibleContexts #-}
module Network.Gitit.Layout ( defaultPageLayout
, defaultRenderPage
, formattedPage
, filledPageTemplate
, uploadsAllowed
)
where
import Network.Gitit.Server
import Network.Gitit.Framework
import Network.Gitit.State
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)
defaultPageLayout :: PageLayout
defaultPageLayout :: PageLayout
defaultPageLayout = PageLayout
{ pgPageName :: String
pgPageName = String
""
, pgRevision :: Maybe String
pgRevision = forall a. Maybe a
Nothing
, pgPrintable :: Bool
pgPrintable = Bool
False
, pgMessages :: [String]
pgMessages = []
, pgTitle :: String
pgTitle = String
""
, pgScripts :: [String]
pgScripts = []
, pgShowPageTools :: Bool
pgShowPageTools = Bool
True
, pgShowSiteNav :: Bool
pgShowSiteNav = Bool
True
, pgMarkupHelp :: Maybe Text
pgMarkupHelp = forall a. Maybe a
Nothing
, pgTabs :: [Tab]
pgTabs = [Tab
ViewTab, Tab
EditTab, Tab
HistoryTab, Tab
DiscussTab]
, pgSelectedTab :: Tab
pgSelectedTab = Tab
ViewTab
, pgLinkToFeed :: Bool
pgLinkToFeed = Bool
False
}
formattedPage :: PageLayout -> Html -> Handler
formattedPage :: PageLayout -> Html -> Handler
formattedPage PageLayout
layout Html
htmlContents = do
PageLayout -> Html -> Handler
renderer <- forall (m :: * -> *) a. MonadIO m => (GititState -> a) -> m a
queryGititState GititState -> PageLayout -> Html -> Handler
renderPage
PageLayout -> Html -> Handler
renderer PageLayout
layout Html
htmlContents
defaultRenderPage :: T.StringTemplate String -> PageLayout -> Html -> Handler
defaultRenderPage :: StringTemplate String -> PageLayout -> Html -> Handler
defaultRenderPage StringTemplate String
templ PageLayout
layout Html
htmlContents = do
Config
cfg <- GititServerPart Config
getConfig
String
base' <- forall (m :: * -> *). ServerMonad m => m String
getWikiBase
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Response -> Response
setContentType String
"text/html; charset=utf-8" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMessage a => a -> Response
toResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stringable a => StringTemplate a -> a
T.render forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String
-> Config
-> PageLayout
-> Html
-> StringTemplate String
-> StringTemplate String
filledPageTemplate String
base' Config
cfg PageLayout
layout Html
htmlContents forall a b. (a -> b) -> a -> b
$ StringTemplate String
templ
filledPageTemplate :: String -> Config -> PageLayout -> Html ->
T.StringTemplate String -> T.StringTemplate String
filledPageTemplate :: String
-> Config
-> PageLayout
-> Html
-> StringTemplate String
-> StringTemplate String
filledPageTemplate String
base' Config
cfg PageLayout
layout Html
htmlContents StringTemplate String
templ =
let rev :: Maybe String
rev = PageLayout -> Maybe String
pgRevision PageLayout
layout
page :: String
page = PageLayout -> String
pgPageName PageLayout
layout
prefixedScript :: String -> String
prefixedScript String
x = case String
x of
Char
'h':Char
't':Char
't':Char
'p':String
_ -> String
x
String
_ -> String
base' forall a. [a] -> [a] -> [a]
++ String
"/js/" forall a. [a] -> [a] -> [a]
++ String
x
scripts :: [String]
scripts = [String
"jquery-1.2.6.min.js", String
"jquery-ui-combined-1.6rc2.min.js", String
"footnotes.js"] forall a. [a] -> [a] -> [a]
++ PageLayout -> [String]
pgScripts PageLayout
layout
scriptLink :: String -> Html
scriptLink String
x = Html -> Html
script forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
src (String -> String
prefixedScript String
x),
String -> HtmlAttr
thetype String
"text/javascript"] forall a b. HTML a => (Html -> b) -> a -> b
<< Html
noHtml
javascriptlinks :: String
javascriptlinks = forall html. HTML html => html -> String
renderHtmlFragment forall a b. (a -> b) -> a -> b
$ forall a. HTML a => [a] -> Html
concatHtml forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Html
scriptLink [String]
scripts
article :: String
article = if String -> Bool
isDiscussPage String
page then forall a. Int -> [a] -> [a]
drop Int
1 String
page else String
page
discussion :: String
discussion = Char
'@'forall a. a -> [a] -> [a]
:String
article
tabli :: Tab -> Html -> Html
tabli Tab
tab = if Tab
tab forall a. Eq a => a -> a -> Bool
== PageLayout -> Tab
pgSelectedTab PageLayout
layout
then Html -> Html
li forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"selected"]
else Html -> Html
li
tabs' :: [Tab]
tabs' = [Tab
x | Tab
x <- PageLayout -> [Tab]
pgTabs PageLayout
layout,
Bool -> Bool
not (Tab
x forall a. Eq a => a -> a -> Bool
== Tab
EditTab Bool -> Bool -> Bool
&& String
page forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Config -> [String]
noEdit Config
cfg)]
tabs :: Html
tabs = Html -> Html
ulist forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
theclass String
"tabs"] forall a b. HTML a => (Html -> b) -> a -> b
<< forall a b. (a -> b) -> [a] -> [b]
map ((Tab -> Html -> Html)
-> String -> String -> Maybe String -> Tab -> Html
linkForTab Tab -> Html -> Html
tabli String
base' String
page Maybe String
rev) [Tab]
tabs'
setStrAttr :: String -> String -> StringTemplate b -> StringTemplate b
setStrAttr String
attr = forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
T.setAttribute String
attr forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
stringToHtmlString
setBoolAttr :: String -> Bool -> StringTemplate b -> StringTemplate b
setBoolAttr String
attr Bool
test = if Bool
test then forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
T.setAttribute String
attr String
"true" else forall a. a -> a
id
in forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
T.setAttribute String
"base" String
base' forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
T.setAttribute String
"feed" (PageLayout -> Bool
pgLinkToFeed PageLayout
layout) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {b}.
Stringable b =>
String -> String -> StringTemplate b -> StringTemplate b
setStrAttr String
"wikititle" (Config -> String
wikiTitle Config
cfg) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {b}.
Stringable b =>
String -> String -> StringTemplate b -> StringTemplate b
setStrAttr String
"pagetitle" (PageLayout -> String
pgTitle PageLayout
layout) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
T.setAttribute String
"javascripts" String
javascriptlinks forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {b}.
Stringable b =>
String -> String -> StringTemplate b -> StringTemplate b
setStrAttr String
"pagename" String
page forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {b}.
Stringable b =>
String -> String -> StringTemplate b -> StringTemplate b
setStrAttr String
"articlename" String
article forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {b}.
Stringable b =>
String -> String -> StringTemplate b -> StringTemplate b
setStrAttr String
"discussionname" String
discussion forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {b}.
Stringable b =>
String -> String -> StringTemplate b -> StringTemplate b
setStrAttr String
"pageUrl" (String -> String
urlForPage String
page) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {b}.
Stringable b =>
String -> String -> StringTemplate b -> StringTemplate b
setStrAttr String
"articleUrl" (String -> String
urlForPage String
article) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {b}.
Stringable b =>
String -> String -> StringTemplate b -> StringTemplate b
setStrAttr String
"discussionUrl" (String -> String
urlForPage String
discussion) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {b}.
Stringable b =>
String -> Bool -> StringTemplate b -> StringTemplate b
setBoolAttr String
"ispage" (String -> Bool
isPage String
page) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {b}.
Stringable b =>
String -> Bool -> StringTemplate b -> StringTemplate b
setBoolAttr String
"isarticlepage" (String -> Bool
isPage String
page Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
isDiscussPage String
page)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {b}.
Stringable b =>
String -> Bool -> StringTemplate b -> StringTemplate b
setBoolAttr String
"isdiscusspage" (String -> Bool
isDiscussPage String
page) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {b}.
Stringable b =>
String -> Bool -> StringTemplate b -> StringTemplate b
setBoolAttr String
"pagetools" (PageLayout -> Bool
pgShowPageTools PageLayout
layout) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {b}.
Stringable b =>
String -> Bool -> StringTemplate b -> StringTemplate b
setBoolAttr String
"sitenav" (PageLayout -> Bool
pgShowSiteNav PageLayout
layout) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
T.setAttribute String
"markuphelp") (PageLayout -> Maybe Text
pgMarkupHelp PageLayout
layout) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {b}.
Stringable b =>
String -> Bool -> StringTemplate b -> StringTemplate b
setBoolAttr String
"printable" (PageLayout -> Bool
pgPrintable PageLayout
layout) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
T.setAttribute String
"revision") Maybe String
rev forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (PageLayout -> [Tab]
pgTabs PageLayout
layout) then forall a. a -> a
id else forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
T.setAttribute String
"tabs"
(forall html. HTML html => html -> String
renderHtmlFragment Html
tabs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\[String] -> StringTemplate String -> StringTemplate String
f StringTemplate String -> StringTemplate String
x [String]
xs -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
xs then StringTemplate String -> StringTemplate String
x else [String] -> StringTemplate String -> StringTemplate String
f [String]
xs) (forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
T.setAttribute String
"messages") forall a. a -> a
id (PageLayout -> [String]
pgMessages PageLayout
layout) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
T.setAttribute String
"usecache" (Config -> Bool
useCache Config
cfg) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b.
(ToSElem a, Stringable b) =>
String -> a -> StringTemplate b -> StringTemplate b
T.setAttribute String
"content" (forall html. HTML html => html -> String
renderHtmlFragment Html
htmlContents) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall {b}.
Stringable b =>
String -> Bool -> StringTemplate b -> StringTemplate b
setBoolAttr String
"wikiupload" ( Config -> Bool
uploadsAllowed Config
cfg) forall a b. (a -> b) -> a -> b
$
StringTemplate String
templ
linkForTab :: (Tab -> Html -> Html) -> String -> String -> Maybe String -> Tab -> Html
linkForTab :: (Tab -> Html -> Html)
-> String -> String -> Maybe String -> Tab -> Html
linkForTab Tab -> Html -> Html
tabli String
base' String
page Maybe String
_ Tab
HistoryTab =
Tab -> Html -> Html
tabli Tab
HistoryTab forall a b. HTML a => (Html -> b) -> a -> b
<< Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String
"/_history" forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage String
page] forall a b. HTML a => (Html -> b) -> a -> b
<< String
"history"
linkForTab Tab -> Html -> Html
tabli String
_ String
_ Maybe String
_ Tab
DiffTab =
Tab -> Html -> Html
tabli Tab
DiffTab forall a b. HTML a => (Html -> b) -> a -> b
<< Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href String
""] forall a b. HTML a => (Html -> b) -> a -> b
<< String
"diff"
linkForTab Tab -> Html -> Html
tabli String
base' String
page Maybe String
rev Tab
ViewTab =
let origPage :: String -> String
origPage String
s = if String -> Bool
isDiscussPage String
s
then forall a. Int -> [a] -> [a]
drop Int
1 String
s
else String
s
in if String -> Bool
isDiscussPage String
page
then Tab -> Html -> Html
tabli Tab
DiscussTab forall a b. HTML a => (Html -> b) -> a -> b
<< Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
!
[String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage (String -> String
origPage String
page)] forall a b. HTML a => (Html -> b) -> a -> b
<< String
"page"
else Tab -> Html -> Html
tabli Tab
ViewTab forall a b. HTML a => (Html -> b) -> a -> b
<< Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
!
[String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage String
page forall a. [a] -> [a] -> [a]
++
case Maybe String
rev of
Just String
r -> String
"?revision=" forall a. [a] -> [a] -> [a]
++ String
r
Maybe String
Nothing -> String
""] forall a b. HTML a => (Html -> b) -> a -> b
<< String
"view"
linkForTab Tab -> Html -> Html
tabli String
base' String
page Maybe String
_ Tab
DiscussTab =
Tab -> Html -> Html
tabli (if String -> Bool
isDiscussPage String
page then Tab
ViewTab else Tab
DiscussTab) forall a b. HTML a => (Html -> b) -> a -> b
<<
Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ if String -> Bool
isDiscussPage String
page then String
"" else String
"/_discuss" forall a. [a] -> [a] -> [a]
++
String -> String
urlForPage String
page] forall a b. HTML a => (Html -> b) -> a -> b
<< String
"discuss"
linkForTab Tab -> Html -> Html
tabli String
base' String
page Maybe String
rev Tab
EditTab =
Tab -> Html -> Html
tabli Tab
EditTab forall a b. HTML a => (Html -> b) -> a -> b
<< Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
!
[String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String
"/_edit" forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage String
page forall a. [a] -> [a] -> [a]
++
case Maybe String
rev of
Just String
r -> String
"?revision=" forall a. [a] -> [a] -> [a]
++ String
r forall a. [a] -> [a] -> [a]
++ String
"&" forall a. [a] -> [a] -> [a]
++
[(String, String)] -> String
urlEncodeVars [(String
"logMsg", String
"Revert to " forall a. [a] -> [a] -> [a]
++ String
r)]
Maybe String
Nothing -> String
""] forall a b. HTML a => (Html -> b) -> a -> b
<< if forall a. Maybe a -> Bool
isNothing Maybe String
rev
then String
"edit"
else String
"revert"
uploadsAllowed :: Config -> Bool
uploadsAllowed :: Config -> Bool
uploadsAllowed = (Integer
0 forall a. Ord a => a -> a -> Bool
<) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Integer
maxUploadSize