Skip to content
Browse files

Improved categories.

Files are now read strictly to avoid too many open files error.
Page now exports readCategories instead of extractCategories.
  • Loading branch information...
1 parent cc8b1a7 commit 919b20c1370d2be20026d794ea789dc16e22f02c John MacFarlane committed May 16, 2012
Showing with 38 additions and 10 deletions.
  1. +7 −9 Network/Gitit/Handlers.hs
  2. +31 −1 Network/Gitit/Page.hs
View
16 Network/Gitit/Handlers.hs
@@ -58,11 +58,11 @@ import Network.Gitit.Framework
import Network.Gitit.Layout
import Network.Gitit.Types
import Network.Gitit.Feed (filestoreToXmlFeed, FeedConfig(..))
-import Network.Gitit.Util (orIfNull, readFileUTF8)
+import Network.Gitit.Util (orIfNull)
import Network.Gitit.Cache (expireCachedFile, lookupCache, cacheContents)
import Network.Gitit.ContentTransformer (showRawPage, showFileAsText, showPage,
exportPage, showHighlightedSource, preview, applyPreCommitPlugins)
-import Network.Gitit.Page (extractCategories)
+import Network.Gitit.Page (readCategories)
import Control.Exception (throwIO, catch, try)
import System.Time
import System.FilePath
@@ -699,9 +699,9 @@ categoryPage = do
files <- liftIO $ index fs
let pages = filter (\f -> isPageFile f && not (isDiscussPageFile f)) files
matches <- liftM catMaybes $
- forM pages $ \f ->
- liftIO (readFileUTF8 $ repoPath </> f) >>= \s ->
- return $ if category `elem` (extractCategories s)
+ forM pages $ \f -> do
+ categories <- liftIO $ readCategories $ repoPath </> f
+ return $ if category `elem` categories
then Just $ dropExtension f
else Nothing
base' <- getWikiBase
@@ -723,10 +723,8 @@ categoryListPage = do
fs <- getFileStore
files <- liftIO $ index fs
let pages = filter (\f -> isPageFile f && not (isDiscussPageFile f)) files
- categories <- liftIO $
- liftM (nub . sort . concat) $
- forM pages $ \f ->
- liftM extractCategories (readFileUTF8 (repoPath </> f))
+ categories <- liftIO $ liftM (nub . sort . concat) $ forM pages $ \f ->
+ readCategories (repoPath </> f)
base' <- getWikiBase
let toCatLink ctg = li <<
[ anchor ! [href $ base' ++ "/_category" ++ urlForPage ctg] << ctg ]
View
32 Network/Gitit/Page.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-
Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu>
@@ -45,7 +46,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
module Network.Gitit.Page ( stringToPage
, pageToString
- , extractCategories
+ , readCategories
)
where
import Network.Gitit.Types
@@ -54,6 +55,10 @@ import Text.ParserCombinators.Parsec
import Data.Char (toLower)
import Data.List (isPrefixOf)
import Data.Maybe (fromMaybe)
+import Data.ByteString.UTF8 (toString)
+import qualified Data.ByteString as B
+import System.IO (withFile, Handle, IOMode(..))
+import Codec.Binary.UTF8.String (encodeString)
parseMetadata :: String -> ([(String, String)], String)
parseMetadata raw =
@@ -144,3 +149,28 @@ extractCategories s | "---" `isPrefixOf` s =
let (md,_) = parseMetadata s
in splitCategories $ fromMaybe "" $ lookup "categories" md
extractCategories _ = []
+
+-- | Read categories from metadata strictly.
+readCategories :: FilePath -> IO [String]
+readCategories f =
+#if MIN_VERSION_base(4,5,0)
+ withFile f ReadMode $ \h -> do
+#else
+ withFile (encodeString f) ReadMode $ \h -> do
+#endif
+ fl <- toString `fmap` B.hGetLine h
+ if fl == "---"
+ then do -- get rest of metadata
+ rest <- hGetLinesTill h "..."
+ let (md,_) = parseMetadata $ unlines $ fl:rest
+ return $ splitCategories $ fromMaybe "" $ lookup "categories" md
+ else return []
+
+hGetLinesTill :: Handle -> String -> IO [String]
+hGetLinesTill h end = do
+ next <- toString `fmap` B.hGetLine h
+ if next == end
+ then return [end]
+ else do
+ rest <- hGetLinesTill h end
+ return (next:rest)

0 comments on commit 919b20c

Please sign in to comment.
Something went wrong with that request. Please try again.