d2e913f · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Work a bit on new runtime

d2e913fJasper Van der Jeugt14 years ago

hakyll.cabal+1−1

compare with master

unifiedsplit

@@ -101,7 +101,7 @@ Library

101 Hakyll.Core.ResourceProvider

102 Hakyll.Core.Routes

103 Hakyll.Core.Rules

104− Hakyll.Core.Run

104+ Hakyll.Core.Runtime

105 Hakyll.Core.Store

106 Hakyll.Core.Util.Arrow

107 Hakyll.Core.Util.File

src/Hakyll/Core/Compiler/Internal.hs+19−10

@@ -4,12 +4,14 @@

4{-# LANGUAGE GeneralizedNewtypeDeriving #-}

5module Hakyll.Core.Compiler.Internal

6 ( CompilerRead (..)

7+ , CompilerResult (..)

7 , Compiler

8 , Compiler

8 , runCompiler

9 , runCompiler

9 , compilerTell

10 , compilerTell

10 , compilerAsk

11 , compilerAsk

11 , compilerThrow

12 , compilerThrow

12 , compilerCatch

13 , compilerCatch

14+ , compilerResult

13 ) where

15 ) where

@@ -56,7 +58,7 @@ type CompilerWrite = [Dependency]

56data CompilerResult a where

58data CompilerResult a where

57 CompilerDone :: a -> CompilerWrite -> CompilerResult a

59 CompilerDone :: a -> CompilerWrite -> CompilerResult a

58 CompilerError :: String -> CompilerResult a

60 CompilerError :: String -> CompilerResult a

59− CompilerRequire :: Identifier -> (b -> Compiler a) -> CompilerResult a

61+ CompilerRequire :: Identifier -> Compiler a -> CompilerResult a

62--------------------------------------------------------------------------------

64--------------------------------------------------------------------------------

@@ -70,9 +72,9 @@ instance Functor Compiler where

70 fmap f (Compiler c) = Compiler $ \r -> do

72 fmap f (Compiler c) = Compiler $ \r -> do

71 res <- c r

73 res <- c r

72 return $ case res of

74 return $ case res of

73− CompilerDone x w -> CompilerDone (f x) w

75+ CompilerDone x w -> CompilerDone (f x) w

74− CompilerError e -> CompilerError e

76+ CompilerError e -> CompilerError e

75− CompilerRequire i g -> CompilerRequire i (\x -> fmap f (g x))

77+ CompilerRequire i c' -> CompilerRequire i (fmap f c')

76 {-# INLINE fmap #-}

78 {-# INLINE fmap #-}

@@ -87,14 +89,14 @@ instance Monad Compiler where

87 CompilerDone x w -> do

89 CompilerDone x w -> do

88 res' <- unCompiler (f x) r

90 res' <- unCompiler (f x) r

89 return $ case res' of

91 return $ case res' of

90− CompilerDone y w' -> CompilerDone y (w `mappend` w')

92+ CompilerDone y w' -> CompilerDone y (w `mappend` w')

91− CompilerError e -> CompilerError e

93+ CompilerError e -> CompilerError e

92− CompilerRequire i g -> CompilerRequire i $ \z -> do

94+ CompilerRequire i c' -> CompilerRequire i $ do

93 compilerTell w -- Save dependencies!

95 compilerTell w -- Save dependencies!

94− g z

96+ c'

96− CompilerError e -> return $ CompilerError e

98+ CompilerError e -> return $ CompilerError e

97− CompilerRequire i g -> return $ CompilerRequire i $ \z -> g z >>= f

99+ CompilerRequire i c' -> return $ CompilerRequire i $ c' >>= f

