git.iko.soy/hakyll
on master help sign in
Add snapshots
0a6b2b2Jasper Van der Jeugt
src/Hakyll/Core/Compiler.hs+19−4
compare with master
unifiedsplit
@@ -10,9 +10,16 @@ module Hakyll.Core.Compiler
10 , getResourceString
10 , getResourceString
11 , getResourceLBS
11 , getResourceLBS
12 , getResourceWith
12 , getResourceWith
13+
14+ , Internal.Snapshot
15+ , saveSnapshot
13− , require
16+ , Internal.require
17+ , Internal.requireSnapshot
14− , requireBody
18+ , Internal.requireBody
19+ , Internal.requireSnapshotBody
15− , requireAll
20+ , Internal.requireAll
21+ , Internal.requireAllSnapshots
22+
16 , cached
23 , cached
17 , unsafeCompiler
24 , unsafeCompiler
18 , debugCompiler
25 , debugCompiler
@@ -30,7 +37,7 @@ import System.Environment (getProgName)
30
37
31--------------------------------------------------------------------------------
38--------------------------------------------------------------------------------
32import Hakyll.Core.Compiler.Internal
39import Hakyll.Core.Compiler.Internal
33−import Hakyll.Core.Compiler.Require
40+import qualified Hakyll.Core.Compiler.Require as Internal
34import Hakyll.Core.Identifier
41import Hakyll.Core.Identifier
35import Hakyll.Core.Item
42import Hakyll.Core.Item
36import Hakyll.Core.Logger as Logger
43import Hakyll.Core.Logger as Logger
@@ -93,6 +100,14 @@ getResourceWith reader = do
93 show fp ++ " not found"
100 show fp ++ " not found"
94
101
95
102
103+--------------------------------------------------------------------------------
104+saveSnapshot :: (Binary a, Typeable a)
105+ => Internal.Snapshot -> Item a -> Compiler ()
106+saveSnapshot snapshot item = do
107+ store <- compilerStore <$> compilerAsk
108+ compilerUnsafeIO $ Internal.saveSnapshot store snapshot item
109+
110+
96--------------------------------------------------------------------------------
111--------------------------------------------------------------------------------
97cached :: (Binary a, Typeable a)
112cached :: (Binary a, Typeable a)
98 => String
113 => String
src/Hakyll/Core/Compiler/Require.hs+56−14
@@ -1,9 +1,14 @@
1--------------------------------------------------------------------------------
1--------------------------------------------------------------------------------
2module Hakyll.Core.Compiler.Require
2module Hakyll.Core.Compiler.Require
3+ ( Snapshot
3− ( save
4+ , save
5+ , saveSnapshot
4 , require
6 , require
7+ , requireSnapshot
5 , requireBody
8 , requireBody
9+ , requireSnapshotBody
6 , requireAll
10 , requireAll
11+ , requireAllSnapshots
7 ) where
12 ) where
8
13
9
14
@@ -25,45 +30,82 @@ import qualified Hakyll.Core.Store as Store
25
30
26
31
27--------------------------------------------------------------------------------
32--------------------------------------------------------------------------------
33+type Snapshot = String
34+
35+
36+--------------------------------------------------------------------------------
28−save :: (Binary a, Typeable a) => Store -> Identifier -> a -> IO ()
37+save :: (Binary a, Typeable a) => Store -> Item a -> IO ()
29−save store identifier x = Store.set store (key identifier) x
38+save store item = saveSnapshot store final item
39+
40+
41+--------------------------------------------------------------------------------
42+saveSnapshot :: (Binary a, Typeable a)
43+ => Store -> Snapshot -> Item a -> IO ()
44+saveSnapshot store snapshot item =
45+ Store.set store (key (itemIdentifier item) snapshot) (itemBody item)
30
46
31
47
32--------------------------------------------------------------------------------
48--------------------------------------------------------------------------------
33require :: (Binary a, Typeable a) => Identifier -> Compiler (Item a)
49require :: (Binary a, Typeable a) => Identifier -> Compiler (Item a)
34−require id' = do
50+require id' = requireSnapshot id' final
51+
52+
53+--------------------------------------------------------------------------------
54+requireSnapshot :: (Binary a, Typeable a)
55+ => Identifier -> Snapshot -> Compiler (Item a)
56+requireSnapshot id' snapshot = do
35 store <- compilerStore <$> compilerAsk
57 store <- compilerStore <$> compilerAsk
36
58
37 compilerTellDependencies [IdentifierDependency id']
59 compilerTellDependencies [IdentifierDependency id']
38 compilerResult $ CompilerRequire id' $ do
60 compilerResult $ CompilerRequire id' $ do
39− result <- compilerUnsafeIO $ Store.get store (key id')
61+ result <- compilerUnsafeIO $ Store.get store (key id' snapshot)
40 case result of
62 case result of
41 Store.NotFound -> compilerThrow notFound
63 Store.NotFound -> compilerThrow notFound
42 Store.WrongType e r -> compilerThrow $ wrongType e r
64 Store.WrongType e r -> compilerThrow $ wrongType e r
43 Store.Found x -> return $ Item id' x
65 Store.Found x -> return $ Item id' x
44 where
66 where
45 notFound =
67 notFound =
46− "Hakyll.Core.Compiler.Require.require: " ++ show id' ++ " was " ++
68+ "Hakyll.Core.Compiler.Require.require: " ++ show id' ++
69+ " (snapshot " ++ snapshot ++ ") was not found in the cache, " ++
47− "not found in the cache, the cache might be corrupted or " ++
70+ "the cache might be corrupted or " ++
48 "the item you are referring to might not exist"
71 "the item you are referring to might not exist"
49 wrongType e r =
72 wrongType e r =
50− "Hakyll.Core.Compiler.Require.require: " ++ show id' ++ " was found " ++
73+ "Hakyll.Core.Compiler.Require.require: " ++ show id' ++
74+ " (snapshot " ++ snapshot ++ ") was found in the cache, " ++
51− "in the cache, but does not have the right type: expected " ++ show e ++
75+ "but does not have the right type: expected " ++ show e ++
52 " but got " ++ show r
76 " but got " ++ show r
53
77
54
78
55--------------------------------------------------------------------------------
79--------------------------------------------------------------------------------
56requireBody :: (Binary a, Typeable a) => Identifier -> Compiler a
80requireBody :: (Binary a, Typeable a) => Identifier -> Compiler a
57−requireBody = fmap itemBody . require
81+requireBody id' = requireSnapshotBody id' final
82+
83+
84+--------------------------------------------------------------------------------
85+requireSnapshotBody :: (Binary a, Typeable a)
86+ => Identifier -> Snapshot -> Compiler a
87+requireSnapshotBody id' snapshot = fmap itemBody $ requireSnapshot id' snapshot
58
88
59
89
60--------------------------------------------------------------------------------
90--------------------------------------------------------------------------------
61requireAll :: (Binary a, Typeable a) => Pattern -> Compiler [Item a]
91requireAll :: (Binary a, Typeable a) => Pattern -> Compiler [Item a]
62−requireAll pattern = do
92+requireAll pattern = requireAllSnapshots pattern final
93+
94+
95+--------------------------------------------------------------------------------
96+requireAllSnapshots :: (Binary a, Typeable a)
97+ => Pattern -> Snapshot -> Compiler [Item a]
98+requireAllSnapshots pattern snapshot = do
63 matching <- getMatches pattern
99 matching <- getMatches pattern
64− mapM require matching
100+ mapM (\i -> requireSnapshot i snapshot) matching
101+
102+
103+--------------------------------------------------------------------------------
104+key :: Identifier -> String -> [String]
105+key identifier snapshot =
106+ ["Hakyll.Core.Compiler.Require", show identifier, snapshot]
65
107
66
108
67--------------------------------------------------------------------------------
109--------------------------------------------------------------------------------
68−key :: Identifier -> [String]
110+final :: Snapshot
69−key identifier = ["Hakyll.Core.Compiler.Require", show identifier]
111+final = "final"
src/Hakyll/Core/Runtime.hs+2−4
@@ -27,7 +27,6 @@ import Hakyll.Core.Compiler.Require
27import Hakyll.Core.Configuration
27import Hakyll.Core.Configuration
28import Hakyll.Core.Dependencies
28import Hakyll.Core.Dependencies
29import Hakyll.Core.Identifier
29import Hakyll.Core.Identifier
30−import Hakyll.Core.Item
31import Hakyll.Core.Item.SomeItem
30import Hakyll.Core.Item.SomeItem
32import Hakyll.Core.Logger (Logger)
31import Hakyll.Core.Logger (Logger)
33import qualified Hakyll.Core.Logger as Logger
32import qualified Hakyll.Core.Logger as Logger
@@ -194,8 +193,7 @@ chase trail id'
194 -- Huge success
193 -- Huge success
195 CompilerDone (SomeItem item) cwrite -> do
194 CompilerDone (SomeItem item) cwrite -> do
196 -- TODO: Sanity check on itemIdentifier?
195 -- TODO: Sanity check on itemIdentifier?
197− let body = itemBody item
198− facts = compilerDependencies cwrite
196+ let facts = compilerDependencies cwrite
199 cacheHits
197 cacheHits
200 | compilerCacheHits cwrite <= 0 = "updated"
198 | compilerCacheHits cwrite <= 0 = "updated"
201 | otherwise = "cached "
199 | otherwise = "cached "
@@ -213,7 +211,7 @@ chase trail id'
213 Logger.debug logger $ "Routed to " ++ path
211 Logger.debug logger $ "Routed to " ++ path
214
212
215 -- Save! (For require)
213 -- Save! (For require)
216− liftIO $ save store id' body
214+ liftIO $ save store item
217
215
218 -- Update state
216 -- Update state
219 modify $ \s -> s
217 modify $ \s -> s
src/Hakyll/Main.hs+42−26
@@ -1,39 +1,47 @@
1+--------------------------------------------------------------------------------
1-- | Module providing the main hakyll function and command-line argument parsing
2-- | Module providing the main hakyll function and command-line argument parsing
2−--
3{-# LANGUAGE CPP #-}
3{-# LANGUAGE CPP #-}
4module Hakyll.Main
4module Hakyll.Main
5 ( hakyll
5 ( hakyll
6 , hakyllWith
6 , hakyllWith
7 ) where
7 ) where
8
8
9−import Control.Monad (when)
10−import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
11−import System.Environment (getProgName, getArgs)
12−import System.Process (system)
13
9
14−import Hakyll.Core.Configuration
10+--------------------------------------------------------------------------------
15−import Hakyll.Core.Identifier
11+import Control.Monad (when)
16−import Hakyll.Core.Runtime
12+import System.Directory (doesDirectoryExist,
17−import Hakyll.Core.Rules
13+ removeDirectoryRecursive)
14+import System.Environment (getArgs, getProgName)
15+import System.Process (system)
18
16
19−#ifdef PREVIEW_SERVER
20−import Control.Applicative ((<$>))
21−import Control.Concurrent (forkIO)
22−import qualified Data.Set as S
23
17
18+--------------------------------------------------------------------------------
19+import Hakyll.Core.Configuration
20+import Hakyll.Core.Rules
21+import Hakyll.Core.Runtime
22+
23+
24+--------------------------------------------------------------------------------
25+#ifdef PREVIEW_SERVER
26+import Control.Applicative ((<$>))
27+import Control.Concurrent (forkIO)
28+import qualified Data.Set as S
29+import Hakyll.Core.Identifier
24−import Hakyll.Core.Rules.Internal
30+import Hakyll.Core.Rules.Internal
25−import Hakyll.Web.Preview.Poll
31+import Hakyll.Web.Preview.Poll
26−import Hakyll.Web.Preview.Server
32+import Hakyll.Web.Preview.Server
27#endif
33#endif
28
34
35+
36+--------------------------------------------------------------------------------
29-- | This usualy is the function with which the user runs the hakyll compiler
37-- | This usualy is the function with which the user runs the hakyll compiler
30−--
31hakyll :: Rules a -> IO ()
38hakyll :: Rules a -> IO ()
32hakyll = hakyllWith defaultConfiguration
39hakyll = hakyllWith defaultConfiguration
33
40
41+
42+--------------------------------------------------------------------------------
34-- | A variant of 'hakyll' which allows the user to specify a custom
43-- | A variant of 'hakyll' which allows the user to specify a custom
35-- configuration
44-- configuration
36−--
37hakyllWith :: Configuration -> Rules a -> IO ()
45hakyllWith :: Configuration -> Rules a -> IO ()
38hakyllWith conf rules = do
46hakyllWith conf rules = do
39 args <- getArgs
47 args <- getArgs
@@ -49,15 +57,17 @@ hakyllWith conf rules = do
49 ["deploy"] -> deploy conf
57 ["deploy"] -> deploy conf
50 _ -> help
58 _ -> help
51
59
60+
61+--------------------------------------------------------------------------------
52-- | Build the site
62-- | Build the site
53−--
54build :: Configuration -> Rules a -> IO ()
63build :: Configuration -> Rules a -> IO ()
55build conf rules = do
64build conf rules = do
56 _ <- run conf rules
65 _ <- run conf rules
57 return ()
66 return ()
58
67
68+
69+--------------------------------------------------------------------------------
59-- | Remove the output directories
70-- | Remove the output directories
60−--
61clean :: Configuration -> IO ()
71clean :: Configuration -> IO ()
62clean conf = do
72clean conf = do
63 remove $ destinationDirectory conf
73 remove $ destinationDirectory conf
@@ -68,8 +78,9 @@ clean conf = do
68 exists <- doesDirectoryExist dir
78 exists <- doesDirectoryExist dir
69 when exists $ removeDirectoryRecursive dir
79 when exists $ removeDirectoryRecursive dir
70
80
81+
82+--------------------------------------------------------------------------------
71-- | Show usage information.
83-- | Show usage information.
72−--
73help :: IO ()
84help :: IO ()
74help = do
85help = do
75 name <- getProgName
86 name <- getProgName
@@ -95,8 +106,9 @@ help = do
95 previewServerDisabled
106 previewServerDisabled
96#endif
107#endif
97
108
109+
110+--------------------------------------------------------------------------------
98-- | Preview the site
111-- | Preview the site
99−--
100preview :: Configuration -> Rules a -> Int -> IO ()
112preview :: Configuration -> Rules a -> Int -> IO ()
101#ifdef PREVIEW_SERVER
113#ifdef PREVIEW_SERVER
102preview conf rules port = do
114preview conf rules port = do
@@ -111,15 +123,17 @@ preview conf rules port = do
111preview _ _ _ = previewServerDisabled
123preview _ _ _ = previewServerDisabled
112#endif
124#endif
113
125
126+
127+--------------------------------------------------------------------------------
114-- | Rebuild the site
128-- | Rebuild the site
115−--
116rebuild :: Configuration -> Rules a -> IO ()
129rebuild :: Configuration -> Rules a -> IO ()
117rebuild conf rules = do
130rebuild conf rules = do
118 clean conf
131 clean conf
119 build conf rules
132 build conf rules
120
133
134+
135+--------------------------------------------------------------------------------
121-- | Start a server
136-- | Start a server
122−--
123server :: Configuration -> Int -> IO ()
137server :: Configuration -> Int -> IO ()
124#ifdef PREVIEW_SERVER
138#ifdef PREVIEW_SERVER
125server conf port = do
139server conf port = do
@@ -131,15 +145,17 @@ server conf port = do
131server _ _ = previewServerDisabled
145server _ _ = previewServerDisabled
132#endif
146#endif
133
147
148+
149+--------------------------------------------------------------------------------
134-- | Upload the site
150-- | Upload the site
135−--
136deploy :: Configuration -> IO ()
151deploy :: Configuration -> IO ()
137deploy conf = do
152deploy conf = do
138 _ <- system $ deployCommand conf
153 _ <- system $ deployCommand conf
139 return ()
154 return ()
140
155
156+
157+--------------------------------------------------------------------------------
141-- | Print a warning message about the preview serving not being enabled
158-- | Print a warning message about the preview serving not being enabled
142−--
143#ifndef PREVIEW_SERVER
159#ifndef PREVIEW_SERVER
144previewServerDisabled :: IO ()
160previewServerDisabled :: IO ()
145previewServerDisabled =
161previewServerDisabled =
tests/Hakyll/Core/Runtime/Tests.hs+18−10
@@ -6,17 +6,14 @@ module Hakyll.Core.Runtime.Tests
6
6
7
7
8--------------------------------------------------------------------------------
8--------------------------------------------------------------------------------
9−import System.FilePath ((</>))
9+import System.FilePath ((</>))
10−import Test.Framework (Test, testGroup)
10+import Test.Framework (Test, testGroup)
11−import Test.HUnit (Assertion, (@?=))
11+import Test.HUnit (Assertion, (@?=))
12
12
13
13
14--------------------------------------------------------------------------------
14--------------------------------------------------------------------------------
15−import Hakyll.Core.Configuration
15+import Hakyll
16−import Hakyll.Core.Routes
17−import Hakyll.Core.Rules
18import Hakyll.Core.Runtime
16import Hakyll.Core.Runtime
19−import Hakyll.Web.Page
20import TestSuite.Util
17import TestSuite.Util
21
18
22
19
@@ -31,7 +28,18 @@ case01 = withTestConfiguration $ \config -> do
31 _ <- run config $ do
28 _ <- run config $ do
32 match "*.md" $ do
29 match "*.md" $ do
33 route $ setExtension "html"
30 route $ setExtension "html"
34− compile $ pageCompiler
31+ compile $ do
32+ body <- getResourceBody
33+ saveSnapshot "raw" body
34+ return $ renderPandoc body
35
35
36+ match "bodies.txt" $ route idRoute
37+ create "bodies.txt" $ do
38+ items <- requireAllSnapshots "*.md" "raw" :: Compiler [Item String]
39+ makeItem $ concat $ map itemBody items
40+
36− out <- readFile $ destinationDirectory config </> "example.html"
41+ example <- readFile $ destinationDirectory config </> "example.html"
37− lines out @?= ["<p>This is an example.</p>"]
42+ lines example @?= ["<p>This is an example.</p>"]
43+
44+ bodies <- readFile $ destinationDirectory config </> "bodies.txt"
45+ head (lines bodies) @?= "This is an example."
tests/Hakyll/Core/Store/Tests.hs−1
@@ -61,7 +61,6 @@ wrongType = withTestStore $ \store -> do
61 -- Store a string and try to fetch an int
61 -- Store a string and try to fetch an int
62 Store.set store ["foo", "bar"] ("qux" :: String)
62 Store.set store ["foo", "bar"] ("qux" :: String)
63 value <- Store.get store ["foo", "bar"] :: IO (Store.Result Int)
63 value <- Store.get store ["foo", "bar"] :: IO (Store.Result Int)
64− print value
65 H.assert $ case value of
64 H.assert $ case value of
66 Store.WrongType e t ->
65 Store.WrongType e t ->
67 e == typeOf (undefined :: Int) &&
66 e == typeOf (undefined :: Int) &&