From e81468e0f64fdbe05794d5f8ccaebc00ee474ee2 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Wed, 6 Apr 2016 14:26:46 +0200 Subject: [PATCH] Initial YAML support See #225 --- .gitignore | 3 +- hakyll.cabal | 116 ++++++++++--------- src/Data/List/Extended.hs | 15 +++ src/Data/Yaml/Extended.hs | 17 +++ src/Hakyll/Core/Metadata.hs | 88 ++++++++++++-- src/Hakyll/Core/Provider/Metadata.hs | 115 ++++++++---------- src/Hakyll/Core/Provider/MetadataCache.hs | 9 +- src/Hakyll/Core/Routes.hs | 1 - src/Hakyll/Core/Runtime.hs | 2 - src/Hakyll/Web/Pandoc/Biblio.hs | 17 ++- src/Hakyll/Web/Tags.hs | 12 +- src/Hakyll/Web/Template/Context.hs | 10 +- stack.yaml | 12 ++ tests/Hakyll/Core/Provider/Metadata/Tests.hs | 27 ++--- tests/Hakyll/Core/Provider/Tests.hs | 13 +-- tests/Hakyll/Core/Routes/Tests.hs | 12 +- tests/Hakyll/Core/Rules/Tests.hs | 13 +-- 17 files changed, 287 insertions(+), 195 deletions(-) create mode 100644 src/Data/List/Extended.hs create mode 100644 src/Data/Yaml/Extended.hs create mode 100644 stack.yaml 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 + + -- Characters + isNewline c = c == '\n' || c == '\r' + isDash c = c == '-' || c == '.' + isInlineSpace c = c == '\t' || c == ' ' -------------------------------------------------------------------------------- --- | Parse a metadata block -metadata :: Parser [(String, String)] -metadata = P.many metadataField +parseMetadata :: String -> Either String Metadata +parseMetadata = Yaml.decodeEither . T.encodeUtf8 . T.pack -------------------------------------------------------------------------------- --- | 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' - - --------------------------------------------------------------------------------- --- | 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 "" 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