Merge pull request #190 from krsch/master

Implemented per-directory metadata support

hakyll.cabal

@@ -132,6 +132,7 @@ Library
     Hakyll.Core.Provider.Metadata
     Hakyll.Core.Provider.MetadataCache
     Hakyll.Core.Rules.Internal
+    Hakyll.Core.Rules.Default
     Hakyll.Core.Runtime
     Hakyll.Core.Store
     Hakyll.Core.Util.File

src/Hakyll/Core/Metadata.hs

@@ -5,13 +5,15 @@ module Hakyll.Core.Metadata
     , getMetadataField
     , getMetadataField'
     , makePatternDependency
+    , metadataFiles
     ) where
 
 
 --------------------------------------------------------------------------------
 import           Control.Monad                  (forM)
 import           Data.Map                       (Map)
 import qualified Data.Map                       as M
+import           System.FilePath.Posix          ((</>), takeDirectory)
 
 
 --------------------------------------------------------------------------------
@@ -61,3 +63,12 @@ makePatternDependency :: MonadMetadata m => Pattern -> m Dependency
 makePatternDependency pattern = do
     matches' <- getMatches pattern
     return $ PatternDependency pattern matches'
+
+--------------------------------------------------------------------------------
+-- | Returns a list of all directory-wise metadata files, subdir first, global last
+metadataFiles :: Identifier -> [Identifier]
+metadataFiles identifier = local : go (takeDirectory $ toFilePath identifier) where
+    go "." = [fromFilePath "metadata"]
+    go dir = fromFilePath (dir </> "metadata") : go (takeDirectory dir)
+    local = fromFilePath $ toFilePath identifier ++ ".metadata"
+

src/Hakyll/Core/Provider/Metadata.hs

@@ -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 identifier
+
+    return (M.unions [md, gmd], body)
   where
     normal = setVersion Nothing identifier
     fp     = resourceFilePath p identifier
