/index.html'
+> route idRoute
+>
+> -- create content without a source file from disk
+> compile $ makeItem ("Hello World
" :: String)
+Note how you can use 'Hakyll.Core.Compiler.makeItem' to create content inline
+(to be processed as a 'Hakyll.Core.Compiler.Compiler' value) as if that content
+was loaded from a file (as it's the case when using 'match').
+To control where the compilation result will be written out, use routing
+functions like 'Hakyll.Core.Routes.idRoute'.
+-}
+create :: [Identifier] -- ^ Identifiers to assign to created content in next argument
+ -> Rules () -- ^ Remaining processing parts that must create content
+ -> Rules () -- ^ Resulting rule
create ids rules = do
flush
-- TODO Maybe check if the resources exist and call tellResources on that
@@ -151,7 +279,54 @@
--------------------------------------------------------------------------------
-version :: String -> Rules () -> Rules ()
+{- | Add the given version name to the implicit identifier(s) under which the
+compilation result of the given remaining 'Rules' value is saved to the
+'Hakyll.Core.Store.Store'.
+See 'Hakyll.Core.Identifier.Identifier' for details.
+
+Use this wrapper function for example when you need to compile the same source
+file into two or more different results, each with a different version name.
+The version is needed to distinguish between these different compilation results
+in the store, otherwise they would get the same conflicting identifier in the
+store.
+
+Warning:
+__If you add a version name with this function, you need to supply the same name__
+when you 'Hakyll.Core.Compiler.load' the content from the store from
+within another rule.
+
+=== __Examples__
+__Compile source file into differently versioned outputs and load both__
+
+> -- e.g. file on disk: 'posts/hakyll.md'
+>
+> -- saved with implicit identifier ('posts/hakyll.md', no-version)
+> match "posts/*" $ do
+> route $ setExtension "html"
+> compile pandocCompiler
+>
+> -- saved with implicit identifier ('posts/hakyll.md', version 'raw')
+> match "posts/*" $ version "raw" $ do
+> route idRoute
+> compile getResourceBody
+>
+> -- use compilation results from rules above
+> create ["index.html"] $ do
+> route idRoute
+> compile $ do
+> -- load no-version version
+> compiledPost <- load (fromFilePath "posts/hakyll.md")
+> -- load version 'raw'
+> rawPost <- load . setVersion (Just "raw") $ fromFilePath "posts/hakyll.md"
+> ...
+Note how a version name is needed to distinguish the unversioned and the "raw"
+version when loading the Hakyll post for the @index.html@ page.
+To control where the compilation result will be written out, use routing
+functions like 'Hakyll.Core.Routes.idRoute' and 'Hakyll.Core.Routes.setExtension'.
+-}
+version :: String -- ^ Version name to add
+ -> Rules () -- ^ Remaining processing parts
+ -> Rules () -- ^ Result
version v rules = do
flush
Rules $ local setVersion' $ unRules $ rules >> flush
@@ -160,19 +335,116 @@
--------------------------------------------------------------------------------
--- | Add a compilation rule to the rules.
---
--- This instructs all resources to be compiled using the given compiler.
-compile :: (Binary a, Typeable a, Writable a) => Compiler (Item a) -> Rules ()
+{- | Add (or replace) the given compilation steps within the given
+'Hakyll.Core.Compiler.Compiler' value to the current 'Rules' value.
+__This functions controls HOW the content within a rule is processed__ (use one
+of the 'match' functions to control WHAT content is processed).
+
+The compilation result is saved to the 'Hakyll.Core.Store.Store' under an
+implicit identifier.
+See 'Hakyll.Core.Identifier.Identifier' for details.
+
+If there's routing attached to the rule where this function is used, the
+compilation result is also written out to a file according to that route.
+See 'route' and 'Hakyll.Core.Routes.Routes' for details.
+
+=== __Examples__
+__Compile Markdown to HTML__
+
+> -- Select all Markdown files in 'posts' directory
+> match "posts/**.md" $ do
+>
+> route $ setExtension "html"
+>
+> -- use pandoc to transform Markdown to HTML in a single step
+> compile pandocCompiler
+Note how we set the content to be processed with
+'Hakyll.Web.Pandoc.pandocCompiler'. The content comes implicitly from the
+matched Markdown files on disk. We don't have to pass that content around
+manually. Every file is processed the same way within this one rule.
+
+To control where the compilation result will be written out, use routing
+functions like 'Hakyll.Core.Routes.setExtension'.
+Here the compilation result of a file like @posts\/hakyll.md@ is written out
+to @posts\/hakyll.html@.
+
+__Compile Markdown to HTML and embed it in a template__
+
+> -- Select all Markdown files in 'posts' directory
+> match "posts/**.md" $ do
+> route $ setExtension "html"
+> compile $
+> pandocCompiler >>=
+> loadAndApplyTemplate "templates/post.html" defaultContext
+>
+> -- To Hakyll templates are just plain files that have to be processed
+> -- and placed into the store like any other file (but without routing).
+> -- e.g. file on disk: 'templates/post.html'
+> match "templates/*" $ compile templateBodyCompiler
+Note how a Markdown post that is compiled to HTML using
+'Hakyll.Web.Pandoc.pandocCompiler' in a first step and then embedded into
+a HTMl 'Hakyll.Web.Template.Template' in a second step by using
+'Hakyll.Web.Template.loadAndApplyTemplate'.
+We can use templates to control the design and layout of a webpage.
+A template may look as follows:
+
+> $title$
+> $body$
+See "Hakyll.Web.Template" to see examples of the templating syntax.
+-}
+compile :: (Binary a, Typeable a, Writable a) => Compiler (Item a) -- ^ How to transform content
+ -> Rules () -- ^ Result
compile compiler = Rules $ modify $ \s ->
s {rulesCompiler = Just (fmap SomeItem compiler)}
--------------------------------------------------------------------------------
--- | Add a route.
---
--- This adds a route for all items matching the current pattern.
-route :: Routes -> Rules ()
+{- | Add (or replace) routing in the current 'Rules' value.
+__This functions controls IF and WHERE the compiled results are written out__
+(use one of the 'match' functions to control WHAT content is processed and
+'compile' to control HOW).
+See 'Hakyll.Core.Routes.Routes' and 'Hakyll.Core.Identifier.Identifier' for
+details on how output filepaths are computed.
+
+Hint:
+__If there's no route attached to a rule, the compilation result is not written out__.
+However, the compilation result is saved to the 'Hakyll.Core.Store.Store'
+and can be loaded and used within another rule. This behavior is needed,
+for example, for templates.
+
+=== __Examples__
+__Rules with and without routing__
+
+> -- e.g. file on disk: 'templates/post.html'
+>
+> -- Rule 1 (without routing)
+> match "templates/*" $ do
+> -- compilation result saved to store with implicit identifier, e.g. 'templates/post.html'
+> compile templateCompiler
+>
+> -- Rule 2 (with routing)
+> match "posts/**.md" $ do
+> route $ setExtension "html"
+> compile $ do
+> -- load compiled result of other rule with explicit identifier.
+> postTemplate <- loadBody "templates/post.html"
+> pandocCompiler >>= applyTemplate postTemplate defaultContext
+Note that we don't set a route in the first rule to avoid writing out our
+compiled templates.
+However, we can still 'Hakyll.Core.Compiler.load' (or
+'Hakyll.Core.Compiler.loadBody') the compiled templates to apply them in a
+second rule.
+The content for 'Hakyll.Web.Template.templateCompiler' comes implicitly from the
+matched template files on disk. We don't have to pass that content around
+manually. See 'match' and 'compile' for details.
+
+To control where a compilation result will be written out (as done in the second
+rule), use routing functions like 'Hakyll.Core.Routes.setExtension'.
+
+See "Hakyll.Web.Template" for examples of templates and the templating syntax.
+-}
+route :: Routes -- ^ Where to output compilation results
+ -> Rules () -- ^ Result
route route' = Rules $ modify $ \s -> s {rulesRoute = Just route'}
diff --git a/lib/Hakyll/Core/Rules/Internal.hs b/lib/Hakyll/Core/Rules/Internal.hs
--- a/lib/Hakyll/Core/Rules/Internal.hs
+++ b/lib/Hakyll/Core/Rules/Internal.hs
@@ -13,14 +13,13 @@
--------------------------------------------------------------------------------
+#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail)
+#endif
import Control.Monad.Reader (ask)
import Control.Monad.RWS (RWST, runRWST)
import Control.Monad.Trans (liftIO)
import qualified Data.Map as M
-#if MIN_VERSION_base(4,9,0)
-import Data.Semigroup (Semigroup (..))
-#endif
import Data.Set (Set)
@@ -57,7 +56,6 @@
--------------------------------------------------------------------------------
-#if MIN_VERSION_base(4,9,0)
instance Semigroup RuleSet where
(<>) (RuleSet r1 c1 s1 p1) (RuleSet r2 c2 s2 p2) =
RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2) (p1 .||. p2)
@@ -65,12 +63,6 @@
instance Monoid RuleSet where
mempty = RuleSet mempty mempty mempty mempty
mappend = (<>)
-#else
-instance Monoid RuleSet where
- mempty = RuleSet mempty mempty mempty mempty
- mappend (RuleSet r1 c1 s1 p1) (RuleSet r2 c2 s2 p2) =
- RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2) (p1 .||. p2)
-#endif
--------------------------------------------------------------------------------
diff --git a/lib/Hakyll/Core/Store.hs b/lib/Hakyll/Core/Store.hs
--- a/lib/Hakyll/Core/Store.hs
+++ b/lib/Hakyll/Core/Store.hs
@@ -16,14 +16,18 @@
--------------------------------------------------------------------------------
-import qualified Data.Hashable as DH
+import Control.Monad (when)
import Data.Binary (Binary, decode, encodeFile)
import qualified Data.ByteString.Lazy as BL
import qualified Data.Cache.LRU.IO as Lru
+import qualified Data.Hashable as DH
+import qualified Data.IORef as IORef
import Data.List (intercalate)
+import qualified Data.Map as Map
import Data.Maybe (isJust)
import Data.Typeable (TypeRep, Typeable, cast, typeOf)
-import System.Directory (createDirectoryIfMissing, doesFileExist, removeFile)
+import System.Directory (createDirectoryIfMissing, doesFileExist,
+ removeFile)
import System.FilePath (())
import System.IO (IOMode (..), hClose, openFile)
import System.IO.Error (catchIOError, ioeSetFileName,
@@ -38,9 +42,11 @@
--------------------------------------------------------------------------------
data Store = Store
{ -- | All items are stored on the filesystem
- storeDirectory :: FilePath
- , -- | Optionally, items are also kept in-memory
- storeMap :: Maybe (Lru.AtomicLRU FilePath Box)
+ storeDirectory :: FilePath
+ , -- | See 'set'
+ storeWriteAhead :: IORef.IORef (Map.Map String Box)
+ -- | Optionally, items are also kept in-memory
+ , storeMap :: Maybe (Lru.AtomicLRU FilePath Box)
}
@@ -72,10 +78,12 @@
-> IO Store -- ^ Store
new inMemory directory = do
createDirectoryIfMissing True directory
+ writeAhead <- IORef.newIORef Map.empty
ref <- if inMemory then Just <$> Lru.newAtomicLRU csize else return Nothing
return Store
- { storeDirectory = directory
- , storeMap = ref
+ { storeDirectory = directory
+ , storeWriteAhead = writeAhead
+ , storeMap = ref
}
where
csize = Just 500
@@ -92,16 +100,16 @@
--------------------------------------------------------------------------------
-- | Auxiliary: add an item to the in-memory cache
cacheInsert :: Typeable a => Store -> String -> a -> IO ()
-cacheInsert (Store _ Nothing) _ _ = return ()
-cacheInsert (Store _ (Just lru)) key x =
+cacheInsert (Store _ _ Nothing) _ _ = return ()
+cacheInsert (Store _ _ (Just lru)) key x =
Lru.insert key (Box x) lru
--------------------------------------------------------------------------------
-- | Auxiliary: get an item from the in-memory cache
cacheLookup :: forall a. Typeable a => Store -> String -> IO (Result a)
-cacheLookup (Store _ Nothing) _ = return NotFound
-cacheLookup (Store _ (Just lru)) key = do
+cacheLookup (Store _ _ Nothing) _ = return NotFound
+cacheLookup (Store _ _ (Just lru)) key = do
res <- Lru.lookup key lru
return $ case res of
Nothing -> NotFound
@@ -112,15 +120,15 @@
--------------------------------------------------------------------------------
cacheIsMember :: Store -> String -> IO Bool
-cacheIsMember (Store _ Nothing) _ = return False
-cacheIsMember (Store _ (Just lru)) key = isJust <$> Lru.lookup key lru
+cacheIsMember (Store _ _ Nothing) _ = return False
+cacheIsMember (Store _ _ (Just lru)) key = isJust <$> Lru.lookup key lru
--------------------------------------------------------------------------------
-- | Auxiliary: delete an item from the in-memory cache
cacheDelete :: Store -> String -> IO ()
-cacheDelete (Store _ Nothing) _ = return ()
-cacheDelete (Store _ (Just lru)) key = do
+cacheDelete (Store _ _ Nothing) _ = return ()
+cacheDelete (Store _ _ (Just lru)) key = do
_ <- Lru.delete key lru
return ()
@@ -129,31 +137,61 @@
-- | Store an item
set :: (Binary a, Typeable a) => Store -> [String] -> a -> IO ()
set store identifier value = withStore store "set" (\key path -> do
- encodeFile path value
+ -- We need to avoid concurrent writes to the filesystem. Imagine the
+ -- follow scenario:
+ --
+ -- * We compile multiple posts
+ -- * All of these fetch some common metadata
+ -- * This metadata is missing; we fetch it and then store it.
+ --
+ -- To solve this, we skip duplicate writes by tracking their status
+ -- in 'storeWriteAhead'. Since this set will usually be small, the
+ -- required locking should be fast. Additionally the actual IO operation
+ -- still happens outside of the locking.
+ first <- IORef.atomicModifyIORef' (storeWriteAhead store) $
+ \wa -> case Map.lookup key wa of
+ Nothing -> (Map.insert key (Box value) wa, True)
+ Just _ -> (wa, False)
+
cacheInsert store key value
+
+ -- Only the thread that stored the writeAhead should actually write this
+ -- file. That way, only one thread at a time will try to write this.
+ -- Release the writeAhead value once we're done.
+ when first $ do
+ encodeFile path value
+ IORef.atomicModifyIORef' (storeWriteAhead store) $
+ \wa -> (Map.delete key wa, ())
) identifier
--------------------------------------------------------------------------------
-- | Load an item
-get :: (Binary a, Typeable a) => Store -> [String] -> IO (Result a)
+get :: forall a. (Binary a, Typeable a) => Store -> [String] -> IO (Result a)
get store = withStore store "get" $ \key path -> do
- -- First check the in-memory map
- ref <- cacheLookup store key
- case ref of
- -- Not found in the map, try the filesystem
- NotFound -> do
- exists <- doesFileExist path
- if not exists
- -- Not found in the filesystem either
- then return NotFound
- -- Found in the filesystem
- else do
- v <- decodeClose path
- cacheInsert store key v
- return $ Found v
- -- Found in the in-memory map (or wrong type), just return
- s -> return s
+ -- Check the writeAhead value
+ writeAhead <- IORef.readIORef $ storeWriteAhead store
+ case Map.lookup key writeAhead of
+ Just (Box x) -> case cast x of
+ Just x' -> pure $ Found x'
+ Nothing -> pure $ WrongType (typeOf (undefined :: a)) (typeOf x)
+ Nothing -> do
+ -- Check the in-memory map
+ ref <- cacheLookup store key
+ case ref of
+ -- Not found in the map, try the filesystem
+ NotFound -> do
+ exists <- doesFileExist path
+ if not exists
+ -- Not found in the filesystem either
+ then return NotFound
+ -- Found in the filesystem
+ else do
+ v <- decodeClose path
+ cacheInsert store key v
+ return $ Found v
+ -- Found in the in-memory map (or wrong type), just return
+ s -> return s
where
-- 'decodeFile' from Data.Binary which closes the file ASAP
decodeClose path = do
@@ -167,8 +205,12 @@
-- | Strict function
isMember :: Store -> [String] -> IO Bool
isMember store = withStore store "isMember" $ \key path -> do
- inCache <- cacheIsMember store key
- if inCache then return True else doesFileExist path
+ writeAhead <- IORef.readIORef $ storeWriteAhead store
+ if Map.member key writeAhead
+ then pure True
+ else do
+ inCache <- cacheIsMember store key
+ if inCache then return True else doesFileExist path
--------------------------------------------------------------------------------
diff --git a/lib/Hakyll/Core/Util/File.hs b/lib/Hakyll/Core/Util/File.hs
--- a/lib/Hakyll/Core/Util/File.hs
+++ b/lib/Hakyll/Core/Util/File.hs
@@ -10,13 +10,18 @@
--------------------------------------------------------------------------------
-import Control.Concurrent (threadDelay)
-import Control.Exception (SomeException, catch)
-import Control.Monad (filterM, forM, when)
+import Control.Monad (filterM, forM)
import System.Directory (createDirectoryIfMissing,
- doesDirectoryExist, getDirectoryContents,
- removeDirectoryRecursive, removePathForcibly)
+ doesDirectoryExist, getDirectoryContents)
import System.FilePath (takeDirectory, ())
+#ifndef mingw32_HOST_OS
+import Control.Monad (when)
+import System.Directory (removeDirectoryRecursive)
+#else
+import Control.Concurrent (threadDelay)
+import Control.Exception (SomeException, catch)
+import System.Directory (removePathForcibly)
+#endif
--------------------------------------------------------------------------------
@@ -66,19 +71,17 @@
-- https://github.com/haskell/directory/issues/96
-- https://github.com/haskell/win32/pull/129
--
--- The hacky solution is to retry deleting directories a few times,
+-- The hacky solution is to retry deleting directories a few times,
-- with a delay, on Windows only.
removeDirectory = retryWithDelay 10 . removePathForcibly
-#endif
-
--------------------------------------------------------------------------------
-- | Retry an operation at most /n/ times (/n/ must be positive).
-- If the operation fails the /n/th time it will throw that final exception.
-- A delay of 100ms is introduced between every retry.
retryWithDelay :: Int -> IO a -> IO a
-retryWithDelay i x
+retryWithDelay i x
| i <= 0 = error "Hakyll.Core.Util.File.retry: retry count must be 1 or more"
| i == 1 = x
| otherwise = catch x $ \(_::SomeException) -> threadDelay 100 >> retryWithDelay (i-1) x
-
+#endif
diff --git a/lib/Hakyll/Main.hs b/lib/Hakyll/Main.hs
--- a/lib/Hakyll/Main.hs
+++ b/lib/Hakyll/Main.hs
@@ -1,7 +1,5 @@
--------------------------------------------------------------------------------
-- | Module providing the main hakyll function and command-line argument parsing
-{-# LANGUAGE CPP #-}
-
module Hakyll.Main
( -- * Entry points
hakyll
@@ -15,6 +13,7 @@
, Command(..)
, optionParser
, commandParser
+ , defaultCommands
, defaultParser
, defaultParserPure
, defaultParserPrefs
@@ -29,7 +28,6 @@
--------------------------------------------------------------------------------
-import Data.Monoid ((<>))
import qualified Options.Applicative as OA
@@ -153,47 +151,49 @@
commandParser :: Config.Configuration -> OA.Parser Command
-commandParser conf = OA.subparser $ foldr ((<>) . produceCommand) mempty commands
+commandParser conf = OA.subparser $ foldr ((<>) . produceCommand) mempty (defaultCommands conf)
where
- portParser = OA.option OA.auto (OA.long "port" <> OA.help "Port to listen on" <> OA.value (Config.previewPort conf))
- hostParser = OA.strOption (OA.long "host" <> OA.help "Host to bind on" <> OA.value (Config.previewHost conf))
-
produceCommand (c,a,b) = OA.command c (OA.info (OA.helper <*> a) (b))
- commands =
- [ ( "build"
- , pure Build <*> OA.flag RunModeNormal RunModePrintOutOfDate (OA.long "dry-run" <> OA.help "Don't build, only print out-of-date items")
- , OA.fullDesc <> OA.progDesc "Generate the site"
- )
- , ( "check"
- , pure Check <*> OA.switch (OA.long "internal-links" <> OA.help "Check internal links only")
- , OA.fullDesc <> OA.progDesc "Validate the site output"
- )
- , ( "clean"
- , pure Clean
- , OA.fullDesc <> OA.progDesc "Clean up and remove cache"
- )
- , ( "deploy"
- , pure Deploy
- , OA.fullDesc <> OA.progDesc "Upload/deploy your site"
- )
- , ( "preview"
- , pure Preview <*> portParser
- , OA.fullDesc <> OA.progDesc "[DEPRECATED] Please use the watch command"
- )
- , ( "rebuild"
- , pure Rebuild
- , OA.fullDesc <> OA.progDesc "Clean and build again"
- )
- , ( "server"
- , pure Server <*> hostParser <*> portParser
- , OA.fullDesc <> OA.progDesc "Start a preview server"
- )
- , ( "watch"
- , pure Watch <*> hostParser <*> portParser <*> OA.switch (OA.long "no-server" <> OA.help "Disable the built-in web server")
- , OA.fullDesc <> OA.progDesc "Autocompile on changes and start a preview server. You can watch and recompile without running a server with --no-server."
- )
- ]
+
+defaultCommands :: Config.Configuration -> [(String, OA.Parser Command, OA.InfoMod a)]
+defaultCommands conf =
+ [ ( "build"
+ , pure Build <*> OA.flag RunModeNormal RunModePrintOutOfDate (OA.long "dry-run" <> OA.help "Don't build, only print out-of-date items")
+ , OA.fullDesc <> OA.progDesc "Generate the site"
+ )
+ , ( "check"
+ , pure Check <*> OA.switch (OA.long "internal-links" <> OA.help "Check internal links only")
+ , OA.fullDesc <> OA.progDesc "Validate the site output"
+ )
+ , ( "clean"
+ , pure Clean
+ , OA.fullDesc <> OA.progDesc "Clean up and remove cache"
+ )
+ , ( "deploy"
+ , pure Deploy
+ , OA.fullDesc <> OA.progDesc "Upload/deploy your site"
+ )
+ , ( "preview"
+ , pure Preview <*> portParser
+ , OA.fullDesc <> OA.progDesc "[DEPRECATED] Please use the watch command"
+ )
+ , ( "rebuild"
+ , pure Rebuild
+ , OA.fullDesc <> OA.progDesc "Clean and build again"
+ )
+ , ( "server"
+ , pure Server <*> hostParser <*> portParser
+ , OA.fullDesc <> OA.progDesc "Start a preview server"
+ )
+ , ( "watch"
+ , pure Watch <*> hostParser <*> portParser <*> OA.switch (OA.long "no-server" <> OA.help "Disable the built-in web server")
+ , OA.fullDesc <> OA.progDesc "Autocompile on changes and start a preview server. You can watch and recompile without running a server with --no-server."
+ )
+ ]
+ where
+ portParser = OA.option OA.auto (OA.long "port" <> OA.help "Port to listen on" <> OA.value (Config.previewPort conf))
+ hostParser = OA.strOption (OA.long "host" <> OA.help "Host to bind on" <> OA.value (Config.previewHost conf))
--------------------------------------------------------------------------------
diff --git a/lib/Hakyll/Preview/Poll.hs b/lib/Hakyll/Preview/Poll.hs
--- a/lib/Hakyll/Preview/Poll.hs
+++ b/lib/Hakyll/Preview/Poll.hs
@@ -18,7 +18,7 @@
#ifdef mingw32_HOST_OS
import Control.Concurrent (threadDelay)
-import Control.Exception (IOException, throw, try)
+import Control.Exception (IOException, try)
import System.Directory (doesFileExist)
import System.Exit (exitFailure)
import System.FilePath (())
diff --git a/lib/Hakyll/Preview/Server.hs b/lib/Hakyll/Preview/Server.hs
--- a/lib/Hakyll/Preview/Server.hs
+++ b/lib/Hakyll/Preview/Server.hs
@@ -18,15 +18,14 @@
import qualified Hakyll.Core.Logger as Logger
staticServer :: Logger -- ^ Logger
- -> FilePath -- ^ Directory to serve
+ -> Static.StaticSettings -- ^ Static file server settings
-> String -- ^ Host to bind on
-> Int -- ^ Port to listen on
-> IO () -- ^ Blocks forever
-staticServer logger directory host port = do
+staticServer logger settings host port = do
Logger.header logger $ "Listening on http://" ++ host ++ ":" ++ show port
Logger.flush logger -- ensure this line is logged before Warp errors
- Warp.runSettings warpSettings $
- Static.staticApp (Static.defaultFileServerSettings directory)
+ Warp.runSettings warpSettings $ Static.staticApp settings
where
warpSettings = Warp.setLogger noLog
$ Warp.setHost (fromString host)
diff --git a/lib/Hakyll/Web/Feed.hs b/lib/Hakyll/Web/Feed.hs
--- a/lib/Hakyll/Web/Feed.hs
+++ b/lib/Hakyll/Web/Feed.hs
@@ -73,7 +73,8 @@
feedDescription :: String
, -- | Name of the feed author.
feedAuthorName :: String
- , -- | Email of the feed author.
+ , -- | Email of the feed author. Set this to the empty String to leave out
+ -- the email address.
feedAuthorEmail :: String
, -- | Absolute root URL of the feed site (e.g. @http://jaspervdj.be@)
feedRoot :: String
@@ -102,7 +103,7 @@
[ itemContext
, constField "root" (feedRoot config)
, constField "authorName" (feedAuthorName config)
- , constField "authorEmail" (feedAuthorEmail config)
+ , emailField
]
feedContext = mconcat
@@ -110,7 +111,7 @@
, constField "title" (feedTitle config)
, constField "description" (feedDescription config)
, constField "authorName" (feedAuthorName config)
- , constField "authorEmail" (feedAuthorEmail config)
+ , emailField
, constField "root" (feedRoot config)
, urlField "url"
, updatedField
@@ -124,6 +125,10 @@
(x : _) -> unContext itemContext' "updated" [] x >>= \cf -> case cf of
StringField s -> return s
_ -> fail "Hakyll.Web.Feed.renderFeed: Internal error"
+
+ emailField = case feedAuthorEmail config of
+ "" -> missingField
+ email -> constField "authorEmail" email
--------------------------------------------------------------------------------
-- | Render an RSS feed using given templates with a number of items.
diff --git a/lib/Hakyll/Web/Html.hs b/lib/Hakyll/Web/Html.hs
--- a/lib/Hakyll/Web/Html.hs
+++ b/lib/Hakyll/Web/Html.hs
@@ -4,6 +4,7 @@
( -- * Generic
withTags
, withTagList
+ , withTagListM
-- * Headers
, demoteHeaders
@@ -23,13 +24,14 @@
--------------------------------------------------------------------------------
+import Control.Monad (void)
+import Control.Monad.Identity (Identity(runIdentity))
import Data.Char (digitToInt, intToDigit,
isDigit, toLower)
import Data.Either (fromRight)
import Data.List (isPrefixOf, intercalate)
import Data.Maybe (fromMaybe)
import qualified Data.Set as S
-import Control.Monad (void)
import System.FilePath (joinPath, splitPath,
takeDirectory)
import Text.Blaze.Html (toHtml)
@@ -51,7 +53,12 @@
-- | Map over all tags (as list) in the document
withTagList :: ([TS.Tag String] -> [TS.Tag String]) -> String -> String
-withTagList f = renderTags' . f . parseTags'
+withTagList f = runIdentity . withTagListM (pure . f)
+
+-- | Map over all tags (as list) in the document, in a monad
+withTagListM :: Monad m => ([TS.Tag String] -> m [TS.Tag String]) -> String -> m String
+withTagListM f = fmap renderTags' . f . parseTags'
+{-# INLINE withTagListM #-}
--------------------------------------------------------------------------------
-- | Map every @h1@ to an @h2@, @h2@ to @h3@, etc.
diff --git a/lib/Hakyll/Web/Meta/TwitterCard.hs b/lib/Hakyll/Web/Meta/TwitterCard.hs
--- a/lib/Hakyll/Web/Meta/TwitterCard.hs
+++ b/lib/Hakyll/Web/Meta/TwitterCard.hs
@@ -59,5 +59,5 @@
twitterCardTemplateString :: String
twitterCardTemplateString =
"\
- \$if(twitter-creator)$$endif$\
- \$if(twitter-site)$$endif$"
+ \$if(twitter-creator)$$endif$\
+ \$if(twitter-site)$$endif$"
diff --git a/lib/Hakyll/Web/Pandoc/Biblio.hs b/lib/Hakyll/Web/Pandoc/Biblio.hs
--- a/lib/Hakyll/Web/Pandoc/Biblio.hs
+++ b/lib/Hakyll/Web/Pandoc/Biblio.hs
@@ -10,7 +10,8 @@
-- source into a 'Pandoc' type and need to add processing for the bibliography,
-- you can use 'processPandocBiblio' instead.
-- 'pandocBiblioCompiler' is a convenience wrapper which works like 'pandocCompiler',
--- but also takes paths to compiled bibliography and csl files.
+-- but also takes paths to compiled bibliography and csl files;
+-- 'pandocBibliosCompiler' is similar but instead takes a glob pattern for bib files.
{-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -25,6 +26,7 @@
, processPandocBiblio
, processPandocBiblios
, pandocBiblioCompiler
+ , pandocBibliosCompiler
) where
@@ -40,6 +42,7 @@
import Hakyll.Core.Compiler
import Hakyll.Core.Compiler.Internal
import Hakyll.Core.Identifier
+import Hakyll.Core.Identifier.Pattern (fromGlob)
import Hakyll.Core.Item
import Hakyll.Core.Writable
import Hakyll.Web.Pandoc
@@ -131,7 +134,7 @@
, Pandoc.FileInfo zeroTime . unBiblio . itemBody $ y
)
)
- [0 ..]
+ [0 :: Integer ..]
biblios
stFiles = foldr ((.) . uncurry Pandoc.insertInFileTree)
@@ -167,6 +170,19 @@
bib <- load $ fromFilePath bibFileName
liftM writePandoc
(getResourceBody >>= readPandocBiblio ropt csl bib)
+ where ropt = defaultHakyllReaderOptions
+ { -- The following option enables citation rendering
+ readerExtensions = enableExtension Ext_citations $ readerExtensions defaultHakyllReaderOptions
+ }
+
+--------------------------------------------------------------------------------
+-- | Compiles a markdown file via Pandoc. Requires the .csl and .bib files to be known to the compiler via match statements.
+pandocBibliosCompiler :: String -> String -> Compiler (Item String)
+pandocBibliosCompiler cslFileName bibFileName = do
+ csl <- load $ fromFilePath cslFileName
+ bibs <- loadAll $ fromGlob bibFileName
+ liftM writePandoc
+ (getResourceBody >>= readPandocBiblios ropt csl bibs)
where ropt = defaultHakyllReaderOptions
{ -- The following option enables citation rendering
readerExtensions = enableExtension Ext_citations $ readerExtensions defaultHakyllReaderOptions
diff --git a/lib/Hakyll/Web/Redirect.hs b/lib/Hakyll/Web/Redirect.hs
--- a/lib/Hakyll/Web/Redirect.hs
+++ b/lib/Hakyll/Web/Redirect.hs
@@ -6,7 +6,6 @@
, createRedirects
) where
-import Control.Applicative ((<$>))
import Control.Monad (forM_, when)
import Data.Binary (Binary (..))
import Data.List (sort, group)
diff --git a/lib/Hakyll/Web/Tags.hs b/lib/Hakyll/Web/Tags.hs
--- a/lib/Hakyll/Web/Tags.hs
+++ b/lib/Hakyll/Web/Tags.hs
@@ -58,6 +58,7 @@
, tagsField
, tagsFieldWith
, categoryField
+ , simpleRenderLink
, sortTagsBy
, caseInsensitiveTags
) where
@@ -283,7 +284,7 @@
renderTagList = renderTags makeLink (intercalate ", ")
where
makeLink tag url count _ _ = renderHtml $
- H.a ! A.href (toValue url) $ toHtml (tag ++ " (" ++ show count ++ ")")
+ H.a ! A.href (toValue url) ! A.rel "tag" $ toHtml (tag ++ " (" ++ show count ++ ")")
--------------------------------------------------------------------------------
@@ -335,6 +336,7 @@
simpleRenderLink tag (Just filePath) = Just $
H.a ! A.title (H.stringValue ("All pages tagged '"++tag++"'."))
! A.href (toValue $ toUrl filePath)
+ ! (A.rel "tag")
$ toHtml tag
diff --git a/lib/Hakyll/Web/Template/Context.hs b/lib/Hakyll/Web/Template/Context.hs
--- a/lib/Hakyll/Web/Template/Context.hs
+++ b/lib/Hakyll/Web/Template/Context.hs
@@ -54,11 +54,10 @@
--------------------------------------------------------------------------------
import Control.Applicative (Alternative (..))
import Control.Monad (msum)
+#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail)
-import Data.List (intercalate, tails)
-#if MIN_VERSION_base(4,9,0)
-import Data.Semigroup (Semigroup (..))
#endif
+import Data.List (intercalate, tails)
import Data.Time.Clock (UTCTime (..))
import Data.Time.Format (formatTime, parseTimeM)
import Data.Time.Locale.Compat (TimeLocale, defaultTimeLocale)
@@ -106,18 +105,12 @@
--------------------------------------------------------------------------------
-- | Tries to find a key in the left context,
-- or when that fails in the right context.
-#if MIN_VERSION_base(4,9,0)
instance Semigroup (Context a) where
(<>) (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i
instance Monoid (Context a) where
mempty = missingField
mappend = (<>)
-#else
-instance Monoid (Context a) where
- mempty = missingField
- mappend (Context f) (Context g) = Context $ \k a i -> f k a i <|> g k a i
-#endif
--------------------------------------------------------------------------------
@@ -326,6 +319,8 @@
--
-- * @2010-09-06@
--
+-- * @06.09.2010@
+--
-- * @September 06, 2010@
--
-- Alternatively, when the metadata has a field called @path@ in a
@@ -391,6 +386,7 @@
, "%Y-%m-%d %H:%M:%S%Z"
, "%Y-%m-%d %H:%M:%S"
, "%Y-%m-%d"
+ , "%d.%m.%Y"
, "%B %e, %Y %l:%M %p"
, "%B %e, %Y"
, "%b %d, %Y"
diff --git a/lib/Hakyll/Web/Template/Internal/Element.hs b/lib/Hakyll/Web/Template/Internal/Element.hs
--- a/lib/Hakyll/Web/Template/Internal/Element.hs
+++ b/lib/Hakyll/Web/Template/Internal/Element.hs
@@ -12,7 +12,7 @@
--------------------------------------------------------------------------------
-import Control.Applicative ((<|>), (<*))
+import Control.Applicative ((<|>))
import Control.Monad (void)
import Control.Arrow (left)
import Data.Binary (Binary, get, getWord8, put, putWord8)
diff --git a/lib/Hakyll/Web/Template/List.hs b/lib/Hakyll/Web/Template/List.hs
--- a/lib/Hakyll/Web/Template/List.hs
+++ b/lib/Hakyll/Web/Template/List.hs
@@ -7,6 +7,7 @@
-- * An image list in a gallery
--
-- * A sitemap
+{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-}
module Hakyll.Web.Template.List
( applyTemplateList
@@ -20,7 +21,9 @@
--------------------------------------------------------------------------------
import Control.Monad (liftM)
+#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail (MonadFail)
+#endif
import Data.List (intersperse, sortBy)
import Data.Ord (comparing)
import Data.Time.Locale.Compat (defaultTimeLocale)
diff --git a/tests/Hakyll/Core/UnixFilter/Tests.hs b/tests/Hakyll/Core/UnixFilter/Tests.hs
--- a/tests/Hakyll/Core/UnixFilter/Tests.hs
+++ b/tests/Hakyll/Core/UnixFilter/Tests.hs
@@ -22,23 +22,22 @@
--------------------------------------------------------------------------------
tests :: TestTree
-tests = testGroup "Hakyll.Core.UnixFilter.Tests"
+tests = testGroup "Hakyll.Core.UnixFilter.Tests" $
#ifdef mingw32_HOST_OS
- -- The `rev` utility is not present by default on Windows
- [ testCase "unixFilter false" unixFilterFalse
- , testCase "unixFilter error" unixFilterError
- ]
+ [] -- The `rev` utility is not present by default on Windows
#else
- [ testCase "unixFilter rev" unixFilterRev
- , testCase "unixFilter false" unixFilterFalse
+ [ testCase "unixFilter rev" unixFilterRev ]
+#endif
+ ++
+ [ testCase "unixFilter false" unixFilterFalse
, testCase "unixFilter error" unixFilterError
]
-#endif
testMarkdown :: Identifier
testMarkdown = "russian.md"
--------------------------------------------------------------------------------
+#ifndef mingw32_HOST_OS
unixFilterRev :: H.Assertion
unixFilterRev = do
store <- newTestStore
@@ -50,6 +49,7 @@
where
compiler = getResourceString >>= withItemBody (unixFilter "rev" [])
rev = map reverse . lines
+#endif
--------------------------------------------------------------------------------
diff --git a/tests/Hakyll/Web/Pandoc/Biblio/Tests.hs b/tests/Hakyll/Web/Pandoc/Biblio/Tests.hs
--- a/tests/Hakyll/Web/Pandoc/Biblio/Tests.hs
+++ b/tests/Hakyll/Web/Pandoc/Biblio/Tests.hs
@@ -1,5 +1,6 @@
--------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
module Hakyll.Web.Pandoc.Biblio.Tests
( tests
) where
@@ -16,7 +17,6 @@
--------------------------------------------------------------------------------
import Hakyll
import Hakyll.Core.Runtime
-import Hakyll.Web.Pandoc.Biblio
import qualified Hakyll.Core.Logger as Logger
import TestSuite.Util
@@ -38,7 +38,7 @@
goldenTest01 =
goldenVsString
"biblio01"
- (goldenTestsDataDir "cites-meijer.golden")
+ (goldenTestsDataDir goldenTest)
(do
-- Code lifted from https://github.com/jaspervdj/hakyll-citeproc-example.
logger <- Logger.new Logger.Error
@@ -66,12 +66,19 @@
cleanTestEnv
return output)
+
+ where
+ goldenTest =
+ if pandocMajorVersion == 2
+ then "cites-meijer-pandoc2.golden"
+ else "cites-meijer-pandoc3.golden"
+
goldenTest02 :: TestTree
goldenTest02 =
goldenVsString
"biblio02"
- (goldenTestsDataDir "cites-meijer.golden")
+ (goldenTestsDataDir goldenTest)
(do
-- Code lifted from https://github.com/jaspervdj/hakyll-citeproc-example.
logger <- Logger.new Logger.Error
@@ -99,12 +106,17 @@
cleanTestEnv
return output)
+ where
+ goldenTest =
+ if pandocMajorVersion == 2
+ then "cites-meijer-pandoc2.golden"
+ else "cites-meijer-pandoc3.golden"
goldenTest03 :: TestTree
goldenTest03 =
goldenVsString
"biblio03"
- (goldenTestsDataDir "cites-multiple.golden")
+ (goldenTestsDataDir goldenTest)
(do
-- Code lifted from https://github.com/jaspervdj/hakyll-citeproc-example.
logger <- Logger.new Logger.Error
@@ -134,3 +146,16 @@
cleanTestEnv
return output)
+ where
+ goldenTest =
+ if pandocMajorVersion == 2
+ then "cites-multiple-pandoc2.golden"
+ else "cites-multiple-pandoc3.golden"
+
+--------------------------------------------------------------------------------
+pandocMajorVersion :: Int
+#if MIN_VERSION_pandoc(3,0,0)
+pandocMajorVersion = 3
+#else
+pandocMajorVersion = 2
+#endif
diff --git a/tests/TestSuite/Util.hs b/tests/TestSuite/Util.hs
--- a/tests/TestSuite/Util.hs
+++ b/tests/TestSuite/Util.hs
@@ -15,7 +15,6 @@
--------------------------------------------------------------------------------
import Data.List (intercalate, isInfixOf)
-import Data.Monoid (mempty)
import qualified Data.Set as S
import Test.Tasty
import Test.Tasty.HUnit
diff --git a/tests/data/biblio/cites-meijer-pandoc2.golden b/tests/data/biblio/cites-meijer-pandoc2.golden
new file mode 100644
--- /dev/null
+++ b/tests/data/biblio/cites-meijer-pandoc2.golden
@@ -0,0 +1,16 @@
+
+
+
+
+ This page cites a paper.
+
+
+ This page cites a paper.
+ I would like to cite one of my favourite papers (Meijer, Fokkinga, and Paterson 1991) here.
+
+
+Meijer, Erik, Maarten Fokkinga, and Ross Paterson. 1991. “Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire.” In Conference on Functional Programming Languages and Computer Architecture, 124–44. Springer.
+
+
This page cites a paper.
+ I would like to cite one of my favourite papers (Meijer, Fokkinga, and Paterson 1991) here.
+
+
+Meijer, Erik, Maarten Fokkinga, and Ross Paterson. 1991. “Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire.” In Conference on Functional Programming Languages and Computer Architecture, 124–44. Springer.
+
+
This page cites a paper.
- I would like to cite one of my favourite papers (Meijer, Fokkinga, and Paterson 1991) here.
-
-
-Meijer, Erik, Maarten Fokkinga, and Ross Paterson. 1991. “Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire.” In Conference on Functional Programming Languages and Computer Architecture, 124–44. Springer.
-
-
This page cites a paper and a book.
+ I would like to cite one of my favourite papers (Meijer, Fokkinga, and Paterson 1991) here.
+And also a book (Lipovača 2012).
+
+
+Lipovača, Miran. 2012. Learn You a Haskell for Great Good! A Beginner’s Guide. San Francisco, CA: No Starch Press.
+
+
+Meijer, Erik, Maarten Fokkinga, and Ross Paterson. 1991. “Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire.” In Conference on Functional Programming Languages and Computer Architecture, 124–44. Springer.
+
+
This page cites a paper and a book.
+ I would like to cite one of my favourite papers (Meijer, Fokkinga, and Paterson 1991) here.
+And also a book (Lipovača 2012).
+
+
+Lipovača, Miran. 2012. Learn You a Haskell for Great Good! A Beginner’s Guide. San Francisco, CA: No Starch Press.
+
+
+Meijer, Erik, Maarten Fokkinga, and Ross Paterson. 1991. “Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire.” In Conference on Functional Programming Languages and Computer Architecture, 124–44. Springer.
+
+
This page cites a paper and a book.
- I would like to cite one of my favourite papers (Meijer, Fokkinga, and Paterson 1991) here.
-And also a book (Lipovača 2012).
-
-
-Lipovača, Miran. 2012. Learn You a Haskell for Great Good! A Beginner’s Guide. San Francisco, CA: No Starch Press.
-
-
-Meijer, Erik, Maarten Fokkinga, and Ross Paterson. 1991. “Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire.” In Conference on Functional Programming Languages and Computer Architecture, 124–44. Springer.
-
-