11d7031 · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Add compilers producing compilers

11d7031Jasper Van der Jeugt16 years ago

src/Hakyll/Core/Compiler.hs+22−13

compare with master

unifiedsplit

@@ -31,25 +31,34 @@ import Hakyll.Core.Writable

31import Hakyll.Core.ResourceProvider

32import Hakyll.Core.Compiler.Internal

33import Hakyll.Core.Store

34+import Hakyll.Core.Rules

35-- | Run a compiler, yielding the resulting target and it's dependencies. This

36-- | Run a compiler, yielding the resulting target and it's dependencies. This

36-- version of 'runCompilerJob' also stores the result

37-- version of 'runCompilerJob' also stores the result

37--

38--

38−runCompiler :: Compiler () CompiledItem -- ^ Compiler to run

39+runCompiler :: Compiler () CompileRule -- ^ Compiler to run

39− -> Identifier -- ^ Target identifier

40+ -> Identifier -- ^ Target identifier

40− -> ResourceProvider -- ^ Resource provider

41+ -> ResourceProvider -- ^ Resource provider

41− -> Maybe FilePath -- ^ Route

42+ -> Maybe FilePath -- ^ Route

42− -> Store -- ^ Store

43+ -> Store -- ^ Store

43− -> Bool -- ^ Was the resource modified?

44+ -> Bool -- ^ Was the resource modified?

44− -> IO CompiledItem -- ^ Resulting item

45+ -> IO CompileRule -- ^ Resulting item

45−runCompiler compiler identifier provider route store modified = do

46+runCompiler compiler identifier provider route' store modified = do

46 -- Run the compiler job

47 -- Run the compiler job

47− CompiledItem result <- runCompilerJob

48− compiler identifier provider route store modified

48+ result <- runCompilerJob compiler identifier provider route' store modified

50− -- Store a copy in the cache and return

50+ -- Inspect the result

51+ case result of

52+ -- In case we compiled an item, we will store a copy in the cache first,

53+ -- before we return control. This makes sure the compiled item can later

54+ -- be accessed by e.g. require.

55+ ItemRule (CompiledItem x) ->

51− storeSet store "Hakyll.Core.Compiler.runCompiler" identifier result

56+ storeSet store "Hakyll.Core.Compiler.runCompiler" identifier x

57+

58+ -- Otherwise, we do nothing here

59+ _ -> return ()

60+

52− return $ CompiledItem result

61+ return result

54-- | Get the identifier of the item that is currently being compiled

63-- | Get the identifier of the item that is currently being compiled

55--

64--

src/Hakyll/Core/Rules.hs+38−12

@@ -3,19 +3,21 @@

3--

