summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJasper Van der Jeugt <jaspervdj@gmail.com>2011-04-06 14:05:29 +0200
committerJasper Van der Jeugt <jaspervdj@gmail.com>2011-04-06 14:05:29 +0200
commit80596b1f56b7d6f2d4ff64d566ae845b7c7a01f6 (patch)
treebf6b02d68833821f7b57f40edc8dd8a60543fa09
parentc3dbb0ca77f65461e60cb801b867fff18afda2be (diff)
parentce444a426ac037c2b32568d8e6325aa5762bf913 (diff)
downloadhakyll-80596b1f56b7d6f2d4ff64d566ae845b7c7a01f6.tar.gz
Merge branch 'master' into dependency-analyzer
-rw-r--r--examples/brochure/hakyll.hs18
-rw-r--r--examples/feedblog/hakyll.hs48
-rw-r--r--examples/hakyll/about.markdown1
-rw-r--r--examples/hakyll/changelog.markdown5
-rw-r--r--examples/hakyll/hakyll.hs34
-rw-r--r--examples/hakyll/tutorial.markdown55
-rw-r--r--examples/morepages/hakyll.hs23
-rw-r--r--examples/simpleblog/hakyll.hs46
-rw-r--r--examples/tagblog/hakyll.hs52
-rw-r--r--hakyll.cabal7
-rw-r--r--src-inotify/Hakyll/Web/Preview/Poll.hs2
-rw-r--r--src-interval/Hakyll/Web/Preview/Poll.hs2
-rw-r--r--src/Hakyll.hs6
-rw-r--r--src/Hakyll/Core/Compiler.hs5
-rw-r--r--src/Hakyll/Core/Compiler/Internal.hs2
-rw-r--r--src/Hakyll/Core/Identifier/Pattern.hs128
-rw-r--r--src/Hakyll/Core/Resource.hs14
-rw-r--r--src/Hakyll/Core/Resource/Provider.hs (renamed from src/Hakyll/Core/ResourceProvider.hs)38
-rw-r--r--src/Hakyll/Core/Resource/Provider/File.hs (renamed from src/Hakyll/Core/ResourceProvider/FileResourceProvider.hs)11
-rw-r--r--src/Hakyll/Core/Routes.hs16
-rw-r--r--src/Hakyll/Core/Rules.hs53
-rw-r--r--src/Hakyll/Core/Rules/Internal.hs19
-rw-r--r--src/Hakyll/Core/Run.hs9
-rw-r--r--src/Hakyll/Core/Util/File.hs2
-rw-r--r--src/Hakyll/Core/Writable/CopyFile.hs2
-rw-r--r--src/Hakyll/Web/CompressCss.hs2
-rw-r--r--src/Hakyll/Web/Page.hs2
-rw-r--r--src/Hakyll/Web/Tags.hs88
-rw-r--r--src/Hakyll/Web/Template.hs2
-rw-r--r--tests/Hakyll/Core/Identifier/Tests.hs40
30 files changed, 447 insertions, 285 deletions
diff --git a/examples/brochure/hakyll.hs b/examples/brochure/hakyll.hs
index 819924f..1bc5919 100644
--- a/examples/brochure/hakyll.hs
+++ b/examples/brochure/hakyll.hs
@@ -6,13 +6,15 @@ import Hakyll
main :: IO ()
main = hakyll $ do
- route "css/*" idRoute
- compile "css/*" compressCssCompiler
+ match "css/*" $ do
+ route idRoute
+ compile compressCssCompiler
- compile "templates/*" templateCompiler
+ match "templates/*" $ compile templateCompiler
- forM_ ["about.rst", "index.markdown", "code.lhs"] $ \page -> do
- route page $ setExtension "html"
- compile page $ pageCompiler
- >>> applyTemplateCompiler "templates/default.html"
- >>> relativizeUrlsCompiler
+ forM_ ["about.rst", "index.markdown", "code.lhs"] $ \page ->
+ match page $ do
+ route $ setExtension "html"
+ compile $ pageCompiler
+ >>> applyTemplateCompiler "templates/default.html"
+ >>> relativizeUrlsCompiler
diff --git a/examples/feedblog/hakyll.hs b/examples/feedblog/hakyll.hs
index e10af10..4aa8ed9 100644
--- a/examples/feedblog/hakyll.hs
+++ b/examples/feedblog/hakyll.hs
@@ -11,47 +11,43 @@ import Hakyll
main :: IO ()
main = hakyll $ do
-- Compress CSS
- route "css/*" idRoute
- compile "css/*" compressCssCompiler
+ match "css/*" $ do
+ route idRoute
+ compile compressCssCompiler
-- Render posts
- route "posts/*" $ setExtension ".html"
- compile "posts/*" $
- pageCompiler
+ match "posts/*" $ do
+ route $ setExtension ".html"
+ compile $ pageCompiler
>>> applyTemplateCompiler "templates/post.html"
>>> applyTemplateCompiler "templates/default.html"
>>> relativizeUrlsCompiler
-- Render posts list
- route "posts.html" $ idRoute
- create "posts.html" $
- constA mempty
- >>> arr (setField "title" "All posts")
- >>> requireAllA "posts/*" addPostList
- >>> applyTemplateCompiler "templates/posts.html"
- >>> applyTemplateCompiler "templates/default.html"
- >>> relativizeUrlsCompiler
+ match "posts.html" $ route idRoute
+ create "posts.html" $ constA mempty
+ >>> arr (setField "title" "All posts")
+ >>> requireAllA "posts/*" addPostList
+ >>> applyTemplateCompiler "templates/posts.html"
+ >>> applyTemplateCompiler "templates/default.html"
+ >>> relativizeUrlsCompiler
-- Index
- route "index.html" $ idRoute
- create "index.html" $
- constA mempty
- >>> arr (setField "title" "Home")
- >>> requireAllA "posts/*" (id *** arr (take 3 . reverse . sortByBaseName) >>> addPostList)
- >>> applyTemplateCompiler "templates/index.html"
- >>> applyTemplateCompiler "templates/default.html"
- >>> relativizeUrlsCompiler
+ match "index.html" $ route idRoute
+ create "index.html" $ constA mempty
+ >>> arr (setField "title" "Home")
+ >>> requireAllA "posts/*" (id *** arr (take 3 . reverse . sortByBaseName) >>> addPostList)
+ >>> applyTemplateCompiler "templates/index.html"
+ >>> applyTemplateCompiler "templates/default.html"
+ >>> relativizeUrlsCompiler
-- Render RSS feed
- route "rss.xml" $ idRoute
+ match "rss.xml" $ route idRoute
create "rss.xml" $
requireAll_ "posts/*" >>> renderRss feedConfiguration
-- Read templates
- compile "templates/*" templateCompiler
-
- -- End
- return ()
+ match "templates/*" $ compile templateCompiler
-- | Auxiliary compiler: generate a post list from a list of given posts, and
-- add it to the current page under @$posts@
diff --git a/examples/hakyll/about.markdown b/examples/hakyll/about.markdown
index bc7886e..108663b 100644
--- a/examples/hakyll/about.markdown
+++ b/examples/hakyll/about.markdown
@@ -33,3 +33,4 @@ who still maintains the package. Contributors:
- [sargon](http://github.com/sargon)
- [Paolo Veronelli](http://github.com/paolino)
- [Benedict Eastaugh](http://extralogical.net/)
+- [Nicolas Wu](http://zenzike.com/)
diff --git a/examples/hakyll/changelog.markdown b/examples/hakyll/changelog.markdown
index 1a4cd6c..06c2765 100644
--- a/examples/hakyll/changelog.markdown
+++ b/examples/hakyll/changelog.markdown
@@ -2,6 +2,11 @@
title: Changelog
---
+## Hakyll 3.1
+
+- New `match` function in rules DSL
+- More expressive `Pattern`s
+
## Hakyll 3
- Complete rewrite
diff --git a/examples/hakyll/hakyll.hs b/examples/hakyll/hakyll.hs
index c4f339c..60ddc33 100644
--- a/examples/hakyll/hakyll.hs
+++ b/examples/hakyll/hakyll.hs
@@ -6,35 +6,37 @@ import Text.Pandoc
main :: IO ()
main = hakyll $ do
- route "css/*" idRoute
- compile "css/*" compressCssCompiler
+ match "css/*" $ do
+ route idRoute
+ compile compressCssCompiler
-- Static directories
- forM_ ["images/*", "examples/*", "reference/*"] $ \f -> do
- route f idRoute
- compile f copyFileCompiler
+ forM_ ["images/*", "examples/*", "reference/*"] $ \f -> match f $ do
+ route idRoute
+ compile copyFileCompiler
-- Pages
- forM_ pages $ \p -> do
- route p $ setExtension "html"
- compile p $ pageCompiler
+ forM_ pages $ \p -> match p $ do
+ route $ setExtension "html"
+ compile $ pageCompiler
>>> requireA "sidebar.markdown" (setFieldA "sidebar" $ arr pageBody)
>>> applyTemplateCompiler "templates/default.html"
>>> relativizeUrlsCompiler
-- Tutorial
- route "tutorial.markdown" $ setExtension "html"
- compile "tutorial.markdown" $ readPageCompiler
- >>> pageRenderPandocWith defaultHakyllParserState withToc
- >>> requireA "sidebar.markdown" (setFieldA "sidebar" $ arr pageBody)
- >>> applyTemplateCompiler "templates/default.html"
- >>> relativizeUrlsCompiler
+ match "tutorial.markdown" $ do
+ route $ setExtension "html"
+ compile $ readPageCompiler
+ >>> pageRenderPandocWith defaultHakyllParserState withToc
+ >>> requireA "sidebar.markdown" (setFieldA "sidebar" $ arr pageBody)
+ >>> applyTemplateCompiler "templates/default.html"
+ >>> relativizeUrlsCompiler
-- Sidebar
- compile "sidebar.markdown" pageCompiler
+ match "sidebar.markdown" $ compile pageCompiler
-- Templates
- compile "templates/*" templateCompiler
+ match "templates/*" $ compile templateCompiler
where
withToc = defaultHakyllWriterOptions
{ writerTableOfContents = True
diff --git a/examples/hakyll/tutorial.markdown b/examples/hakyll/tutorial.markdown
index 3b80db2..5c8a0c0 100644
--- a/examples/hakyll/tutorial.markdown
+++ b/examples/hakyll/tutorial.markdown
@@ -65,16 +65,18 @@ import Hakyll
main :: IO ()
main = hakyll $ do
- route "css/*" idRoute
- compile "css/*" compressCssCompiler
-
- compile "templates/*" templateCompiler
-
- forM_ ["about.rst", "index.markdown", "code.lhs"] $ \page -> do
- route page $ setExtension "html"
- compile page $ pageCompiler
- >>> applyTemplateCompiler "templates/default.html"
- >>> relativizeUrlsCompiler
+ match "css/*" $ do
+ route idRoute
+ compile compressCssCompiler
+
+ match "templates/*" $ compile templateCompiler
+
+ forM_ ["about.rst", "index.markdown", "code.lhs"] $ \page ->
+ match page $ do
+ route $ setExtension "html"
+ compile $ pageCompiler
+ >>> applyTemplateCompiler "templates/default.html"
+ >>> relativizeUrlsCompiler
~~~~~
This is enough code to create a small brochure site! You can find all code
@@ -111,12 +113,11 @@ main :: IO ()
main = hakyll $ do
~~~~~
-The `RulesM` monad is composed of a few functions. A first important one is
-`route`: this creates a new rule for routing items. This rule is applied to all
-items it matches -- and matching is done using the `"css/*"` [pattern].
-`idRoute` simply means that an item will be routed to it's own filename. For
-example, `css/screen.css` will be routed to `css/screen.css` -- not very
-exciting.
+The `RulesM` monad is composed of a few functions. Seldomly, you want to apply a
+compiler to *all* resources. You want to apply a compiler to certain files
+instead. That's why the `match` function exists. First, let's handle the CSS of
+our file. We use a `"css/*"` [Pattern] to match all files in the `css/`
+directory.
Note that a [Pattern] matches an [Identifier], it doesn't match filenames.
@@ -124,7 +125,16 @@ Note that a [Pattern] matches an [Identifier], it doesn't match filenames.
[Identifier]: /reference/Hakyll-Core-Identifier.html
~~~~~{.haskell}
-route "css/*" idRoute
+match "css/*" $ do
+~~~~~
+
+`route` creates a new rule for routing items. This rule is applied to all items
+that are currently matched -- in this case, `"css/*"`. `idRoute` simply means
+that an item will be routed to it's own filename. For example, `css/screen.css`
+will be routed to `css/screen.css` -- not very exciting.
+
+~~~~~{.haskell}
+route idRoute
~~~~~
Apart from specifying where the items should go (using `route`), we also have to
@@ -135,12 +145,12 @@ good default compilers. The `compressCssCompiler` compiler will simply compress
the CSS found in the files.
~~~~~{.haskell}
-compile "css/*" compressCssCompiler
+compile compressCssCompiler
~~~~~
Next, we're going to render some pages. We're going to style the results a
little, so we're going to need a [Template]. We simply compile a template using
-the `defaultTemplateRead` compiler, it's good enough in most cases.
+the `templateCompiler` compiler, it's good enough in most cases.
[Template]: /reference/Hakyll-Web-Template.html
@@ -148,7 +158,7 @@ We don't use a route for these templates, after all, we don't want to route them
anywhere, we just want to use them to style our pages a little.
~~~~~{.haskell}
-compile "templates/*" templateCompiler
+match "templates/*" $ compile templateCompiler
~~~~~
We can conclude that some rules do not *directly* add an output page on our
@@ -164,13 +174,14 @@ manually).
~~~~~{.haskell}
forM_ ["about.rst", "index.markdown", "code.lhs"] $ \page -> do
+ match page $ do
~~~~~
The pages all have different extensions. In our website, we only want to see
`.html` files. Hakyll provides a route to do just that:
~~~~~{.haskell}
-route page $ setExtension "html"
+route setExtension "html"
~~~~~
The [Rules] reference page has a complete listing of the API used.
@@ -189,7 +200,7 @@ reference page has some more readable information on this subject.
[Compiler]: /reference/Hakyll-Core-Compiler.html
~~~~~{.haskell}
-compile page $ pageCompiler
+compile pageCompiler
>>> applyTemplateCompiler "templates/default.html"
>>> relativizeUrlsCompiler
~~~~~
diff --git a/examples/morepages/hakyll.hs b/examples/morepages/hakyll.hs
index d62f8a8..c1b96e6 100644
--- a/examples/morepages/hakyll.hs
+++ b/examples/morepages/hakyll.hs
@@ -9,20 +9,21 @@ import Hakyll
main :: IO ()
main = hakyll $ do
-- Compress CSS
- route "css/*" idRoute
- compile "css/*" compressCssCompiler
+ match "css/*" $ do
+ route idRoute
+ compile compressCssCompiler
-- Render static pages
- forM_ ["about.markdown", "index.markdown", "products.markdown"] $ \p -> do
- route p $ setExtension ".html"
- compile p $
- pageCompiler
- >>> requireA "footer.markdown" (setFieldA "footer" $ arr pageBody)
- >>> applyTemplateCompiler "templates/default.html"
- >>> relativizeUrlsCompiler
+ forM_ ["about.markdown", "index.markdown", "products.markdown"] $ \p ->
+ match p $ do
+ route $ setExtension ".html"
+ compile $ pageCompiler
+ >>> requireA "footer.markdown" (setFieldA "footer" $ arr pageBody)
+ >>> applyTemplateCompiler "templates/default.html"
+ >>> relativizeUrlsCompiler
-- Compile footer
- compile "footer.markdown" pageCompiler
+ match "footer.markdown" $ compile pageCompiler
-- Read templates
- compile "templates/*" templateCompiler
+ match "templates/*" $ compile templateCompiler
diff --git a/examples/simpleblog/hakyll.hs b/examples/simpleblog/hakyll.hs
index db4230f..270c3e3 100644
--- a/examples/simpleblog/hakyll.hs
+++ b/examples/simpleblog/hakyll.hs
@@ -11,42 +11,38 @@ import Hakyll
main :: IO ()
main = hakyll $ do
-- Compress CSS
- route "css/*" idRoute
- compile "css/*" compressCssCompiler
+ match "css/*" $ do
+ route idRoute
+ compile compressCssCompiler
-- Render posts
- route "posts/*" $ setExtension ".html"
- compile "posts/*" $
- pageCompiler
+ match "posts/*" $ do
+ route $ setExtension ".html"
+ compile $ pageCompiler
>>> applyTemplateCompiler "templates/post.html"
>>> applyTemplateCompiler "templates/default.html"
>>> relativizeUrlsCompiler
-- Render posts list
- route "posts.html" $ idRoute
- create "posts.html" $
- constA mempty
- >>> arr (setField "title" "All posts")
- >>> requireAllA "posts/*" addPostList
- >>> applyTemplateCompiler "templates/posts.html"
- >>> applyTemplateCompiler "templates/default.html"
- >>> relativizeUrlsCompiler
+ match "posts.html" $ route idRoute
+ create "posts.html" $ constA mempty
+ >>> arr (setField "title" "All posts")
+ >>> requireAllA "posts/*" addPostList
+ >>> applyTemplateCompiler "templates/posts.html"
+ >>> applyTemplateCompiler "templates/default.html"
+ >>> relativizeUrlsCompiler
-- Index
- route "index.html" idRoute
- create "index.html" $
- constA mempty
- >>> arr (setField "title" "Home")
- >>> requireAllA "posts/*" (id *** arr (take 3 . reverse . sortByBaseName) >>> addPostList)
- >>> applyTemplateCompiler "templates/index.html"
- >>> applyTemplateCompiler "templates/default.html"
- >>> relativizeUrlsCompiler
+ match "index.html" $ route idRoute
+ create "index.html" $ constA mempty
+ >>> arr (setField "title" "Home")
+ >>> requireAllA "posts/*" (id *** arr (take 3 . reverse . sortByBaseName) >>> addPostList)
+ >>> applyTemplateCompiler "templates/index.html"
+ >>> applyTemplateCompiler "templates/default.html"
+ >>> relativizeUrlsCompiler
-- Read templates
- compile "templates/*" templateCompiler
-
- -- End
- return ()
+ match "templates/*" $ compile templateCompiler
-- | Auxiliary compiler: generate a post list from a list of given posts, and
-- add it to the current page under @$posts@
diff --git a/examples/tagblog/hakyll.hs b/examples/tagblog/hakyll.hs
index 976a017..53e635f 100644
--- a/examples/tagblog/hakyll.hs
+++ b/examples/tagblog/hakyll.hs
@@ -12,13 +12,14 @@ import Hakyll
main :: IO ()
main = hakyll $ do
-- Compress CSS
- route "css/*" idRoute
- compile "css/*" compressCssCompiler
+ match "css/*" $ do
+ route idRoute
+ compile compressCssCompiler
-- Render posts
- route "posts/*" $ setExtension ".html"
- compile "posts/*" $
- pageCompiler
+ match "posts/*" $ do
+ route $ setExtension ".html"
+ compile $ pageCompiler
>>> arr (renderDateField "date" "%B %e, %Y" "Date unknown")
>>> renderTagsField "prettytags" (fromCaptureString "tags/*")
>>> applyTemplateCompiler "templates/post.html"
@@ -26,48 +27,43 @@ main = hakyll $ do
>>> relativizeUrlsCompiler
-- Render posts list
- route "posts.html" $ idRoute
- create "posts.html" $
- constA mempty
- >>> arr (setField "title" "All posts")
- >>> requireAllA "posts/*" addPostList
- >>> applyTemplateCompiler "templates/posts.html"
- >>> applyTemplateCompiler "templates/default.html"
- >>> relativizeUrlsCompiler
+ match "posts.html" $ route idRoute
+ create "posts.html" $ constA mempty
+ >>> arr (setField "title" "All posts")
+ >>> requireAllA "posts/*" addPostList
+ >>> applyTemplateCompiler "templates/posts.html"
+ >>> applyTemplateCompiler "templates/default.html"
+ >>> relativizeUrlsCompiler
-- Index
- route "index.html" $ idRoute
- create "index.html" $
- constA mempty
- >>> arr (setField "title" "Home")
- >>> requireA "tags" (setFieldA "tagcloud" (renderTagCloud'))
- >>> requireAllA "posts/*" (id *** arr (take 3 . reverse . sortByBaseName) >>> addPostList)
- >>> applyTemplateCompiler "templates/index.html"
- >>> applyTemplateCompiler "templates/default.html"
- >>> relativizeUrlsCompiler
+ match "index.html" $ route idRoute
+ create "index.html" $ constA mempty
+ >>> arr (setField "title" "Home")
+ >>> requireA "tags" (setFieldA "tagcloud" (renderTagCloud'))
+ >>> requireAllA "posts/*" (id *** arr (take 3 . reverse . sortByBaseName) >>> addPostList)
+ >>> applyTemplateCompiler "templates/index.html"
+ >>> applyTemplateCompiler "templates/default.html"
+ >>> relativizeUrlsCompiler
-- Tags
create "tags" $
requireAll "posts/*" (\_ ps -> readTags ps :: Tags String)
-- Add a tag list compiler for every tag
- route "tags/*" $ setExtension ".html"
+ match "tags/*" $ route $ setExtension ".html"
metaCompile $ require_ "tags"
>>> arr (M.toList . tagsMap)
>>> arr (map (\(t, p) -> (tagIdentifier t, makeTagList t p)))
-- Render RSS feed
- route "rss.xml" $ idRoute
+ match "rss.xml" $ route idRoute
create "rss.xml" $
requireAll_ "posts/*"
>>> mapCompiler (arr $ copyBodyToField "description")
>>> renderRss feedConfiguration
-- Read templates
- compile "templates/*" templateCompiler
-
- -- End
- return ()
+ match "templates/*" $ compile templateCompiler
where
renderTagCloud' :: Compiler (Tags String) String
renderTagCloud' = renderTagCloud tagIdentifier 100 120
diff --git a/hakyll.cabal b/hakyll.cabal
index fd4da06..6336dd5 100644
--- a/hakyll.cabal
+++ b/hakyll.cabal
@@ -1,5 +1,5 @@
Name: hakyll
-Version: 3.0.2.0
+Version: 3.1.0.0
Synopsis: A simple static site generator library.
Description: A simple static site generator library, mainly aimed at
@@ -81,7 +81,6 @@ library
Hakyll.Web.RelativizeUrls
Hakyll.Web.Page.Read
Hakyll.Web.Page.Metadata
- Hakyll.Core.ResourceProvider.FileResourceProvider
Hakyll.Core.Configuration
Hakyll.Core.DependencyAnalyzer
Hakyll.Core.Identifier.Pattern
@@ -89,7 +88,9 @@ library
Hakyll.Core.Util.Arrow
Hakyll.Core.Util.File
Hakyll.Core.Util.String
- Hakyll.Core.ResourceProvider
+ Hakyll.Core.Resource
+ Hakyll.Core.Resource.Provider
+ Hakyll.Core.Resource.Provider.File
Hakyll.Core.CompiledItem
Hakyll.Core.Compiler
Hakyll.Core.Run
diff --git a/src-inotify/Hakyll/Web/Preview/Poll.hs b/src-inotify/Hakyll/Web/Preview/Poll.hs
index 686f045..2e028cc 100644
--- a/src-inotify/Hakyll/Web/Preview/Poll.hs
+++ b/src-inotify/Hakyll/Web/Preview/Poll.hs
@@ -13,7 +13,7 @@ import Data.List (isPrefixOf)
import System.INotify
import Hakyll.Core.Configuration
-import Hakyll.Core.ResourceProvider
+import Hakyll.Core.Resource
import Hakyll.Core.Identifier
-- | Calls the given callback when the directory tree changes
diff --git a/src-interval/Hakyll/Web/Preview/Poll.hs b/src-interval/Hakyll/Web/Preview/Poll.hs
index ec6df0c..bb18b51 100644
--- a/src-interval/Hakyll/Web/Preview/Poll.hs
+++ b/src-interval/Hakyll/Web/Preview/Poll.hs
@@ -15,7 +15,7 @@ import System.Directory (getModificationTime)
import Hakyll.Core.Configuration
import Hakyll.Core.Identifier
-import Hakyll.Core.ResourceProvider
+import Hakyll.Core.Resource
-- | A preview thread that periodically recompiles the site.
--
diff --git a/src/Hakyll.hs b/src/Hakyll.hs
index 5fe1f26..341bb53 100644
--- a/src/Hakyll.hs
+++ b/src/Hakyll.hs
@@ -5,7 +5,8 @@ module Hakyll
, module Hakyll.Core.Configuration
, module Hakyll.Core.Identifier
, module Hakyll.Core.Identifier.Pattern
- , module Hakyll.Core.ResourceProvider
+ , module Hakyll.Core.Resource
+ , module Hakyll.Core.Resource.Provider
, module Hakyll.Core.Routes
, module Hakyll.Core.Rules
, module Hakyll.Core.UnixFilter
@@ -34,7 +35,8 @@ import Hakyll.Core.Compiler
import Hakyll.Core.Configuration
import Hakyll.Core.Identifier
import Hakyll.Core.Identifier.Pattern
-import Hakyll.Core.ResourceProvider
+import Hakyll.Core.Resource
+import Hakyll.Core.Resource.Provider
import Hakyll.Core.Routes
import Hakyll.Core.Rules
import Hakyll.Core.UnixFilter
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index 371594f..db51131 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -124,7 +124,8 @@ import Hakyll.Core.Identifier
import Hakyll.Core.Identifier.Pattern
import Hakyll.Core.CompiledItem
import Hakyll.Core.Writable
-import Hakyll.Core.ResourceProvider
+import Hakyll.Core.Resource
+import Hakyll.Core.Resource.Provider
import Hakyll.Core.Compiler.Internal
import Hakyll.Core.Store
import Hakyll.Core.Rules.Internal
@@ -237,7 +238,7 @@ requireAll_ :: (Binary a, Typeable a, Writable a)
-> Compiler b [a]
requireAll_ pattern = fromDependencies (const getDeps) >>> fromJob requireAll_'
where
- getDeps = matches pattern . map unResource . resourceList
+ getDeps = filterMatches pattern . map unResource . resourceList
requireAll_' = const $ CompilerM $ do
deps <- getDeps . compilerResourceProvider <$> ask
mapM (unCompilerM . getDependency) deps
diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index 4eef91c..1a3c4c3 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/src/Hakyll/Core/Compiler/Internal.hs
@@ -26,7 +26,7 @@ import Control.Category (Category, (.), id)
import Control.Arrow (Arrow, ArrowChoice, arr, first, left)
import Hakyll.Core.Identifier
-import Hakyll.Core.ResourceProvider
+import Hakyll.Core.Resource.Provider
import Hakyll.Core.Store
import Hakyll.Core.Routes
import Hakyll.Core.Logger
diff --git a/src/Hakyll/Core/Identifier/Pattern.hs b/src/Hakyll/Core/Identifier/Pattern.hs
index a1e36df..8f3ac01 100644
--- a/src/Hakyll/Core/Identifier/Pattern.hs
+++ b/src/Hakyll/Core/Identifier/Pattern.hs
@@ -1,4 +1,12 @@
-- | Module providing pattern matching and capturing on 'Identifier's.
+-- 'Pattern's come in two kinds:
+--
+-- * Simple glob patterns, like @foo\/*@;
+--
+-- * Custom, arbitrary predicates of the type @Identifier -> Bool@.
+--
+-- They both have advantages and disadvantages. By default, globs are used,
+-- unless you construct your 'Pattern' using the 'predicate' function.
--
-- A very simple pattern could be, for example, @foo\/bar@. This pattern will
-- only match the exact @foo\/bar@ identifier.
@@ -20,15 +28,17 @@
--
-- * @foo\/*.html@ will match all HTML files in the @foo\/@ directory.
--
--- The 'match' function allows the user to get access to the elements captured
+-- The 'capture' function allows the user to get access to the elements captured
-- by the capture elements in the pattern.
--
module Hakyll.Core.Identifier.Pattern
( Pattern
- , parsePattern
- , match
- , doesMatch
+ , parseGlob
+ , predicate
+ , regex
, matches
+ , filterMatches
+ , capture
, fromCapture
, fromCaptureString
, fromCaptures
@@ -37,32 +47,39 @@ module Hakyll.Core.Identifier.Pattern
import Data.List (isPrefixOf, inits, tails)
import Control.Arrow ((&&&), (>>>))
import Control.Monad (msum)
-import Data.Maybe (isJust)
-import Data.Monoid (mempty, mappend)
+import Data.Maybe (isJust, fromMaybe)
+import Data.Monoid (Monoid, mempty, mappend)
import GHC.Exts (IsString, fromString)
+import Text.Regex.PCRE ((=~~))
import Hakyll.Core.Identifier
-- | One base element of a pattern
--
-data PatternComponent = Capture
- | CaptureMany
- | Literal String
- deriving (Eq, Show)
+data GlobComponent = Capture
+ | CaptureMany
+ | Literal String
+ deriving (Eq, Show)
-- | Type that allows matching on identifiers
--
-newtype Pattern = Pattern {unPattern :: [PatternComponent]}
- deriving (Eq, Show)
+data Pattern = Glob [GlobComponent]
+ | Predicate (Identifier -> Bool)
instance IsString Pattern where
- fromString = parsePattern
+ fromString = parseGlob
+
+instance Monoid Pattern where
+ mempty = Predicate (const True)
+ g@(Glob _) `mappend` x = Predicate (matches g) `mappend` x
+ x `mappend` g@(Glob _) = x `mappend` Predicate (matches g)
+ Predicate f `mappend` Predicate g = Predicate $ \i -> f i && g i
-- | Parse a pattern from a string
--
-parsePattern :: String -> Pattern
-parsePattern = Pattern . parse' -- undefined -- Pattern . map toPattern . unIdentifier . parseIdentifier
+parseGlob :: String -> Pattern
+parseGlob = Glob . parse'
where
parse' str =
let (chunk, rest) = break (`elem` "\\*") str
@@ -72,20 +89,34 @@ parsePattern = Pattern . parse' -- undefined -- Pattern . map toPattern . unIden
('*' : xs) -> Literal chunk : Capture : parse' xs
xs -> Literal chunk : Literal xs : []
--- | Match an identifier against a pattern, generating a list of captures
+-- | Create a 'Pattern' from an arbitrary predicate
+--
+-- Example:
+--
+-- > predicate (\i -> matches "foo/*" i && not (matches "foo/bar" i))
+--
+predicate :: (Identifier -> Bool) -> Pattern
+predicate = Predicate
+
+-- | Create a 'Pattern' from a regex
+--
+-- Example:
+--
+-- > regex "^foo/[^x]*$
--
-match :: Pattern -> Identifier -> Maybe [Identifier]
-match p (Identifier i) = fmap (map Identifier) $ match' (unPattern p) i
+regex :: String -> Pattern
+regex str = predicate $ fromMaybe False . (=~~ str) . toFilePath
-- | Check if an identifier matches a pattern
--
-doesMatch :: Pattern -> Identifier -> Bool
-doesMatch p = isJust . match p
+matches :: Pattern -> Identifier -> Bool
+matches (Glob p) = isJust . capture (Glob p)
+matches (Predicate p) = (p $)
-- | Given a list of identifiers, retain only those who match the given pattern
--
-matches :: Pattern -> [Identifier] -> [Identifier]
-matches p = filter (doesMatch p)
+filterMatches :: Pattern -> [Identifier] -> [Identifier]
+filterMatches = filter . matches
-- | Split a list at every possible point, generate a list of (init, tail)
-- cases. The result is sorted with inits decreasing in length.
@@ -93,30 +124,35 @@ matches p = filter (doesMatch p)
splits :: [a] -> [([a], [a])]
splits = inits &&& tails >>> uncurry zip >>> reverse
--- | Internal verion of 'match'
+-- | Match a glob against a pattern, generating a list of captures
--
-match' :: [PatternComponent] -> String -> Maybe [String]
-match' [] [] = Just [] -- An empty match
-match' [] _ = Nothing -- No match
--- match' _ [] = Nothing -- No match
-match' (Literal l : ms) str
+capture :: Pattern -> Identifier -> Maybe [Identifier]
+capture (Glob p) (Identifier i) = fmap (map Identifier) $ capture' p i
+capture (Predicate _) _ = Nothing
+
+-- | Internal verion of 'capture'
+--
+capture' :: [GlobComponent] -> String -> Maybe [String]
+capture' [] [] = Just [] -- An empty match
+capture' [] _ = Nothing -- No match
+capture' (Literal l : ms) str
-- Match the literal against the string
- | l `isPrefixOf` str = match' ms $ drop (length l) str
+ | l `isPrefixOf` str = capture' ms $ drop (length l) str
| otherwise = Nothing
-match' (Capture : ms) str =
+capture' (Capture : ms) str =
-- Match until the next /
let (chunk, rest) = break (== '/') str
- in msum $ [ fmap (i :) (match' ms (t ++ rest)) | (i, t) <- splits chunk ]
-match' (CaptureMany : ms) str =
+ in msum $ [ fmap (i :) (capture' ms (t ++ rest)) | (i, t) <- splits chunk ]
+capture' (CaptureMany : ms) str =
-- Match everything
- msum $ [ fmap (i :) (match' ms t) | (i, t) <- splits str ]
+ msum $ [ fmap (i :) (capture' ms t) | (i, t) <- splits str ]
-- | Create an identifier from a pattern by filling in the captures with a given
-- string
--
-- Example:
--
--- > fromCapture (parsePattern "tags/*") (parseIdentifier "foo")
+-- > fromCapture (parseGlob "tags/*") (parseIdentifier "foo")
--
-- Result:
--
@@ -128,7 +164,7 @@ fromCapture pattern = fromCaptures pattern . repeat
-- | Simplified version of 'fromCapture' which takes a 'String' instead of an
-- 'Identifier'
--
--- > fromCaptureString (parsePattern "tags/*") "foo"
+-- > fromCaptureString (parseGlob "tags/*") "foo"
--
-- Result:
--
@@ -141,11 +177,19 @@ fromCaptureString pattern = fromCapture pattern . parseIdentifier
-- given list of strings
--
fromCaptures :: Pattern -> [Identifier] -> Identifier
-fromCaptures (Pattern []) _ = mempty
-fromCaptures (Pattern (m : ms)) [] = case m of
- Literal l -> Identifier l `mappend` fromCaptures (Pattern ms) []
- _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures: "
+fromCaptures (Glob p) = fromCaptures' p
+fromCaptures (Predicate _) = error $
+ "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures called on a " ++
+ "predicate instead of a glob"
+
+-- | Internally used version of 'fromCaptures'
+--
+fromCaptures' :: [GlobComponent] -> [Identifier] -> Identifier
+fromCaptures' [] _ = mempty
+fromCaptures' (m : ms) [] = case m of
+ Literal l -> Identifier l `mappend` fromCaptures' ms []
+ _ -> error $ "Hakyll.Core.Identifier.Pattern.fromCaptures': "
++ "identifier list exhausted"
-fromCaptures (Pattern (m : ms)) ids@(i : is) = case m of
- Literal l -> Identifier l `mappend` fromCaptures (Pattern ms) ids
- _ -> i `mappend` fromCaptures (Pattern ms) is
+fromCaptures' (m : ms) ids@(i : is) = case m of
+ Literal l -> Identifier l `mappend` fromCaptures' ms ids
+ _ -> i `mappend` fromCaptures' ms is
diff --git a/src/Hakyll/Core/Resource.hs b/src/Hakyll/Core/Resource.hs
new file mode 100644
index 0000000..d60fda9
--- /dev/null
+++ b/src/Hakyll/Core/Resource.hs
@@ -0,0 +1,14 @@
+-- | Module exporting the simple 'Resource' type
+--
+module Hakyll.Core.Resource
+ ( Resource (..)
+ ) where
+
+import Hakyll.Core.Identifier
+
+-- | A resource
+--
+-- Invariant: the resource specified by the given identifier must exist
+--
+newtype Resource = Resource {unResource :: Identifier}
+ deriving (Eq, Show, Ord)
diff --git a/src/Hakyll/Core/ResourceProvider.hs b/src/Hakyll/Core/Resource/Provider.hs
index dcd4af0..90e93f8 100644
--- a/src/Hakyll/Core/ResourceProvider.hs
+++ b/src/Hakyll/Core/Resource/Provider.hs
@@ -10,16 +10,18 @@
-- Therefore, it is not recommended to read files directly -- you should use the
-- provided 'Resource' methods.
--
-module Hakyll.Core.ResourceProvider
- ( Resource (..)
- , ResourceProvider (..)
+module Hakyll.Core.Resource.Provider
+ ( ResourceProvider (..)
, resourceExists
, resourceDigest
, resourceModified
) where
+import Control.Concurrent (MVar, readMVar, modifyMVar_)
import Control.Monad ((<=<))
import Data.Word (Word8)
+import Data.Map (Map)
+import qualified Data.Map as M
import qualified Data.ByteString.Lazy as LB
import OpenSSL.Digest.ByteString.Lazy (digest)
@@ -27,13 +29,7 @@ import OpenSSL.Digest (MessageDigest (MD5))
import Hakyll.Core.Identifier
import Hakyll.Core.Store
-
--- | A resource
---
--- Invariant: the resource specified by the given identifier must exist
---
-newtype Resource = Resource {unResource :: Identifier}
- deriving (Eq, Show, Ord)
+import Hakyll.Core.Resource
-- | A value responsible for retrieving and listing resources
--
@@ -44,6 +40,8 @@ data ResourceProvider = ResourceProvider
resourceString :: Resource -> IO String
, -- | Retrieve a certain resource as lazy bytestring
resourceLazyByteString :: Resource -> IO LB.ByteString
+ , -- | Cache keeping track of modified items
+ resourceModifiedCache :: MVar (Map Resource Bool)
}
-- | Check if a given identifier has a resource
@@ -60,6 +58,24 @@ resourceDigest provider = digest MD5 <=< resourceLazyByteString provider
--
resourceModified :: ResourceProvider -> Resource -> Store -> IO Bool
resourceModified provider resource store = do
+ cache <- readMVar mvar
+ case M.lookup resource cache of
+ -- Already in the cache
+ Just m -> return m
+ -- Not yet in the cache, check digests (if it exists)
+ Nothing -> do
+ m <- if resourceExists provider (unResource resource)
+ then digestModified provider resource store
+ else return False
+ modifyMVar_ mvar (return . M.insert resource m)
+ return m
+ where
+ mvar = resourceModifiedCache provider
+
+-- | Check if a resource digest was modified
+--
+digestModified :: ResourceProvider -> Resource -> Store -> IO Bool
+digestModified provider resource store = do
-- Get the latest seen digest from the store
lastDigest <- storeGet store itemName $ unResource resource
-- Calculate the digest for the resource
@@ -72,4 +88,4 @@ resourceModified provider resource store = do
else do storeSet store itemName (unResource resource) newDigest
return True
where
- itemName = "Hakyll.Core.ResourceProvider.resourceModified"
+ itemName = "Hakyll.Core.ResourceProvider.digestModified"
diff --git a/src/Hakyll/Core/ResourceProvider/FileResourceProvider.hs b/src/Hakyll/Core/Resource/Provider/File.hs
index 0d89b21..953d61c 100644
--- a/src/Hakyll/Core/ResourceProvider/FileResourceProvider.hs
+++ b/src/Hakyll/Core/Resource/Provider/File.hs
@@ -1,14 +1,17 @@
-- | A concrete 'ResourceProvider' that gets it's resources from the filesystem
--
-module Hakyll.Core.ResourceProvider.FileResourceProvider
+module Hakyll.Core.Resource.Provider.File
( fileResourceProvider
) where
import Control.Applicative ((<$>))
+import Control.Concurrent (newMVar)
+import qualified Data.Map as M
import qualified Data.ByteString.Lazy as LB
-import Hakyll.Core.ResourceProvider
+import Hakyll.Core.Resource
+import Hakyll.Core.Resource.Provider
import Hakyll.Core.Identifier
import Hakyll.Core.Util.File
import Hakyll.Core.Configuration
@@ -21,9 +24,13 @@ fileResourceProvider configuration = do
list <- map parseIdentifier . filter (not . ignoreFile configuration) <$>
getRecursiveContents False "."
+ -- MVar for the cache
+ mvar <- newMVar M.empty
+
-- Construct a resource provider
return ResourceProvider
{ resourceList = map Resource list
, resourceString = readFile . toFilePath . unResource
, resourceLazyByteString = LB.readFile . toFilePath . unResource
+ , resourceModifiedCache = mvar
}
diff --git a/src/Hakyll/Core/Routes.hs b/src/Hakyll/Core/Routes.hs
index fcab28d..abbd0a7 100644
--- a/src/Hakyll/Core/Routes.hs
+++ b/src/Hakyll/Core/Routes.hs
@@ -30,7 +30,7 @@ module Hakyll.Core.Routes
, runRoutes
, idRoute
, setExtension
- , ifMatch
+ , matchRoute
, customRoute
, gsubRoute
, composeRoutes
@@ -85,15 +85,15 @@ setExtension :: String -> Routes
setExtension extension = Routes $ fmap (`replaceExtension` extension)
. unRoutes idRoute
--- | Modify a route: apply the route if the identifier matches the given
--- pattern, fail otherwise.
+-- | Apply the route if the identifier matches the given pattern, fail
+-- otherwise
--
-ifMatch :: Pattern -> Routes -> Routes
-ifMatch pattern (Routes route) = Routes $ \id' ->
- if doesMatch pattern id' then route id'
- else Nothing
+matchRoute :: Pattern -> Routes -> Routes
+matchRoute pattern (Routes route) = Routes $ \id' ->
+ if matches pattern id' then route id' else Nothing
--- | Create a custom route. This should almost always be used with 'ifMatch'.
+-- | Create a custom route. This should almost always be used with
+-- 'matchRoute'
--
customRoute :: (Identifier -> FilePath) -> Routes
customRoute f = Routes $ Just . f
diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs
index eba3fb9..892cf7c 100644
--- a/src/Hakyll/Core/Rules.hs
+++ b/src/Hakyll/Core/Rules.hs
@@ -7,13 +7,18 @@
-- A typical usage example would be:
--
-- > main = hakyll $ do
--- > route "posts/*" (setExtension "html")
--- > compile "posts/*" someCompiler
+-- > match "posts/*" $ do
+-- > route (setExtension "html")
+-- > compile someCompiler
+-- > match "css/*" $ do
+-- > route idRoute
+-- > compile compressCssCompiler
--
{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-}
module Hakyll.Core.Rules
( RulesM
, Rules
+ , match
, compile
, create
, route
@@ -23,16 +28,17 @@ module Hakyll.Core.Rules
import Control.Applicative ((<$>))
import Control.Monad.Writer (tell)
-import Control.Monad.Reader (ask)
+import Control.Monad.Reader (ask, local)
import Control.Arrow (second, (>>>), arr, (>>^))
import Control.Monad.State (get, put)
-import Data.Monoid (mempty)
+import Data.Monoid (mempty, mappend)
import qualified Data.Set as S
import Data.Typeable (Typeable)
import Data.Binary (Binary)
-import Hakyll.Core.ResourceProvider
+import Hakyll.Core.Resource
+import Hakyll.Core.Resource.Provider
import Hakyll.Core.Identifier
import Hakyll.Core.Identifier.Pattern
import Hakyll.Core.Compiler.Internal
@@ -63,21 +69,32 @@ tellResources :: [Resource]
-> Rules
tellResources resources = RulesM $ tell $ RuleSet mempty mempty $ S.fromList resources
+-- | Only compile/route items satisfying the given predicate
+--
+match :: Pattern -> Rules -> Rules
+match pattern = RulesM . local addPredicate . unRulesM
+ where
+ addPredicate env = env
+ { rulesPattern = rulesPattern env `mappend` pattern
+ }
+
-- | Add a compilation rule to the rules.
--
--- This instructs all resources matching the given pattern to be compiled using
--- the given compiler. When no resources match the given pattern, nothing will
--- happen. In this case, you might want to have a look at 'create'.
+-- This instructs all resources to be compiled using the given compiler. When
+-- no resources match the current selection, nothing will happen. In this case,
+-- you might want to have a look at 'create'.
--
compile :: (Binary a, Typeable a, Writable a)
- => Pattern -> Compiler Resource a -> Rules
-compile pattern compiler = RulesM $ do
- identifiers <- matches pattern . map unResource . resourceList <$> ask
+ => Compiler Resource a -> Rules
+compile compiler = RulesM $ do
+ pattern <- rulesPattern <$> ask
+ provider <- rulesResourceProvider <$> ask
+ let ids = filterMatches pattern $ map unResource $ resourceList provider
unRulesM $ do
- tellCompilers $ flip map identifiers $ \identifier ->
+ tellCompilers $ flip map ids $ \identifier ->
(identifier, constA (Resource identifier) >>> compiler)
- tellResources $ map Resource identifiers
-
+ tellResources $ map Resource ids
+
-- | Add a compilation rule
--
-- This sets a compiler for the given identifier. No resource is needed, since
@@ -91,10 +108,12 @@ create identifier compiler = tellCompilers [(identifier, compiler)]
-- | Add a route.
--
--- This adds a route for all items matching the given pattern.
+-- This adds a route for all items matching the current pattern.
--
-route :: Pattern -> Routes -> Rules
-route pattern route' = tellRoute $ ifMatch pattern route'
+route :: Routes -> Rules
+route route' = RulesM $ do
+ pattern <- rulesPattern <$> ask
+ unRulesM $ tellRoute $ matchRoute pattern route'
-- | Apart from regular compilers, one is also able to specify metacompilers.
-- Metacompilers are a special class of compilers: they are compilers which
diff --git a/src/Hakyll/Core/Rules/Internal.hs b/src/Hakyll/Core/Rules/Internal.hs
index 2895257..0e117ec 100644
--- a/src/Hakyll/Core/Rules/Internal.hs
+++ b/src/Hakyll/Core/Rules/Internal.hs
@@ -5,6 +5,7 @@ module Hakyll.Core.Rules.Internal
( CompileRule (..)
, RuleSet (..)
, RuleState (..)
+ , RuleEnvironment (..)
, RulesM (..)
, Rules
, runRules
@@ -17,8 +18,10 @@ import Control.Monad.State (State, evalState)
import Data.Monoid (Monoid, mempty, mappend)
import Data.Set (Set)
-import Hakyll.Core.ResourceProvider
+import Hakyll.Core.Resource
+import Hakyll.Core.Resource.Provider
import Hakyll.Core.Identifier
+import Hakyll.Core.Identifier.Pattern
import Hakyll.Core.Compiler.Internal
import Hakyll.Core.Routes
import Hakyll.Core.CompiledItem
@@ -55,10 +58,17 @@ data RuleState = RuleState
{ rulesMetaCompilerIndex :: Int
} deriving (Show)
+-- | Rule environment
+--
+data RuleEnvironment = RuleEnvironment
+ { rulesResourceProvider :: ResourceProvider
+ , rulesPattern :: Pattern
+ }
+
-- | The monad used to compose rules
--
newtype RulesM a = RulesM
- { unRulesM :: ReaderT ResourceProvider (WriterT RuleSet (State RuleState)) a
+ { unRulesM :: ReaderT RuleEnvironment (WriterT RuleSet (State RuleState)) a
} deriving (Monad, Functor, Applicative)
-- | Simplification of the RulesM type; usually, it will not return any
@@ -70,6 +80,9 @@ type Rules = RulesM ()
--
runRules :: Rules -> ResourceProvider -> RuleSet
runRules rules provider =
- evalState (execWriterT $ runReaderT (unRulesM rules) provider) state
+ evalState (execWriterT $ runReaderT (unRulesM rules) env) state
where
state = RuleState {rulesMetaCompilerIndex = 0}
+ env = RuleEnvironment { rulesResourceProvider = provider
+ , rulesPattern = mempty
+ }
diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs
index 58fd49a..c2cc21b 100644
--- a/src/Hakyll/Core/Run.hs
+++ b/src/Hakyll/Core/Run.hs
@@ -25,8 +25,9 @@ import Hakyll.Core.Identifier
import Hakyll.Core.Util.File
import Hakyll.Core.Compiler
import Hakyll.Core.Compiler.Internal
-import Hakyll.Core.ResourceProvider
-import Hakyll.Core.ResourceProvider.FileResourceProvider
+import Hakyll.Core.Resource
+import Hakyll.Core.Resource.Provider
+import Hakyll.Core.Resource.Provider.File
import Hakyll.Core.Rules.Internal
import Hakyll.Core.DirectedGraph
import Hakyll.Core.DirectedGraph.Dot
@@ -108,9 +109,7 @@ modified :: ResourceProvider -- ^ Resource provider
-> [Identifier] -- ^ Identifiers to check
-> IO (Set Identifier) -- ^ Modified resources
modified provider store ids = fmap S.fromList $ flip filterM ids $ \id' ->
- if resourceExists provider id'
- then resourceModified provider (Resource id') store
- else return False
+ resourceModified provider (Resource id') store
-- | Add a number of compilers and continue using these compilers
--
diff --git a/src/Hakyll/Core/Util/File.hs b/src/Hakyll/Core/Util/File.hs
index 9babc8b..24814ae 100644
--- a/src/Hakyll/Core/Util/File.hs
+++ b/src/Hakyll/Core/Util/File.hs
@@ -47,7 +47,7 @@ getRecursiveContents includeDirs topdir = do
return $ if includeDirs then topdir : concat paths
else concat paths
where
- isProper = not . (== ".") . take 1
+ isProper = (`notElem` [".", ".."])
-- | Check if a timestamp is obsolete compared to the timestamps of a number of
-- files. When they are no files, it is never obsolete.
diff --git a/src/Hakyll/Core/Writable/CopyFile.hs b/src/Hakyll/Core/Writable/CopyFile.hs
index 1cd5fd2..ab9c698 100644
--- a/src/Hakyll/Core/Writable/CopyFile.hs
+++ b/src/Hakyll/Core/Writable/CopyFile.hs
@@ -12,7 +12,7 @@ import System.Directory (copyFile)
import Data.Typeable (Typeable)
import Data.Binary (Binary)
-import Hakyll.Core.ResourceProvider
+import Hakyll.Core.Resource
import Hakyll.Core.Writable
import Hakyll.Core.Compiler
import Hakyll.Core.Identifier
diff --git a/src/Hakyll/Web/CompressCss.hs b/src/Hakyll/Web/CompressCss.hs
index 2df08fd..090fe10 100644
--- a/src/Hakyll/Web/CompressCss.hs
+++ b/src/Hakyll/Web/CompressCss.hs
@@ -11,7 +11,7 @@ import Data.List (isPrefixOf)
import Control.Arrow ((>>^))
import Hakyll.Core.Compiler
-import Hakyll.Core.ResourceProvider
+import Hakyll.Core.Resource
import Hakyll.Core.Util.String
-- | Compiler form of 'compressCss'
diff --git a/src/Hakyll/Web/Page.hs b/src/Hakyll/Web/Page.hs
index c41647b..5146bdc 100644
--- a/src/Hakyll/Web/Page.hs
+++ b/src/Hakyll/Web/Page.hs
@@ -67,7 +67,7 @@ import Data.Ord (comparing)
import Hakyll.Core.Identifier
import Hakyll.Core.Compiler
-import Hakyll.Core.ResourceProvider
+import Hakyll.Core.Resource
import Hakyll.Web.Page.Internal
import Hakyll.Web.Page.Read
import Hakyll.Web.Page.Metadata
diff --git a/src/Hakyll/Web/Tags.hs b/src/Hakyll/Web/Tags.hs
index 328ae8b..32076a0 100644
--- a/src/Hakyll/Web/Tags.hs
+++ b/src/Hakyll/Web/Tags.hs
@@ -32,6 +32,7 @@ module Hakyll.Web.Tags
, readTags
, readCategory
, renderTagCloud
+ , renderTagList
, renderTagsField
, renderCategoryField
) where
@@ -39,9 +40,8 @@ module Hakyll.Web.Tags
import Prelude hiding (id)
import Control.Category (id)
import Control.Applicative ((<$>))
-import Data.Map (Map)
import qualified Data.Map as M
-import Data.List (intersperse)
+import Data.List (intersperse, intercalate)
import Control.Arrow (arr, (&&&), (>>>), (***), (<<^), returnA)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Monoid (mconcat)
@@ -64,7 +64,7 @@ import Hakyll.Core.Util.String
-- | Data about tags
--
data Tags a = Tags
- { tagsMap :: Map String [Page a]
+ { tagsMap :: [(String, [Page a])]
} deriving (Show, Typeable)
instance Binary a => Binary (Tags a) where
@@ -90,7 +90,8 @@ readTagsWith :: (Page a -> [String]) -- ^ Function extracting tags from a page
-> [Page a] -- ^ Pages
-> Tags a -- ^ Resulting tags
readTagsWith f pages = Tags
- { tagsMap = foldl (M.unionWith (++)) M.empty (map readTagsWith' pages)
+ { tagsMap = M.toList $
+ foldl (M.unionWith (++)) M.empty (map readTagsWith' pages)
}
where
-- Create a tag map for one page
@@ -108,41 +109,64 @@ readTags = readTagsWith getTags
readCategory :: [Page a] -> Tags a
readCategory = readTagsWith getCategory
--- | Render a tag cloud in HTML
+-- | Render tags in HTML
--
-renderTagCloud :: (String -> Identifier) -- ^ Produce a link for a tag
- -> Double -- ^ Smallest font size, in percent
- -> Double -- ^ Biggest font size, in percent
- -> Compiler (Tags a) String -- ^ Tag cloud renderer
-renderTagCloud makeUrl minSize maxSize = proc (Tags tags) -> do
+renderTags :: (String -> Identifier)
+ -- ^ Produce a link
+ -> (String -> String -> Int -> Int -> Int -> String)
+ -- ^ Produce a tag item: tag, url, count, min count, max count
+ -> ([String] -> String)
+ -- ^ Join items
+ -> Compiler (Tags a) String
+ -- ^ Tag cloud renderer
+renderTags makeUrl makeItem concatItems = proc (Tags tags) -> do
-- In tags' we create a list: [((tag, route), count)]
tags' <- mapCompiler ((id &&& (getRouteFor <<^ makeUrl)) *** arr length)
- -< M.toList tags
+ -< tags
let -- Absolute frequencies of the pages
freqs = map snd tags'
- -- Find out the relative count of a tag: on a scale from 0 to 1
- relative count = (fromIntegral count - min') / (1 + max' - min')
-
- -- Show the relative size of one 'count' in percent
- size count =
- let size' = floor $ minSize + relative count * (maxSize - minSize)
- in show (size' :: Int) ++ "%"
-
- -- The minimum and maximum count found, as doubles
+ -- The minimum and maximum count found
(min', max')
| null freqs = (0, 1)
- | otherwise = (minimum &&& maximum) $ map fromIntegral freqs
+ | otherwise = (minimum &&& maximum) freqs
-- Create a link for one item
- makeLink ((tag, url), count) =
- H.a ! A.style (toValue $ "font-size: " ++ size count)
- ! A.href (toValue $ toUrl $ fromMaybe "/" url)
- $ toHtml tag
+ makeItem' ((tag, url), count) =
+ makeItem tag (toUrl $ fromMaybe "/" url) count min' max'
-- Render and return the HTML
- returnA -< renderHtml $ mconcat $ intersperse " " $ map makeLink tags'
+ returnA -< concatItems $ map makeItem' tags'
+
+-- | Render a tag cloud in HTML
+--
+renderTagCloud :: (String -> Identifier) -- ^ Produce a link for a tag
+ -> Double -- ^ Smallest font size, in percent
+ -> Double -- ^ Biggest font size, in percent
+ -> Compiler (Tags a) String -- ^ Tag cloud renderer
+renderTagCloud makeUrl minSize maxSize =
+ renderTags makeUrl makeLink (intercalate " ")
+ where
+ makeLink tag url count min' max' = renderHtml $
+ H.a ! A.style (toValue $ "font-size: " ++ size count min' max')
+ ! A.href (toValue url)
+ $ toHtml tag
+
+ -- Show the relative size of one 'count' in percent
+ size count min' max' =
+ let diff = 1 + fromIntegral max' - fromIntegral min'
+ relative = (fromIntegral count - fromIntegral min') / diff
+ size' = floor $ minSize + relative * (maxSize - minSize)
+ in show (size' :: Int) ++ "%"
+
+-- | Render a simple tag list in HTML, with the tag count next to the item
+--
+renderTagList :: (String -> Identifier) -> Compiler (Tags a) (String)
+renderTagList makeUrl = renderTags makeUrl makeLink (intercalate ", ")
+ where
+ makeLink tag url count _ _ = renderHtml $
+ H.a ! A.href (toValue url) $ toHtml (tag ++ "(" ++ show count ++ ")")
-- | Render tags with links
--
@@ -151,14 +175,14 @@ renderTagsFieldWith :: (Page a -> [String]) -- ^ Function to get the tags
-> (String -> Identifier) -- ^ Create a link for a tag
-> Compiler (Page a) (Page a) -- ^ Resulting compiler
renderTagsFieldWith tags destination makeUrl =
- id &&& arr tags >>> setFieldA destination renderTags
+ id &&& arr tags >>> setFieldA destination renderTags'
where
-- Compiler creating a comma-separated HTML string for a list of tags
- renderTags :: Compiler [String] String
- renderTags = arr (map $ id &&& makeUrl)
- >>> mapCompiler (id *** getRouteFor)
- >>> arr (map $ uncurry renderLink)
- >>> arr (renderHtml . mconcat . intersperse ", " . catMaybes)
+ renderTags' :: Compiler [String] String
+ renderTags' = arr (map $ id &&& makeUrl)
+ >>> mapCompiler (id *** getRouteFor)
+ >>> arr (map $ uncurry renderLink)
+ >>> arr (renderHtml . mconcat . intersperse ", " . catMaybes)
-- Render one tag link
renderLink _ Nothing = Nothing
diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs
index 9c49278..33e7a9b 100644
--- a/src/Hakyll/Web/Template.hs
+++ b/src/Hakyll/Web/Template.hs
@@ -59,7 +59,7 @@ import Text.Hamlet (HamletSettings, defaultHamletSettings)
import Hakyll.Core.Compiler
import Hakyll.Core.Identifier
-import Hakyll.Core.ResourceProvider
+import Hakyll.Core.Resource
import Hakyll.Web.Template.Internal
import Hakyll.Web.Template.Read
import Hakyll.Web.Page.Internal
diff --git a/tests/Hakyll/Core/Identifier/Tests.hs b/tests/Hakyll/Core/Identifier/Tests.hs
index 64b5abc..0d7bfb8 100644
--- a/tests/Hakyll/Core/Identifier/Tests.hs
+++ b/tests/Hakyll/Core/Identifier/Tests.hs
@@ -10,18 +10,30 @@ import Hakyll.Core.Identifier.Pattern
import TestSuite.Util
tests :: [Test]
-tests = fromAssertions "match"
- [ Just ["bar"] @=? match "foo/**" "foo/bar"
- , Just ["foo/bar"] @=? match "**" "foo/bar"
- , Nothing @=? match "*" "foo/bar"
- , Just [] @=? match "foo" "foo"
- , Just ["foo"] @=? match "*/bar" "foo/bar"
- , Just ["foo/bar"] @=? match "**/qux" "foo/bar/qux"
- , Just ["foo/bar", "qux"] @=? match "**/*" "foo/bar/qux"
- , Just ["foo", "bar/qux"] @=? match "*/**" "foo/bar/qux"
- , Just ["foo"] @=? match "*.html" "foo.html"
- , Nothing @=? match "*.html" "foo/bar.html"
- , Just ["foo/bar"] @=? match "**.html" "foo/bar.html"
- , Just ["foo/bar", "wut"] @=? match "**/qux/*" "foo/bar/qux/wut"
- , Just ["lol", "fun/large"] @=? match "*cat/**.jpg" "lolcat/fun/large.jpg"
+tests = concat
+ [ captureTests
+ , regexTests
+ ]
+
+captureTests :: [Test]
+captureTests = fromAssertions "capture"
+ [ Just ["bar"] @=? capture "foo/**" "foo/bar"
+ , Just ["foo/bar"] @=? capture "**" "foo/bar"
+ , Nothing @=? capture "*" "foo/bar"
+ , Just [] @=? capture "foo" "foo"
+ , Just ["foo"] @=? capture "*/bar" "foo/bar"
+ , Just ["foo/bar"] @=? capture "**/qux" "foo/bar/qux"
+ , Just ["foo/bar", "qux"] @=? capture "**/*" "foo/bar/qux"
+ , Just ["foo", "bar/qux"] @=? capture "*/**" "foo/bar/qux"
+ , Just ["foo"] @=? capture "*.html" "foo.html"
+ , Nothing @=? capture "*.html" "foo/bar.html"
+ , Just ["foo/bar"] @=? capture "**.html" "foo/bar.html"
+ , Just ["foo/bar", "wut"] @=? capture "**/qux/*" "foo/bar/qux/wut"
+ , Just ["lol", "fun/large"] @=? capture "*cat/**.jpg" "lolcat/fun/large.jpg"
+ ]
+
+regexTests :: [Test]
+regexTests = fromAssertions "regex"
+ [ True @=? matches (regex "^foo/[^x]*$") "foo/bar"
+ , False @=? matches (regex "^foo/[^x]*$") "foo/barx"
]