diff options
Diffstat (limited to 'src/Hakyll/Core')
-rw-r--r-- | src/Hakyll/Core/CompiledItem.hs | 40 | ||||
-rw-r--r-- | src/Hakyll/Core/Compiler.hs | 21 | ||||
-rw-r--r-- | src/Hakyll/Core/Rules.hs | 72 | ||||
-rw-r--r-- | src/Hakyll/Core/Rules/Internal.hs | 16 | ||||
-rw-r--r-- | src/Hakyll/Core/Run.hs | 14 |
5 files changed, 44 insertions, 119 deletions
diff --git a/src/Hakyll/Core/CompiledItem.hs b/src/Hakyll/Core/CompiledItem.hs index e40ab56..85e85b3 100644 --- a/src/Hakyll/Core/CompiledItem.hs +++ b/src/Hakyll/Core/CompiledItem.hs @@ -1,3 +1,4 @@ +-------------------------------------------------------------------------------- -- | A module containing a box datatype representing a compiled item. This -- item can be of any type, given that a few restrictions hold: -- @@ -6,42 +7,49 @@ -- * we need a 'Binary' instance so we can serialize these items to the cache; -- -- * we need a 'Writable' instance so the results can be saved. --- -{-# LANGUAGE ExistentialQuantification, DeriveDataTypeable #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ExistentialQuantification #-} module Hakyll.Core.CompiledItem ( CompiledItem (..) , compiledItem , unCompiledItem ) where -import Data.Binary (Binary) -import Data.Typeable (Typeable, cast, typeOf) -import Data.Maybe (fromMaybe) -import Hakyll.Core.Writable +-------------------------------------------------------------------------------- +import Data.Binary (Binary) +import Data.Maybe (fromMaybe) +import Data.Typeable (Typeable, cast, typeOf) + + +-------------------------------------------------------------------------------- +import Hakyll.Core.Writable + +-------------------------------------------------------------------------------- -- | Box type for a compiled item -- data CompiledItem = forall a. (Binary a, Typeable a, Writable a) => CompiledItem a deriving (Typeable) + +-------------------------------------------------------------------------------- instance Writable CompiledItem where write p (CompiledItem x) = write p x + +-------------------------------------------------------------------------------- -- | Box a value into a 'CompiledItem' --- -compiledItem :: (Binary a, Typeable a, Writable a) - => a - -> CompiledItem +compiledItem :: (Binary a, Typeable a, Writable a) => a -> CompiledItem compiledItem = CompiledItem + +-------------------------------------------------------------------------------- -- | Unbox a value from a 'CompiledItem' --- -unCompiledItem :: (Binary a, Typeable a, Writable a) - => CompiledItem - -> a +unCompiledItem :: (Binary a, Typeable a, Writable a) => CompiledItem -> a unCompiledItem (CompiledItem x) = fromMaybe error' $ cast x where - error' = error $ "Hakyll.Core.CompiledItem.unCompiledItem: " - ++ "unsupported type (got " ++ show (typeOf x) ++ ")" + error' = error $ + "Hakyll.Core.CompiledItem.unCompiledItem: " ++ + "unsupported type (got " ++ show (typeOf x) ++ ")" diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs index ee3f90e..31b25e3 100644 --- a/src/Hakyll/Core/Compiler.hs +++ b/src/Hakyll/Core/Compiler.hs @@ -137,7 +137,6 @@ import Hakyll.Core.Writable import Hakyll.Core.ResourceProvider import Hakyll.Core.Compiler.Internal import Hakyll.Core.Store (Store) -import Hakyll.Core.Rules.Internal import Hakyll.Core.Routes import Hakyll.Core.Logger import qualified Hakyll.Core.Store as Store @@ -145,15 +144,15 @@ import qualified Hakyll.Core.Store as Store -- | Run a compiler, yielding the resulting target and it's dependencies. This -- version of 'runCompilerJob' also stores the result -- -runCompiler :: Compiler () CompileRule -- ^ Compiler to run - -> Identifier () -- ^ Target identifier - -> ResourceProvider -- ^ Resource provider - -> [Identifier ()] -- ^ Universe - -> Routes -- ^ Route - -> Store -- ^ Store - -> Bool -- ^ Was the resource modified? - -> Logger -- ^ Logger - -> IO (Throwing CompileRule) -- ^ Resulting item +runCompiler :: Compiler () CompiledItem -- ^ Compiler to run + -> Identifier () -- ^ Target identifier + -> ResourceProvider -- ^ Resource provider + -> [Identifier ()] -- ^ Universe + -> Routes -- ^ Route + -> Store -- ^ Store + -> Bool -- ^ Was the resource modified? + -> Logger -- ^ Logger + -> IO (Throwing CompiledItem) -- ^ Resulting item runCompiler compiler id' provider universe routes store modified logger = do -- Run the compiler job result <- handle (\(e :: SomeException) -> return $ Left $ show e) $ @@ -165,7 +164,7 @@ runCompiler compiler id' provider universe routes store modified logger = do -- In case we compiled an item, we will store a copy in the cache first, -- before we return control. This makes sure the compiled item can later -- be accessed by e.g. require. - Right (CompileRule (CompiledItem x)) -> + Right (CompiledItem x) -> Store.set store ["Hakyll.Core.Compiler.runCompiler", show id'] x -- Otherwise, we do nothing here diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs index 5ac63bc..ba89d75 100644 --- a/src/Hakyll/Core/Rules.hs +++ b/src/Hakyll/Core/Rules.hs @@ -25,15 +25,13 @@ module Hakyll.Core.Rules , create , route , resources - , metaCompile - , metaCompileWith , freshIdentifier ) where -------------------------------------------------------------------------------- import Control.Applicative ((<$>)) -import Control.Arrow (arr, (***), (>>>), (>>^)) +import Control.Arrow (arr, (***), (>>>)) import Control.Monad.Reader (ask, local) import Control.Monad.State (get, put) import Control.Monad.Writer (tell) @@ -73,7 +71,7 @@ tellCompilers compilers = RulesM $ do let compilers' = map (castIdentifier *** boxCompiler) compilers tell $ RuleSet mempty compilers' mempty where - boxCompiler = (>>> arr compiledItem >>> arr CompileRule) + boxCompiler = (>>> arr compiledItem) -------------------------------------------------------------------------------- @@ -188,72 +186,8 @@ resources = RulesM $ do -------------------------------------------------------------------------------- --- | Apart from regular compilers, one is also able to specify metacompilers. --- Metacompilers are a special class of compilers: they are compilers which --- produce other compilers. --- --- This is needed when the list of compilers depends on something we cannot know --- before actually running other compilers. The most typical example is if we --- have a blogpost using tags. --- --- Every post has a collection of tags. For example, --- --- > post1: code, haskell --- > post2: code, random --- --- Now, we want to create a list of posts for every tag. We cannot write this --- down in our 'Rules' DSL directly, since we don't know what tags the different --- posts will have -- we depend on information that will only be available when --- we are actually compiling the pages. --- --- The solution is simple, using 'metaCompile', we can add a compiler that will --- parse the pages and produce the compilers needed for the different tag pages. --- --- And indeed, we can see that the first argument to 'metaCompile' is a --- 'Compiler' which produces a list of ('Identifier', 'Compiler') pairs. The --- idea is simple: 'metaCompile' produces a list of compilers, and the --- corresponding identifiers. --- --- For simple hakyll systems, it is no need for this construction. More --- formally, it is only needed when the content of one or more items determines --- which items must be rendered. -metaCompile :: (Binary a, Typeable a, Writable a) - => Compiler () [(Identifier a, Compiler () a)] - -- ^ Compiler generating the other compilers - -> Rules - -- ^ Resulting rules -metaCompile compiler = do - id' <- freshIdentifier "Hakyll.Core.Rules.metaCompile" - metaCompileWith id' compiler - - --------------------------------------------------------------------------------- --- | Version of 'metaCompile' that allows you to specify a custom identifier for --- the metacompiler. -metaCompileWith :: (Binary a, Typeable a, Writable a) - => Identifier () - -- ^ Identifier for this compiler - -> Compiler () [(Identifier a, Compiler () a)] - -- ^ Compiler generating the other compilers - -> Rules - -- ^ Resulting rules -metaCompileWith identifier compiler = RulesM $ do - group' <- rulesGroup <$> ask - - let -- Set the correct group on the identifier - id' = setGroup group' identifier - -- Function to box an item into a rule - makeRule = MetaCompileRule . map (castIdentifier *** box) - -- Entire boxing function - box = (>>> fromDependency id' >>^ CompileRule . compiledItem) - -- Resulting compiler list - compilers = [(id', compiler >>> arr makeRule )] - - tell $ RuleSet mempty compilers mempty - - --------------------------------------------------------------------------------- -- | Generate a fresh Identifier with a given prefix +-- TODO: remove? freshIdentifier :: String -- ^ Prefix -> RulesM (Identifier a) -- ^ Fresh identifier freshIdentifier prefix = RulesM $ do diff --git a/src/Hakyll/Core/Rules/Internal.hs b/src/Hakyll/Core/Rules/Internal.hs index 245d935..dc2badd 100644 --- a/src/Hakyll/Core/Rules/Internal.hs +++ b/src/Hakyll/Core/Rules/Internal.hs @@ -3,8 +3,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE Rank2Types #-} module Hakyll.Core.Rules.Internal - ( CompileRule (..) - , RuleSet (..) + ( RuleSet (..) , RuleState (..) , RuleEnvironment (..) , RulesM (..) @@ -31,23 +30,12 @@ import Hakyll.Core.Routes -------------------------------------------------------------------------------- --- | Output of a compiler rule --- --- * The compiler will produce a simple item. This is the most common case. --- --- * The compiler will produce more compilers. These new compilers need to be --- added to the runtime if possible, since other items might depend upon them. -data CompileRule = CompileRule CompiledItem - | MetaCompileRule [(Identifier (), Compiler () CompileRule)] - - --------------------------------------------------------------------------------- -- | A collection of rules for the compilation process data RuleSet = RuleSet { -- | Routes used in the compilation structure rulesRoutes :: Routes , -- | Compilation rules - rulesCompilers :: [(Identifier (), Compiler () CompileRule)] + rulesCompilers :: [(Identifier (), Compiler () CompiledItem)] , -- | A set of the actually used files rulesResources :: Set (Identifier ()) } diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs index ff7acac..5c0e1c8 100644 --- a/src/Hakyll/Core/Run.hs +++ b/src/Hakyll/Core/Run.hs @@ -18,6 +18,7 @@ import System.FilePath ((</>)) import qualified Data.Map as M import qualified Data.Set as S +import Hakyll.Core.CompiledItem import Hakyll.Core.Compiler import Hakyll.Core.Compiler.Internal import Hakyll.Core.Configuration @@ -94,7 +95,7 @@ data RuntimeEnvironment = RuntimeEnvironment data RuntimeState = RuntimeState { hakyllAnalyzer :: DependencyAnalyzer (Identifier ()) - , hakyllCompilers :: Map (Identifier ()) (Compiler () CompileRule) + , hakyllCompilers :: Map (Identifier ()) (Compiler () CompiledItem) } newtype Runtime a = Runtime @@ -104,7 +105,7 @@ newtype Runtime a = Runtime -- | Add a number of compilers and continue using these compilers -- -addNewCompilers :: [(Identifier (), Compiler () CompileRule)] +addNewCompilers :: [(Identifier (), Compiler () CompiledItem)] -- ^ Compilers to add -> Runtime () addNewCompilers newCompilers = Runtime $ do @@ -190,8 +191,8 @@ build id' = Runtime $ do store isModified logger case result of - -- Compile rule for one item, easy stuff - Right (CompileRule compiled) -> do + -- Success + Right compiled -> do case runRoutes routes id' of Nothing -> return () Just url -> timed logger ("Routing to " ++ url) $ do @@ -204,10 +205,5 @@ build id' = Runtime $ do -- Continue for the remaining compilers unRuntime stepAnalyzer - -- Metacompiler, slightly more complicated - Right (MetaCompileRule newCompilers) -> - -- Actually I was just kidding, it's not hard at all - unRuntime $ addNewCompilers newCompilers - -- Some error happened, rethrow in Runtime monad Left err -> throwError err |