4{-# LANGUAGE GeneralizedNewtypeDeriving #-}

5module Hakyll.Core.Rules

6+ ( CompileRule (..)

6− ( RuleSet (..)

7+ , RuleSet (..)

7 , RulesM

8 , RulesM

8 , Rules

9 , Rules

9 , runRules

10 , runRules

10 , compile

11 , compile

11 , create

12 , create

12 , route

13 , route

14+ , addCompilers

13 ) where

15 ) where

15import Control.Applicative (Applicative, (<$>))

17import Control.Applicative (Applicative, (<$>))

16import Control.Monad.Writer

18import Control.Monad.Writer

17import Control.Monad.Reader

19import Control.Monad.Reader

18−import Control.Arrow (second, (>>>), arr)

20+import Control.Arrow (second, (>>>), arr, (>>^))

20import Data.Typeable (Typeable)

22import Data.Typeable (Typeable)

21import Data.Binary (Binary)

23import Data.Binary (Binary)

@@ -23,16 +25,26 @@ import Data.Binary (Binary)

23import Hakyll.Core.ResourceProvider

25import Hakyll.Core.ResourceProvider

24import Hakyll.Core.Identifier

26import Hakyll.Core.Identifier

25import Hakyll.Core.Identifier.Pattern

27import Hakyll.Core.Identifier.Pattern

26−import Hakyll.Core.Compiler

28+import Hakyll.Core.Compiler.Internal

27import Hakyll.Core.Route

29import Hakyll.Core.Route

28import Hakyll.Core.CompiledItem

30import Hakyll.Core.CompiledItem

29import Hakyll.Core.Writable

31import Hakyll.Core.Writable

33+-- | Output of a compiler rule

34+--

35+-- * The compiler will produce a simple item. This is the most common case.

36+--

37+-- * The compiler will produce more compilers. These new compilers need to be

38+-- added to the runtime if possible, since other items might depend upon them.

39+--

40+data CompileRule = ItemRule CompiledItem

41+ | AddCompilersRule [(Identifier, Compiler () CompiledItem)]

42+

31-- | A collection of rules for the compilation process

43-- | A collection of rules for the compilation process

32--

44--

33data RuleSet = RuleSet

45data RuleSet = RuleSet

34 { rulesRoute :: Route

46 { rulesRoute :: Route

35− , rulesCompilers :: [(Identifier, Compiler () CompiledItem)]

47+ , rulesCompilers :: [(Identifier, Compiler () CompileRule)]

36 }

48 }

38instance Monoid RuleSet where

50instance Monoid RuleSet where

@@ -58,18 +70,18 @@ runRules rules provider = execWriter $ runReaderT (unRulesM rules) provider

59-- | Add a route

71-- | Add a route

60--

72--

61−addRoute :: Route -> Rules

73+tellRoute :: Route -> Rules

62−addRoute route' = RulesM $ tell $ RuleSet route' mempty

74+tellRoute route' = RulesM $ tell $ RuleSet route' mempty

64-- | Add a number of compilers

76-- | Add a number of compilers

65--

77--

66−addCompilers :: (Binary a, Typeable a, Writable a)

78+tellCompilers :: (Binary a, Typeable a, Writable a)

67 => [(Identifier, Compiler () a)]

79 => [(Identifier, Compiler () a)]

68 -> Rules

80 -> Rules

69−addCompilers compilers = RulesM $ tell $ RuleSet mempty $

81+tellCompilers compilers = RulesM $ tell $ RuleSet mempty $

70 map (second boxCompiler) compilers

82 map (second boxCompiler) compilers

71 where

83 where

72− boxCompiler = (>>> arr compiledItem)

84+ boxCompiler = (>>> arr compiledItem >>> arr ItemRule)

74-- | Add a compilation rule

86-- | Add a compilation rule

75--

87--

@@ -80,7 +92,7 @@ compile :: (Binary a, Typeable a, Writable a)

80 => Pattern -> Compiler () a -> Rules

92 => Pattern -> Compiler () a -> Rules

81compile pattern compiler = RulesM $ do

93compile pattern compiler = RulesM $ do

82 identifiers <- matches pattern . resourceList <$> ask

94 identifiers <- matches pattern . resourceList <$> ask

83− unRulesM $ addCompilers $ zip identifiers (repeat compiler)

95+ unRulesM $ tellCompilers $ zip identifiers (repeat compiler)

85-- | Add a compilation rule

97-- | Add a compilation rule

86--

98--

@@ -88,9 +100,23 @@ compile pattern compiler = RulesM $ do

88--

100--

89create :: (Binary a, Typeable a, Writable a)

101create :: (Binary a, Typeable a, Writable a)

90 => Identifier -> Compiler () a -> Rules

102 => Identifier -> Compiler () a -> Rules

91−create identifier compiler = addCompilers [(identifier, compiler)]

103+create identifier compiler = tellCompilers [(identifier, compiler)]

104

93-- | Add a route

105-- | Add a route

94--

106--

95route :: Pattern -> Route -> Rules

107route :: Pattern -> Route -> Rules

96−route pattern route' = addRoute $ ifMatch pattern route'

108+route pattern route' = tellRoute $ ifMatch pattern route'

109+

110+-- | Add a compiler that produces other compilers over time

111+--

112+addCompilers :: (Binary a, Typeable a, Writable a)

113+ => Identifier

114+ -- ^ Identifier for this compiler

115+ -> Compiler () [(Identifier, Compiler () a)]

116+ -- ^ Compiler generating the other compilers

117+ -> Rules

118+ -- ^ Resulting rules

119+addCompilers identifier compiler = RulesM $ tell $ RuleSet mempty $

120+ [(identifier, compiler >>^ makeRule)]

121+ where

122+ makeRule = AddCompilersRule . map (second (>>^ compiledItem))

src/Hakyll/Core/Run.hs+1−1

@@ -91,7 +91,7 @@ hakyllWith rules provider store = do

91 let isModified = id' `S.member` modified'

93 -- Run the compiler

94− compiled <- runCompiler comp id' provider url store isModified

94+ ItemRule compiled <- runCompiler comp id' provider url store isModified

95 putStrLn $ "Generated target: " ++ show id'

97 case url of