Initial YAML support

See #225

.gitignore

@@ -1,4 +1,4 @@
-# Ignore swap files and cabal output.
+# Ignore swap files and stack/cabal output.
 *.hi
 *.o
 *.swo
@@ -10,6 +10,7 @@ dist
 tags
 cabal.sandbox.config
 .cabal-sandbox/
+.stack-work
 
 # Ignore test builds.
 tests/Main

hakyll.cabal

@@ -121,6 +121,8 @@ Library
     Hakyll.Web.Template.List
 
   Other-Modules:
+    Data.List.Extended
+    Data.Yaml.Extended
     Hakyll.Check
     Hakyll.Commands
     Hakyll.Core.Compiler.Internal
@@ -140,33 +142,36 @@ Library
     Paths_hakyll
 
   Build-Depends:
-    base               >= 4       && < 5,
+    base                 >= 4      && < 5,
-    binary             >= 0.5     && < 0.8,
+    binary               >= 0.5    && < 0.8,
-    blaze-html         >= 0.5     && < 0.9,
+    blaze-html           >= 0.5    && < 0.9,
-    blaze-markup       >= 0.5.1   && < 0.8,
+    blaze-markup         >= 0.5.1  && < 0.8,
-    bytestring         >= 0.9     && < 0.11,
+    bytestring           >= 0.9    && < 0.11,
-    cmdargs            >= 0.10    && < 0.11,
+    cmdargs              >= 0.10   && < 0.11,
-    containers         >= 0.3     && < 0.6,
+    containers           >= 0.3    && < 0.6,
-    cryptohash         >= 0.7     && < 0.12,
+    cryptohash           >= 0.7    && < 0.12,
-    data-default       >= 0.4     && < 0.6,
+    data-default         >= 0.4    && < 0.6,
-    deepseq            >= 1.3     && < 1.5,
+    deepseq              >= 1.3    && < 1.5,
-    directory          >= 1.0     && < 1.3,
+    directory            >= 1.0    && < 1.3,
-    filepath           >= 1.0     && < 1.5,
+    filepath             >= 1.0    && < 1.5,
-    lrucache           >= 1.1.1   && < 1.3,
+    lrucache             >= 1.1.1  && < 1.3,
-    mtl                >= 1       && < 2.3,
+    mtl                  >= 1      && < 2.3,
-    network            >= 2.6     && < 2.7,
+    network              >= 2.6    && < 2.7,
-    network-uri        >= 2.6     && < 2.7,
+    network-uri          >= 2.6    && < 2.7,
-    pandoc             >= 1.14    && < 1.18,
+    pandoc               >= 1.14   && < 1.18,
-    pandoc-citeproc    >= 0.4     && < 0.10,
+    pandoc-citeproc      >= 0.4    && < 0.10,
-    parsec             >= 3.0     && < 3.2,
+    parsec               >= 3.0    && < 3.2,
-    process            >= 1.0     && < 1.3,
+    process              >= 1.0    && < 1.3,
-    random             >= 1.0     && < 1.2,
+    random               >= 1.0    && < 1.2,
-    regex-base         >= 0.93    && < 0.94,
+    regex-base           >= 0.93   && < 0.94,
-    regex-tdfa         >= 1.1     && < 1.3,
+    regex-tdfa           >= 1.1    && < 1.3,
-    tagsoup            >= 0.13.1  && < 0.14,
+    tagsoup              >= 0.13.1 && < 0.14,
-    text               >= 0.11    && < 1.3,
+    text                 >= 0.11   && < 1.3,
-    time               >= 1.4     && < 1.6,
+    time                 >= 1.4    && < 1.6,
-    time-locale-compat >= 0.1     && < 0.2
+    time-locale-compat   >= 0.1    && < 0.2,
+    unordered-containers >= 0.2    && < 0.3,
+    vector               >= 0.11   && < 0.12,
+    yaml                 >= 0.8    && < 0.9
 
   If flag(previewServer)
     Build-depends:
@@ -226,33 +231,36 @@ Test-suite hakyll-tests
     test-framework-hunit       >= 0.3 && < 0.4,
     test-framework-quickcheck2 >= 0.3 && < 0.4,
     -- Copy pasted from hakyll dependencies:
