0a6b2b2 · hakyll · git.iko.soy

git.iko.soy/hakyll

Add snapshots

commit0a6b2b259862b90ccca11281de89091e2e01cb4d authorJasper Van der Jeugt <m@jaspervdj.be> dateSat 24 Nov 2012, 10:56 (14 years ago) parentbc192a1

6 files changed+137−59

compare with master

unifiedsplit

src/Hakyll/Core/Compiler.hs+19−4 src/Hakyll/Core/Compiler/Require.hs+56−14 src/Hakyll/Core/Runtime.hs+2−4 src/Hakyll/Main.hs+42−26 tests/Hakyll/Core/Runtime/Tests.hs+18−10 tests/Hakyll/Core/Store/Tests.hs−1

src/Hakyll/Core/Compiler.hs+19−4

@@ -10,9 +10,16 @@ module Hakyll.Core.Compiler

1010 , getResourceString

1111 , getResourceLBS

1212 , getResourceWith

13− , require

14− , requireBody

15− , requireAll

13+

14+ , Internal.Snapshot

15+ , saveSnapshot

16+ , Internal.require

17+ , Internal.requireSnapshot

18+ , Internal.requireBody

19+ , Internal.requireSnapshotBody

20+ , Internal.requireAll

21+ , Internal.requireAllSnapshots

22+

1623 , cached

1724 , unsafeCompiler

1825 , debugCompiler

@@ -30,7 +37,7 @@ import System.Environment (getProgName)

3037

3138--------------------------------------------------------------------------------

3239import Hakyll.Core.Compiler.Internal

33−import Hakyll.Core.Compiler.Require

40+import qualified Hakyll.Core.Compiler.Require as Internal

3441import Hakyll.Core.Identifier

3542import Hakyll.Core.Item

3643import Hakyll.Core.Logger as Logger

@@ -93,6 +100,14 @@ getResourceWith reader = do

93100 show fp ++ " not found"

94101

95102

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+

96111--------------------------------------------------------------------------------

97112cached :: (Binary a, Typeable a)

98113 => String

src/Hakyll/Core/Compiler/Require.hs+56−14

@@ -1,9 +1,14 @@

11--------------------------------------------------------------------------------

22module Hakyll.Core.Compiler.Require

3− ( save

3+ ( Snapshot

4+ , save

5+ , saveSnapshot

46 , require

7+ , requireSnapshot

58 , requireBody

9+ , requireSnapshotBody

610 , requireAll

11+ , requireAllSnapshots

712 ) where

813

914

@@ -25,45 +30,82 @@ import qualified Hakyll.Core.Store as Store

2530

2631

2732--------------------------------------------------------------------------------

28−save :: (Binary a, Typeable a) => Store -> Identifier -> a -> IO ()

29−save store identifier x = Store.set store (key identifier) x

33+type Snapshot = String

34+

35+

36+--------------------------------------------------------------------------------

37+save :: (Binary a, Typeable a) => Store -> Item a -> IO ()

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)

3046

3147

3248--------------------------------------------------------------------------------

