Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Added Gitit.Layout.

  • Loading branch information...
commit 7abc4100056ca69a2819d70609334c89c98b4de1 1 parent d639e2c
@jgm authored
Showing with 152 additions and 107 deletions.
  1. +2 −106 Gitit.hs
  2. +149 −0 Gitit/Layout.hs
  3. +1 −1  gitit.cabal
View
108 Gitit.hs
@@ -24,6 +24,7 @@ import Gitit.HAppS
import Gitit.Util (orIfNull, consolidateHeads)
import Gitit.Initialize (createStaticIfMissing, createRepoIfMissing)
import Gitit.Framework
+import Gitit.Layout
import Gitit.Convert
import Gitit.Export (exportFormats)
import System.IO.UTF8
@@ -39,7 +40,7 @@ import Gitit.Config (getConfigFromOpts)
import Text.XHtml hiding ( (</>), dir, method, password, rev )
import qualified Text.XHtml as X ( password, method )
import Data.List (intersperse, sort, nub, sortBy, isSuffixOf, find, isPrefixOf)
-import Data.Maybe (fromMaybe, fromJust, mapMaybe, isJust, isNothing)
+import Data.Maybe (fromMaybe, fromJust, mapMaybe, isNothing)
import Codec.Binary.UTF8.String (encodeString)
import qualified Data.Map as M
import Data.Ord (comparing)
@@ -553,101 +554,6 @@ fileListToHtml prefix lst = ulist ! [identifier "index", theclass "folding"] <<
else li ! [theclass "folder"] << [stringToHtml h', fileListToHtml (prefix ++ h') l]) $
consolidateHeads lst)
--- | 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
-
-- user authentication
loginForm :: Html
loginForm =
@@ -790,16 +696,6 @@ showHighlightedSource file params = do
formattedPage defaultPageLayout file params $ formattedContents
Nothing -> noHandle
-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
-
exportPage :: String -> Params -> Web Response
exportPage page params = do
let format = pFormat params
View
149 Gitit/Layout.hs
@@ -0,0 +1,149 @@
+{-
+Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu>
+
+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 HAppS.Server hiding (look, lookRead, lookCookieValue, mkCookie)
+import Data.FileStore
+import Gitit.HAppS
+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
+
View
2  gitit.cabal
@@ -42,7 +42,7 @@ data-files: css/screen.css, css/print.css, css/ie.css, css/hk-pyg.css,
Executable gitit
hs-source-dirs: .
main-is: Gitit.hs
- other-modules: Gitit.State, Gitit.HAppS, Gitit.Util, Gitit.Export,
+ other-modules: Gitit.State, Gitit.HAppS, Gitit.Util, Gitit.Export, Gitit.Layout,
Gitit.Convert, Gitit.Initialize, Gitit.Config, Gitit.Framework,
Paths_gitit
build-depends: base >=3, parsec < 3, pretty, xhtml, containers, pandoc
Please sign in to comment.
Something went wrong with that request. Please try again.