hakyll 4.7.5.2 → 4.8.0.0

raw patch · 39 files changed

+371/−262 lines, 39 filesdep +resourcetdep +unordered-containersdep +vectordep ~basedep ~data-defaultdep ~directoryPVP ok

version bump matches the API change (PVP)

Dependencies added: resourcet, unordered-containers, vector, yaml

Dependency ranges changed: base, data-default, directory, regex-tdfa, time

API changes (from Hackage documentation)

Files

• hakyll.cabal +69/−55
• src/Data/List/Extended.hs +15/−0
• src/Data/Yaml/Extended.hs +20/−0
• src/Hakyll/Check.hs +32/−29
• src/Hakyll/Commands.hs +0/−3
• src/Hakyll/Core/Compiler.hs +0/−1
• src/Hakyll/Core/Compiler/Internal.hs +2/−4
• src/Hakyll/Core/Compiler/Require.hs +0/−1
• src/Hakyll/Core/Dependencies.hs +0/−1
• src/Hakyll/Core/File.hs +0/−1
• src/Hakyll/Core/Identifier.hs +0/−1
• src/Hakyll/Core/Identifier/Pattern.hs +0/−2
• src/Hakyll/Core/Item.hs +0/−2
• src/Hakyll/Core/Logger.hs +0/−1
• src/Hakyll/Core/Metadata.hs +81/−7
• src/Hakyll/Core/Provider/Internal.hs +0/−2
• src/Hakyll/Core/Provider/Metadata.hs +74/−60
• src/Hakyll/Core/Provider/MetadataCache.hs +3/−6
• src/Hakyll/Core/Routes.hs +0/−1
• src/Hakyll/Core/Rules.hs +0/−2
• src/Hakyll/Core/Rules/Internal.hs +0/−2
• src/Hakyll/Core/Runtime.hs +3/−5
• src/Hakyll/Core/Store.hs +0/−1
• src/Hakyll/Core/UnixFilter.hs +0/−1
• src/Hakyll/Core/Util/File.hs +0/−1
• src/Hakyll/Core/Util/Parser.hs +1/−1
• src/Hakyll/Web/CompressCss.hs +0/−1
• src/Hakyll/Web/Feed.hs +0/−1
• src/Hakyll/Web/Paginate.hs +0/−1
• src/Hakyll/Web/Pandoc.hs +0/−2
• src/Hakyll/Web/Pandoc/Biblio.hs +7/−10
• src/Hakyll/Web/Tags.hs +7/−5
• src/Hakyll/Web/Template.hs +7/−8
• src/Hakyll/Web/Template/Context.hs +20/−7
• src/Hakyll/Web/Template/Internal.hs +1/−1
• tests/Hakyll/Core/Provider/Metadata/Tests.hs +14/−13
• tests/Hakyll/Core/Provider/Tests.hs +5/−8
• tests/Hakyll/Core/Routes/Tests.hs +5/−7
• tests/Hakyll/Core/Rules/Tests.hs +5/−8

@@ -1,5 +1,5 @@ Name:    hakyll-Version: 4.7.5.2+Version: 4.8.0.0  Synopsis: A static website compiler library Description:@@ -121,6 +121,8 @@     Hakyll.Web.Template.List    Other-Modules:+    Data.List.Extended+    Data.Yaml.Extended     Hakyll.Check     Hakyll.Commands     Hakyll.Core.Compiler.Internal@@ -140,33 +142,37 @@     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.8    && < 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.7,+    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,+    resourcet            >= 1.1    && < 1.2,+    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 +232,37 @@     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.8    && < 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.7,+    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,+    resourcet            >= 1.1    && < 1.2,+    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:@@ -291,3 +301,7 @@     base      >= 4   && < 5,     directory >= 1.0 && < 1.3,     filepath  >= 1.0 && < 1.5++  Other-modules:+    Hakyll.Core.Util.File+    Paths_hakyll

@@ -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

@@ -0,0 +1,20 @@+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 (Bool   True)  = Just "true"+toString (Bool   False) = Just "false"+toString (Number d)     = Just (show d)+toString _              = Nothing++toList :: Value -> Maybe [Value]+toList (Array a) = Just (V.toList a)+toList _         = Nothing