-    base               >= 4       && < 5,
+    base                 >= 4      && < 5,
-    binary             >= 0.5     && < 0.8,
+    binary               >= 0.5    && < 0.8,
-    blaze-html         >= 0.5     && < 0.9,
+    blaze-html           >= 0.5    && < 0.9,
-    blaze-markup       >= 0.5.1   && < 0.8,
+    blaze-markup         >= 0.5.1  && < 0.8,
-    bytestring         >= 0.9     && < 0.11,
+    bytestring           >= 0.9    && < 0.11,
-    cmdargs            >= 0.10    && < 0.11,
+    cmdargs              >= 0.10   && < 0.11,
-    containers         >= 0.3     && < 0.6,
+    containers           >= 0.3    && < 0.6,
-    cryptohash         >= 0.7     && < 0.12,
+    cryptohash           >= 0.7    && < 0.12,
-    data-default       >= 0.4     && < 0.6,
+    data-default         >= 0.4    && < 0.6,
-    deepseq            >= 1.3     && < 1.5,
+    deepseq              >= 1.3    && < 1.5,
-    directory          >= 1.0     && < 1.3,
+    directory            >= 1.0    && < 1.3,
-    filepath           >= 1.0     && < 1.5,
+    filepath             >= 1.0    && < 1.5,
-    lrucache           >= 1.1.1   && < 1.3,
+    lrucache             >= 1.1.1  && < 1.3,
-    mtl                >= 1       && < 2.3,
+    mtl                  >= 1      && < 2.3,
-    network            >= 2.6     && < 2.7,
+    network              >= 2.6    && < 2.7,
-    network-uri        >= 2.6     && < 2.7,
+    network-uri          >= 2.6    && < 2.7,
-    pandoc             >= 1.14    && < 1.18,
+    pandoc               >= 1.14   && < 1.18,
-    pandoc-citeproc    >= 0.4     && < 0.10,
+    pandoc-citeproc      >= 0.4    && < 0.10,
-    parsec             >= 3.0     && < 3.2,
+    parsec               >= 3.0    && < 3.2,
-    process            >= 1.0     && < 1.3,
+    process              >= 1.0    && < 1.3,
-    random             >= 1.0     && < 1.2,
+    random               >= 1.0    && < 1.2,
-    regex-base         >= 0.93    && < 0.94,
+    regex-base           >= 0.93   && < 0.94,
-    regex-tdfa         >= 1.1     && < 1.3,
+    regex-tdfa           >= 1.1    && < 1.3,
-    tagsoup            >= 0.13.1  && < 0.14,
+    tagsoup              >= 0.13.1 && < 0.14,
-    text               >= 0.11    && < 1.3,
+    text                 >= 0.11   && < 1.3,
-    time               >= 1.5     && < 1.6,
+    time                 >= 1.4    && < 1.6,
-    time-locale-compat >= 0.1     && < 0.2
+    time-locale-compat   >= 0.1    && < 0.2,
+    unordered-containers >= 0.2    && < 0.3,
+    vector               >= 0.11   && < 0.12,
+    yaml                 >= 0.8    && < 0.9
 
   If flag(previewServer)
     Build-depends:

src/Data/List/Extended.hs

@@ -0,0 +1,15 @@
+module Data.List.Extended
+    ( module Data.List
+    , breakWhen
+    ) where
+
+import           Data.List
+
+-- | Like 'break', but can act on the entire tail of the list.
+breakWhen :: ([a] -> Bool) -> [a] -> ([a], [a])
+breakWhen predicate = go []
+  where
+    go buf []                = (reverse buf, [])
+    go buf (x : xs)
+        | predicate (x : xs) = (reverse buf, x : xs)
+        | otherwise          = go (x : buf) xs

src/Data/Yaml/Extended.hs

@@ -0,0 +1,17 @@
+module Data.Yaml.Extended
+    ( module Data.Yaml
+    , toString
+    , toList
+    ) where
+
+import qualified Data.Text   as T
+import qualified Data.Vector as V
+import           Data.Yaml
+
+toString :: Value -> Maybe String
+toString (String t) = Just (T.unpack t)
+toString _          = Nothing
+
+toList :: Value -> Maybe [Value]
+toList (Array a) = Just (V.toList a)
+toList _         = Nothing

