summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJasper Van der Jeugt <m@jaspervdj.be>2016-04-06 14:26:46 +0200
committerJasper Van der Jeugt <m@jaspervdj.be>2016-04-06 14:26:46 +0200
commite81468e0f64fdbe05794d5f8ccaebc00ee474ee2 (patch)
tree882c422a312ed3e6eb8eaacfcc9c292a09296845
parent3f3e09672d3d279bc5cbaa8b3ac7508abc98aa2d (diff)
downloadhakyll-e81468e0f64fdbe05794d5f8ccaebc00ee474ee2.tar.gz
Initial YAML support
See #225
-rw-r--r--.gitignore3
-rw-r--r--hakyll.cabal116
-rw-r--r--src/Data/List/Extended.hs15
-rw-r--r--src/Data/Yaml/Extended.hs17
-rw-r--r--src/Hakyll/Core/Metadata.hs88
-rw-r--r--src/Hakyll/Core/Provider/Metadata.hs111
-rw-r--r--src/Hakyll/Core/Provider/MetadataCache.hs9
-rw-r--r--src/Hakyll/Core/Routes.hs1
-rw-r--r--src/Hakyll/Core/Runtime.hs2
-rw-r--r--src/Hakyll/Web/Pandoc/Biblio.hs17
-rw-r--r--src/Hakyll/Web/Tags.hs12
-rw-r--r--src/Hakyll/Web/Template/Context.hs10
-rw-r--r--stack.yaml12
-rw-r--r--tests/Hakyll/Core/Provider/Metadata/Tests.hs27
-rw-r--r--tests/Hakyll/Core/Provider/Tests.hs13
-rw-r--r--tests/Hakyll/Core/Routes/Tests.hs12
-rw-r--r--tests/Hakyll/Core/Rules/Tests.hs13
17 files changed, 285 insertions, 193 deletions
diff --git a/.gitignore b/.gitignore
index 7e47278..e670565 100644
--- a/.gitignore
+++ b/.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
diff --git a/hakyll.cabal b/hakyll.cabal
index 6a9c23c..479561e 100644
--- a/hakyll.cabal
+++ b/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,
- binary >= 0.5 && < 0.8,
- blaze-html >= 0.5 && < 0.9,
- blaze-markup >= 0.5.1 && < 0.8,
- bytestring >= 0.9 && < 0.11,
- cmdargs >= 0.10 && < 0.11,
- containers >= 0.3 && < 0.6,
- cryptohash >= 0.7 && < 0.12,
- data-default >= 0.4 && < 0.6,
- deepseq >= 1.3 && < 1.5,
- directory >= 1.0 && < 1.3,
- filepath >= 1.0 && < 1.5,
- lrucache >= 1.1.1 && < 1.3,
- mtl >= 1 && < 2.3,
- network >= 2.6 && < 2.7,
- network-uri >= 2.6 && < 2.7,
- pandoc >= 1.14 && < 1.18,
- pandoc-citeproc >= 0.4 && < 0.10,
- parsec >= 3.0 && < 3.2,
- process >= 1.0 && < 1.3,
- random >= 1.0 && < 1.2,
- regex-base >= 0.93 && < 0.94,
- regex-tdfa >= 1.1 && < 1.3,
- tagsoup >= 0.13.1 && < 0.14,
- text >= 0.11 && < 1.3,
- time >= 1.4 && < 1.6,
- time-locale-compat >= 0.1 && < 0.2
+ base >= 4 && < 5,
+ binary >= 0.5 && < 0.8,
+ blaze-html >= 0.5 && < 0.9,
+ blaze-markup >= 0.5.1 && < 0.8,
+ bytestring >= 0.9 && < 0.11,
+ cmdargs >= 0.10 && < 0.11,
+ containers >= 0.3 && < 0.6,
+ cryptohash >= 0.7 && < 0.12,
+ data-default >= 0.4 && < 0.6,
+ deepseq >= 1.3 && < 1.5,
+ directory >= 1.0 && < 1.3,
+ filepath >= 1.0 && < 1.5,
+ lrucache >= 1.1.1 && < 1.3,
+ mtl >= 1 && < 2.3,
+ network >= 2.6 && < 2.7,
+ network-uri >= 2.6 && < 2.7,
+ pandoc >= 1.14 && < 1.18,
+ pandoc-citeproc >= 0.4 && < 0.10,
+ parsec >= 3.0 && < 3.2,
+ process >= 1.0 && < 1.3,
+ random >= 1.0 && < 1.2,
+ regex-base >= 0.93 && < 0.94,
+ regex-tdfa >= 1.1 && < 1.3,
+ tagsoup >= 0.13.1 && < 0.14,
+ text >= 0.11 && < 1.3,
+ time >= 1.4 && < 1.6,
+ 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,
- binary >= 0.5 && < 0.8,
- blaze-html >= 0.5 && < 0.9,
- blaze-markup >= 0.5.1 && < 0.8,
- bytestring >= 0.9 && < 0.11,
- cmdargs >= 0.10 && < 0.11,
- containers >= 0.3 && < 0.6,
- cryptohash >= 0.7 && < 0.12,
- data-default >= 0.4 && < 0.6,
- deepseq >= 1.3 && < 1.5,
- directory >= 1.0 && < 1.3,
- filepath >= 1.0 && < 1.5,
- lrucache >= 1.1.1 && < 1.3,
- mtl >= 1 && < 2.3,
- network >= 2.6 && < 2.7,
- network-uri >= 2.6 && < 2.7,
- pandoc >= 1.14 && < 1.18,
- pandoc-citeproc >= 0.4 && < 0.10,
- parsec >= 3.0 && < 3.2,
- process >= 1.0 && < 1.3,
- random >= 1.0 && < 1.2,
- regex-base >= 0.93 && < 0.94,
- regex-tdfa >= 1.1 && < 1.3,
- tagsoup >= 0.13.1 && < 0.14,
- text >= 0.11 && < 1.3,
- time >= 1.5 && < 1.6,
- time-locale-compat >= 0.1 && < 0.2
+ base >= 4 && < 5,
+ binary >= 0.5 && < 0.8,
+ blaze-html >= 0.5 && < 0.9,
+ blaze-markup >= 0.5.1 && < 0.8,
+ bytestring >= 0.9 && < 0.11,
+ cmdargs >= 0.10 && < 0.11,
+ containers >= 0.3 && < 0.6,
+ cryptohash >= 0.7 && < 0.12,
+ data-default >= 0.4 && < 0.6,
+ deepseq >= 1.3 && < 1.5,
+ directory >= 1.0 && < 1.3,
+ filepath >= 1.0 && < 1.5,
+ lrucache >= 1.1.1 && < 1.3,
+ mtl >= 1 && < 2.3,
+ network >= 2.6 && < 2.7,
+ network-uri >= 2.6 && < 2.7,
+ pandoc >= 1.14 && < 1.18,
+ pandoc-citeproc >= 0.4 && < 0.10,
+ parsec >= 3.0 && < 3.2,
+ process >= 1.0 && < 1.3,
+ random >= 1.0 && < 1.2,
+ regex-base >= 0.93 && < 0.94,
+ regex-tdfa >= 1.1 && < 1.3,
+ tagsoup >= 0.13.1 && < 0.14,
+ text >= 0.11 && < 1.3,
+ time >= 1.4 && < 1.6,
+ 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:
diff --git a/src/Data/List/Extended.hs b/src/Data/List/Extended.hs
new file mode 100644
index 0000000..485cba8
--- /dev/null
+++ b/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
diff --git a/src/Data/Yaml/Extended.hs b/src/Data/Yaml/Extended.hs
new file mode 100644
index 0000000..9ad05f3
--- /dev/null
+++ b/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
diff --git a/src/Hakyll/Core/Metadata.hs b/src/Hakyll/Core/Metadata.hs
index 3ce854f..1cf536e 100644
--- a/src/Hakyll/Core/Metadata.hs
+++ b/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 qualified Data.Map as M
+import Data.Binary (Binary (..), getWord8,
+ 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"
diff --git a/src/Hakyll/Core/Provider/Metadata.hs b/src/Hakyll/Core/Provider/Metadata.hs
index 7e4d7ed..c7fdd55 100644
--- a/src/Hakyll/Core/Provider/Metadata.hs
+++ b/src/Hakyll/Core/Provider/Metadata.hs
@@ -1,33 +1,32 @@
--------------------------------------------------------------------------------
-- | Internal module to parse metadata
+{-# LANGUAGE BangPatterns #-}
module Hakyll.Core.Provider.Metadata
( loadMetadata
- , metadata
- , page
-
- -- This parser can be reused in some places
- , metadataKey
+ , parsePage
) 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 Text.Parsec ((<?>))
-import qualified Text.Parsec as P
-import Text.Parsec.String (Parser)
-
-
---------------------------------------------------------------------------------
+import Data.Maybe (fromMaybe)
+import Data.Monoid ((<>))
+import qualified Data.Text as T
+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
- case P.parse page fp contents of
- Left err -> error (show err)
- Right (md, b) -> return (M.fromList md, b)
+ fileContent <- readFile fp
+ either fail return (parsePage fileContent)
--------------------------------------------------------------------------------
loadMetadataFile :: FilePath -> IO Metadata
loadMetadataFile fp = do
- contents <- readFile fp
- case P.parse metadata fp contents of
- Left err -> error (show err)
- Right md -> return $ M.fromList md
+ errOrMeta <- Yaml.decodeFileEither fp
+ either (fail . show) return errOrMeta
--------------------------------------------------------------------------------
@@ -83,53 +78,41 @@ probablyHasMetadataHeader fp = do
--------------------------------------------------------------------------------
--- | Space or tab, no newline
-inlineSpace :: Parser Char
-inlineSpace = P.oneOf ['\t', ' '] <?> "space"
-
-
---------------------------------------------------------------------------------
--- | Parse Windows newlines as well (i.e. "\n" or "\r\n")
-newline :: Parser String
-newline = P.string "\n" <|> P.string "\r\n"
-
-
---------------------------------------------------------------------------------
--- | 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')
+-- | Parse the page metadata and body.
+splitMetadata :: String -> (Maybe String, String)
+splitMetadata str0 = fromMaybe (Nothing, str0) $ do
+ guard $ leading >= 3
+ let !(!meta, !content0) = breakWhen isTrailing (drop leading str0)
+ guard $ not $ null content0
+ let !content1 = drop (leading + 1) content0
+ !content2 = dropWhile isNewline $ dropWhile isInlineSpace content1
+ return (Just meta, content2)
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
---------------------------------------------------------------------------------
--- | Parse a metadata block
-metadata :: Parser [(String, String)]
-metadata = P.many metadataField
+ -- Characters
+ isNewline c = c == '\n' || c == '\r'
+ isDash c = c == '-' || c == '.'
+ isInlineSpace c = c == '\t' || c == ' '
--------------------------------------------------------------------------------
--- | Parse a metadata block, including delimiters and trailing newlines
-metadataBlock :: Parser [(String, String)]
-metadataBlock = do
- open <- P.many1 (P.char '-') <* P.many inlineSpace <* newline
- metadata' <- metadata
- _ <- P.choice $ map (P.string . replicate (length open)) ['-', '.']
- P.skipMany inlineSpace
- P.skipMany1 newline
- return metadata'
+parseMetadata :: String -> Either String Metadata
+parseMetadata = Yaml.decodeEither . T.encodeUtf8 . T.pack
--------------------------------------------------------------------------------
--- | 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)
+parsePage :: String -> Either String (Metadata, String)
+parsePage fileContent = case mbMetaBlock of
+ Nothing -> return (mempty, content)
+ Just metaBlock -> case parseMetadata metaBlock of
+ Left err -> Left err
+ Right meta -> return (meta, content)
+ where
+ !(!mbMetaBlock, !content) = splitMetadata fileContent
diff --git a/src/Hakyll/Core/Provider/MetadataCache.hs b/src/Hakyll/Core/Provider/MetadataCache.hs
index 28d2bd5..46dbf3e 100644
--- a/src/Hakyll/Core/Provider/MetadataCache.hs
+++ b/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
diff --git a/src/Hakyll/Core/Routes.hs b/src/Hakyll/Core/Routes.hs
index 470d727..513725f 100644
--- a/src/Hakyll/Core/Routes.hs
+++ b/src/Hakyll/Core/Routes.hs
@@ -42,7 +42,6 @@ module Hakyll.Core.Routes
--------------------------------------------------------------------------------
-import Data.Monoid (Monoid, mappend, mempty)
import System.FilePath (replaceExtension)
diff --git a/src/Hakyll/Core/Runtime.hs b/src/Hakyll/Core/Runtime.hs
index e85d60d..bdcd66c 100644
--- a/src/Hakyll/Core/Runtime.hs
+++ b/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 (..))
diff --git a/src/Hakyll/Web/Pandoc/Biblio.hs b/src/Hakyll/Web/Pandoc/Biblio.hs
index 53e3419..dfe6d93 100644
--- a/src/Hakyll/Web/Pandoc/Biblio.hs
+++ b/src/Hakyll/Web/Pandoc/Biblio.hs
@@ -23,22 +23,19 @@ module Hakyll.Web.Pandoc.Biblio
--------------------------------------------------------------------------------
-import Control.Applicative ((<$>))
-import Control.Monad (replicateM, liftM)
-import Data.Binary (Binary (..))
-import Data.Default (def)
-import Data.Typeable (Typeable)
-import qualified Text.CSL as CSL
-import Text.CSL.Pandoc (processCites)
-import Text.Pandoc (Pandoc, ReaderOptions (..))
-
---------------------------------------------------------------------------------
+import Control.Monad (liftM, replicateM)
+import Data.Binary (Binary (..))
+import Data.Default (def)
+import Data.Typeable (Typeable)
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 (..))
--------------------------------------------------------------------------------
diff --git a/src/Hakyll/Web/Tags.hs b/src/Hakyll/Web/Tags.hs
index 0887856..b5b44fc 100644
--- a/src/Hakyll/Web/Tags.hs
+++ b/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.
diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs
index 6879187..efe808a 100644
--- a/src/Hakyll/Web/Template/Context.hs
+++ b/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 $
diff --git a/stack.yaml b/stack.yaml
new file mode 100644
index 0000000..b85cc63
--- /dev/null
+++ b/stack.yaml
@@ -0,0 +1,12 @@
+resolver: lts-5.11
+extra-deps: []
+extra-package-dbs: []
+
+flags:
+ hakyll:
+ previewServer: True
+ watchServer: True
+ checkExternal: True
+
+packages:
+ - '.'
diff --git a/tests/Hakyll/Core/Provider/Metadata/Tests.hs b/tests/Hakyll/Core/Provider/Metadata/Tests.hs
index 1217180..fc609f2 100644
--- a/tests/Hakyll/Core/Provider/Metadata/Tests.hs
+++ b/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
- ([("description", descr)], "Hello I am dog\n")
+testPage02 =
+ 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
-testParse parser expected input = case P.parse parser "<inline>" input of
- Left err -> error $ show err
- Right x -> expected @=? x
+meta :: Yaml.ToJSON a => [(String, a)] -> Metadata
+meta pairs = HMS.fromList [(T.pack k, Yaml.toJSON v) | (k, v) <- pairs]
diff --git a/tests/Hakyll/Core/Provider/Tests.hs b/tests/Hakyll/Core/Provider/Tests.hs
index abe5c1d..8a505d2 100644
--- a/tests/Hakyll/Core/Provider/Tests.hs
+++ b/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 "External data" @=? M.lookup "external" metadata
+ Just "An example" @=? lookupString "title" metadata
+ Just "External data" @=? lookupString "external" metadata
doesntExist <- resourceMetadata provider "doesntexist.md"
- M.empty @=? doesntExist
+ mempty @=? doesntExist
cleanTestEnv
diff --git a/tests/Hakyll/Core/Routes/Tests.hs b/tests/Hakyll/Core/Routes/Tests.hs
index 4f975ae..5a833b0 100644
--- a/tests/Hakyll/Core/Routes/Tests.hs
+++ b/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"
]
diff --git a/tests/Hakyll/Core/Rules/Tests.hs b/tests/Hakyll/Core/Rules/Tests.hs
index dbd077d..ec81c1c 100644
--- a/tests/Hakyll/Core/Rules/Tests.hs
+++ b/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