@@ -8,42 +8,44 @@   ---------------------------------------------------------------------------------import           Control.Applicative       ((<$>))-import           Control.Monad             (forM_)-import           Control.Monad.Reader      (ask)-import           Control.Monad.RWS         (RWST, runRWST)-import           Control.Monad.Trans       (liftIO)-import           Control.Monad.Writer      (tell)-import           Data.List                 (isPrefixOf)-import           Data.Monoid               (Monoid (..))-import           Data.Set                  (Set)-import qualified Data.Set                  as S-import           Network.URI               (unEscapeString)-import           System.Directory          (doesDirectoryExist, doesFileExist)-import           System.Exit               (ExitCode (..))-import           System.FilePath           (takeDirectory, takeExtension, (</>))-import qualified Text.HTML.TagSoup         as TS+import           Control.Monad                (forM_)+import           Control.Monad.Reader         (ask)+import           Control.Monad.RWS            (RWST, runRWST)+import           Control.Monad.Trans          (liftIO)+import           Control.Monad.Trans.Resource (runResourceT)+import           Control.Monad.Writer         (tell)+import           Data.List                    (isPrefixOf)+import           Data.Set                     (Set)+import qualified Data.Set                     as S+import           Network.URI                  (unEscapeString)+import           System.Directory             (doesDirectoryExist,+                                               doesFileExist)+import           System.Exit                  (ExitCode (..))+import           System.FilePath              (takeDirectory, takeExtension,+                                               (</>))+import qualified Text.HTML.TagSoup            as TS   -------------------------------------------------------------------------------- #ifdef CHECK_EXTERNAL-import           Control.Exception         (AsyncException (..),-                                            SomeException (..), handle, throw)-import           Control.Monad.State       (get, modify)-import           Data.List                 (intercalate)-import           Data.Typeable             (cast)-import           Data.Version              (versionBranch)-import           GHC.Exts                  (fromString)-import qualified Network.HTTP.Conduit      as Http-import qualified Network.HTTP.Types        as Http-import qualified Paths_hakyll              as Paths_hakyll+import           Control.Exception            (AsyncException (..),+                                               SomeException (..), handle,+                                               throw)+import           Control.Monad.State          (get, modify)+import           Data.List                    (intercalate)+import           Data.Typeable                (cast)+import           Data.Version                 (versionBranch)+import           GHC.Exts                     (fromString)+import qualified Network.HTTP.Conduit         as Http+import qualified Network.HTTP.Types           as Http+import qualified Paths_hakyll                 as Paths_hakyll #endif   -------------------------------------------------------------------------------- import           Hakyll.Core.Configuration-import           Hakyll.Core.Logger        (Logger)-import qualified Hakyll.Core.Logger        as Logger+import           Hakyll.Core.Logger           (Logger)+import qualified Hakyll.Core.Logger           as Logger import           Hakyll.Core.Util.File import           Hakyll.Web.Html @@ -196,8 +198,9 @@     if not needsCheck || checked         then Logger.debug logger "Already checked, skipping"         else do-            isOk <- liftIO $ handle (failure logger) $-                Http.withManager $ \mgr -> do+            isOk <- liftIO $ handle (failure logger) $ do+                mgr <- Http.newManager Http.tlsManagerSettings+                runResourceT $ do                     request  <- Http.parseUrl urlToCheck                     response <- Http.http (settings request) mgr                     let code = Http.statusCode (Http.responseStatus response)

@@ -14,11 +14,8 @@   ---------------------------------------------------------------------------------import           Control.Applicative import           Control.Concurrent-import           Control.Monad              (void) import           System.Exit                (ExitCode, exitWith)-import           System.IO.Error            (catchIOError)  -------------------------------------------------------------------------------- import qualified Hakyll.Check               as Check

@@ -28,7 +28,6 @@   ---------------------------------------------------------------------------------import           Control.Applicative           ((<$>)) import           Control.Monad                 (when) import           Data.Binary                   (Binary) import           Data.ByteString.Lazy          (ByteString)

@@ -28,12 +28,10 @@   ---------------------------------------------------------------------------------import           Control.Applicative            (Alternative (..),-                                                 Applicative (..), (<$>))+import           Control.Applicative            (Alternative (..)) import           Control.Exception              (SomeException, handle) import           Control.Monad                  (forM_)-import           Control.Monad.Error            (MonadError (..))-import           Data.Monoid                    (Monoid (..))+import           Control.Monad.Except            (MonadError (..)) import           Data.Set                       (Set) import qualified Data.Set                       as S 

@@ -13,7 +13,6 @@   ---------------------------------------------------------------------------------import           Control.Applicative            ((<$>)) import           Control.Monad                  (when) import           Data.Binary                    (Binary) import qualified Data.Set                       as S

@@ -8,7 +8,6 @@   ---------------------------------------------------------------------------------import           Control.Applicative            ((<$>), (<*>)) import           Control.Monad                  (foldM, forM_, unless, when) import           Control.Monad.Reader           (ask) import           Control.Monad.RWS              (RWS, runRWS)

