From bc4fef81b7143d3b2035f3bd28fe89bea8dbc30d Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Tue, 15 Feb 2011 22:20:39 +0100 Subject: defaultRelativizeUrls → relativizeUrlsCompiler MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Hakyll/Web/CompressCss.hs | 3 +-- src/Hakyll/Web/RelativizeUrls.hs | 19 ++++++++++++++++++- 2 files changed, 19 insertions(+), 3 deletions(-) (limited to 'src/Hakyll/Web') diff --git a/src/Hakyll/Web/CompressCss.hs b/src/Hakyll/Web/CompressCss.hs index 3e86e09..94ba9a9 100644 --- a/src/Hakyll/Web/CompressCss.hs +++ b/src/Hakyll/Web/CompressCss.hs @@ -14,8 +14,7 @@ import Hakyll.Core.Compiler import Hakyll.Core.ResourceProvider import Hakyll.Web.Util.String --- | Compiler form of 'compressCss' which automatically picks the right root --- path +-- | Compiler form of 'compressCss' -- compressCssCompiler :: Compiler Resource String compressCssCompiler = getResourceString >>^ compressCss diff --git a/src/Hakyll/Web/RelativizeUrls.hs b/src/Hakyll/Web/RelativizeUrls.hs index 40a5847..1df4fea 100644 --- a/src/Hakyll/Web/RelativizeUrls.hs +++ b/src/Hakyll/Web/RelativizeUrls.hs @@ -15,14 +15,31 @@ -- > Funny zomgroflcopter -- module Hakyll.Web.RelativizeUrls - ( relativizeUrls + ( relativizeUrlsCompiler + , relativizeUrls ) where +import Prelude hiding (id) +import Control.Category (id) +import Control.Arrow ((&&&), (>>^)) import Data.List (isPrefixOf) import qualified Data.Set as S import Text.HTML.TagSoup +import Hakyll.Core.Compiler +import Hakyll.Web.Page +import Hakyll.Web.Util.String + +-- | Compiler form of 'compressCss' which automatically picks the right root +-- path +-- +relativizeUrlsCompiler :: Compiler (Page String) (Page String) +relativizeUrlsCompiler = getRoute &&& id >>^ uncurry relativize + where + relativize Nothing = id + relativize (Just r) = fmap (relativizeUrls $ toSiteRoot r) + -- | Relativize URL's in HTML -- relativizeUrls :: String -- ^ Path to the site root -- cgit v1.2.3