Permalink
Browse files

Merge ../gitit

  • Loading branch information...
2 parents b755ba0 + 2465bcb commit 95f2256c071f816a0b4ff7fbf7974d7bd1d146df @gwern gwern committed Apr 13, 2011
View
@@ -22,7 +22,7 @@ The following is a minimal standalone wiki program:
> import Network.Gitit
> import Happstack.Server.SimpleHTTP
->
+>
> main = do
> conf <- getDefaultConfig
> createStaticIfMissing conf
@@ -38,12 +38,12 @@ under different paths, and uses a custom authentication scheme:
> import Control.Monad
> import Text.XHtml hiding (dir)
> import Happstack.Server.SimpleHTTP
->
+>
> type WikiSpec = (String, FileStoreType, PageType)
->
+>
> wikis = [ ("markdownWiki", Git, Markdown)
> , ("latexWiki", Darcs, LaTeX) ]
->
+>
> -- custom authentication
> myWithUser :: Handler -> Handler
> myWithUser handler = do
@@ -66,7 +66,7 @@ under different paths, and uses a custom authentication scheme:
> indexPage = ok $ toResponse $
> (p << "Wiki index") +++
> ulist << map (\(path', _, _) -> li << hotlink (path' ++ "/") << path') wikis
->
+>
> main = do
> conf <- getDefaultConfig
> let conf' = conf{authHandler = myAuthHandler, withUser = myWithUser}
@@ -216,7 +216,7 @@ runHandler :: WikiState -> Handler -> ServerPart Response
runHandler = mapServerPartT . unpackReaderT
unpackReaderT:: (Monad m)
- => c
+ => c
-> (ReaderT c m) (Maybe ((Either b a), FilterFun b))
-> m (Maybe ((Either b a), FilterFun b))
unpackReaderT st handler = runReaderT handler st
@@ -119,7 +119,7 @@ resetPasswordRequest params = do
response
else registerForm >>=
formattedPage defaultPageLayout{
- pgMessages = errors,
+ pgMessages = errors,
pgShowPageTools = False,
pgTabs = [],
pgTitle = "Register for an account"
@@ -163,7 +163,7 @@ validateReset params postValidate = do
let errors = case (knownUser, resetCodeMatches) of
(True, True) -> []
(True, False) -> ["Your reset code is invalid"]
- (False, _) -> ["User " ++ uname ++ " is not known"]
+ (False, _) -> ["User " ++ uname ++ " is not known"]
if null errors
then postValidate (fromJust user)
else registerForm >>=
@@ -68,39 +68,38 @@ module Network.Gitit.ContentTransformer
)
where
-import Prelude hiding (catch)
-import Network.Gitit.Server
+import Control.Exception (throwIO, catch)
+import Control.Monad.State
+import Data.Maybe (isNothing, mapMaybe)
+import Network.Gitit.Cache (lookupCache, cacheContents)
+import Network.Gitit.Export (exportFormats)
import Network.Gitit.Framework
-import Network.Gitit.State
-import Network.Gitit.Types
import Network.Gitit.Layout
-import Network.Gitit.Export (exportFormats)
import Network.Gitit.Page (stringToPage)
-import Network.Gitit.Cache (lookupCache, cacheContents)
-import qualified Data.FileStore as FS
-import Data.Maybe (mapMaybe)
+import Network.Gitit.Server
+import Network.Gitit.State
+import Network.Gitit.Types
+import Network.URI (isUnescapedInURI)
+import Network.URL (encString)
+import Prelude hiding (catch)
+import System.FilePath
+import Text.HTML.SanitizeXSS (sanitizeBalance)
+import Text.Highlighting.Kate
import Text.Pandoc hiding (MathML, WebTeX)
-import qualified Text.Pandoc as Pandoc
import Text.Pandoc.Shared (ObfuscationMethod(..))
import Text.XHtml hiding ( (</>), dir, method, password, rev )
-import Text.Highlighting.Kate
-import Data.Maybe (isNothing)
-import System.FilePath
-import Control.Monad.State
-import Control.Exception (throwIO, catch)
-import qualified Data.ByteString as S (concat)
+import qualified Data.ByteString as S (concat)
import qualified Data.ByteString.Lazy as L (toChunks, fromChunks)
-import Network.URL (encString)
-import Network.URI (isUnescapedInURI)
-import Text.HTML.SanitizeXSS (sanitizeBalance)
+import qualified Data.FileStore as FS
+import qualified Text.Pandoc as Pandoc
--
-- ContentTransformer runners
--
runTransformer :: ToMessage a
=> (String -> String)
-> ContentTransformer a
- -> GititServerPart a
+ -> GititServerPart a
runTransformer pathFor xform = withData $ \params -> do
page <- getPage
cfg <- getConfig
@@ -122,7 +121,7 @@ runTransformer pathFor xform = withData $ \params -> do
-- specialized to wiki pages.
runPageTransformer :: ToMessage a
=> ContentTransformer a
- -> GititServerPart a
+ -> GititServerPart a
runPageTransformer = runTransformer pathForPage
-- | Converts a @ContentTransformer@ into a @GititServerPart@;
@@ -150,7 +149,7 @@ showPage :: Handler
showPage = runPageTransformer htmlViaPandoc
-- | Responds with page exported into selected format.
-exportPage :: Handler
+exportPage :: Handler
exportPage = runPageTransformer exportViaPandoc
-- | Responds with highlighted source code.
@@ -184,7 +183,7 @@ rawTextResponse :: ContentTransformer Response
rawTextResponse = rawContents >>= textResponse
-- | Responds with a wiki page in the format specified
--- by the @format@ parameter.
+-- by the @format@ parameter.
exportViaPandoc :: ContentTransformer Response
exportViaPandoc = rawContents >>=
maybe mzero return >>=
@@ -212,7 +211,7 @@ htmlViaPandoc = cachedHtml `mplus`
highlightRawSource :: ContentTransformer Response
highlightRawSource =
cachedHtml `mplus`
- (updateLayout (\l -> l { pgTabs = [ViewTab,HistoryTab] }) >>
+ (updateLayout (\l -> l { pgTabs = [ViewTab,HistoryTab] }) >>
rawContents >>=
highlightSource >>=
applyWikiTemplate >>=
@@ -223,8 +222,8 @@ highlightRawSource =
--
-- | Caches a response (actually just the response body) on disk,
--- unless the context indicates that the page is not cacheable.
-cacheHtml :: Response -> ContentTransformer Response
+-- unless the context indicates that the page is not cacheable.
+cacheHtml :: Response -> ContentTransformer Response
cacheHtml resp' = do
params <- getParams
file <- getFileName
@@ -283,7 +282,7 @@ mimeResponse :: Monad m
mimeResponse c mimeType =
return . setContentType mimeType . toResponse $ c
--- | Converts Pandoc to response using format specified in parameters.
+-- | Converts Pandoc to response using format specified in parameters.
exportPandoc :: Pandoc -> ContentTransformer Response
exportPandoc doc = do
params <- getParams
@@ -403,7 +402,7 @@ applyTransform inp transform = do
return result'
-- | Applies all the page transform plugins to a Pandoc document.
-applyPageTransforms :: Pandoc -> ContentTransformer Pandoc
+applyPageTransforms :: Pandoc -> ContentTransformer Pandoc
applyPageTransforms c = do
xforms <- getPageTransforms
foldM applyTransform c (wikiLinksTransform : xforms)
@@ -488,7 +487,7 @@ updateLayout f = do
-- Pandoc and wiki content conversion support
--
-readerFor :: PageType -> Bool -> (String -> Pandoc)
+readerFor :: PageType -> Bool -> String -> Pandoc
readerFor pt lhs =
let defPS = defaultParserState{ stateSmart = True
, stateLiterateHaskell = lhs }
View
@@ -57,7 +57,7 @@ respond :: String
respond mimetype ext fn page doc = liftIO (fn doc) >>=
ok . setContentType mimetype .
(if null ext then id else setFilename (page ++ "." ++ ext)) .
- toResponseBS (B.empty)
+ toResponseBS B.empty
respondX :: String -> String -> String
-> (WriterOptions -> Pandoc -> IO L.ByteString)
@@ -225,7 +225,7 @@ respondPDF page old_pndc = fixURLs old_pndc >>= \pndc -> do
-- run pdflatex twice to get the references and toc right
let cmd = "pdflatex"
oldEnv <- getEnvironment
- let env = Just $ ("TEXINPUTS",".:" ++
+ let env = Just $ ("TEXINPUTS",".:" ++
escapeStringUsing [(' ',"\\ "),('"',"\\\"")]
(curdir </> repositoryPath cfg) ++ ":") : oldEnv
let opts = ["-interaction=batchmode", "-no-shell-escape", tempfile]
@@ -257,13 +257,13 @@ fixURLs :: Pandoc -> GititServerPart Pandoc
fixURLs pndc = do
curdir <- liftIO getCurrentDirectory
cfg <- getConfig
-
+
let go (Image ils (url, title)) = Image ils (fixURL url, title)
go x = x
-
+
fixURL ('/':url) = curdir </> staticDir cfg </> url
fixURL url = url
-
+
return $ bottomUp go pndc
exportFormats :: Config -> [(String, String -> Pandoc -> Handler)]
View
@@ -18,7 +18,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
module Network.Gitit.Framework (
- -- * Combinators for dealing with users
+ -- * Combinators for dealing with users
withUserFromSession
, withUserFromHTTPAuth
, authenticateUserThat
@@ -61,11 +61,11 @@ import Network.Gitit.State
import Network.Gitit.Types
import Data.FileStore
import Data.Char (toLower)
-import Control.Monad (mzero, liftM, MonadPlus)
+import Control.Monad (mzero, liftM, unless, MonadPlus)
import qualified Data.Map as M
import Data.ByteString.UTF8 (toString)
import Data.ByteString.Lazy.UTF8 (fromString)
-import Data.Maybe (fromJust)
+import Data.Maybe (fromJust, fromMaybe)
import Data.List (intercalate, isPrefixOf, isInfixOf)
import System.FilePath ((<.>), takeExtension, takeFileName)
import Text.Highlighting.Kate
@@ -116,7 +116,7 @@ withUserFromSession handler = withData $ \(sk :: Maybe SessionKey) -> do
withUserFromHTTPAuth :: Handler -> Handler
withUserFromHTTPAuth handler = do
req <- askRq
- let user = case (getHeader "authorization" req) of
+ let user = case getHeader "authorization" req of
Nothing -> ""
Just authHeader -> case parse pAuthorizationHeader "" (toString authHeader) of
Left _ -> ""
@@ -140,14 +140,14 @@ pAuthorizationHeader = try pBasicHeader <|> pDigestHeader
pDigestHeader :: GenParser Char st String
pDigestHeader = do
- string "Digest username=\""
+ _ <- string "Digest username=\""
result' <- many (noneOf "\"")
- char '"'
+ _ <- char '"'
return result'
pBasicHeader :: GenParser Char st String
pBasicHeader = do
- string "Basic "
+ _ <- string "Basic "
result' <- many (noneOf " \t\n")
return $ takeWhile (/=':') $ decode result'
@@ -240,7 +240,7 @@ splitOn c cs =
let (next, rest) = break (==c) cs
in case rest of
[] -> [next]
- (_:rs) -> next : splitOn c rs
+ (_:rs) -> next : splitOn c rs
-- | Returns path portion of URI, without initial @\/@.
-- Consecutive spaces are collapsed. We don't want to distinguish
@@ -274,8 +274,7 @@ isSourceCode path' =
-- | Returns encoded URL path for the page with the given name, relative to
-- the wiki base.
urlForPage :: String -> String
-urlForPage page = "/" ++
- encString False isUnescapedInURI page
+urlForPage page = '/' : encString False isUnescapedInURI page
-- | Returns the filestore path of the file containing the page's source.
pathForPage :: String -> FilePath
@@ -285,9 +284,8 @@ pathForPage page = page <.> "page"
getMimeTypeForExtension :: String -> GititServerPart String
getMimeTypeForExtension ext = do
mimes <- liftM mimeMap getConfig
- return $ case M.lookup (dropWhile (=='.') $ map toLower ext) mimes of
- Nothing -> "application/octet-stream"
- Just t -> t
+ return $ fromMaybe "application/octet-stream"
+ (M.lookup (dropWhile (== '.') $ map toLower ext) mimes)
-- | Simple helper for validation of forms.
validate :: [(Bool, String)] -- ^ list of conditions and error messages
@@ -310,19 +308,17 @@ guardIndex = do
base <- getWikiBase
uri' <- liftM rqUri askRq
let localpath = drop (length base) uri'
- if length localpath > 1 && lastNote "guardIndex" uri' == '/'
- then return ()
- else mzero
+ unless (length localpath > 1 && lastNote "guardIndex" uri' == '/')
+ mzero
-- Guard against a path like @\/wiki@ when the wiki is being
-- served at @\/wiki@.
guardBareBase :: GititServerPart ()
guardBareBase = do
base' <- getWikiBase
uri' <- liftM rqUri askRq
- if not (null base') && base' == uri'
- then return ()
- else mzero
+ unless (not (null base') && base' == uri')
+ mzero
-- | Runs a server monad in a local context after setting
-- the "messages" request header.
@@ -290,7 +290,7 @@ searchResults = withData $ \(params :: Params) -> do
let relevance (f, ms) = length ms + if f `elem` pageNameMatches
then 100
else 0
- let preamble = if null patterns
+ 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]
@@ -446,7 +446,7 @@ showDiff file page params = do
from' <- case (from, to) of
(Just _, _) -> return from
(Nothing, Nothing) -> return from
- (Nothing, Just t) -> do
+ (Nothing, Just t) -> do
pageHist <- liftIO $ history fs [file]
(TimeRange Nothing Nothing)
let (_, upto) = break (\r -> idsMatch fs (revId r) t)
@@ -593,7 +593,7 @@ deletePage = withData $ \(params :: Params) -> do
let author = Author user email
let descrip = "Deleted using web interface."
base' <- getWikiBase
- if pConfirm params && (file == page || file == page <.> "page")
+ if pConfirm params && (file == page || file == page <.> "page")
then do
fs <- getFileStore
liftIO $ delete fs file author descrip
@@ -172,7 +172,7 @@ createStaticIfMissing conf = do
logM "gitit" WARNING $ "Created " ++ (cssdir </> f)
{-
- let icondir = staticdir </> "img" </> "icons"
+ let icondir = staticdir </> "img" </> "icons"
createDirectoryIfMissing True icondir
iconDataDir <- getDataFileName $ "data" </> "static" </> "img" </> "icons"
iconFiles <- liftM (filter (\f -> takeExtension f == ".png")) $ getDirectoryContents iconDataDir
Oops, something went wrong.

0 comments on commit 95f2256

Please sign in to comment.