diff --git a/Network/Gitit/Cache.hs b/Network/Gitit/Cache.hs index b93322c00..91b6c0a69 100644 --- a/Network/Gitit/Cache.hs +++ b/Network/Gitit/Cache.hs @@ -50,11 +50,11 @@ expireCachedFile file = do exists <- liftIO $ doesFileExist target when exists $ liftIO $ do liftIO $ removeFile target - expireCachedPDF target + expireCachedPDF target (defaultExtension cfg) -expireCachedPDF :: String -> IO () -expireCachedPDF file = - when (takeExtension file == ".page") $ do +expireCachedPDF :: String -> String -> IO () +expireCachedPDF file ext = + when (takeExtension file == "." ++ ext) $ do let pdfname = file ++ ".export.pdf" exists <- doesFileExist pdfname when exists $ removeFile pdfname @@ -84,4 +84,4 @@ cacheContents file contents = do liftIO $ do createDirectoryIfMissing True targetDir B.writeFile target contents - expireCachedPDF target + expireCachedPDF target (defaultExtension cfg) diff --git a/Network/Gitit/Config.hs b/Network/Gitit/Config.hs index 1ee19a73b..674771dba 100644 --- a/Network/Gitit/Config.hs +++ b/Network/Gitit/Config.hs @@ -83,7 +83,7 @@ extractConfig cp = do cfRepositoryType <- get cp "DEFAULT" "repository-type" cfRepositoryPath <- get cp "DEFAULT" "repository-path" cfDefaultPageType <- get cp "DEFAULT" "default-page-type" - cfDefaultExtension <- get cp "DEFAULT" "default-page-type" + cfDefaultExtension <- get cp "DEFAULT" "default-extension" cfMathMethod <- get cp "DEFAULT" "math" cfMathjaxScript <- get cp "DEFAULT" "mathjax-script" cfShowLHSBirdTracks <- get cp "DEFAULT" "show-lhs-bird-tracks" diff --git a/Network/Gitit/ContentTransformer.hs b/Network/Gitit/ContentTransformer.hs index 25441eaf0..26942a74f 100644 --- a/Network/Gitit/ContentTransformer.hs +++ b/Network/Gitit/ContentTransformer.hs @@ -111,14 +111,33 @@ import Text.URI (parseURI, URI(..), uriQueryItems) -- ContentTransformer runners -- -runTransformer :: ToMessage a - => (String -> String) - -> ContentTransformer a +runPageTransformer :: ToMessage a + => ContentTransformer a + -> GititServerPart a +runPageTransformer xform = withData $ \params -> do + page <- getPage + cfg <- getConfig + evalStateT xform Context{ ctxFile = pathForPage page (defaultExtension cfg) + , ctxLayout = defaultPageLayout{ + pgPageName = page + , pgTitle = page + , pgPrintable = pPrintable params + , pgMessages = pMessages params + , pgRevision = pRevision params + , pgLinkToFeed = useFeed cfg } + , ctxCacheable = True + , ctxTOC = tableOfContents cfg + , ctxBirdTracks = showLHSBirdTracks cfg + , ctxCategories = [] + , ctxMeta = [] } + +runFileTransformer :: ToMessage a + => ContentTransformer a -> GititServerPart a -runTransformer pathFor xform = withData $ \params -> do +runFileTransformer xform = withData $ \params -> do page <- getPage cfg <- getConfig - evalStateT xform Context{ ctxFile = pathFor page + evalStateT xform Context{ ctxFile = id page , ctxLayout = defaultPageLayout{ pgPageName = page , pgTitle = page @@ -134,17 +153,17 @@ runTransformer pathFor xform = withData $ \params -> do -- | Converts a @ContentTransformer@ into a @GititServerPart@; -- specialized to wiki pages. -runPageTransformer :: ToMessage a - => ContentTransformer a - -> GititServerPart a -runPageTransformer = runTransformer pathForPage +-- runPageTransformer :: ToMessage a +-- => ContentTransformer a +-- -> GititServerPart a +-- runPageTransformer = runTransformer pathForPage -- | Converts a @ContentTransformer@ into a @GititServerPart@; -- specialized to non-pages. -runFileTransformer :: ToMessage a - => ContentTransformer a - -> GititServerPart a -runFileTransformer = runTransformer id +-- runFileTransformer :: ToMessage a +-- => ContentTransformer a +-- -> GititServerPart a +-- runFileTransformer = runTransformer id -- -- Gitit responders diff --git a/Network/Gitit/Export.hs b/Network/Gitit/Export.hs index a2f73bb3b..f7dea71e4 100644 --- a/Network/Gitit/Export.hs +++ b/Network/Gitit/Export.hs @@ -214,7 +214,7 @@ respondPDF :: Bool -> String -> Pandoc -> Handler respondPDF useBeamer page old_pndc = fixURLs page old_pndc >>= \pndc -> do cfg <- getConfig unless (pdfExport cfg) $ error "PDF export disabled" - let cacheName = pathForPage page ++ ".export.pdf" + let cacheName = pathForPage page (defaultExtension cfg) ++ ".export.pdf" cached <- if useCache cfg then lookupCache cacheName else return Nothing diff --git a/Network/Gitit/Framework.hs b/Network/Gitit/Framework.hs index 555252e60..af89a51e0 100644 --- a/Network/Gitit/Framework.hs +++ b/Network/Gitit/Framework.hs @@ -43,6 +43,7 @@ module Network.Gitit.Framework ( , isPageFile , isDiscussPage , isDiscussPageFile + , isNotDiscussPageFile , isSourceCode -- * Combinators that change the request locally , withMessages @@ -255,16 +256,22 @@ isPage s = all (`notElem` "*?") s && not (".." `isInfixOf` s) && not ("/_" `isIn -- for now, we disallow @*@ and @?@ in page names, because git filestore -- does not deal with them properly, and darcs filestore disallows them. -isPageFile :: FilePath -> Bool -isPageFile f = takeExtension f == ".page" +isPageFile :: FilePath -> GititServerPart Bool +isPageFile f = do + cfg <- getConfig + return $ takeExtension f == "." ++ (defaultExtension cfg) isDiscussPage :: String -> Bool isDiscussPage ('@':xs) = isPage xs isDiscussPage _ = False -isDiscussPageFile :: FilePath -> Bool +isDiscussPageFile :: FilePath -> GititServerPart Bool isDiscussPageFile ('@':xs) = isPageFile xs -isDiscussPageFile _ = False +isDiscussPageFile _ = return False + +isNotDiscussPageFile :: FilePath -> GititServerPart Bool +isNotDiscussPageFile ('@':_) = return False +isNotDiscussPageFile _ = return True isSourceCode :: String -> Bool isSourceCode path' = @@ -279,8 +286,8 @@ urlForPage :: String -> String urlForPage page = '/' : encString False isUnescapedInURI page -- | Returns the filestore path of the file containing the page's source. -pathForPage :: String -> FilePath -pathForPage page = page <.> "page" +pathForPage :: String -> String -> FilePath +pathForPage page ext = page <.> ext -- | Retrieves a mime type based on file extension. getMimeTypeForExtension :: String -> GititServerPart String diff --git a/Network/Gitit/Handlers.hs b/Network/Gitit/Handlers.hs index 5eade81b0..0f5ce3f37 100644 --- a/Network/Gitit/Handlers.hs +++ b/Network/Gitit/Handlers.hs @@ -111,10 +111,9 @@ debugHandler = withData $ \(params :: Params) -> do randomPage :: Handler randomPage = do fs <- getFileStore - files <- liftIO $ index fs base' <- getWikiBase - let pages = map dropExtension $ - filter (\f -> isPageFile f && not (isDiscussPageFile f)) files + prunedFiles <- liftIO (index fs) >>= filterM isPageFile >>= filterM isNotDiscussPageFile + let pages = map dropExtension prunedFiles if null pages then error "No pages found!" else do @@ -194,6 +193,7 @@ uploadFile = withData $ \(params :: Params) -> do $ pWikiname params `orIfNull` takeFileName origPath let logMsg = pLogMsg params cfg <- getConfig + wPF <- isPageFile wikiname mbUser <- getLoggedInUser (user, email) <- case mbUser of Nothing -> return ("Anonymous", "") @@ -218,7 +218,7 @@ uploadFile = withData $ \(params :: Params) -> do , (not overwrite && exists, "A file named '" ++ wikiname ++ "' already exists in the repository: choose a new name " ++ "or check the box to overwrite the existing file.") - , (isPageFile wikiname, + , (wPF, "This file extension is reserved for wiki pages.") ] if null errors @@ -246,8 +246,8 @@ goToPage :: Handler goToPage = withData $ \(params :: Params) -> do let gotopage = pGotoPage params fs <- getFileStore - allPageNames <- liftM (map dropExtension . filter isPageFile) $ - liftIO $ index fs + pruned_files <- liftIO (index fs) >>= filterM isPageFile + let allPageNames = map dropExtension pruned_files let findPage f = find f allPageNames let exactMatch f = gotopage == f let insensitiveMatch f = (map toLower gotopage) == (map toLower f) @@ -281,14 +281,14 @@ searchResults = withData $ \(params :: Params) -> do -- doesn't handle this properly: (\(_ :: FileStoreError) -> return []) let contentMatches = map matchResourceName matchLines - allPages <- liftM (filter isPageFile) $ liftIO $ index fs + allPages <- liftIO (index fs) >>= filterM isPageFile let slashToSpace = map (\c -> if c == '/' then ' ' else c) let inPageName pageName' x = x `elem` (words $ slashToSpace $ dropExtension pageName') let matchesPatterns pageName' = not (null patterns) && all (inPageName (map toLower pageName')) (map (map toLower) patterns) let pageNameMatches = filter matchesPatterns allPages - let allMatchedFiles = nub $ filter isPageFile contentMatches ++ - pageNameMatches + prunedFiles <- filterM isPageFile (contentMatches ++ pageNameMatches) + let allMatchedFiles = nub $ prunedFiles let matchesInFile f = mapMaybe (\x -> if matchResourceName x == f then Just (matchLine x) else Nothing) matchLines @@ -324,7 +324,8 @@ searchResults = withData $ \(params :: Params) -> do showPageHistory :: Handler showPageHistory = withData $ \(params :: Params) -> do page <- getPage - showHistory (pathForPage page) page params + cfg <- getConfig + showHistory (pathForPage page $ defaultExtension cfg) page params showFileHistory :: Handler showFileHistory = withData $ \(params :: Params) -> do @@ -403,9 +404,8 @@ showActivity = withData $ \(params :: Params) -> do let fileFromChange (Added f) = f fileFromChange (Modified f) = f fileFromChange (Deleted f) = f - base' <- getWikiBase - let fileAnchor revis file = if isPageFile file + 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 " ") $ @@ -435,7 +435,8 @@ showActivity = withData $ \(params :: Params) -> do showPageDiff :: Handler showPageDiff = withData $ \(params :: Params) -> do page <- getPage - showDiff (pathForPage page) page params + cfg <- getConfig + showDiff (pathForPage page $ defaultExtension cfg) page params showFileDiff :: Handler showFileDiff = withData $ \(params :: Params) -> do @@ -499,13 +500,14 @@ editPage' params = do let rev = pRevision params -- if this is set, we're doing a revert fs <- getFileStore page <- getPage + cfg <- getConfig let getRevisionAndText = E.catch - (do c <- liftIO $ retrieve fs (pathForPage page) rev + (do c <- liftIO $ retrieve fs (pathForPage page $ defaultExtension cfg) rev -- even if pRevision is set, we return revId of latest -- saved version (because we're doing a revert and -- we don't want gitit to merge the changes with the -- latest version) - r <- liftIO $ latest fs (pathForPage page) >>= revision fs + r <- liftIO $ latest fs (pathForPage page $ defaultExtension cfg) >>= revision fs return (Just $ revId r, c)) (\e -> if e == NotFound then return (Nothing, "") @@ -528,7 +530,6 @@ editPage' params = do strAttr "style" "color: gray"] else [] base' <- getWikiBase - cfg <- getConfig let editForm = gui (base' ++ urlForPage page) ! [identifier "editform"] << [ sha1Box , textarea ! (readonly ++ [cols "80", name "editedText", @@ -570,11 +571,12 @@ confirmDelete :: Handler confirmDelete = do page <- getPage fs <- getFileStore + cfg <- getConfig -- determine whether there is a corresponding page, and if not whether there -- is a corresponding file - pageTest <- liftIO $ E.try $ latest fs (pathForPage page) + pageTest <- liftIO $ E.try $ latest fs (pathForPage page $ defaultExtension cfg) fileToDelete <- case pageTest of - Right _ -> return $ pathForPage page -- a page + Right _ -> return $ pathForPage page $ defaultExtension cfg -- a page Left NotFound -> do fileTest <- liftIO $ E.try $ latest fs page case fileTest of @@ -599,6 +601,7 @@ confirmDelete = do deletePage :: Handler deletePage = withData $ \(params :: Params) -> do page <- getPage + cfg <- getConfig let file = pFileToDelete params mbUser <- getLoggedInUser (user, email) <- case mbUser of @@ -607,7 +610,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 <.> (defaultExtension cfg)) then do fs <- getFileStore liftIO $ Data.FileStore.delete fs file author descrip @@ -636,12 +639,12 @@ updatePage = withData $ \(params :: Params) -> do error "Page exceeds maximum size." -- check SHA1 in case page has been modified, merge modifyRes <- if null oldSHA1 - then liftIO $ create fs (pathForPage page) + then liftIO $ create fs (pathForPage page $ defaultExtension cfg) (Author user email) logMsg editedText >> return (Right ()) else do - expireCachedFile (pathForPage page) `mplus` return () - liftIO $ E.catch (modify fs (pathForPage page) + expireCachedFile (pathForPage page $ defaultExtension cfg) `mplus` return () + liftIO $ E.catch (modify fs (pathForPage page $ defaultExtension cfg) oldSHA1 (Author user email) logMsg editedText) (\e -> if e == Unchanged @@ -665,13 +668,15 @@ indexPage :: Handler indexPage = do path' <- getPath base' <- getWikiBase + cfg <- getConfig + let ext = defaultExtension cfg let prefix' = if null path' then "" else path' ++ "/" fs <- getFileStore listing <- liftIO $ directory fs prefix' - let isDiscussionPage (FSFile f) = isDiscussPageFile f - isDiscussionPage (FSDirectory _) = False - let prunedListing = filter (not . isDiscussionPage) listing - let htmlIndex = fileListToHtml base' prefix' prunedListing + let isNotDiscussionPage (FSFile f) = isNotDiscussPageFile f + isNotDiscussionPage (FSDirectory _) = return True + prunedListing <- filterM isNotDiscussionPage listing + let htmlIndex = fileListToHtml base' prefix' ext prunedListing formattedPage defaultPageLayout{ pgPageName = prefix', pgShowPageTools = False, @@ -679,9 +684,9 @@ indexPage = do pgScripts = [], pgTitle = "Contents"} htmlIndex -fileListToHtml :: String -> String -> [Resource] -> Html -fileListToHtml base' prefix files = - let fileLink (FSFile f) | isPageFile f = +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 @@ -713,8 +718,7 @@ categoryPage = do let repoPath = repositoryPath cfg let categoryDescription = "Category: " ++ (intercalate " + " pcategories) fs <- getFileStore - files <- liftIO $ index fs - let pages = filter (\f -> isPageFile f && not (isDiscussPageFile f)) files + pages <- liftIO (index fs) >>= filterM isPageFile >>= filterM isNotDiscussPageFile matches <- liftM catMaybes $ forM pages $ \f -> do categories <- liftIO $ readCategories $ repoPath f @@ -751,8 +755,7 @@ categoryListPage = do cfg <- getConfig let repoPath = repositoryPath cfg fs <- getFileStore - files <- liftIO $ index fs - let pages = filter (\f -> isPageFile f && not (isDiscussPageFile f)) files + pages <- liftIO (index fs) >>= filterM isPageFile >>= filterM isNotDiscussPageFile categories <- liftIO $ liftM (nub . sort . concat) $ forM pages $ \f -> readCategories (repoPath f) base' <- getWikiBase @@ -769,8 +772,9 @@ categoryListPage = do expireCache :: Handler expireCache = do page <- getPage + cfg <- getConfig -- try it as a page first, then as an uploaded file - expireCachedFile (pathForPage page) + expireCachedFile (pathForPage page $ defaultExtension cfg) expireCachedFile page ok $ toResponse () diff --git a/Network/Gitit/Initialize.hs b/Network/Gitit/Initialize.hs index 880b8652e..650974a01 100644 --- a/Network/Gitit/Initialize.hs +++ b/Network/Gitit/Initialize.hs @@ -154,11 +154,11 @@ createDefaultPages conf = do "\n...\n\n" -- add front page, help page, and user's guide let auth = Author "Gitit" "" - createIfMissing fs (frontPage conf <.> "page") auth "Default front page" + createIfMissing fs (frontPage conf <.> defaultExtension conf) auth "Default front page" $ header ++ welcomecontents - createIfMissing fs "Help.page" auth "Default help page" + createIfMissing fs ("Help" <.> defaultExtension conf) auth "Default help page" $ header ++ helpcontents - createIfMissing fs "Gitit User’s Guide.page" auth "User’s guide (README)" + createIfMissing fs ("Gitit User's Guide" <.> defaultExtension conf) auth "User's guide (README)" $ header ++ usersguidecontents createIfMissing :: FileStore -> FilePath -> Author -> Description -> String -> IO ()