src/Hakyll/Core/Metadata.hs

@@ -1,28 +1,46 @@
 --------------------------------------------------------------------------------
 module Hakyll.Core.Metadata
     ( Metadata
+    , lookupString
+    , lookupStringList
+
     , MonadMetadata (..)
     , getMetadataField
     , getMetadataField'
     , makePatternDependency
+
+    , BinaryMetadata (..)
     ) where
 
 
 --------------------------------------------------------------------------------
+import           Control.Arrow                  (second)
 import           Control.Monad                  (forM)
-import           Data.Map                       (Map)
+import           Data.Binary                    (Binary (..), getWord8,
-import qualified Data.Map                       as M
+                                                 putWord8, Get)
+import qualified Data.HashMap.Strict            as HMS
 import qualified Data.Set                       as S
-
+import qualified Data.Text                      as T
-
+import qualified Data.Vector                    as V
---------------------------------------------------------------------------------
+import qualified Data.Yaml.Extended                      as Yaml
 import           Hakyll.Core.Dependencies
 import           Hakyll.Core.Identifier
 import           Hakyll.Core.Identifier.Pattern
 
 
 --------------------------------------------------------------------------------
-type Metadata = Map String String
+type Metadata = Yaml.Object
+
+
+--------------------------------------------------------------------------------
+lookupString :: String -> Metadata -> Maybe String
+lookupString key meta = HMS.lookup (T.pack key) meta >>= Yaml.toString
+
+
+--------------------------------------------------------------------------------
+lookupStringList :: String -> Metadata -> Maybe [String]
+lookupStringList key meta =
+    HMS.lookup (T.pack key) meta >>= Yaml.toList >>= mapM Yaml.toString
 
 
 --------------------------------------------------------------------------------
@@ -42,7 +60,7 @@ class Monad m => MonadMetadata m where
 getMetadataField :: MonadMetadata m => Identifier -> String -> m (Maybe String)
 getMetadataField identifier key = do
     metadata <- getMetadata identifier
-    return $ M.lookup key metadata
+    return $ lookupString key metadata
 
 
 --------------------------------------------------------------------------------
