summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--hakyll.cabal1
-rw-r--r--src/Text/Hakyll.hs45
-rw-r--r--src/Text/Hakyll/File.hs31
-rw-r--r--src/Text/Hakyll/Hakyll.hs4
-rw-r--r--src/Text/Hakyll/Internal/Cache.hs12
-rw-r--r--src/Text/Hakyll/Render.hs21
-rw-r--r--src/Text/Hakyll/Render/Internal.hs4
-rw-r--r--tests/Tests.hs12
8 files changed, 71 insertions, 59 deletions
diff --git a/hakyll.cabal b/hakyll.cabal
index 9ce3e5f..d96b499 100644
--- a/hakyll.cabal
+++ b/hakyll.cabal
@@ -49,3 +49,4 @@ library
Text.Hakyll.Regex
Network.Hakyll.SimpleServer
other-modules: Text.Hakyll.Render.Internal
+ Text.Hakyll.Internal.Cache
diff --git a/src/Text/Hakyll.hs b/src/Text/Hakyll.hs
index c0486e7..33b1b57 100644
--- a/src/Text/Hakyll.hs
+++ b/src/Text/Hakyll.hs
@@ -4,7 +4,7 @@ module Text.Hakyll
, hakyllWithConfiguration
) where
-import Control.Monad.Reader (runReaderT)
+import Control.Monad.Reader (runReaderT, liftIO)
import Control.Monad (when)
import qualified Data.Map as M
import System.Environment (getArgs, getProgName)
@@ -17,6 +17,8 @@ import Text.Hakyll.Hakyll
defaultHakyllConfiguration :: HakyllConfiguration
defaultHakyllConfiguration = HakyllConfiguration
{ additionalContext = M.empty
+ , siteDirectory = "_site"
+ , cacheDirectory = "_cache"
}
-- | Hakyll with a default configuration.
@@ -27,32 +29,27 @@ hakyll = hakyllWithConfiguration defaultHakyllConfiguration
hakyllWithConfiguration :: HakyllConfiguration -> Hakyll () -> IO ()
hakyllWithConfiguration configuration buildFunction = do
args <- getArgs
- case args of ["build"] -> build'
- ["clean"] -> clean
- ["preview", p] -> build' >> server (read p)
- ["preview"] -> build' >> server 8000
- ["server", p] -> server (read p)
- ["server"] -> server 8000
- _ -> help
- where
- build' = build configuration buildFunction
-
--- | Build the site.
-build :: HakyllConfiguration -> Hakyll () -> IO ()
-build configuration buildFunction = do putStrLn "Generating..."
- runReaderT buildFunction configuration
+ let f = case args of ["build"] -> buildFunction
+ ["clean"] -> clean
+ ["preview", p] -> buildFunction >> server (read p)
+ ["preview"] -> buildFunction >> server 8000
+ ["server", p] -> server (read p)
+ ["server"] -> server 8000
+ _ -> help
+ runReaderT f configuration
-- | Clean up directories.
-clean :: IO ()
-clean = remove' "_site"
+clean :: Hakyll ()
+clean = do askHakyll siteDirectory >>= remove'
+ askHakyll cacheDirectory >>= remove'
where
- remove' dir = do putStrLn $ "Removing " ++ dir ++ "..."
- exists <- doesDirectoryExist dir
- when exists $ removeDirectoryRecursive dir
+ remove' dir = liftIO $ do putStrLn $ "Removing " ++ dir ++ "..."
+ exists <- doesDirectoryExist dir
+ when exists $ removeDirectoryRecursive dir
-- | Show usage information.
-help :: IO ()
-help = do
+help :: Hakyll ()
+help = liftIO $ do
name <- getProgName
putStrLn $ "This is a Hakyll site generator program. You should always\n"
++ "run it from the project root directory.\n"
@@ -64,5 +61,5 @@ help = do
++ name ++ " preview [port] Generate site, then start a server.\n"
++ name ++ " server [port] Run a local test server.\n"
-server :: Integer -> IO ()
-server p = simpleServer (fromIntegral p) "_site"
+server :: Integer -> Hakyll ()
+server p = askHakyll siteDirectory >>= liftIO . simpleServer (fromIntegral p)
diff --git a/src/Text/Hakyll/File.hs b/src/Text/Hakyll/File.hs
index af40500..852436b 100644
--- a/src/Text/Hakyll/File.hs
+++ b/src/Text/Hakyll/File.hs
@@ -2,13 +2,14 @@
-- files and directories.
module Text.Hakyll.File
( toDestination
+ , toCache
, toURL
, toRoot
, removeSpaces
, makeDirectories
, getRecursiveContents
, havingExtension
- , isCacheValid
+ , isMoreRecent
, directory
) where
@@ -18,7 +19,7 @@ import Control.Monad
import Data.List (isPrefixOf)
import Control.Monad.Reader (liftIO)
-import Text.Hakyll.Hakyll (Hakyll)
+import Text.Hakyll.Hakyll
-- | Auxiliary function to remove pathSeparators form the start. We don't deal
-- with absolute paths here. We also remove $root from the start.
@@ -31,9 +32,17 @@ removeLeadingSeparator path
path' = if "$root" `isPrefixOf` path then drop 5 path
else path
--- | Convert a relative filepath to a filepath in the destination (@_site@).
-toDestination :: FilePath -> FilePath
-toDestination path = "_site" </> removeLeadingSeparator path
+-- | Convert a relative filepath to a filepath in the destination
+-- (default: @_site@).
+toDestination :: FilePath -> Hakyll FilePath
+toDestination path = do dir <- askHakyll siteDirectory
+ return $ dir </> removeLeadingSeparator path
+
+-- | Convert a relative filepath to a filepath in the cache
+-- (default: @_cache@).
+toCache :: FilePath -> Hakyll FilePath
+toCache path = do dir <- askHakyll cacheDirectory
+ return $ dir </> removeLeadingSeparator path
-- | Get the url for a given page.
toURL :: FilePath -> FilePath
@@ -103,14 +112,14 @@ havingExtension extension = filter ((==) extension . takeExtension)
directory :: (FilePath -> Hakyll ()) -> FilePath -> Hakyll ()
directory action dir = getRecursiveContents dir >>= mapM_ action
--- | Check if a cache file is still valid.
-isCacheValid :: FilePath -- ^ The cached file.
+-- | Check if a file is newer then a number of given files.
+isMoreRecent :: FilePath -- ^ The cached file.
-> [FilePath] -- ^ Dependencies of the cached file.
-> Hakyll Bool
-isCacheValid cache depends = do
- exists <- liftIO $ doesFileExist cache
+isMoreRecent file depends = do
+ exists <- liftIO $ doesFileExist file
if not exists
then return False
else do dependsModified <- liftIO $ mapM getModificationTime depends
- cacheModified <- liftIO $ getModificationTime cache
- return (cacheModified >= maximum dependsModified)
+ fileModified <- liftIO $ getModificationTime file
+ return (fileModified >= maximum dependsModified)
diff --git a/src/Text/Hakyll/Hakyll.hs b/src/Text/Hakyll/Hakyll.hs
index af8c9c5..b33bbda 100644
--- a/src/Text/Hakyll/Hakyll.hs
+++ b/src/Text/Hakyll/Hakyll.hs
@@ -15,6 +15,10 @@ data HakyllConfiguration = HakyllConfiguration
{ -- | An additional context to use when rendering. This additional context
-- is used globally.
additionalContext :: Context
+ , -- | Directory where the site is placed.
+ siteDirectory :: FilePath
+ , -- | Directory for cache files.
+ cacheDirectory :: FilePath
}
-- | Our custom monad stack.
diff --git a/src/Text/Hakyll/Internal/Cache.hs b/src/Text/Hakyll/Internal/Cache.hs
new file mode 100644
index 0000000..8e52bb4
--- /dev/null
+++ b/src/Text/Hakyll/Internal/Cache.hs
@@ -0,0 +1,12 @@
+module Text.Hakyll.Internal.Cache
+ ( storeInCache
+ , getFromCache
+ ) where
+
+import Text.Hakyll.Hakyll (Hakyll)
+
+storeInCache :: (Show a) => a -> FilePath -> Hakyll ()
+storeInCache = undefined
+
+getFromCache :: (Read a) => FilePath -> Hakyll (Maybe a)
+getFromCache = undefined
diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs
index a0f067f..030d999 100644
--- a/src/Text/Hakyll/Render.hs
+++ b/src/Text/Hakyll/Render.hs
@@ -28,7 +28,8 @@ depends :: FilePath -- ^ File to be rendered or created.
-> Hakyll () -- ^ IO action to execute when the file is out of date.
-> Hakyll ()
depends file dependencies action = do
- valid <- isCacheValid (toDestination file) dependencies
+ destination <- toDestination file
+ valid <- isMoreRecent destination dependencies
unless valid action
-- | Render to a Page.
@@ -108,17 +109,17 @@ renderChainWith manipulation templatePaths renderable =
-- | Mark a certain file as static, so it will just be copied when the site is
-- generated.
static :: FilePath -> Hakyll ()
-static source = depends destination [source] action
+static source = do destination <- toDestination source
+ depends destination [source] (action destination)
where
- destination = toDestination source
- action = do makeDirectories destination
- liftIO $ copyFile source destination
+ action destination = do makeDirectories destination
+ liftIO $ copyFile source destination
-- | Render a css file, compressing it.
css :: FilePath -> Hakyll ()
-css source = depends destination [source] css'
+css source = do destination <- toDestination source
+ depends destination [source] (css' destination)
where
- destination = toDestination source
- css' = do contents <- liftIO $ readFile source
- makeDirectories destination
- liftIO $ writeFile destination (compressCSS contents)
+ css' destination = do contents <- liftIO $ readFile source
+ makeDirectories destination
+ liftIO $ writeFile destination (compressCSS contents)
diff --git a/src/Text/Hakyll/Render/Internal.hs b/src/Text/Hakyll/Render/Internal.hs
index d0b5814..51eecc7 100644
--- a/src/Text/Hakyll/Render/Internal.hs
+++ b/src/Text/Hakyll/Render/Internal.hs
@@ -85,8 +85,8 @@ pureRenderChainWith manipulation templates context =
writePage :: Page -> Hakyll ()
writePage page = do
additionalContext' <- askHakyll additionalContext
- let destination = toDestination url
- context = additionalContext' `M.union` M.singleton "root" (toRoot url)
+ destination <- toDestination url
+ let context = additionalContext' `M.union` M.singleton "root" (toRoot url)
makeDirectories destination
    -- Substitute $root here, just before writing.
liftIO $ writeFile destination $ finalSubstitute (getBody page) context
diff --git a/tests/Tests.hs b/tests/Tests.hs
index 018d148..5e449f2 100644
--- a/tests/Tests.hs
+++ b/tests/Tests.hs
@@ -45,9 +45,6 @@ tests = [ testGroup "Util group"
]
, testGroup "File group"
- [ testCase "toDestination 1" test_to_destination1
- , testCase "toDestination 2" test_to_destination2
- , testCase "toDestination 3" test_to_destination3
, testCase "toRoot 1" test_to_root1
, testCase "toRoot 2" test_to_root2
, testCase "toRoot 3" test_to_root3
@@ -112,15 +109,6 @@ test_render_date2 = M.lookup "date" rendered @?= Just "Unknown date"
rendered = renderDate "date" "%B %e, %Y" "Unknown date" $
M.singleton "path" "2009-badness-30-a-title.markdown"
--- toDestination test cases
-test_to_destination1 = toDestination "/posts/foo.html"
- @?= "_site/posts/foo.html"
-
-test_to_destination2 = toDestination "$root/posts/foo.html"
- @?= "_site/posts/foo.html"
-
-test_to_destination3 = toDestination "foo.html" @?= "_site/foo.html"
-
-- toRoot test cases
test_to_root1 = toRoot "/posts/foo.html" @?= ".."
test_to_root2 = toRoot "posts/foo.html" @?= ".."
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-08 09:13:24 +0000