@@ -11,7 +11,6 @@   ---------------------------------------------------------------------------------import           Control.Applicative           ((<$>)) import           Data.Binary                   (Binary (..)) import           Data.Typeable                 (Typeable) import           System.Directory              (copyFile, doesFileExist,

@@ -19,7 +19,6 @@   ---------------------------------------------------------------------------------import           Control.Applicative ((<$>), (<*>)) import           Control.DeepSeq     (NFData (..)) import           Data.List           (intercalate) import           System.FilePath     (dropTrailingPathSeparator, splitPath)

@@ -57,13 +57,11 @@   ---------------------------------------------------------------------------------import           Control.Applicative    (pure, (<$>), (<*>)) import           Control.Arrow          ((&&&), (>>>)) import           Control.Monad          (msum) import           Data.Binary            (Binary (..), getWord8, putWord8) import           Data.List              (inits, isPrefixOf, tails) import           Data.Maybe             (isJust)-import           Data.Monoid            (Monoid, mappend, mempty) import           Data.Set               (Set) import qualified Data.Set               as S 

@@ -10,10 +10,8 @@   ---------------------------------------------------------------------------------import           Control.Applicative           ((<$>), (<*>)) import           Data.Binary                   (Binary (..)) import           Data.Foldable                 (Foldable (..))-import           Data.Traversable              (Traversable (..)) import           Data.Typeable                 (Typeable) import           Prelude                       hiding (foldr) 

@@ -13,7 +13,6 @@   ---------------------------------------------------------------------------------import           Control.Applicative     (pure, (<$>), (<*>)) import           Control.Concurrent      (forkIO) import           Control.Concurrent.Chan (Chan, newChan, readChan, writeChan) import           Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)

@@ -1,31 +1,49 @@ -------------------------------------------------------------------------------- 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+++-------------------------------------------------------------------------------- class Monad m => MonadMetadata m where     getMetadata    :: Identifier -> m Metadata     getMatches     :: Pattern -> m [Identifier]@@ -42,7 +60,7 @@ 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 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"

@@ -20,7 +20,6 @@   ---------------------------------------------------------------------------------import           Control.Applicative    ((<$>), (<*>)) import           Control.DeepSeq        (NFData (..), deepseq) import           Control.Monad          (forM) import           Data.Binary            (Binary (..))@@ -28,7 +27,6 @@ import           Data.Map               (Map) import qualified Data.Map               as M import           Data.Maybe             (fromMaybe)-import           Data.Monoid            (mempty) import           Data.Set               (Set) import qualified Data.Set               as S import           Data.Time              (Day (..), UTCTime (..))

