summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Hakyll/Core/Compiler.hs23
-rw-r--r--src/Hakyll/Core/Compiler/Require.hs70
-rw-r--r--src/Hakyll/Core/Runtime.hs6
-rw-r--r--src/Hakyll/Main.hs68
4 files changed, 119 insertions, 48 deletions
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index c542ce7..94f1ef2 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -10,9 +10,16 @@ module Hakyll.Core.Compiler
, getResourceString
, getResourceLBS
, getResourceWith
- , require
- , requireBody
- , requireAll
+
+ , Internal.Snapshot
+ , saveSnapshot
+ , Internal.require
+ , Internal.requireSnapshot
+ , Internal.requireBody
+ , Internal.requireSnapshotBody
+ , Internal.requireAll
+ , Internal.requireAllSnapshots
+
, cached
, unsafeCompiler
, debugCompiler
@@ -30,7 +37,7 @@ import System.Environment (getProgName)
--------------------------------------------------------------------------------
import Hakyll.Core.Compiler.Internal
-import Hakyll.Core.Compiler.Require
+import qualified Hakyll.Core.Compiler.Require as Internal
import Hakyll.Core.Identifier
import Hakyll.Core.Item
import Hakyll.Core.Logger as Logger
@@ -94,6 +101,14 @@ getResourceWith reader = do
--------------------------------------------------------------------------------
+saveSnapshot :: (Binary a, Typeable a)
+ => Internal.Snapshot -> Item a -> Compiler ()
+saveSnapshot snapshot item = do
+ store <- compilerStore <$> compilerAsk
+ compilerUnsafeIO $ Internal.saveSnapshot store snapshot item
+
+
+--------------------------------------------------------------------------------
cached :: (Binary a, Typeable a)
=> String
-> Compiler a
diff --git a/src/Hakyll/Core/Compiler/Require.hs b/src/Hakyll/Core/Compiler/Require.hs
index b9e0cc7..3c6ddfc 100644
--- a/src/Hakyll/Core/Compiler/Require.hs
+++ b/src/Hakyll/Core/Compiler/Require.hs
@@ -1,9 +1,14 @@
--------------------------------------------------------------------------------
module Hakyll.Core.Compiler.Require
- ( save
+ ( Snapshot
+ , save
+ , saveSnapshot
, require
+ , requireSnapshot
, requireBody
+ , requireSnapshotBody
, requireAll
+ , requireAllSnapshots
) where
@@ -25,45 +30,82 @@ import qualified Hakyll.Core.Store as Store
--------------------------------------------------------------------------------
-save :: (Binary a, Typeable a) => Store -> Identifier -> a -> IO ()
-save store identifier x = Store.set store (key identifier) x
+type Snapshot = String
+
+
+--------------------------------------------------------------------------------
+save :: (Binary a, Typeable a) => Store -> Item a -> IO ()
+save store item = saveSnapshot store final item
+
+
+--------------------------------------------------------------------------------
+saveSnapshot :: (Binary a, Typeable a)
+ => Store -> Snapshot -> Item a -> IO ()
+saveSnapshot store snapshot item =
+ Store.set store (key (itemIdentifier item) snapshot) (itemBody item)
--------------------------------------------------------------------------------
require :: (Binary a, Typeable a) => Identifier -> Compiler (Item a)
-require id' = do
+require id' = requireSnapshot id' final
+
+
+--------------------------------------------------------------------------------
+requireSnapshot :: (Binary a, Typeable a)
+ => Identifier -> Snapshot -> Compiler (Item a)
+requireSnapshot id' snapshot = do
store <- compilerStore <$> compilerAsk
compilerTellDependencies [IdentifierDependency id']
compilerResult $ CompilerRequire id' $ do
- result <- compilerUnsafeIO $ Store.get store (key id')
+ result <- compilerUnsafeIO $ Store.get store (key id' snapshot)
case result of
Store.NotFound -> compilerThrow notFound
Store.WrongType e r -> compilerThrow $ wrongType e r
Store.Found x -> return $ Item id' x
where
notFound =
- "Hakyll.Core.Compiler.Require.require: " ++ show id' ++ " was " ++
- "not found in the cache, the cache might be corrupted or " ++
+ "Hakyll.Core.Compiler.Require.require: " ++ show id' ++
+ " (snapshot " ++ snapshot ++ ") was not found in the cache, " ++
+ "the cache might be corrupted or " ++
"the item you are referring to might not exist"
wrongType e r =
- "Hakyll.Core.Compiler.Require.require: " ++ show id' ++ " was found " ++
- "in the cache, but does not have the right type: expected " ++ show e ++
+ "Hakyll.Core.Compiler.Require.require: " ++ show id' ++
+ " (snapshot " ++ snapshot ++ ") was found in the cache, " ++
+ "but does not have the right type: expected " ++ show e ++
" but got " ++ show r
--------------------------------------------------------------------------------
requireBody :: (Binary a, Typeable a) => Identifier -> Compiler a
-requireBody = fmap itemBody . require
+requireBody id' = requireSnapshotBody id' final
+
+
+--------------------------------------------------------------------------------
+requireSnapshotBody :: (Binary a, Typeable a)
+ => Identifier -> Snapshot -> Compiler a
+requireSnapshotBody id' snapshot = fmap itemBody $ requireSnapshot id' snapshot
--------------------------------------------------------------------------------
requireAll :: (Binary a, Typeable a) => Pattern -> Compiler [Item a]
-requireAll pattern = do
+requireAll pattern = requireAllSnapshots pattern final
+
+
+--------------------------------------------------------------------------------
+requireAllSnapshots :: (Binary a, Typeable a)
+ => Pattern -> Snapshot -> Compiler [Item a]
+requireAllSnapshots pattern snapshot = do
matching <- getMatches pattern
- mapM require matching
+ mapM (\i -> requireSnapshot i snapshot) matching
+
+
+--------------------------------------------------------------------------------
+key :: Identifier -> String -> [String]
+key identifier snapshot =
+ ["Hakyll.Core.Compiler.Require", show identifier, snapshot]
--------------------------------------------------------------------------------
-key :: Identifier -> [String]
-key identifier = ["Hakyll.Core.Compiler.Require", show identifier]
+final :: Snapshot
+final = "final"
diff --git a/src/Hakyll/Core/Runtime.hs b/src/Hakyll/Core/Runtime.hs
index 96b21cd..cdc7fdb 100644
--- a/src/Hakyll/Core/Runtime.hs
+++ b/src/Hakyll/Core/Runtime.hs
@@ -27,7 +27,6 @@ import Hakyll.Core.Compiler.Require
import Hakyll.Core.Configuration
import Hakyll.Core.Dependencies
import Hakyll.Core.Identifier
-import Hakyll.Core.Item
import Hakyll.Core.Item.SomeItem
import Hakyll.Core.Logger (Logger)
import qualified Hakyll.Core.Logger as Logger
@@ -194,8 +193,7 @@ chase trail id'
-- Huge success
CompilerDone (SomeItem item) cwrite -> do
-- TODO: Sanity check on itemIdentifier?
- let body = itemBody item
- facts = compilerDependencies cwrite
+ let facts = compilerDependencies cwrite
cacheHits
| compilerCacheHits cwrite <= 0 = "updated"
| otherwise = "cached "
@@ -213,7 +211,7 @@ chase trail id'
Logger.debug logger $ "Routed to " ++ path
-- Save! (For require)
- liftIO $ save store id' body
+ liftIO $ save store item
-- Update state
modify $ \s -> s
diff --git a/src/Hakyll/Main.hs b/src/Hakyll/Main.hs
index e0f5b93..37dc0fa 100644
--- a/src/Hakyll/Main.hs
+++ b/src/Hakyll/Main.hs
@@ -1,39 +1,47 @@
+--------------------------------------------------------------------------------
-- | Module providing the main hakyll function and command-line argument parsing
---
{-# LANGUAGE CPP #-}
module Hakyll.Main
( hakyll
, hakyllWith
) where
-import Control.Monad (when)
-import System.Directory (doesDirectoryExist, removeDirectoryRecursive)
-import System.Environment (getProgName, getArgs)
-import System.Process (system)
-import Hakyll.Core.Configuration
-import Hakyll.Core.Identifier
-import Hakyll.Core.Runtime
-import Hakyll.Core.Rules
+--------------------------------------------------------------------------------
+import Control.Monad (when)
+import System.Directory (doesDirectoryExist,
+ removeDirectoryRecursive)
+import System.Environment (getArgs, getProgName)
+import System.Process (system)
-#ifdef PREVIEW_SERVER
-import Control.Applicative ((<$>))
-import Control.Concurrent (forkIO)
-import qualified Data.Set as S
-import Hakyll.Core.Rules.Internal
-import Hakyll.Web.Preview.Poll
-import Hakyll.Web.Preview.Server
+--------------------------------------------------------------------------------
+import Hakyll.Core.Configuration
+import Hakyll.Core.Rules
+import Hakyll.Core.Runtime
+
+
+--------------------------------------------------------------------------------
+#ifdef PREVIEW_SERVER
+import Control.Applicative ((<$>))
+import Control.Concurrent (forkIO)
+import qualified Data.Set as S
+import Hakyll.Core.Identifier
+import Hakyll.Core.Rules.Internal
+import Hakyll.Web.Preview.Poll
+import Hakyll.Web.Preview.Server
#endif
+
+--------------------------------------------------------------------------------
-- | This usualy is the function with which the user runs the hakyll compiler
---
hakyll :: Rules a -> IO ()
hakyll = hakyllWith defaultConfiguration
+
+--------------------------------------------------------------------------------
-- | A variant of 'hakyll' which allows the user to specify a custom
-- configuration
---
hakyllWith :: Configuration -> Rules a -> IO ()
hakyllWith conf rules = do
args <- getArgs
@@ -49,15 +57,17 @@ hakyllWith conf rules = do
["deploy"] -> deploy conf
_ -> help
+
+--------------------------------------------------------------------------------
-- | Build the site
---
build :: Configuration -> Rules a -> IO ()
build conf rules = do
_ <- run conf rules
return ()
+
+--------------------------------------------------------------------------------
-- | Remove the output directories
---
clean :: Configuration -> IO ()
clean conf = do
remove $ destinationDirectory conf
@@ -68,8 +78,9 @@ clean conf = do
exists <- doesDirectoryExist dir
when exists $ removeDirectoryRecursive dir
+
+--------------------------------------------------------------------------------
-- | Show usage information.
---
help :: IO ()
help = do
name <- getProgName
@@ -95,8 +106,9 @@ help = do
previewServerDisabled
#endif
+
+--------------------------------------------------------------------------------
-- | Preview the site
---
preview :: Configuration -> Rules a -> Int -> IO ()
#ifdef PREVIEW_SERVER
preview conf rules port = do
@@ -111,15 +123,17 @@ preview conf rules port = do
preview _ _ _ = previewServerDisabled
#endif
+
+--------------------------------------------------------------------------------
-- | Rebuild the site
---
rebuild :: Configuration -> Rules a -> IO ()
rebuild conf rules = do
clean conf
build conf rules
+
+--------------------------------------------------------------------------------
-- | Start a server
---
server :: Configuration -> Int -> IO ()
#ifdef PREVIEW_SERVER
server conf port = do
@@ -131,15 +145,17 @@ server conf port = do
server _ _ = previewServerDisabled
#endif
+
+--------------------------------------------------------------------------------
-- | Upload the site
---
deploy :: Configuration -> IO ()
deploy conf = do
_ <- system $ deployCommand conf
return ()
+
+--------------------------------------------------------------------------------
-- | Print a warning message about the preview serving not being enabled
---
#ifndef PREVIEW_SERVER
previewServerDisabled :: IO ()
previewServerDisabled =
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-23 13:32:07 +0000