@@ -133,3 +137,32 @@ page = do
     metadata' <- P.option [] metadataBlock
     body      <- P.many P.anyChar
     return (metadata', body)
+
+
+--------------------------------------------------------------------------------
+-- | Load directory-wise metadata
+loadGlobalMetadata :: Provider -> Identifier -> IO Metadata
+loadGlobalMetadata p fp = liftM M.fromList $ loadgm fp where 
+    loadgm :: Identifier -> IO [(String, String)]
+    loadgm = liftM concat . mapM loadOne . reverse . filter (resourceExists p) . metadataFiles
+    loadOne mfp =
+        let path = resourceFilePath p mfp
+            dir = takeDirectory $ toFilePath mfp
+        -- TODO: It might be better to print warning and continue
+        in either (error.show) (findMetadata dir) . P.parse namedMetadata path <$> readFile path
+    findMetadata dir = 
+        concatMap snd . filter (flip matches fp . fromGlob . normalise . combine dir . fst)
+
+namedMetadata :: Parser [(String, [(String, String)])]
+namedMetadata = liftA2 (:) (namedMetadataBlock False) $ P.many $ namedMetadataBlock True
+
+namedMetadataBlock :: Bool -> Parser (String, [(String, String)])
+namedMetadataBlock isNamed = do
+    name      <- if isNamed
+        then P.many1 (P.char '-') *> P.many inlineSpace *> P.manyTill P.anyChar newline
+        else pure "**"
+    metadata' <- metadata
+    P.skipMany P.space
+    return (name, metadata')
+
+

src/Hakyll/Core/Rules/Default.hs

@@ -0,0 +1,24 @@
+{-# LANGUAGE OverloadedStrings          #-}
+module Hakyll.Core.Rules.Default 
+    ( internalRules
+    , addMetadataDependencies 
+    )
+where
+import           Hakyll.Core.Rules
+import           Hakyll.Core.Compiler
+import           Hakyll.Core.Compiler.Internal (compilerTellDependencies)
+import           Hakyll.Core.Metadata          (getMatches, metadataFiles)
+import           Hakyll.Core.Identifier.Pattern(fromList)
+
+internalRules :: Rules ()
+internalRules  = do
+    match "metadata" $ compile $ makeItem ()
+    match "**/metadata" $ compile $ makeItem ()
+    match "**.metadata" $ compile $ makeItem ()
+
+--------------------------------------------------------------------------------
+addMetadataDependencies :: Compiler ()
+addMetadataDependencies =
+    compilerTellDependencies . map IdentifierDependency =<< getMatches . fromList =<< fmap metadataFiles getUnderlying
+
+

src/Hakyll/Core/Runtime.hs

@@ -35,6 +35,7 @@ import qualified Hakyll.Core.Logger            as Logger
 import           Hakyll.Core.Provider
 import           Hakyll.Core.Routes
 import           Hakyll.Core.Rules.Internal
+import           Hakyll.Core.Rules.Default
 import           Hakyll.Core.Store             (Store)
 import qualified Hakyll.Core.Store             as Store
 import           Hakyll.Core.Util.File
@@ -53,7 +54,7 @@ run config verbosity rules = do
     provider <- newProvider store (shouldIgnoreFile config) $
         providerDirectory config
     Logger.message logger "Running rules..."
-    ruleSet  <- runRules rules provider
+    ruleSet  <- runRules (rules >> internalRules) provider
 
     -- Get old facts
     mOldFacts <- Store.get store factsKey
@@ -186,7 +187,7 @@ chase trail id'
         config   <- runtimeConfiguration <$> ask
         Logger.debug logger $ "Processing " ++ show id'
 
-        let compiler = todo M.! id'
+        let compiler = addMetadataDependencies >> todo M.! id'
             read' = CompilerRead
                 { compilerConfig     = config
                 , compilerUnderlying = id'

tests/Hakyll/Core/Provider/GlobalMetadata/Tests.hs

@@ -0,0 +1,31 @@
+--------------------------------------------------------------------------------
+{-# LANGUAGE OverloadedStrings #-}
+module Hakyll.Core.Provider.GlobalMetadata.Tests
+    ( tests
+    ) where
+
+--------------------------------------------------------------------------------
+import qualified Data.Map                      as M
+import           Control.Monad                 (forM_)
+import           Test.Framework                (Test, testGroup)
+import           Test.HUnit                    (Assertion, (@=?))
+
+
+--------------------------------------------------------------------------------
+import           Hakyll.Core.Provider          (resourceMetadata)
+import           TestSuite.Util
+
+--------------------------------------------------------------------------------
+tests :: Test
+tests = testGroup "Hakyll.Core.Provider.GlobalMetadata.Tests" $
+    fromAssertions "page" [testPage]
+
+testPage :: Assertion
+testPage = do
+    store <- newTestStore
+    provider <- newTestProvider store
+
+    metadata <- resourceMetadata provider "posts/2013-10-18-metadata-test.md"
+    forM_ ["1", "2", "3", "4", "5", "6", "7", "8"] $ \a ->
+        Just a @=? M.lookup ('a':a) metadata
+

tests/TestSuite.hs

@@ -12,6 +12,7 @@ import           Test.Framework                       (defaultMain)
 import qualified Hakyll.Core.Dependencies.Tests
 import qualified Hakyll.Core.Identifier.Tests
 import qualified Hakyll.Core.Provider.Metadata.Tests
+import qualified Hakyll.Core.Provider.GlobalMetadata.Tests
 import qualified Hakyll.Core.Provider.Tests
 import qualified Hakyll.Core.Routes.Tests
 import qualified Hakyll.Core.Rules.Tests
@@ -32,6 +33,7 @@ main = defaultMain
     [ Hakyll.Core.Dependencies.Tests.tests
     , Hakyll.Core.Identifier.Tests.tests
     , Hakyll.Core.Provider.Metadata.Tests.tests
+    , Hakyll.Core.Provider.GlobalMetadata.Tests.tests
     , Hakyll.Core.Provider.Tests.tests
     , Hakyll.Core.Routes.Tests.tests
     , Hakyll.Core.Rules.Tests.tests

tests/data/metadata

@@ -0,0 +1,27 @@
+--- posts/2013-10-18-metadata-test.md
+a1: 8
+a2: 8
+a3: 8
+a4: 8
+a5: 8
+a6: 8
+a7: 8
+a8: 8
+
+--- posts/*
+a1: 7
+a2: 7
+a3: 7
+a4: 7
+a5: 7
+a6: 7
+a7: 7
+
+--- **
+a1: 6
+a2: 6
+a3: 6
+a4: 6
+a5: 6
+a6: 6
+

tests/data/posts/2013-10-18-metadata-test.md

@@ -0,0 +1,4 @@
+---
+a1: 1
+---
+Nothing interesting here.

tests/data/posts/2013-10-18-metadata-test.md.metadata

@@ -0,0 +1,2 @@
+a1: 2
+a2: 2

tests/data/posts/metadata

@@ -0,0 +1,20 @@
+--- **
+a1: 5
+a2: 5
+a3: 5
+a4: 5
+a5: 5
+
+--- *
+a1: 4
+a2: 4
+a3: 4
+a4: 4
+
+--- 2013-10-18-metadata-test.md
+a1: 3
+a2: 3
+a3: 3
+
+--- nonexistent
+a3: 0