@@ -1,33 +1,31 @@ -------------------------------------------------------------------------------- -- | Internal module to parse metadata+{-# LANGUAGE BangPatterns    #-}+{-# LANGUAGE RecordWildCards #-} module Hakyll.Core.Provider.Metadata     ( loadMetadata-    , metadata-    , page+    , parsePage -      -- This parser can be reused in some places-    , metadataKey+    , MetadataException (..)     ) where   ---------------------------------------------------------------------------------import           Control.Applicative import           Control.Arrow                 (second)+import           Control.Exception             (Exception, throwIO)+import           Control.Monad                 (guard) import qualified Data.ByteString.Char8         as BC-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 +34,13 @@     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 +50,17 @@ -------------------------------------------------------------------------------- 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+    case parsePage fileContent of+        Right x   -> return x+        Left  err -> throwIO $ MetadataException fp err   -------------------------------------------------------------------------------- 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 +79,71 @@   ----------------------------------------------------------------------------------- | Space or tab, no newline-inlineSpace :: Parser Char-inlineSpace = P.oneOf ['\t', ' '] <?> "space"+-- | Parse the page metadata and body.+splitMetadata :: String -> (Maybe String, String)+splitMetadata str0 = fromMaybe (Nothing, str0) $ do+    guard $ leading >= 3+    let !str1 = drop leading str0+    guard $ all isNewline (take 1 str1)+    let !(!meta, !content0) = breakWhen isTrailing str1+    guard $ not $ null content0+    let !content1 = drop (leading + 1) content0+        !content2 = dropWhile isNewline $ dropWhile isInlineSpace content1+    -- Adding this newline fixes the line numbers reported by the YAML parser.+    -- It's a bit ugly but it works.+    return (Just ('\n' : meta), content2)+  where+    -- 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 Windows newlines as well (i.e. "\n" or "\r\n")-newline :: Parser String-newline = P.string "\n" <|> P.string "\r\n"+parseMetadata :: String -> Either Yaml.ParseException Metadata+parseMetadata = Yaml.decodeEither' . T.encodeUtf8 . T.pack   ----------------------------------------------------------------------------------- | 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')+parsePage :: String -> Either Yaml.ParseException (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-    trailing = P.many1 inlineSpace *> P.manyTill P.anyChar newline+    !(!mbMetaBlock, !content) = splitMetadata fileContent   ----------------------------------------------------------------------------------- | Parse a metadata block-metadata :: Parser [(String, String)]-metadata = P.many metadataField+-- | Thrown in the IO monad if things go wrong. Provides a nice-ish error+-- message.+data MetadataException = MetadataException FilePath Yaml.ParseException   ----------------------------------------------------------------------------------- | 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'+instance Exception MetadataException   ----------------------------------------------------------------------------------- | 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)+instance Show MetadataException where+    show (MetadataException fp err) =+        fp ++ ": " ++ Yaml.prettyPrintParseException err ++ hint++      where+        hint = case err of+            Yaml.InvalidYaml (Just (Yaml.YamlParseException {..}))+                | yamlProblem == problem -> "\n" +++                    "Hint: if the metadata value contains characters such\n" +++                    "as ':' or '-', try enclosing it in quotes."+            _ -> ""++        problem = "mapping values are not allowed in this context"

@@ -8,9 +8,6 @@  -------------------------------------------------------------------------------- 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 @@ -------------------------------------------------------------------------------- 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 @@     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

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

@@ -33,13 +33,11 @@   ---------------------------------------------------------------------------------import           Control.Applicative            ((<$>)) import           Control.Monad.Reader           (ask, local) import           Control.Monad.State            (get, modify, put) import           Control.Monad.Trans            (liftIO) import           Control.Monad.Writer           (censor, tell) import           Data.Maybe                     (fromMaybe)-import           Data.Monoid                    (mempty) import qualified Data.Set                       as S  

@@ -12,12 +12,10 @@   ---------------------------------------------------------------------------------import           Control.Applicative            (Applicative, (<$>)) import           Control.Monad.Reader           (ask) import           Control.Monad.RWS              (RWST, runRWST) import           Control.Monad.Trans            (liftIO) import qualified Data.Map                       as M-import           Data.Monoid                    (Monoid, mappend, mempty) import           Data.Set                       (Set)  

@@ -5,9 +5,8 @@   ---------------------------------------------------------------------------------import           Control.Applicative           ((<$>)) import           Control.Monad                 (unless)-import           Control.Monad.Error           (ErrorT, runErrorT, throwError)+import           Control.Monad.Except          (ExceptT, runExceptT, throwError) import           Control.Monad.Reader          (ask) import           Control.Monad.RWS             (RWST, runRWST) import           Control.Monad.State           (get, modify)@@ -15,7 +14,6 @@ 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 (..))@@ -77,7 +75,7 @@             }      -- Run the program and fetch the resulting state-    result <- runErrorT $ runRWST build read' state+    result <- runExceptT $ runRWST build read' state     case result of         Left e          -> do             Logger.error logger e@@ -117,7 +115,7 @@   ---------------------------------------------------------------------------------type Runtime a = RWST RuntimeRead () RuntimeState (ErrorT String IO) a+type Runtime a = RWST RuntimeRead () RuntimeState (ExceptT String IO) a   --------------------------------------------------------------------------------

@@ -16,7 +16,6 @@   ---------------------------------------------------------------------------------import           Control.Applicative  ((<$>)) import           Control.Exception    (IOException, handle) import qualified Crypto.Hash.MD5      as MD5 import           Data.Binary          (Binary, decode, encodeFile)

@@ -16,7 +16,6 @@ import           Data.ByteString.Lazy    (ByteString) import qualified Data.ByteString.Lazy    as LB import           Data.IORef              (newIORef, readIORef, writeIORef)-import           Data.Monoid             (Monoid, mempty) import           System.Exit             (ExitCode (..)) import           System.IO               (Handle, hClose, hFlush, hGetContents,                                           hPutStr, hSetEncoding, localeEncoding)

