-
Notifications
You must be signed in to change notification settings - Fork 0
/
Layout.hs
148 lines (137 loc) · 7.24 KB
/
Layout.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
{-
Copyright (C) 2009 John MacFarlane <[email protected]>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
{- Functions and data structures for wiki page layout.
-}
module Gitit.Layout ( PageLayout(..)
, Tab(..)
, defaultPageLayout
, formattedPage
)
where
import Data.FileStore
import Gitit.Server
import Gitit.Framework
import Gitit.State
import Gitit.Util (orIfNull)
import Gitit.Export (exportFormats)
import Network.HTTP (urlEncodeVars)
import Codec.Binary.UTF8.String (encodeString)
import qualified Text.StringTemplate as T
import Text.XHtml hiding ( (</>), dir, method, password, rev )
import Data.Maybe (isNothing, isJust, mapMaybe, fromJust)
import Data.List (isSuffixOf)
import Prelude hiding (catch)
import Control.Exception (throwIO, catch)
import Control.Monad.Trans (liftIO)
-- | Abstract representation of page layout (tabs, scripts, etc.)
data PageLayout = PageLayout
{ pgTitle :: String
, pgScripts :: [String]
, pgShowPageTools :: Bool
, pgTabs :: [Tab]
, pgSelectedTab :: Tab
}
data Tab = ViewTab | EditTab | HistoryTab | DiscussTab | DiffTab deriving (Eq, Show)
defaultPageLayout :: PageLayout
defaultPageLayout = PageLayout
{ pgTitle = ""
, pgScripts = []
, pgShowPageTools = True
, pgTabs = [ViewTab, EditTab, HistoryTab, DiscussTab]
, pgSelectedTab = ViewTab
}
-- | Returns formatted page
formattedPage :: PageLayout -> String -> Params -> Html -> Web Response
formattedPage layout page params htmlContents = do
let rev = pRevision params
let path' = if isPage page then pathForPage page else page
fs <- getFileStore
sha1 <- case rev of
Nothing -> liftIO $ catch (latest fs path')
(\e -> if e == NotFound
then return ""
else throwIO e)
Just r -> return r
user <- getLoggedInUser params
let javascriptlinks = if null (pgScripts layout)
then ""
else renderHtmlFragment $ concatHtml $ map
(\x -> script ! [src ("/js/" ++ x), thetype "text/javascript"] << noHtml)
(["jquery.min.js", "jquery-ui.packed.js"] ++ pgScripts layout)
let pageTitle = pgTitle layout `orIfNull` page
let tabli tab = if tab == pgSelectedTab layout
then li ! [theclass "selected"]
else li
let origPage s = if ":discuss" `isSuffixOf` s then take (length s - 8) s else s
let linkForTab HistoryTab = Just $ tabli HistoryTab << anchor ! [href $ urlForPage page ++ "?history" ++
case rev of { Just r -> "&revision" ++ r; Nothing -> "" }] << "history"
linkForTab DiffTab = Just $ tabli DiffTab << anchor ! [href ""] << "diff"
linkForTab ViewTab = if isDiscussPage page
then Just $ tabli DiscussTab << anchor ! [href $ urlForPage $ origPage page] << "page"
else Just $ tabli ViewTab << anchor ! [href $ urlForPage page ++
case rev of { Just r -> "?revision=" ++ r; Nothing -> "" }] << "view"
linkForTab DiscussTab = if isDiscussPage page
then Just $ tabli ViewTab << anchor ! [href $ urlForPage page] << "discuss"
else if isPage page
then Just $ tabli DiscussTab << anchor ! [href $ urlForPage page ++ "?discuss"] << "discuss"
else Nothing
linkForTab EditTab = if isPage page
then Just $ tabli EditTab << anchor ! [href $ urlForPage page ++ "?edit" ++
(case rev of
Just r -> "&revision=" ++ r ++ "&" ++ urlEncodeVars [("logMsg", "Revert to " ++ r)]
Nothing -> "")] <<
if isNothing rev then "edit" else "revert"
else Nothing
let tabs = ulist ! [theclass "tabs"] << mapMaybe linkForTab (pgTabs layout)
let searchbox = gui ("/_search") ! [identifier "searchform"] <<
[ textfield "patterns"
, submit "search" "Search" ]
let gobox = gui ("/_go") ! [identifier "goform"] <<
[ textfield "gotopage"
, submit "go" "Go" ]
let messages = pMessages params
let htmlMessages = if null messages
then noHtml
else ulist ! [theclass "messages"] << map (li <<) messages
templ <- queryAppState template
let filledTemp = T.render $
T.setAttribute "pagetitle" pageTitle $
T.setAttribute "javascripts" javascriptlinks $
T.setAttribute "pagename" page $
(case user of
Just u -> T.setAttribute "user" u
Nothing -> id) $
(if isPage page then T.setAttribute "ispage" "true" else id) $
(if pgShowPageTools layout then T.setAttribute "pagetools" "true" else id) $
(if pPrintable params then T.setAttribute "printable" "true" else id) $
(if isJust rev then T.setAttribute "nothead" "true" else id) $
(if isJust rev then T.setAttribute "revision" (fromJust rev) else id) $
T.setAttribute "sha1" sha1 $
T.setAttribute "searchbox" (renderHtmlFragment (searchbox +++ gobox)) $
T.setAttribute "exportbox" (renderHtmlFragment $ exportBox page params) $
T.setAttribute "tabs" (renderHtmlFragment tabs) $
T.setAttribute "messages" (renderHtmlFragment htmlMessages) $
T.setAttribute "content" (renderHtmlFragment htmlContents) $
templ
ok $ setContentType "text/html" $ toResponse $ encodeString filledTemp
exportBox :: String -> Params -> Html
exportBox page params | isPage page =
let rev = pRevision params
in gui (urlForPage page) ! [identifier "exportbox"] <<
([ textfield "revision" ! [thestyle "display: none;", value (fromJust rev)] | isJust rev ] ++
[ select ! [name "format"] <<
map ((\f -> option ! [value f] << f) . fst) exportFormats
, submit "export" "Export" ])
exportBox _ _ = noHtml