3349require :: (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

3557 store <- compilerStore <$> compilerAsk

3658

3759 compilerTellDependencies [IdentifierDependency id']

3860 compilerResult $ CompilerRequire id' $ do

39− result <- compilerUnsafeIO $ Store.get store (key id')

61+ result <- compilerUnsafeIO $ Store.get store (key id' snapshot)

4062 case result of

4163 Store.NotFound -> compilerThrow notFound

4264 Store.WrongType e r -> compilerThrow $ wrongType e r

4365 Store.Found x -> return $ Item id' x

4466 where

4567 notFound =

46− "Hakyll.Core.Compiler.Require.require: " ++ show id' ++ " was " ++

47− "not found in the cache, the cache might be corrupted or " ++

68+ "Hakyll.Core.Compiler.Require.require: " ++ show id' ++

69+ " (snapshot " ++ snapshot ++ ") was not found in the cache, " ++

70+ "the cache might be corrupted or " ++

4871 "the item you are referring to might not exist"

4972 wrongType e r =

50− "Hakyll.Core.Compiler.Require.require: " ++ show id' ++ " was found " ++

51− "in the cache, but does not have the right type: expected " ++ show e ++

73+ "Hakyll.Core.Compiler.Require.require: " ++ show id' ++

74+ " (snapshot " ++ snapshot ++ ") was found in the cache, " ++

75+ "but does not have the right type: expected " ++ show e ++

5276 " but got " ++ show r

5377

5478

5579--------------------------------------------------------------------------------

5680requireBody :: (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

5888

5989

6090--------------------------------------------------------------------------------

6191requireAll :: (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

6399 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]

65107

66108

67109--------------------------------------------------------------------------------

68−key :: Identifier -> [String]

69−key identifier = ["Hakyll.Core.Compiler.Require", show identifier]

110+final :: Snapshot

111+final = "final"

src/Hakyll/Core/Runtime.hs+2−4

@@ -27,7 +27,6 @@ import Hakyll.Core.Compiler.Require

2727import Hakyll.Core.Configuration

2828import Hakyll.Core.Dependencies

2929import Hakyll.Core.Identifier

30−import Hakyll.Core.Item

3130import Hakyll.Core.Item.SomeItem

3231import Hakyll.Core.Logger (Logger)

3332import qualified Hakyll.Core.Logger as Logger

@@ -194,8 +193,7 @@ chase trail id'

194193 -- Huge success

195194 CompilerDone (SomeItem item) cwrite -> do

196195 -- TODO: Sanity check on itemIdentifier?

197− let body = itemBody item

198− facts = compilerDependencies cwrite

196+ let facts = compilerDependencies cwrite

199197 cacheHits

200198 | compilerCacheHits cwrite <= 0 = "updated"

201199 | otherwise = "cached "

@@ -213,7 +211,7 @@ chase trail id'

213211 Logger.debug logger $ "Routed to " ++ path

214212

215213 -- Save! (For require)

216− liftIO $ save store id' body

214+ liftIO $ save store item

217215

218216 -- Update state

219217 modify $ \s -> s

src/Hakyll/Main.hs+42−26

@@ -1,39 +1,47 @@

1+--------------------------------------------------------------------------------

12-- | Module providing the main hakyll function and command-line argument parsing

2−--

33{-# LANGUAGE CPP #-}

44module Hakyll.Main

55 ( hakyll

66 , hakyllWith

77 ) where

9−import Control.Monad (when)

10−import System.Directory (doesDirectoryExist, removeDirectoryRecursive)

11−import System.Environment (getProgName, getArgs)

12−import System.Process (system)

139

14−import Hakyll.Core.Configuration

15−import Hakyll.Core.Identifier

16−import Hakyll.Core.Runtime

17−import Hakyll.Core.Rules

10+--------------------------------------------------------------------------------

11+import Control.Monad (when)

12+import System.Directory (doesDirectoryExist,

13+ removeDirectoryRecursive)

14+import System.Environment (getArgs, getProgName)

15+import System.Process (system)

1816

19−#ifdef PREVIEW_SERVER

20−import Control.Applicative ((<$>))

21−import Control.Concurrent (forkIO)

22−import qualified Data.Set as S

2317

24−import Hakyll.Core.Rules.Internal

25−import Hakyll.Web.Preview.Poll

26−import Hakyll.Web.Preview.Server

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

30+import Hakyll.Core.Rules.Internal

31+import Hakyll.Web.Preview.Poll

32+import Hakyll.Web.Preview.Server

2733#endif

2834

35+

36+--------------------------------------------------------------------------------

2937-- | This usualy is the function with which the user runs the hakyll compiler

30−--

3138hakyll :: Rules a -> IO ()

3239hakyll = hakyllWith defaultConfiguration

3340

41+

42+--------------------------------------------------------------------------------

3443-- | A variant of 'hakyll' which allows the user to specify a custom

3544-- configuration

36−--

3745hakyllWith :: Configuration -> Rules a -> IO ()

3846hakyllWith conf rules = do

3947 args <- getArgs

@@ -49,15 +57,17 @@ hakyllWith conf rules = do

4957 ["deploy"] -> deploy conf

5058 _ -> help

5159

60+

61+--------------------------------------------------------------------------------

5262-- | Build the site

53−--

5463build :: Configuration -> Rules a -> IO ()

5564build conf rules = do

5665 _ <- run conf rules

5766 return ()

5867

68+

69+--------------------------------------------------------------------------------

5970-- | Remove the output directories

60−--

6171clean :: Configuration -> IO ()

6272clean conf = do

6373 remove $ destinationDirectory conf

@@ -68,8 +78,9 @@ clean conf = do

6878 exists <- doesDirectoryExist dir

6979 when exists $ removeDirectoryRecursive dir

7080

81+

82+--------------------------------------------------------------------------------

7183-- | Show usage information.

72−--

7384help :: IO ()

7485help = do

7586 name <- getProgName

@@ -95,8 +106,9 @@ help = do

95106 previewServerDisabled

96107#endif

97108

109+

110+--------------------------------------------------------------------------------

98111-- | Preview the site

99−--

100112preview :: Configuration -> Rules a -> Int -> IO ()

101113#ifdef PREVIEW_SERVER

102114preview conf rules port = do

@@ -111,15 +123,17 @@ preview conf rules port = do

111123preview _ _ _ = previewServerDisabled

112124#endif

113125

126+

127+--------------------------------------------------------------------------------

114128-- | Rebuild the site

115−--

116129rebuild :: Configuration -> Rules a -> IO ()

117130rebuild conf rules = do

118131 clean conf

119132 build conf rules

120133

134+

135+--------------------------------------------------------------------------------

121136-- | Start a server

122−--

123137server :: Configuration -> Int -> IO ()

124138#ifdef PREVIEW_SERVER

125139server conf port = do

@@ -131,15 +145,17 @@ server conf port = do

131145server _ _ = previewServerDisabled

132146#endif

133147

148+

149+--------------------------------------------------------------------------------

134150-- | Upload the site

135−--

136151deploy :: Configuration -> IO ()

137152deploy conf = do

138153 _ <- system $ deployCommand conf

139154 return ()

140155

156+

157+--------------------------------------------------------------------------------

141158-- | Print a warning message about the preview serving not being enabled

142−--

143159#ifndef PREVIEW_SERVER

144160previewServerDisabled :: IO ()

145161previewServerDisabled =

tests/Hakyll/Core/Runtime/Tests.hs+18−10

@@ -6,17 +6,14 @@ module Hakyll.Core.Runtime.Tests

88--------------------------------------------------------------------------------

9−import System.FilePath ((</>))

10−import Test.Framework (Test, testGroup)

11−import Test.HUnit (Assertion, (@?=))

9+import System.FilePath ((</>))

10+import Test.Framework (Test, testGroup)

11+import Test.HUnit (Assertion, (@?=))

1212

1313

1414--------------------------------------------------------------------------------

15−import Hakyll.Core.Configuration

16−import Hakyll.Core.Routes

17−import Hakyll.Core.Rules

15+import Hakyll

1816import Hakyll.Core.Runtime

19−import Hakyll.Web.Page

2017import TestSuite.Util

2118

2219

@@ -31,7 +28,18 @@ case01 = withTestConfiguration $ \config -> do

3128 _ <- run config $ do

3229 match "*.md" $ do

3330 route $ setExtension "html"

34− compile $ pageCompiler

31+ compile $ do

32+ body <- getResourceBody

33+ saveSnapshot "raw" body

34+ return $ renderPandoc body

3535

36− out <- readFile $ destinationDirectory config </> "example.html"

37− lines out @?= ["<p>This is an example.</p>"]

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+

41+ example <- readFile $ destinationDirectory config </> "example.html"

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

6161 -- Store a string and try to fetch an int

6262 Store.set store ["foo", "bar"] ("qux" :: String)

6363 value <- Store.get store ["foo", "bar"] :: IO (Store.Result Int)

64− print value

6564 H.assert $ case value of

6665 Store.WrongType e t ->

6766 e == typeOf (undefined :: Int) &&