diff options
Diffstat (limited to 'src/Hakyll')
-rw-r--r-- | src/Hakyll/Core/Compiler.hs | 7 | ||||
-rw-r--r-- | src/Hakyll/Core/Run.hs | 2 | ||||
-rw-r--r-- | src/Hakyll/Web.hs | 13 | ||||
-rw-r--r-- | src/Hakyll/Web/Page.hs | 1 | ||||
-rw-r--r-- | src/Hakyll/Web/RelativizeUrls.hs | 29 |
5 files changed, 49 insertions, 3 deletions
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs index 57a6d07..0c13c78 100644 --- a/src/Hakyll/Core/Compiler.hs +++ b/src/Hakyll/Core/Compiler.hs @@ -43,8 +43,11 @@ runCompiler :: Compiler () CompiledItem -- ^ Compiler to run -> Bool -- ^ Was the resource modified? -> IO CompiledItem -- ^ Resulting item runCompiler compiler identifier provider lookup' route store modified = do + -- Run the compiler job CompiledItem result <- runCompilerJob compiler identifier provider lookup' route store modified + + -- Store a copy in the cache and return storeSet store "Hakyll.Core.Compiler.runCompiler" identifier result return $ CompiledItem result @@ -81,7 +84,9 @@ getDependencyOrResult identifier = CompilerM $ do Nothing -> fmap (fromMaybe error') $ liftIO $ storeGet store "Hakyll.Core.Compiler.runCompiler" identifier where - error' = error "Hakyll.Core.Compiler.getDependency: Not found" + error' = error $ "Hakyll.Core.Compiler.getDependency: " + ++ show identifier + ++ " not found in the cache, the cache might be corrupted" -- | Require another target. Using this function ensures automatic handling of -- dependencies diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs index c5e6489..9e6a6ee 100644 --- a/src/Hakyll/Core/Run.hs +++ b/src/Hakyll/Core/Run.hs @@ -108,6 +108,8 @@ hakyllWith rules provider store = do dependencyLookup map' id' = M.lookup id' map' +-- | Return a set of modified identifiers +-- modified :: ResourceProvider -- ^ Resource provider -> Store -- ^ Store -> [Identifier] -- ^ Identifiers to check diff --git a/src/Hakyll/Web.hs b/src/Hakyll/Web.hs index bc7710f..536abda 100644 --- a/src/Hakyll/Web.hs +++ b/src/Hakyll/Web.hs @@ -3,19 +3,30 @@ module Hakyll.Web ( defaultPageRead , defaultTemplateRead + , defaultRelativizeUrls ) where -import Control.Arrow (arr, (>>>), (>>^)) +import Prelude hiding (id) +import Control.Category (id) +import Control.Arrow (arr, (>>>), (>>^), (&&&)) import Hakyll.Core.Compiler import Hakyll.Web.Page import Hakyll.Web.Pandoc import Hakyll.Web.Template +import Hakyll.Web.RelativizeUrls +import Hakyll.Web.Util.String defaultPageRead :: Compiler () (Page String) defaultPageRead = cached "Hakyll.Web.defaultPageRead" $ pageRead >>> addDefaultFields >>> arr applySelf >>> pageRenderPandoc +defaultRelativizeUrls :: Compiler (Page String) (Page String) +defaultRelativizeUrls = getRoute &&& id >>^ uncurry relativize + where + relativize Nothing = id + relativize (Just r) = fmap (relativizeUrls $ toSiteRoot r) + defaultTemplateRead :: Compiler () Template defaultTemplateRead = cached "Hakyll.Web.defaultTemplateRead" $ getResourceString >>^ readTemplate diff --git a/src/Hakyll/Web/Page.hs b/src/Hakyll/Web/Page.hs index 531c951..883da74 100644 --- a/src/Hakyll/Web/Page.hs +++ b/src/Hakyll/Web/Page.hs @@ -57,7 +57,6 @@ addDefaultFields = (getRoute &&& id >>^ uncurry addRoute) -- Add root and url, based on route addRoute Nothing = id addRoute (Just r) = addField "url" (toUrl r) - . addField "root" (toSiteRoot $ toUrl r) -- Add title and category, based on identifier addIdentifier i = addField "title" (takeBaseName p) diff --git a/src/Hakyll/Web/RelativizeUrls.hs b/src/Hakyll/Web/RelativizeUrls.hs new file mode 100644 index 0000000..2a3b98f --- /dev/null +++ b/src/Hakyll/Web/RelativizeUrls.hs @@ -0,0 +1,29 @@ +module Hakyll.Web.RelativizeUrls + ( relativizeUrls + ) where + +import Data.List (isPrefixOf) +import qualified Data.Set as S + +import Text.HTML.TagSoup + +-- | Relativize URL's in HTML +-- +relativizeUrls :: String -- ^ Path to the site root + -> String -- ^ HTML to relativize + -> String -- ^ Resulting HTML +relativizeUrls root = renderTags . map relativizeUrls' . parseTags + where + relativizeUrls' (TagOpen s a) = TagOpen s $ map (relativizeUrlsAttrs root) a + relativizeUrls' x = x + +-- | Relativize URL's in attributes +-- +relativizeUrlsAttrs :: String -- ^ Path to the site root + -> Attribute String -- ^ Attribute to relativize + -> Attribute String -- ^ Resulting attribute +relativizeUrlsAttrs root (key, value) + | key `S.member` urls && "/" `isPrefixOf` value = (key, root ++ value) + | otherwise = (key, value) + where + urls = S.fromList ["src", "href"] |