hakyll 4.5.5.1 → 4.6.0.0

raw patch · 11 files changed

+217/−77 lines, 11 filesdep ~randomPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: random

API changes (from Hackage documentation)

Files

• hakyll.cabal +3/−3
• src/Hakyll/Core/Rules.hs +25/−3
• src/Hakyll/Core/Util/Parser.hs +1/−1
• src/Hakyll/Web/Feed.hs +1/−1
• src/Hakyll/Web/Template.hs +36/−13
• src/Hakyll/Web/Template/Context.hs +35/−24
• src/Hakyll/Web/Template/Internal.hs +97/−26
• tests/Hakyll/Web/Template/Context/Tests.hs +1/−1
• tests/Hakyll/Web/Template/Tests.hs +15/−4
• tests/data/template.html +2/−1
• tests/data/template.html.out +1/−0

@@ -1,5 +1,5 @@ Name:    hakyll-Version: 4.5.5.1+Version: 4.6.0.0  Synopsis: A static website compiler library Description:@@ -163,7 +163,7 @@     pandoc-citeproc >= 0.4    && < 0.5,     parsec          >= 3.0    && < 3.2,     process         >= 1.0    && < 1.3,-    random          >= 1.0    && < 1.1,+    random          >= 1.0    && < 1.2,     regex-base      >= 0.93   && < 0.94,     regex-tdfa      >= 1.1    && < 1.3,     tagsoup         >= 0.13.1 && < 0.14,@@ -250,7 +250,7 @@     pandoc-citeproc >= 0.4    && < 0.5,     parsec          >= 3.0    && < 3.2,     process         >= 1.0    && < 1.3,-    random          >= 1.0    && < 1.1,+    random          >= 1.0    && < 1.2,     regex-base      >= 0.93   && < 0.94,     regex-tdfa      >= 1.1    && < 1.3,     tagsoup         >= 0.13.1 && < 0.14,

