added gloabl metadata parsing

This commit is contained in:
Alexey Kreshchuk 2013-10-11 02:37:46 +04:00
parent 7edbcd6216
commit e0f45b29b3

View file

@ -20,6 +20,8 @@ import System.IO as IO
import Text.Parsec ((<?>))
import qualified Text.Parsec as P
import Text.Parsec.String (Parser)
import System.FilePath.Posix
import Control.Monad (liftM)
--------------------------------------------------------------------------------
@ -28,7 +30,7 @@ import Hakyll.Core.Metadata
import Hakyll.Core.Provider.Internal
import Hakyll.Core.Util.Parser
import Hakyll.Core.Util.String
import Hakyll.Core.Identifier.Pattern
--------------------------------------------------------------------------------
loadMetadata :: Provider -> Identifier -> IO (Metadata, Maybe String)
@ -42,7 +44,9 @@ loadMetadata p identifier = do
Nothing -> return M.empty
Just mi' -> loadMetadataFile $ resourceFilePath p mi'
return (M.union md emd, body)
gmd <- loadGlobalMetadata p fp
return (M.unions [md, emd, gmd], body)
where
normal = setVersion Nothing identifier
fp = resourceFilePath p identifier
@ -133,3 +137,40 @@ page = do
metadata' <- P.option [] metadataBlock
body <- P.many P.anyChar
return (metadata', body)
--------------------------------------------------------------------------------
-- | Load directory-wise metadata
loadGlobalMetadata :: Provider -> FilePath -> IO (M.Map String String)
loadGlobalMetadata p fp = do
let dir = takeDirectory fp
liftM M.fromList $ loadgm dir
where
loadgm :: FilePath -> IO [(String, String)]
loadgm dir | dir == providerDirectory p = return []
| otherwise = do
let mfp = combine dir "metadata"
md <- if M.member (fromFilePath $ normalise mfp) (providerFiles p)
then loadOne mfp dir
else return []
others <- loadgm (takeDirectory dir)
return $ others ++ md
loadOne mfp dir = do
contents <- IO.readFile mfp
return $ case P.parse namedMetadata mfp contents of
Left err -> error (show err)
Right mds -> findMetadata mds dir
findMetadata mds dir =
concatMap snd $ filter (flip matches (fromFilePath fp) . fromGlob . combine dir . fst) mds
namedMetadata :: Parser [(String, [(String, String)])]
namedMetadata = P.many namedMetadataBlock
namedMetadataBlock :: Parser (String, [(String, String)])
namedMetadataBlock = do
name <- P.many1 (P.char '-') *> P.many inlineSpace *> P.manyTill P.anyChar newline
metadata' <- metadata
P.skipMany P.space
return (name, metadata')