@@ -62,3 +80,59 @@ makePatternDependency :: MonadMetadata m => Pattern -> m Dependency
 makePatternDependency pattern = do
     matches' <- getMatches pattern
     return $ PatternDependency pattern (S.fromList matches')
+
+
+--------------------------------------------------------------------------------
+-- | Newtype wrapper for serialization.
+newtype BinaryMetadata = BinaryMetadata
+    {unBinaryMetadata :: Metadata}
+
+
+instance Binary BinaryMetadata where
+    put (BinaryMetadata obj) = put (BinaryYaml $ Yaml.Object obj)
+    get = do
+        BinaryYaml (Yaml.Object obj) <- get
+        return $ BinaryMetadata obj
+
+
+--------------------------------------------------------------------------------
+newtype BinaryYaml = BinaryYaml {unBinaryYaml :: Yaml.Value}
+
+
+--------------------------------------------------------------------------------
+instance Binary BinaryYaml where
+    put (BinaryYaml yaml) = case yaml of
+        Yaml.Object obj -> do
+            putWord8 0
+            let list :: [(T.Text, BinaryYaml)]
+                list = map (second BinaryYaml) $ HMS.toList obj
+            put list
+
+        Yaml.Array arr -> do
+            putWord8 1
+            let list = map BinaryYaml (V.toList arr) :: [BinaryYaml]
+            put list
+
+        Yaml.String s -> putWord8 2 >> put s
+        Yaml.Number n -> putWord8 3 >> put n
+        Yaml.Bool   b -> putWord8 4 >> put b
+        Yaml.Null     -> putWord8 5
+
+    get = do
+        tag <- getWord8
+        case tag of
+            0 -> do
+                list <- get :: Get [(T.Text, BinaryYaml)]
+                return $ BinaryYaml $ Yaml.Object $
+                    HMS.fromList $ map (second unBinaryYaml) list
+
+            1 -> do
+                list <- get :: Get [BinaryYaml]
+                return $ BinaryYaml $
+                    Yaml.Array $ V.fromList $ map unBinaryYaml list
+
+            2 -> BinaryYaml . Yaml.String <$> get
+            3 -> BinaryYaml . Yaml.Number <$> get
+            4 -> BinaryYaml . Yaml.Bool   <$> get
+            5 -> return $ BinaryYaml Yaml.Null
+            _ -> fail "Data.Binary.get: Invalid Binary Metadata"

src/Hakyll/Core/Provider/Metadata.hs

@@ -1,33 +1,32 @@
 --------------------------------------------------------------------------------
 -- | Internal module to parse metadata
+{-# LANGUAGE BangPatterns #-}
 module Hakyll.Core.Provider.Metadata
     ( loadMetadata
-    , metadata
+    , parsePage
-    , page
-
-      -- This parser can be reused in some places
-    , metadataKey
     ) where
 
 
 --------------------------------------------------------------------------------
 import           Control.Applicative
 import           Control.Arrow                 (second)
+import           Control.Monad                 (guard)
 import qualified Data.ByteString.Char8         as BC
+import qualified Data.HashMap.Strict           as HMS
 import           Data.List                     (intercalate)
+import           Data.List.Extended            (breakWhen)
 import qualified Data.Map                      as M
-import           System.IO                     as IO
+import           Data.Maybe                    (fromMaybe)
-import           Text.Parsec                   ((<?>))
+import           Data.Monoid                   ((<>))
-import qualified Text.Parsec                   as P
+import qualified Data.Text                     as T
-import           Text.Parsec.String            (Parser)
+import qualified Data.Text.Encoding            as T
-
+import qualified Data.Yaml                     as Yaml
-
---------------------------------------------------------------------------------
 import           Hakyll.Core.Identifier
 import           Hakyll.Core.Metadata
 import           Hakyll.Core.Provider.Internal
 import           Hakyll.Core.Util.Parser
 import           Hakyll.Core.Util.String
+import           System.IO                     as IO
 
 
 --------------------------------------------------------------------------------
@@ -36,13 +35,13 @@ loadMetadata p identifier = do
     hasHeader  <- probablyHasMetadataHeader fp
     (md, body) <- if hasHeader
         then second Just <$> loadMetadataHeader fp
-        else return (M.empty, Nothing)
+        else return (mempty, Nothing)
 
     emd <- case mi of
-        Nothing  -> return M.empty
+        Nothing  -> return mempty
         Just mi' -> loadMetadataFile $ resourceFilePath p mi'
 
-    return (M.union md emd, body)
+    return (md <> emd, body)
   where
     normal = setVersion Nothing identifier
     fp     = resourceFilePath p identifier
@@ -52,19 +51,15 @@ loadMetadata p identifier = do
 --------------------------------------------------------------------------------
 loadMetadataHeader :: FilePath -> IO (Metadata, String)
 loadMetadataHeader fp = do
-    contents <- readFile fp
+    fileContent <- readFile fp
-    case P.parse page fp contents of
+    either fail return (parsePage fileContent)
-        Left err      -> error (show err)
-        Right (md, b) -> return (M.fromList md, b)
 
 
 --------------------------------------------------------------------------------
 loadMetadataFile :: FilePath -> IO Metadata
 loadMetadataFile fp = do
-    contents <- readFile fp
+    errOrMeta <- Yaml.decodeFileEither fp
-    case P.parse metadata fp contents of
+    either (fail . show) return errOrMeta
-        Left err  -> error (show err)
-        Right md  -> return $ M.fromList md
 
 
 --------------------------------------------------------------------------------
@@ -83,53 +78,41 @@ probablyHasMetadataHeader fp = do
 
 
 --------------------------------------------------------------------------------
--- | Space or tab, no newline
+-- | Parse the page metadata and body.
-inlineSpace :: Parser Char
+splitMetadata :: String -> (Maybe String, String)
-inlineSpace = P.oneOf ['\t', ' '] <?> "space"
+splitMetadata str0 = fromMaybe (Nothing, str0) $ do
-
+    guard $ leading >= 3
-
+    let !(!meta, !content0) = breakWhen isTrailing (drop leading str0)
---------------------------------------------------------------------------------
+    guard $ not $ null content0
--- | Parse Windows newlines as well (i.e. "\n" or "\r\n")
+    let !content1 = drop (leading + 1) content0
-newline :: Parser String
+        !content2 = dropWhile isNewline $ dropWhile isInlineSpace content1
-newline = P.string "\n" <|> P.string "\r\n"
+    return (Just meta, content2)
-
-
---------------------------------------------------------------------------------
--- | Parse a single metadata field
-metadataField :: Parser (String, String)
-metadataField = do
-    key <- metadataKey
-    _   <- P.char ':'
-    P.skipMany1 inlineSpace <?> "space followed by metadata for: " ++ key
-    value     <- P.manyTill P.anyChar newline
-    trailing' <- P.many trailing
-    return (key, trim $ intercalate " " $ value : trailing')
   where
-    trailing = P.many1 inlineSpace *> P.manyTill P.anyChar newline
+    -- Parse the leading "---"
+    !leading = length $ takeWhile (== '-') str0
+
+    -- Predicate to recognize the trailing "---" or "..."
+    isTrailing []       = False
+    isTrailing (x : xs) =
+        isNewline x && length (takeWhile isDash xs) == leading
+
+    -- Characters
+    isNewline     c = c == '\n' || c == '\r'
+    isDash        c = c == '-'  || c == '.'
+    isInlineSpace c = c == '\t' || c == ' '
 
 
 --------------------------------------------------------------------------------
--- | Parse a metadata block
+parseMetadata :: String -> Either String Metadata
-metadata :: Parser [(String, String)]
+parseMetadata = Yaml.decodeEither . T.encodeUtf8 . T.pack
-metadata = P.many metadataField
 
 
 --------------------------------------------------------------------------------
--- | Parse a metadata block, including delimiters and trailing newlines
+parsePage :: String -> Either String (Metadata, String)
-metadataBlock :: Parser [(String, String)]
+parsePage fileContent = case mbMetaBlock of
-metadataBlock = do
+    Nothing        -> return (mempty, content)
-    open      <- P.many1 (P.char '-') <* P.many inlineSpace <* newline
+    Just metaBlock -> case parseMetadata metaBlock of
-    metadata' <- metadata
+        Left  err  -> Left   err
-    _         <- P.choice $ map (P.string . replicate (length open)) ['-', '.']
+        Right meta -> return (meta, content)
-    P.skipMany inlineSpace
+  where
-    P.skipMany1 newline
+    !(!mbMetaBlock, !content) = splitMetadata fileContent
-    return metadata'
-
-
---------------------------------------------------------------------------------
--- | Parse a page consisting of a metadata header and a body
-page :: Parser ([(String, String)], String)
-page = do
-    metadata' <- P.option [] metadataBlock
-    body      <- P.many P.anyChar
-    return (metadata', body)

src/Hakyll/Core/Provider/MetadataCache.hs

@@ -8,9 +8,6 @@ module Hakyll.Core.Provider.MetadataCache
 
 --------------------------------------------------------------------------------
 import           Control.Monad                 (unless)
-import qualified Data.Map                      as M
-
---------------------------------------------------------------------------------
 import           Hakyll.Core.Identifier
 import           Hakyll.Core.Metadata
 import           Hakyll.Core.Provider.Internal
@@ -21,11 +18,11 @@ import qualified Hakyll.Core.Store             as Store
 --------------------------------------------------------------------------------
 resourceMetadata :: Provider -> Identifier -> IO Metadata
 resourceMetadata p r
-    | not (resourceExists p r) = return M.empty
+    | not (resourceExists p r) = return mempty
     | otherwise                = do
         -- TODO keep time in md cache
         load p r
-        Store.Found md <- Store.get (providerStore p)
+        Store.Found (BinaryMetadata md) <- Store.get (providerStore p)
             [name, toFilePath r, "metadata"]
         return md
 
@@ -52,7 +49,7 @@ load p r = do
     mmof <- Store.isMember store mdk
     unless mmof $ do
         (md, body) <- loadMetadata p r
-        Store.set store mdk md
+        Store.set store mdk (BinaryMetadata md)
         Store.set store bk  body
   where
     store = providerStore p

src/Hakyll/Core/Routes.hs

@@ -42,7 +42,6 @@ module Hakyll.Core.Routes
 
 
 --------------------------------------------------------------------------------
-import           Data.Monoid                    (Monoid, mappend, mempty)
 import           System.FilePath                (replaceExtension)
 
 

src/Hakyll/Core/Runtime.hs

@@ -5,7 +5,6 @@ module Hakyll.Core.Runtime
 
 
 --------------------------------------------------------------------------------
-import           Control.Applicative           ((<$>))
 import           Control.Monad                 (unless)
 import           Control.Monad.Error           (ErrorT, runErrorT, throwError)
 import           Control.Monad.Reader          (ask)
@@ -15,7 +14,6 @@ import           Control.Monad.Trans           (liftIO)
 import           Data.List                     (intercalate)
 import           Data.Map                      (Map)
 import qualified Data.Map                      as M
-import           Data.Monoid                   (mempty)
 import           Data.Set                      (Set)
 import qualified Data.Set                      as S
 import           System.Exit                   (ExitCode (..))

src/Hakyll/Web/Pandoc/Biblio.hs

@@ -23,22 +23,19 @@ module Hakyll.Web.Pandoc.Biblio
 
 
 --------------------------------------------------------------------------------
-import           Control.Applicative    ((<$>))
+import           Control.Monad            (liftM, replicateM)
-import           Control.Monad          (replicateM, liftM)
+import           Data.Binary              (Binary (..))
-import           Data.Binary            (Binary (..))
+import           Data.Default             (def)
-import           Data.Default           (def)
+import           Data.Typeable            (Typeable)
-import           Data.Typeable          (Typeable)
-import qualified Text.CSL               as CSL
-import           Text.CSL.Pandoc        (processCites)
-import           Text.Pandoc            (Pandoc, ReaderOptions (..))
-
---------------------------------------------------------------------------------
 import           Hakyll.Core.Compiler
 import           Hakyll.Core.Identifier
 import           Hakyll.Core.Item
 import           Hakyll.Core.Writable
 import           Hakyll.Web.Pandoc
 import           Hakyll.Web.Pandoc.Binary ()
+import qualified Text.CSL                 as CSL
+import           Text.CSL.Pandoc          (processCites)
+import           Text.Pandoc              (Pandoc, ReaderOptions (..))
 
 
 --------------------------------------------------------------------------------

src/Hakyll/Web/Tags.hs

@@ -63,13 +63,12 @@ module Hakyll.Web.Tags
 
 --------------------------------------------------------------------------------
 import           Control.Arrow                   ((&&&))
-import           Control.Monad                   (foldM, forM, forM_)
+import           Control.Monad                   (foldM, forM, forM_, mplus)
 import           Data.Char                       (toLower)
 import           Data.List                       (intercalate, intersperse,
                                                   sortBy)
 import qualified Data.Map                        as M
 import           Data.Maybe                      (catMaybes, fromMaybe)
-import           Data.Monoid                     (mconcat)
 import           Data.Ord                        (comparing)
 import qualified Data.Set                        as S
 import           System.FilePath                 (takeBaseName, takeDirectory)
@@ -88,8 +87,8 @@ import           Hakyll.Core.Item
 import           Hakyll.Core.Metadata
 import           Hakyll.Core.Rules
 import           Hakyll.Core.Util.String
-import           Hakyll.Web.Template.Context
 import           Hakyll.Web.Html
+import           Hakyll.Web.Template.Context
 
 
 --------------------------------------------------------------------------------
@@ -103,11 +102,14 @@ data Tags = Tags
 
 --------------------------------------------------------------------------------
 -- | Obtain tags from a page in the default way: parse them from the @tags@
--- metadata field.
+-- metadata field. This can either be a list or a comma-separated string.
 getTags :: MonadMetadata m => Identifier -> m [String]
 getTags identifier = do
     metadata <- getMetadata identifier
-    return $ maybe [] (map trim . splitAll ",") $ M.lookup "tags" metadata
+    return $ fromMaybe [] $
+        (lookupStringList "tags" metadata) `mplus`
+        (map trim . splitAll "," <$> lookupString "tags" metadata)
+
 
 --------------------------------------------------------------------------------
 -- | Obtain categories from a page.

src/Hakyll/Web/Template/Context.hs

@@ -31,18 +31,13 @@ module Hakyll.Web.Template.Context
 
 
 --------------------------------------------------------------------------------
-import           Control.Applicative           (Alternative (..), pure, (<$>))
+import           Control.Applicative           (Alternative (..))
 import           Control.Monad                 (msum)
 import           Data.List                     (intercalate)
-import qualified Data.Map                      as M
-import           Data.Monoid                   (Monoid (..))
 import           Data.Time.Clock               (UTCTime (..))
 import           Data.Time.Format              (formatTime)
 import qualified Data.Time.Format              as TF
 import           Data.Time.Locale.Compat       (TimeLocale, defaultTimeLocale)
-import           System.FilePath               (splitDirectories, takeBaseName)
-
---------------------------------------------------------------------------------
 import           Hakyll.Core.Compiler
 import           Hakyll.Core.Compiler.Internal
 import           Hakyll.Core.Identifier
@@ -51,6 +46,7 @@ import           Hakyll.Core.Metadata
 import           Hakyll.Core.Provider
 import           Hakyll.Core.Util.String       (needlePrefix, splitAll)
 import           Hakyll.Web.Html
+import           System.FilePath               (splitDirectories, takeBaseName)
 
 
 --------------------------------------------------------------------------------
@@ -274,7 +270,7 @@ getItemUTC :: MonadMetadata m
            -> m UTCTime         -- ^ Parsed UTCTime
 getItemUTC locale id' = do
     metadata <- getMetadata id'
-    let tryField k fmt = M.lookup k metadata >>= parseTime' fmt
+    let tryField k fmt = lookupString k metadata >>= parseTime' fmt
         paths          = splitDirectories $ toFilePath id'
 
     maybe empty' return $ msum $

stack.yaml

@@ -0,0 +1,12 @@
+resolver: lts-5.11
+extra-deps: []
+extra-package-dbs: []
+
+flags:
+  hakyll:
+    previewServer: True
+    watchServer:   True
+    checkExternal: True
+
+packages:
+  - '.'

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

@@ -5,14 +5,13 @@ module Hakyll.Core.Provider.Metadata.Tests
 
 
 --------------------------------------------------------------------------------
+import qualified Data.HashMap.Strict           as HMS
+import qualified Data.Text                     as T
+import qualified Data.Yaml                     as Yaml
+import           Hakyll.Core.Metadata
+import           Hakyll.Core.Provider.Metadata
 import           Test.Framework                (Test, testGroup)
 import           Test.HUnit                    (Assertion, (@=?))
-import           Text.Parsec                   as P
-import           Text.Parsec.String            (Parser)
-
-
---------------------------------------------------------------------------------
-import           Hakyll.Core.Provider.Metadata
 import           TestSuite.Util
 
 
@@ -22,9 +21,11 @@ tests = testGroup "Hakyll.Core.Provider.Metadata.Tests" $
     fromAssertions "page" [testPage01, testPage02]
 
 
+
 --------------------------------------------------------------------------------
 testPage01 :: Assertion
-testPage01 = testParse page ([("foo", "bar")], "qux\n")
+testPage01 =
+    Right (meta [("foo", "bar")], "qux\n") @=? parsePage
     "---\n\
     \foo: bar\n\
     \---\n\
@@ -33,21 +34,21 @@ testPage01 = testParse page ([("foo", "bar")], "qux\n")
 
 --------------------------------------------------------------------------------
 testPage02 :: Assertion
-testPage02 = testParse page
+testPage02 =
-    ([("description", descr)], "Hello I am dog\n")
+    Right (meta [("description", descr)], "Hello I am dog\n") @=?
+    parsePage
     "---\n\
     \description: A long description that would look better if it\n\
     \             spanned multiple lines and was indented\n\
     \---\n\
     \Hello I am dog\n"
   where
+    descr :: String
     descr =
         "A long description that would look better if it \
         \spanned multiple lines and was indented"
 
 
 --------------------------------------------------------------------------------
-testParse :: (Eq a, Show a) => Parser a -> a -> String -> Assertion
+meta :: Yaml.ToJSON a => [(String, a)] -> Metadata
-testParse parser expected input = case P.parse parser "<inline>" input of
+meta pairs = HMS.fromList [(T.pack k, Yaml.toJSON v) | (k, v) <- pairs]
-    Left err -> error $ show err
-    Right x  -> expected @=? x

tests/Hakyll/Core/Provider/Tests.hs

@@ -6,14 +6,11 @@ module Hakyll.Core.Provider.Tests
 
 
 --------------------------------------------------------------------------------
-import qualified Data.Map                       as M
+import           Hakyll.Core.Metadata
+import           Hakyll.Core.Provider
 import           Test.Framework                 (Test, testGroup)
 import           Test.Framework.Providers.HUnit (testCase)
 import           Test.HUnit                     (Assertion, assert, (@=?))
-
-
---------------------------------------------------------------------------------
-import           Hakyll.Core.Provider
 import           TestSuite.Util
 
 
@@ -32,9 +29,9 @@ case01 = do
     assert $ resourceExists provider "example.md"
 
     metadata <- resourceMetadata provider "example.md"
-    Just "An example"    @=? M.lookup "title"    metadata
+    Just "An example"    @=? lookupString "title"    metadata
-    Just "External data" @=? M.lookup "external" metadata
+    Just "External data" @=? lookupString "external" metadata
 
     doesntExist <- resourceMetadata provider "doesntexist.md"
-    M.empty @=? doesntExist
+    mempty @=? doesntExist
     cleanTestEnv

tests/Hakyll/Core/Routes/Tests.hs

@@ -6,15 +6,13 @@ module Hakyll.Core.Routes.Tests
 
 
 --------------------------------------------------------------------------------
-import qualified Data.Map               as M
+import           Data.Maybe             (fromMaybe)
+import           Hakyll.Core.Identifier
+import           Hakyll.Core.Metadata
+import           Hakyll.Core.Routes
 import           System.FilePath        ((</>))
 import           Test.Framework         (Test, testGroup)
 import           Test.HUnit             (Assertion, (@=?))
-
-
---------------------------------------------------------------------------------
-import           Hakyll.Core.Identifier
-import           Hakyll.Core.Routes
 import           TestSuite.Util
 
 
@@ -37,7 +35,7 @@ tests = testGroup "Hakyll.Core.Routes.Tests" $ fromAssertions "runRoutes"
         "tags/rss/bar"
 
     , testRoutes "food/example.md" (metadataRoute $ \md -> customRoute $ \id' ->
-        M.findWithDefault "?" "subblog" md </> toFilePath id')
+        fromMaybe "?" (lookupString "subblog" md) </> toFilePath id')
         "example.md"
     ]
 

tests/Hakyll/Core/Rules/Tests.hs

@@ -8,22 +8,19 @@ module Hakyll.Core.Rules.Tests
 --------------------------------------------------------------------------------
 import           Data.IORef                     (IORef, newIORef, readIORef,
                                                  writeIORef)
-import qualified Data.Map                       as M
 import qualified Data.Set                       as S
-import           System.FilePath                ((</>))
-import           Test.Framework                 (Test, testGroup)
-import           Test.HUnit                     (Assertion, assert, (@=?))
-
-
---------------------------------------------------------------------------------
 import           Hakyll.Core.Compiler
 import           Hakyll.Core.File
 import           Hakyll.Core.Identifier
 import           Hakyll.Core.Identifier.Pattern
+import           Hakyll.Core.Metadata
 import           Hakyll.Core.Routes
 import           Hakyll.Core.Rules
 import           Hakyll.Core.Rules.Internal
 import           Hakyll.Web.Pandoc
+import           System.FilePath                ((</>))
+import           Test.Framework                 (Test, testGroup)
+import           Test.HUnit                     (Assertion, assert, (@=?))
 import           TestSuite.Util
 
 
@@ -89,7 +86,7 @@ rules01 ioref = do
         compile getResourceString
 
     version "metadataMatch" $
-        matchMetadata "*.md" (\md -> M.lookup "subblog" md == Just "food") $ do
+        matchMetadata "*.md" (\md -> lookupString "subblog" md == Just "food") $ do
             route $ customRoute $ \id' -> "food" </> toFilePath id'
             compile getResourceString