@@ -181,10 +181,32 @@ -- -- A useful utility for this purpose is 'makePatternDependency'. rulesExtraDependencies :: [Dependency] -> Rules a -> Rules a-rulesExtraDependencies deps = Rules . censor addDependencies . unRules+rulesExtraDependencies deps rules =+    -- Note that we add the dependencies seemingly twice here. However, this is+    -- done so that 'rulesExtraDependencies' works both if we have something+    -- like:+    --+    -- > match "*.css" $ rulesExtraDependencies [foo] $ ...+    --+    -- and something like:+    --+    -- > rulesExtraDependencies [foo] $ match "*.css" $ ...+    --+    -- (1) takes care of the latter and (2) of the former.+    Rules $ censor fixRuleSet $ do+        x <- unRules rules+        fixCompiler+        return x   where-    -- Adds the dependencies to the compilers in the ruleset-    addDependencies ruleSet = ruleSet+    -- (1) Adds the dependencies to the compilers we are yet to create+    fixCompiler = modify $ \s -> case rulesCompiler s of+        Nothing -> s+        Just c  -> s+            { rulesCompiler = Just $ compilerTellDependencies deps >> c+            }++    -- (2) Adds the dependencies to the compilers that are already in the ruleset+    fixRuleSet ruleSet = ruleSet         { rulesCompilers =             [ (i, compilerTellDependencies deps >> c)             | (i, c) <- rulesCompilers ruleSet

@@ -16,7 +16,7 @@ -------------------------------------------------------------------------------- metadataKey :: Parser String metadataKey = do-    i <- (:) <$> P.letter <*> (P.many $ P.alphaNum <|> P.oneOf " _-.")+    i <- (:) <$> P.letter <*> (P.many $ P.alphaNum <|> P.oneOf "_-.")     if i `elem` reservedKeys then mzero else return i  

@@ -96,7 +96,7 @@     -- recent.     updatedField = field "updated" $ \_ -> case items of         []      -> return "Unknown"-        (x : _) -> unContext itemContext' "updated" x >>= \cf -> case cf of+        (x : _) -> unContext itemContext' "updated" [] x >>= \cf -> case cf of             ListField _ _ -> fail "Hakyll.Web.Feed.renderFeed: Internal error"             StringField s -> return s 

@@ -115,7 +115,7 @@ -- That is, calling @$partial$@ is equivalent to just copying and pasting -- template code. ---+{-# LANGUAGE ScopedTypeVariables #-} module Hakyll.Web.Template     ( Template     , templateCompiler@@ -161,44 +161,67 @@   ---------------------------------------------------------------------------------applyTemplate' :: Template         -- ^ Template-               -> Context a        -- ^ Context-               -> Item a           -- ^ Page-               -> Compiler String  -- ^ Resulting item+applyTemplate'+    :: forall a.+       Template         -- ^ Template+    -> Context a        -- ^ Context+    -> Item a           -- ^ Page+    -> Compiler String  -- ^ Resulting item applyTemplate' tpl context x = go tpl   where+    context' :: String -> [String] -> Item a -> Compiler ContextField     context' = unContext (context `mappend` missingField)+     go = liftM concat . mapM applyElem . unTemplate +    ---------------------------------------------------------------------------++    applyElem :: TemplateElement -> Compiler String+     applyElem (Chunk c) = return c -    applyElem Escaped = return "$"+    applyElem (Expr e) = applyExpr e >>= getString e -    applyElem (Key k) = context' k x >>= getString k+    applyElem Escaped = return "$" -    applyElem (If k t mf) = (context' k x >> go t) `catchError` handler+    applyElem (If e t mf) = (applyExpr e >> go t) `catchError` handler       where         handler _ = case mf of             Nothing -> return ""             Just f  -> go f -    applyElem (For k b s) = context' k x >>= \cf -> case cf of+    applyElem (For e b s) = applyExpr e >>= \cf -> case cf of         StringField _  -> fail $             "Hakyll.Web.Template.applyTemplateWith: expected ListField but " ++-            "got StringField for key " ++ show k+            "got StringField for expr " ++ show e         ListField c xs -> do             sep <- maybe (return "") go s             bs  <- mapM (applyTemplate' b c) xs             return $ intercalate sep bs -    applyElem (Partial p) = do+    applyElem (Partial e) = do+        p    <- applyExpr e >>= getString e         tpl' <- loadBody (fromFilePath p)         applyTemplate' tpl' context x +    ---------------------------------------------------------------------------++    applyExpr :: TemplateExpr -> Compiler ContextField++    applyExpr (Ident (TemplateKey k)) = context' k [] x++    applyExpr (Call (TemplateKey k) args) = do+        args' <- mapM (\e -> applyExpr e >>= getString e) args+        context' k args' x++    applyExpr (StringLiteral s) = return (StringField s)++    ----------------------------------------------------------------------------+     getString _ (StringField s) = return s-    getString k (ListField _ _) = fail $+    getString e (ListField _ _) = fail $         "Hakyll.Web.Template.applyTemplateWith: expected StringField but " ++-        "got ListField for key " ++ show k+        "got ListField for expr " ++ show e   --------------------------------------------------------------------------------

@@ -6,6 +6,7 @@     , field     , constField     , listField+    , listFieldWith     , functionField     , mapContext @@ -33,7 +34,7 @@ import           Data.Monoid                   (Monoid (..)) import           Data.Time.Clock               (UTCTime (..)) import           Data.Time.Format              (formatTime, parseTime)-import           System.FilePath               (takeBaseName, takeFileName)+import           System.FilePath               (takeBaseName, splitDirectories) import           System.Locale                 (TimeLocale, defaultTimeLocale)  @@ -69,29 +70,30 @@ -- @ -- 'metadataField' \<\> field \"date\" fDate -- @--- +-- newtype Context a = Context-    { unContext :: String -> Item a -> Compiler ContextField+    { unContext :: String -> [String] -> Item a -> Compiler ContextField     }   -------------------------------------------------------------------------------- instance Monoid (Context a) where     mempty                          = missingField-    mappend (Context f) (Context g) = Context $ \k i -> f k i <|> g k i+    mappend (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i   -------------------------------------------------------------------------------- field' :: String -> (Item a -> Compiler ContextField) -> Context a-field' key value = Context $ \k i -> if k == key then value i else empty+field' key value = Context $ \k _ i -> if k == key then value i else empty   -------------------------------------------------------------------------------- -- | Constructs a new field in the 'Context.'-field :: String  -- ^ Key-      -> (Item a -> Compiler String) -- ^ Function that constructs a -                                     -- value based on the item-      -> Context a+field+    :: String                      -- ^ Key+    -> (Item a -> Compiler String) -- ^ Function that constructs a value based+                                   -- on the item+    -> Context a field key value = field' key (fmap StringField . value)  @@ -103,22 +105,27 @@  -------------------------------------------------------------------------------- listField :: String -> Context a -> Compiler [Item a] -> Context b-listField key c xs = field' key $ \_ -> fmap (ListField c) xs+listField key c xs = listFieldWith key c (const xs)   --------------------------------------------------------------------------------+listFieldWith+    :: String -> Context a -> (Item b -> Compiler [Item a]) -> Context b+listFieldWith key c f = field' key $ fmap (ListField c) . f+++-------------------------------------------------------------------------------- functionField :: String -> ([String] -> Item a -> Compiler String) -> Context a-functionField name value = Context $ \k i -> case words k of-    []              -> empty-    (n : args)-        | n == name -> StringField <$> value args i-        | otherwise -> empty+functionField name value = Context $ \k args i ->+    if k == name+        then StringField <$> value args i+        else empty   -------------------------------------------------------------------------------- mapContext :: (String -> String) -> Context a -> Context a-mapContext f (Context c) = Context $ \k i -> do-    fld <- c k i+mapContext f (Context c) = Context $ \k a i -> do+    fld <- c k a i     case fld of         StringField str -> return $ StringField (f str)         ListField _ _   -> fail $@@ -132,12 +139,12 @@ --     1. A @$body$@ field -- --     2. Metadata fields---        +-- --     3. A @$url$@ 'urlField' -- --     4. A @$path$@ 'pathField' -----     5. A @$title$@ 'titleField'        +--     5. A @$title$@ 'titleField' defaultContext :: Context String defaultContext =     bodyField     "body"     `mappend`@@ -162,7 +169,7 @@ -------------------------------------------------------------------------------- -- | Map any field to its metadata value, if present metadataField :: Context a-metadataField = Context $ \k i -> do+metadataField = Context $ \k _ i -> do     value <- getMetadataField (itemIdentifier i) k     maybe empty (return . StringField) value @@ -218,7 +225,11 @@ -- Alternatively, when the metadata has a field called @path@ in a -- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages) -- and no @published@ metadata field set, this function can render--- the date.+-- the date. This pattern matches the file name or directory names +-- that begins with @yyyy-mm-dd@ . For example:+-- @folder//yyyy-mm-dd-title//dist//main.extension@ .+-- In case of multiple matches, the rightmost one is used.+ dateField :: String     -- ^ Key in which the rendered date should be placed           -> String     -- ^ Format to use on the date           -> Context a  -- ^ Resulting context@@ -249,12 +260,12 @@ getItemUTC locale id' = do     metadata <- getMetadata id'     let tryField k fmt = M.lookup k metadata >>= parseTime' fmt-        fn             = takeFileName $ toFilePath id'+        paths          = splitDirectories $ toFilePath id'      maybe empty' return $ msum $         [tryField "published" fmt | fmt <- formats] ++         [tryField "date"      fmt | fmt <- formats] ++-        [parseTime' "%Y-%m-%d" $ intercalate "-" $ take 3 $ splitAll "-" fn]+        [parseTime' "%Y-%m-%d" $ intercalate "-" $ take 3 $ splitAll "-" fnCand | fnCand <- reverse paths]   where     empty'     = fail $ "Hakyll.Web.Template.Context.getItemUTC: " ++         "could not parse time for " ++ show id'@@ -306,6 +317,6 @@  -------------------------------------------------------------------------------- missingField :: Context a-missingField = Context $ \k i -> fail $+missingField = Context $ \k _ i -> fail $     "Missing field $" ++ k ++ "$ in context for item " ++     show (itemIdentifier i)

@@ -4,6 +4,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Hakyll.Web.Template.Internal     ( Template (..)+    , TemplateKey (..)+    , TemplateExpr (..)     , TemplateElement (..)     , readTemplate     ) where@@ -14,6 +16,7 @@ import           Control.Monad           (void) import           Data.Binary             (Binary, get, getWord8, put, putWord8) import           Data.Typeable           (Typeable)+import           Data.List (intercalate) import           GHC.Exts                (IsString (..)) import qualified Text.Parsec             as P import qualified Text.Parsec.String      as P@@ -38,29 +41,44 @@   --------------------------------------------------------------------------------+instance IsString Template where+    fromString = readTemplate+++--------------------------------------------------------------------------------+newtype TemplateKey = TemplateKey String+    deriving (Binary, Show, Eq, Typeable)+++--------------------------------------------------------------------------------+instance IsString TemplateKey where+    fromString = TemplateKey+++-------------------------------------------------------------------------------- -- | Elements of a template. data TemplateElement     = Chunk String-    | Key String+    | Expr TemplateExpr     | Escaped-    | If String Template (Maybe Template)   -- key, then branch, else branch-    | For String Template (Maybe Template)  -- key, body, separator-    | Partial String                        -- filename+    | If TemplateExpr Template (Maybe Template)   -- expr, then, else+    | For TemplateExpr Template (Maybe Template)  -- expr, body, separator+    | Partial TemplateExpr                        -- filename     deriving (Show, Eq, Typeable)   -------------------------------------------------------------------------------- instance Binary TemplateElement where     put (Chunk string) = putWord8 0 >> put string-    put (Key k)        = putWord8 1 >> put k+    put (Expr e)       = putWord8 1 >> put e     put (Escaped)      = putWord8 2-    put (If k t f  )   = putWord8 3 >> put k >> put t >> put f-    put (For k b s)    = putWord8 4 >> put k >> put b >> put s-    put (Partial p)    = putWord8 5 >> put p+    put (If e t f  )   = putWord8 3 >> put e >> put t >> put f+    put (For e b s)    = putWord8 4 >> put e >> put b >> put s+    put (Partial e)    = putWord8 5 >> put e      get = getWord8 >>= \tag -> case tag of         0 -> Chunk <$> get-        1 -> Key   <$> get+        1 -> Expr <$> get         2 -> pure Escaped         3 -> If <$> get <*> get <*> get         4 -> For <$> get <*> get <*> get@@ -70,11 +88,37 @@   ---------------------------------------------------------------------------------instance IsString Template where-    fromString = readTemplate+-- | Expression in a template+data TemplateExpr+    = Ident TemplateKey+    | Call TemplateKey [TemplateExpr]+    | StringLiteral String+    deriving (Eq, Typeable)   --------------------------------------------------------------------------------+instance Show TemplateExpr where+    show (Ident (TemplateKey k))   = k+    show (Call (TemplateKey k) as) =+        k ++ "(" ++ intercalate ", " (map show as) ++ ")"+    show (StringLiteral s)         = show s+++--------------------------------------------------------------------------------+instance Binary TemplateExpr where+    put (Ident k)         = putWord8 0 >> put k+    put (Call k as)       = putWord8 1 >> put k >> put as+    put (StringLiteral s) = putWord8 2 >> put s++    get = getWord8 >>= \tag -> case tag of+        0 -> Ident         <$> get+        1 -> Call          <$> get <*> get+        2 -> StringLiteral <$> get+        _ -> error $+            "Hakyll.Web.Tamplte.Internal: Error reading cached template"+++-------------------------------------------------------------------------------- readTemplate :: String -> Template readTemplate input = case P.parse template "" input of     Left err -> error $ "Cannot parse template: " ++ show err@@ -84,7 +128,7 @@ -------------------------------------------------------------------------------- template :: P.Parser Template template = Template <$>-    (P.many1 $ chunk <|> escaped <|> conditional <|> for <|> partial <|> key)+    (P.many1 $ chunk <|> escaped <|> conditional <|> for <|> partial <|> expr)   --------------------------------------------------------------------------------@@ -93,6 +137,20 @@   --------------------------------------------------------------------------------+expr :: P.Parser TemplateElement+expr = P.try $ do+    void $ P.char '$'+    e <- expr'+    void $ P.char '$'+    return $ Expr e+++--------------------------------------------------------------------------------+expr' :: P.Parser TemplateExpr+expr' = stringLiteral <|> call <|> ident+++-------------------------------------------------------------------------------- escaped :: P.Parser TemplateElement escaped = Escaped <$ (P.try $ P.string "$$") @@ -101,50 +159,63 @@ conditional :: P.Parser TemplateElement conditional = P.try $ do     void $ P.string "$if("-    i <- metadataKey+    e <- expr'     void $ P.string ")$"     thenBranch <- template     elseBranch <- P.optionMaybe $ P.try (P.string "$else$") >> template     void $ P.string "$endif$"-    return $ If i thenBranch elseBranch+    return $ If e thenBranch elseBranch   -------------------------------------------------------------------------------- for :: P.Parser TemplateElement for = P.try $ do     void $ P.string "$for("-    i <- metadataKey+    e <- expr'     void $ P.string ")$"     body <- template     sep  <- P.optionMaybe $ P.try (P.string "$sep$") >> template     void $ P.string "$endfor$"-    return $ For i body sep+    return $ For e body sep   -------------------------------------------------------------------------------- partial :: P.Parser TemplateElement partial = P.try $ do     void $ P.string "$partial("-    i <- stringLiteral+    e <- expr'     void $ P.string ")$"-    return $ Partial i+    return $ Partial e   ---------------------------------------------------------------------------------key :: P.Parser TemplateElement-key = P.try $ do-    void $ P.char '$'-    k <- metadataKey-    void $ P.char '$'-    return $ Key k+ident :: P.Parser TemplateExpr+ident = P.try $ Ident <$> key   ---------------------------------------------------------------------------------stringLiteral :: P.Parser String+call :: P.Parser TemplateExpr+call = P.try $ do+    f <- key+    void $ P.char '('+    P.spaces+    as <- P.sepBy expr' (P.spaces >> P.char ',' >> P.spaces)+    P.spaces+    void $ P.char ')'+    return $ Call f as+++--------------------------------------------------------------------------------+stringLiteral :: P.Parser TemplateExpr stringLiteral = do     void $ P.char '\"'     str <- P.many $ do         x <- P.noneOf "\""         if x == '\\' then P.anyChar else return x     void $ P.char '\"'-    return str+    return $ StringLiteral str+++--------------------------------------------------------------------------------+key :: P.Parser TemplateKey+key = TemplateKey <$> metadataKey

@@ -51,7 +51,7 @@ testContextDone store provider identifier key context =     testCompilerDone store provider identifier $ do         item <- getResourceBody-        cf   <- unContext context key item+        cf   <- unContext context key [] item         case cf of             StringField str -> return str             ListField _ _   -> error $

@@ -26,9 +26,20 @@  -------------------------------------------------------------------------------- tests :: Test-tests = testGroup "Hakyll.Core.Template.Tests"-    [ testCase "case01"                case01-    , testCase "applyJoinTemplateList" testApplyJoinTemplateList+tests = testGroup "Hakyll.Core.Template.Tests" $ concat+    [ [ testCase "case01"                case01+      , testCase "applyJoinTemplateList" testApplyJoinTemplateList+      ]++    , fromAssertions "readTemplate"+        [ Template [Chunk "Hello ", Expr (Call "guest" [])]+            @=?  readTemplate "Hello $guest()$"+        , Template+            [If (Call "a" [StringLiteral "bar"])+                (Template [Chunk "foo"])+                Nothing]+            @=?  readTemplate "$if(a(\"bar\"))$foo$endif$"+        ]     ]  @@ -76,4 +87,4 @@   where     i1  = Item "item1" "Hello"     i2  = Item "item2" "World"-    tpl = Template [Chunk "<b>", Key "body", Chunk "</b>"]+    tpl = Template [Chunk "<b>", Expr (Ident "body"), Chunk "</b>"]

@@ -1,7 +1,8 @@ <div>     I'm so rich I have $$3. -    $rev foo$+    $rev("foo")$+    $rev(rev("foo"))$      $if(body)$     I have body

@@ -2,6 +2,7 @@     I'm so rich I have $3.      oof+    foo           I have body