git.iko.soy/hakyll
on master help sign in
Add relativize URL's functionality
0969fe4Jasper Van der Jeugt
src/Hakyll/Core/Compiler.hs+6−1
compare with master
unifiedsplit
@@ -43,8 +43,11 @@ runCompiler :: Compiler () CompiledItem -- ^ Compiler to run
43 -> Bool -- ^ Was the resource modified?
43 -> Bool -- ^ Was the resource modified?
44 -> IO CompiledItem -- ^ Resulting item
44 -> IO CompiledItem -- ^ Resulting item
45runCompiler compiler identifier provider lookup' route store modified = do
45runCompiler compiler identifier provider lookup' route store modified = do
46+ -- Run the compiler job
46 CompiledItem result <- runCompilerJob
47 CompiledItem result <- runCompilerJob
47 compiler identifier provider lookup' route store modified
48 compiler identifier provider lookup' route store modified
49+
50+ -- Store a copy in the cache and return
48 storeSet store "Hakyll.Core.Compiler.runCompiler" identifier result
51 storeSet store "Hakyll.Core.Compiler.runCompiler" identifier result
49 return $ CompiledItem result
52 return $ CompiledItem result
50
53
@@ -81,7 +84,9 @@ getDependencyOrResult identifier = CompilerM $ do
81 Nothing -> fmap (fromMaybe error') $ liftIO $
84 Nothing -> fmap (fromMaybe error') $ liftIO $
82 storeGet store "Hakyll.Core.Compiler.runCompiler" identifier
85 storeGet store "Hakyll.Core.Compiler.runCompiler" identifier
83 where
86 where
84− error' = error "Hakyll.Core.Compiler.getDependency: Not found"
87+ error' = error $ "Hakyll.Core.Compiler.getDependency: "
88+ ++ show identifier
89+ ++ " not found in the cache, the cache might be corrupted"
85
90
86-- | Require another target. Using this function ensures automatic handling of
91-- | Require another target. Using this function ensures automatic handling of
87-- dependencies
92-- dependencies
src/Hakyll/Core/Run.hs+2
@@ -108,6 +108,8 @@ hakyllWith rules provider store = do
108
108
109 dependencyLookup map' id' = M.lookup id' map'
109 dependencyLookup map' id' = M.lookup id' map'
110
110
111+-- | Return a set of modified identifiers
112+--
111modified :: ResourceProvider -- ^ Resource provider
113modified :: ResourceProvider -- ^ Resource provider
112 -> Store -- ^ Store
114 -> Store -- ^ Store
113 -> [Identifier] -- ^ Identifiers to check
115 -> [Identifier] -- ^ Identifiers to check
src/Hakyll/Web.hs+12−1
@@ -3,19 +3,30 @@
3module Hakyll.Web
3module Hakyll.Web
4 ( defaultPageRead
4 ( defaultPageRead
5 , defaultTemplateRead
5 , defaultTemplateRead
6+ , defaultRelativizeUrls
6 ) where
7 ) where
7
8
9+import Prelude hiding (id)
10+import Control.Category (id)
8−import Control.Arrow (arr, (>>>), (>>^))
11+import Control.Arrow (arr, (>>>), (>>^), (&&&))
9
12
10import Hakyll.Core.Compiler
13import Hakyll.Core.Compiler
11import Hakyll.Web.Page
14import Hakyll.Web.Page
12import Hakyll.Web.Pandoc
15import Hakyll.Web.Pandoc
13import Hakyll.Web.Template
16import Hakyll.Web.Template
17+import Hakyll.Web.RelativizeUrls
18+import Hakyll.Web.Util.String
14
19
15defaultPageRead :: Compiler () (Page String)
20defaultPageRead :: Compiler () (Page String)
16defaultPageRead = cached "Hakyll.Web.defaultPageRead" $
21defaultPageRead = cached "Hakyll.Web.defaultPageRead" $
17 pageRead >>> addDefaultFields >>> arr applySelf >>> pageRenderPandoc
22 pageRead >>> addDefaultFields >>> arr applySelf >>> pageRenderPandoc
18
23
24+defaultRelativizeUrls :: Compiler (Page String) (Page String)
25+defaultRelativizeUrls = getRoute &&& id >>^ uncurry relativize
26+ where
27+ relativize Nothing = id
28+ relativize (Just r) = fmap (relativizeUrls $ toSiteRoot r)
29+
19defaultTemplateRead :: Compiler () Template
30defaultTemplateRead :: Compiler () Template
20defaultTemplateRead = cached "Hakyll.Web.defaultTemplateRead" $
31defaultTemplateRead = cached "Hakyll.Web.defaultTemplateRead" $
21 getResourceString >>^ readTemplate
32 getResourceString >>^ readTemplate
src/Hakyll/Web/Page.hs−1
@@ -57,7 +57,6 @@ addDefaultFields = (getRoute &&& id >>^ uncurry addRoute)
57 -- Add root and url, based on route
57 -- Add root and url, based on route
58 addRoute Nothing = id
58 addRoute Nothing = id
59 addRoute (Just r) = addField "url" (toUrl r)
59 addRoute (Just r) = addField "url" (toUrl r)
60− . addField "root" (toSiteRoot $ toUrl r)
61
60
62 -- Add title and category, based on identifier
61 -- Add title and category, based on identifier
63 addIdentifier i = addField "title" (takeBaseName p)
62 addIdentifier i = addField "title" (takeBaseName p)
src/Hakyll/Web/RelativizeUrls.hsnew file+29
@@ -0,0 +1,29 @@
1+module Hakyll.Web.RelativizeUrls
2+ ( relativizeUrls
3+ ) where
4+
5+import Data.List (isPrefixOf)
6+import qualified Data.Set as S
7+
8+import Text.HTML.TagSoup
9+
10+-- | Relativize URL's in HTML
11+--
12+relativizeUrls :: String -- ^ Path to the site root
13+ -> String -- ^ HTML to relativize
14+ -> String -- ^ Resulting HTML
15+relativizeUrls root = renderTags . map relativizeUrls' . parseTags
16+ where
17+ relativizeUrls' (TagOpen s a) = TagOpen s $ map (relativizeUrlsAttrs root) a
18+ relativizeUrls' x = x
19+
20+-- | Relativize URL's in attributes
21+--
22+relativizeUrlsAttrs :: String -- ^ Path to the site root
23+ -> Attribute String -- ^ Attribute to relativize
24+ -> Attribute String -- ^ Resulting attribute
25+relativizeUrlsAttrs root (key, value)
26+ | key `S.member` urls && "/" `isPrefixOf` value = (key, root ++ value)
27+ | otherwise = (key, value)
28+ where
29+ urls = S.fromList ["src", "href"]