98 {-# INLINE (>>=) #-}

100 {-# INLINE (>>=) #-}

101

100

102

@@ -145,3 +147,10 @@ compilerCatch (Compiler x) f = Compiler $ \r -> do

145 CompilerError e -> unCompiler (f e) r

147 CompilerError e -> unCompiler (f e) r

146 _ -> return res

148 _ -> return res

147{-# INLINE compilerCatch #-}

149{-# INLINE compilerCatch #-}

150+

151+

152+--------------------------------------------------------------------------------

153+-- | Put the result back in a compiler

154+compilerResult :: CompilerResult a -> Compiler a

155+compilerResult x = Compiler $ \_ -> return x

156+{-# INLINE compilerResult #-}

src/Hakyll/Core/Configuration.hs+21−15

@@ -1,19 +1,23 @@

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

1-- | Exports a datastructure for the top-level hakyll configuration

2-- | Exports a datastructure for the top-level hakyll configuration

2−--

3module Hakyll.Core.Configuration

4− ( HakyllConfiguration (..)

4+ ( Configuration (..)

5 , shouldIgnoreFile

6− , defaultHakyllConfiguration

6+ , defaultConfiguration

7 ) where

9−import System.FilePath (takeFileName)

10−import Data.List (isPrefixOf, isSuffixOf)

12−data HakyllConfiguration = HakyllConfiguration

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

11+import Data.List (isPrefixOf, isSuffixOf)

12+import System.FilePath (takeFileName)

13+

14+

15+--------------------------------------------------------------------------------

16+data Configuration = Configuration

13 { -- | Directory in which the output written

17 { -- | Directory in which the output written

14 destinationDirectory :: FilePath

18 destinationDirectory :: FilePath

15 , -- | Directory where hakyll's internal store is kept

19 , -- | Directory where hakyll's internal store is kept

16− storeDirectory :: FilePath

20+ storeDirectory :: FilePath

17 , -- | Function to determine ignored files

21 , -- | Function to determine ignored files

18 --

22 --

19 -- In 'defaultHakyllConfiguration', the following files are ignored:

23 -- In 'defaultHakyllConfiguration', the following files are ignored:

@@ -30,7 +34,7 @@ data HakyllConfiguration = HakyllConfiguration

30 -- also be ignored. Note that this is the configuration parameter, if you

34 -- also be ignored. Note that this is the configuration parameter, if you

31 -- want to use the test, you should use @shouldIgnoreFile@.

35 -- want to use the test, you should use @shouldIgnoreFile@.

32 --

36 --

33− ignoreFile :: FilePath -> Bool

37+ ignoreFile :: FilePath -> Bool

34 , -- | Here, you can plug in a system command to upload/deploy your site.

38 , -- | Here, you can plug in a system command to upload/deploy your site.

35 --

39 --

36 -- Example:

40 -- Example:

@@ -41,16 +45,17 @@ data HakyllConfiguration = HakyllConfiguration

41 --

45 --

42 -- > ./hakyll deploy

46 -- > ./hakyll deploy

43 --

47 --

44− deployCommand :: String

48+ deployCommand :: String

45 , -- | Use an in-memory cache for items. This is faster but uses more

49 , -- | Use an in-memory cache for items. This is faster but uses more

46 -- memory.

50 -- memory.

47− inMemoryCache :: Bool

51+ inMemoryCache :: Bool

48 }

52 }

54+

55+--------------------------------------------------------------------------------

50-- | Default configuration for a hakyll application

56-- | Default configuration for a hakyll application

51−--

57+defaultConfiguration :: Configuration

52−defaultHakyllConfiguration :: HakyllConfiguration

58+defaultConfiguration = Configuration

53−defaultHakyllConfiguration = HakyllConfiguration

54 { destinationDirectory = "_site"

59 { destinationDirectory = "_site"

55 , storeDirectory = "_cache"

60 , storeDirectory = "_cache"

56 , ignoreFile = ignoreFile'

61 , ignoreFile = ignoreFile'

@@ -67,9 +72,10 @@ defaultHakyllConfiguration = HakyllConfiguration

67 where

72 where

68 fileName = takeFileName path

73 fileName = takeFileName path

75+

76+--------------------------------------------------------------------------------

70-- | Check if a file should be ignored

77-- | Check if a file should be ignored

71−--

72−shouldIgnoreFile :: HakyllConfiguration -> FilePath -> Bool

78+shouldIgnoreFile :: Configuration -> FilePath -> Bool

73shouldIgnoreFile conf path =

79shouldIgnoreFile conf path =

74 destinationDirectory conf `isPrefixOf` path ||

80 destinationDirectory conf `isPrefixOf` path ||

75 storeDirectory conf `isPrefixOf` path ||

81 storeDirectory conf `isPrefixOf` path ||

src/Hakyll/Core/Dependencies.hs+24−9

@@ -1,4 +1,5 @@

1--------------------------------------------------------------------------------

2+{-# LANGUAGE DeriveDataTypeable #-}

2module Hakyll.Core.Dependencies

3module Hakyll.Core.Dependencies

3 ( Dependency (..)

4 ( Dependency (..)

4 , DependencyFacts

5 , DependencyFacts

@@ -7,18 +8,21 @@ module Hakyll.Core.Dependencies

9--------------------------------------------------------------------------------

10--------------------------------------------------------------------------------

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

11+import Control.Applicative ((<$>), (<*>))

11import Control.Monad (foldM, forM_, unless, when)

12import Control.Monad (foldM, forM_, unless, when)

12import Control.Monad.Reader (ask)

13import Control.Monad.Reader (ask)

13import Control.Monad.RWS (RWS, runRWS)

14import Control.Monad.RWS (RWS, runRWS)

14−import Control.Monad.State (get, modify)

15+import qualified Control.Monad.State as State

15import Control.Monad.Writer (tell)

16import Control.Monad.Writer (tell)

17+import Data.Binary (Binary (..), getWord8,

18+ putWord8)

16import Data.List (find)

19import Data.List (find)

17import Data.Map (Map)

20import Data.Map (Map)

18import qualified Data.Map as M

21import qualified Data.Map as M

19import Data.Maybe (fromMaybe)

22import Data.Maybe (fromMaybe)

20import Data.Set (Set)

23import Data.Set (Set)

21import qualified Data.Set as S

24import qualified Data.Set as S

25+import Data.Typeable (Typeable)

24--------------------------------------------------------------------------------

28--------------------------------------------------------------------------------

@@ -30,7 +34,17 @@ import Hakyll.Core.Identifier.Pattern

30data Dependency

34data Dependency

31 = Pattern Pattern [Identifier]

35 = Pattern Pattern [Identifier]

32 | Identifier Identifier

36 | Identifier Identifier

33− deriving (Show)

37+ deriving (Show, Typeable)

38+

39+

40+--------------------------------------------------------------------------------

41+instance Binary Dependency where

42+ put (Pattern p is) = putWord8 0 >> put p >> put is

43+ put (Identifier i) = putWord8 1 >> put i

44+ get = getWord8 >>= \t -> case t of

45+ 0 -> Pattern <$> get <*> get

46+ 1 -> Identifier <$> get

47+ _ -> error "Data.Binary.get: Invalid Dependency"

36--------------------------------------------------------------------------------

50--------------------------------------------------------------------------------

@@ -66,13 +80,14 @@ type DependencyM a = RWS [Identifier] [String] DependencyState a

67--------------------------------------------------------------------------------

81--------------------------------------------------------------------------------

68markOod :: Identifier -> DependencyM ()

82markOod :: Identifier -> DependencyM ()

83+markOod id' = State.modify $ \s ->

69−markOod id' = modify $ \s -> s {dependencyOod = S.insert id' $ dependencyOod s}

84+ s {dependencyOod = S.insert id' $ dependencyOod s}

72--------------------------------------------------------------------------------

87--------------------------------------------------------------------------------

73dependenciesFor :: Identifier -> DependencyM [Identifier]

88dependenciesFor :: Identifier -> DependencyM [Identifier]

74dependenciesFor id' = do

89dependenciesFor id' = do

75− facts <- dependencyFacts <$> get

90+ facts <- dependencyFacts <$> State.get

76 let relevant = fromMaybe [] $ M.lookup id' facts

91 let relevant = fromMaybe [] $ M.lookup id' facts

77 return [i | Identifier i <- relevant]

92 return [i | Identifier i <- relevant]

@@ -81,7 +96,7 @@ dependenciesFor id' = do

81checkNew :: DependencyM ()

96checkNew :: DependencyM ()

82checkNew = do

97checkNew = do

83 universe <- ask

98 universe <- ask

84− facts <- dependencyFacts <$> get

99+ facts <- dependencyFacts <$> State.get

85 forM_ universe $ \id' -> unless (id' `M.member` facts) $ do

100 forM_ universe $ \id' -> unless (id' `M.member` facts) $ do

86 tell [show id' ++ " is out-of-date because it is new"]

101 tell [show id' ++ " is out-of-date because it is new"]

87 markOod id'

102 markOod id'

@@ -90,10 +105,10 @@ checkNew = do

90--------------------------------------------------------------------------------

105--------------------------------------------------------------------------------

91checkChangedPatterns :: DependencyM ()

106checkChangedPatterns :: DependencyM ()

92checkChangedPatterns = do

107checkChangedPatterns = do

93− facts <- M.toList . dependencyFacts <$> get

108+ facts <- M.toList . dependencyFacts <$> State.get

94 forM_ facts $ \(id', deps) -> do

109 forM_ facts $ \(id', deps) -> do

95 deps' <- foldM (go id') [] deps

110 deps' <- foldM (go id') [] deps

96− modify $ \s -> s

111+ State.modify $ \s -> s

97 {dependencyFacts = M.insert id' deps' $ dependencyFacts s}

112 {dependencyFacts = M.insert id' deps' $ dependencyFacts s}

98 where

113 where

99 go _ ds (Identifier i) = return $ Identifier i : ds

114 go _ ds (Identifier i) = return $ Identifier i : ds

@@ -120,7 +135,7 @@ bruteForce = do

120

135

121 check (todo, changed) id' = do

136 check (todo, changed) id' = do

122 deps <- dependenciesFor id'

137 deps <- dependenciesFor id'

123− ood <- dependencyOod <$> get

138+ ood <- dependencyOod <$> State.get

124 case find (`S.member` ood) deps of

139 case find (`S.member` ood) deps of

125 Nothing -> return (id' : todo, changed)

140 Nothing -> return (id' : todo, changed)

126 Just d -> do

141 Just d -> do

src/Hakyll/Core/Runtime.hsnew file+208

@@ -0,0 +1,208 @@

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

2+module Hakyll.Core.Runtime

3+ ( run

4+ ) where

7+--------------------------------------------------------------------------------

8+import Control.Applicative ((<$>))

9+import Control.Monad (filterM)

10+import Control.Monad.Error (ErrorT, runErrorT, throwError)

11+import Control.Monad.Reader (ask)

12+import Control.Monad.RWS (RWST, runRWST)

13+import Control.Monad.State (get, modify)

14+import Control.Monad.Trans (liftIO)

15+import Data.Map (Map)

16+import qualified Data.Map as M

17+import Data.Monoid (mempty)

18+import Data.Set (Set)

19+import qualified Data.Set as S

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

21+

22+

23+--------------------------------------------------------------------------------

24+import Hakyll.Core.CompiledItem

25+import Hakyll.Core.Compiler.Internal

26+import Hakyll.Core.Configuration

27+import Hakyll.Core.Dependencies

28+import Hakyll.Core.Identifier

29+import Hakyll.Core.Logger

30+import Hakyll.Core.ResourceProvider

31+import Hakyll.Core.Routes

32+import Hakyll.Core.Rules.Internal

33+import Hakyll.Core.Store (Store)

34+import qualified Hakyll.Core.Store as Store

35+import Hakyll.Core.Util.File

36+import Hakyll.Core.Writable

37+

38+

39+--------------------------------------------------------------------------------

40+run :: Configuration -> Rules a -> IO RuleSet

41+run configuration rules = do

42+ -- Initialization

43+ logger <- makeLogger putStrLn

44+ section logger "Initialising"

45+ store <- timed logger "Creating store" $

46+ Store.new (inMemoryCache configuration) $ storeDirectory configuration

47+ provider <- timed logger "Creating provider" $

48+ newResourceProvider store (ignoreFile configuration) "."

49+ ruleSet <- timed logger "Running rules" $ runRules rules provider

50+

51+ -- Get old facts

52+ mOldFacts <- Store.get store factsKey

53+ let (oldFacts) = case mOldFacts of Store.Found f -> f

54+ _ -> mempty

55+

56+ -- Build runtime read/state

57+ let compilers = rulesCompilers ruleSet

58+ read' = RuntimeRead

59+ { runtimeConfiguration = configuration

60+ , runtimeLogger = logger

61+ , runtimeProvider = provider

62+ , runtimeStore = store

63+ , runtimeRoutes = rulesRoutes ruleSet

64+ , runtimeUniverse = compilers

65+ }

66+ state = RuntimeState

67+ { runtimeDone = S.empty

68+ , runtimeTodo = M.empty

69+ , runtimeFacts = oldFacts

70+ }

71+

72+ -- Run the program and fetch the resulting state

73+ result <- runErrorT $ runRWST build read' state

74+ case result of

75+ Left e -> thrown logger e

76+ Right (_, s, _) -> Store.set store factsKey $ runtimeFacts s

77+

78+ -- Flush and return

79+ flushLogger logger

80+ return ruleSet

81+ where

82+ factsKey = ["Hakyll.Core.Runtime.run", "facts"]

83+

84+

85+--------------------------------------------------------------------------------

86+data RuntimeRead = RuntimeRead

87+ { runtimeConfiguration :: Configuration

88+ , runtimeLogger :: Logger

89+ , runtimeProvider :: ResourceProvider

90+ , runtimeStore :: Store

91+ , runtimeRoutes :: Routes

92+ , runtimeUniverse :: [(Identifier, Compiler CompiledItem)]

93+ }

94+

95+

96+--------------------------------------------------------------------------------

97+data RuntimeState = RuntimeState

98+ { runtimeDone :: Set Identifier

99+ , runtimeTodo :: Map Identifier (Compiler CompiledItem)

100+ , runtimeFacts :: DependencyFacts

101+ }

102+

103+

104+--------------------------------------------------------------------------------

105+type Runtime a = RWST RuntimeRead () RuntimeState (ErrorT String IO) a

106+

107+

108+--------------------------------------------------------------------------------

109+build :: Runtime ()

110+build = do

111+ scheduleOutOfDate

112+ pickAndChase

113+

114+

115+--------------------------------------------------------------------------------

116+scheduleOutOfDate :: Runtime ()

117+scheduleOutOfDate = do

118+ logger <- runtimeLogger <$> ask

119+ provider <- runtimeProvider <$> ask

120+ universe <- runtimeUniverse <$> ask

121+ facts <- runtimeFacts <$> get

122+ todo <- runtimeTodo <$> get

123+

124+ let identifiers = map fst universe

125+ modified <- timed logger "Checking for modified items" $

126+ fmap S.fromList $ flip filterM identifiers $

127+ liftIO . resourceModified provider

128+ let (ood, facts', _) = outOfDate identifiers modified facts

129+ todo' = M.fromList

130+ [(id', c) | (id', c) <- universe, id' `S.member` ood]

131+

132+ -- Update facts and todo items

133+ modify $ \s -> s

134+ { runtimeTodo = todo `M.union` todo'

135+ , runtimeFacts = facts'

136+ }

137+

138+

139+--------------------------------------------------------------------------------

140+pickAndChase :: Runtime ()

141+pickAndChase = do

142+ todo <- runtimeTodo <$> get

143+ case M.minViewWithKey todo of

144+ Nothing -> return ()

145+ Just ((id', _), _) -> chase [] id'

146+

147+

148+--------------------------------------------------------------------------------

149+chase :: [Identifier] -> Identifier -> Runtime ()

150+chase trail id'

151+ | id' `elem` trail = return () -- Cycle detected!

152+ | otherwise = do

153+ logger <- runtimeLogger <$> ask

154+ todo <- runtimeTodo <$> get

155+ provider <- runtimeProvider <$> ask

156+ universe <- runtimeUniverse <$> ask

157+ routes <- runtimeRoutes <$> ask

158+ store <- runtimeStore <$> ask

159+ config <- runtimeConfiguration <$> ask

160+

161+ section logger $ "Processing " ++ show id'

162+ isModified <- liftIO $ resourceModified provider id'

163+ let compiler = todo M.! id'

164+ read' = CompilerRead

165+ { compilerIdentifier = id'

166+ , compilerResourceProvider = provider

167+ , compilerUniverse = map fst universe

168+ , compilerRoutes = routes

169+ , compilerStore = store

170+ , compilerResourceModified = isModified

171+ , compilerLogger = logger

172+ }

173+

174+ result <- timed logger "Compiling" $ liftIO $ runCompiler compiler read'

175+ case result of

176+ -- Rethrow error

177+ CompilerError e -> throwError e

178+

179+ -- Huge success

180+ CompilerDone compiled facts -> do

181+ -- Write if necessary

182+ case runRoutes routes id' of

183+ Nothing -> return ()

184+ Just url -> timed logger ("Routing to " ++ url) $ do

185+ let path = destinationDirectory config </> url

186+ liftIO $ makeDirectories path

187+ liftIO $ write path compiled

188+

189+ -- Update state

190+ modify $ \s -> s

191+ { runtimeDone = S.insert id' (runtimeDone s)

192+ , runtimeTodo = M.delete id' (runtimeTodo s)

193+ , runtimeFacts = M.insert id' facts (runtimeFacts s)

194+ }

195+

196+ -- Try something else first

197+ CompilerRequire dep c -> do

198+ -- Update the compiler so we don't execute it twice

199+ depDone <- (dep `S.member`) . runtimeDone <$> get

200+ modify $ \s -> s

201+ { runtimeTodo = M.insert id'

202+ (if depDone then c else compilerResult result)

203+ (runtimeTodo s)

204+ }

205+

206+ -- If the required item is already compiled, continue, or, start

207+ -- chasing that

208+ if depDone then chase trail id' else chase (id' : trail) dep

src/Hakyll/Core/Util/File.hs+2−2

@@ -47,8 +47,8 @@ getRecursiveContents includeDirs topdir = do

47-- | Check if a file is meant for Hakyll internal use, i.e. if it is located in

48-- the destination or store directory

49--

50−isFileInternal :: HakyllConfiguration -- ^ Configuration

50+isFileInternal :: Configuration -- ^ Configuration

51− -> FilePath -- ^ File to check

51+ -> FilePath -- ^ File to check

52 -> Bool -- ^ If the given file is internal

53isFileInternal configuration file =

54 any (`isPrefixOf` split file) dirs

src/Hakyll/Web/Preview/Poll.hs+3−3

@@ -19,9 +19,9 @@ import Hakyll.Core.Configuration

20-- | A preview thread that periodically recompiles the site.

21--

22−previewPoll :: HakyllConfiguration -- ^ Configuration

22+previewPoll :: Configuration -- ^ Configuration

23− -> IO [FilePath] -- ^ Updating action

23+ -> IO [FilePath] -- ^ Updating action

24− -> IO () -- ^ Can block forever

24+ -> IO () -- ^ Can block forever

25previewPoll _ update = do

26#if MIN_VERSION_directory(1,2,0)

27 time <- getCurrentTime