@@ -8,7 +8,6 @@   ---------------------------------------------------------------------------------import           Control.Applicative ((<$>)) import           Control.Monad       (filterM, forM, when) import           System.Directory    (createDirectoryIfMissing,                                       doesDirectoryExist, getDirectoryContents,

@@ -7,7 +7,7 @@   ---------------------------------------------------------------------------------import           Control.Applicative ((<$>), (<*>), (<|>))+import           Control.Applicative ((<|>)) import           Control.Monad       (mzero) import qualified Text.Parsec         as P import           Text.Parsec.String  (Parser)

@@ -8,7 +8,6 @@   ---------------------------------------------------------------------------------import           Control.Applicative     ((<$>)) import           Data.Char               (isSpace) import           Data.List               (isPrefixOf) 

@@ -25,7 +25,6 @@  -------------------------------------------------------------------------------- import           Control.Monad                 ((<=<))-import           Data.Monoid                   (mconcat)   --------------------------------------------------------------------------------

@@ -13,7 +13,6 @@ -------------------------------------------------------------------------------- import           Control.Monad                  (forM_) import qualified Data.Map                       as M-import           Data.Monoid                    (mconcat) import qualified Data.Set                       as S  

@@ -22,9 +22,7 @@   ---------------------------------------------------------------------------------import           Control.Applicative        ((<$>)) import qualified Data.Set                   as S-import           Data.Traversable           (traverse) import           Text.Pandoc import           Text.Pandoc.Error          (PandocError (..)) 

@@ -23,22 +23,19 @@   ---------------------------------------------------------------------------------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 (..))   --------------------------------------------------------------------------------

@@ -63,13 +63,12 @@  -------------------------------------------------------------------------------- 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.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 @@  -------------------------------------------------------------------------------- -- | 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.

@@ -54,7 +54,7 @@ -- The @for@ macro is used for enumerating 'Context' elements that are -- lists, i.e. constructed using the 'listField' function. Assume that -- in a context we have an element @listField \"key\" c itms@. Then--- the snippet +-- the snippet -- -- > $for(key)$ -- >   $x$@@ -70,21 +70,21 @@ -- -- > listField "things" (field "thing" (return . itemBody)) -- >    (sequence [makeItem "fruits", makeItem "vegetables"])--- +-- -- and a template -- -- >  I like -- >  $for(things)$--- >    fresh $thing$$sep$, and +-- >    fresh $thing$$sep$, and -- >  $endfor$ -- -- the resulting page would look like -- -- > <p> -- >  I like--- > --- >   fresh fruits, and --- > +-- >+-- >   fresh fruits, and+-- > -- >   fresh vegetables -- > </p> --@@ -129,9 +129,8 @@  -------------------------------------------------------------------------------- import           Control.Monad                (liftM)-import           Control.Monad.Error          (MonadError (..))+import           Control.Monad.Except         (MonadError (..)) import           Data.List                    (intercalate)-import           Data.Monoid                  (mappend) import           Prelude                      hiding (id)  

@@ -18,6 +18,7 @@     , urlField     , pathField     , titleField+    , snippetField     , dateField     , dateFieldWith     , getItemUTC@@ -31,18 +32,13 @@   ---------------------------------------------------------------------------------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 +47,7 @@ import           Hakyll.Core.Provider import           Hakyll.Core.Util.String       (needlePrefix, splitAll) import           Hakyll.Web.Html+import           System.FilePath               (splitDirectories, takeBaseName)   --------------------------------------------------------------------------------@@ -147,6 +144,22 @@             "Hakyll.Web.Template.Context.mapContext: " ++             "can't map over a ListField!" +--------------------------------------------------------------------------------+-- | A context that allows snippet inclusion. In processed file, use as:+--+-- > ...+-- > $snippet("path/to/snippet/")$+-- > ...+--+-- The contents of the included file will not be interpolated.+--+snippetField :: Context String+snippetField = functionField "snippet" f+  where+    f [contentsPath] _ = loadBody (fromFilePath contentsPath)+    f _              i = error $+        "Too many arguments to function 'snippet()' in item " +++            show (itemIdentifier i)  -------------------------------------------------------------------------------- -- | A context that contains (in that order)@@ -274,7 +287,7 @@            -> 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 $

@@ -12,7 +12,7 @@   ---------------------------------------------------------------------------------import           Control.Applicative     (pure, (<$), (<$>), (<*>), (<|>))+import           Control.Applicative     ((<|>)) import           Control.Monad           (void) import           Data.Binary             (Binary, get, getWord8, put, putWord8) import           Data.Typeable           (Typeable)

@@ -5,14 +5,13 @@   --------------------------------------------------------------------------------+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 @@     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 @@  -------------------------------------------------------------------------------- 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]

@@ -6,14 +6,11 @@   ---------------------------------------------------------------------------------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 @@     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

@@ -6,15 +6,13 @@   ---------------------------------------------------------------------------------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 @@         "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"     ] 

@@ -8,22 +8,19 @@ -------------------------------------------------------------------------------- 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 @@         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