From 2c8d76cd97e670fdfd216e2288b8cc6633287046 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Mon, 2 Aug 2010 13:48:08 +0200 Subject: Add a simple static configuration --- src/Text/Hakyll/Configurations/Static.hs | 59 ++++++++++++++++++++++++++++++++ src/Text/Hakyll/File.hs | 39 +++++++++++++-------- src/Text/Hakyll/HakyllAction.hs | 4 +-- src/Text/Hakyll/HakyllMonad.hs | 8 +++++ 4 files changed, 93 insertions(+), 17 deletions(-) create mode 100644 src/Text/Hakyll/Configurations/Static.hs (limited to 'src/Text/Hakyll') diff --git a/src/Text/Hakyll/Configurations/Static.hs b/src/Text/Hakyll/Configurations/Static.hs new file mode 100644 index 0000000..5a2c1be --- /dev/null +++ b/src/Text/Hakyll/Configurations/Static.hs @@ -0,0 +1,59 @@ +-- | Module for a simple static configuration of a website. +-- +-- The configuration works like this: +-- +-- * The @templates/@ directory should contain one template. +-- +-- * Renderable files in the directory tree are rendered using this template. +-- +-- * The @static/@ directory is copied entirely (if it exists). +-- +-- * All files in the @css/@ directory are compressed. +-- +module Text.Hakyll.Configurations.Static + ( staticConfiguration + ) where + +import Control.Applicative ((<$>)) +import Control.Monad (filterM, forM_) + +import Text.Hakyll.File ( getRecursiveContents, inDirectory, inHakyllDirectory + , directory ) +import Text.Hakyll.Internal.FileType (isRenderableFile) +import Text.Hakyll.HakyllMonad (Hakyll, logHakyll) +import Text.Hakyll.Render (renderChain, css, static) +import Text.Hakyll.CreateContext (createPage) + +-- | A simple configuration for an entirely static website. +-- +staticConfiguration :: Hakyll () +staticConfiguration = do + -- Find all files not in _site or _cache. + files <- filterM isRenderableFile' =<< getRecursiveContents "." + + -- Find a main template to use + mainTemplate <- take 1 <$> getRecursiveContents templateDir + logHakyll $ case mainTemplate of [] -> "Using no template" + (x : _) -> "Using template " ++ x + + -- Render all files using this template + forM_ files $ renderChain mainTemplate . createPage + + -- Render a static directory + directory static staticDir + + -- Render a css directory + directory css cssDir + where + -- A file should have a renderable extension and not be in a hakyll + -- directory, and not in a special directory. + isRenderableFile' file = do + inHakyllDirectory' <- inHakyllDirectory file + return $ isRenderableFile file + && not (any (inDirectory file) [templateDir, cssDir, staticDir]) + && not inHakyllDirectory' + + -- Directories + templateDir = "templates" + cssDir = "css" + staticDir = "static" diff --git a/src/Text/Hakyll/File.hs b/src/Text/Hakyll/File.hs index 96d05be..15903c7 100644 --- a/src/Text/Hakyll/File.hs +++ b/src/Text/Hakyll/File.hs @@ -5,6 +5,7 @@ module Text.Hakyll.File , toCache , toUrl , toRoot + , inDirectory , inHakyllDirectory , removeSpaces , makeDirectories @@ -87,6 +88,15 @@ toRoot = emptyException . joinPath . map parent . splitPath emptyException [] = "." emptyException x = x +-- | Check if a file is in a given directory. +-- +inDirectory :: FilePath -- ^ File path + -> FilePath -- ^ Directory + -> Bool -- ^ Result +inDirectory path dir = case splitDirectories path of + [] -> False + (x : _) -> x == dir + -- | Check if a file is in a Hakyll directory. With a Hakyll directory, we mean -- a directory that should be "ignored" such as the @_site@ or @_cache@ -- directory. @@ -101,11 +111,8 @@ toRoot = emptyException . joinPath . map parent . splitPath -- inHakyllDirectory :: FilePath -> Hakyll Bool inHakyllDirectory path = - or <$> mapM (liftM inDirectory . askHakyll) [siteDirectory, cacheDirectory] - where - inDirectory dir = case splitDirectories path of - [] -> False - (x : _) -> x == dir + or <$> mapM (liftM (inDirectory path) . askHakyll) + [siteDirectory, cacheDirectory] -- | Swaps spaces for '-'. removeSpaces :: FilePath -> FilePath @@ -123,17 +130,21 @@ makeDirectories path = liftIO $ createDirectoryIfMissing True dir -- | Get all contents of a directory. Note that files starting with a dot (.) -- will be ignored. +-- getRecursiveContents :: FilePath -> Hakyll [FilePath] getRecursiveContents topdir = do - names <- liftIO $ getDirectoryContents topdir - let properNames = filter isProper names - paths <- forM properNames $ \name -> do - let path = topdir name - isDirectory <- liftIO $ doesDirectoryExist path - if isDirectory - then getRecursiveContents path - else return [path] - return (concat paths) + topdirExists <- liftIO $ doesDirectoryExist topdir + if topdirExists + then do names <- liftIO $ getDirectoryContents topdir + let properNames = filter isProper names + paths <- forM properNames $ \name -> do + let path = topdir name + isDirectory <- liftIO $ doesDirectoryExist path + if isDirectory + then getRecursiveContents path + else return [normalise path] + return (concat paths) + else return [] where isProper = not . (== '.') . head diff --git a/src/Text/Hakyll/HakyllAction.hs b/src/Text/Hakyll/HakyllAction.hs index be4df2d..491f1f1 100644 --- a/src/Text/Hakyll/HakyllAction.hs +++ b/src/Text/Hakyll/HakyllAction.hs @@ -12,9 +12,7 @@ module Text.Hakyll.HakyllAction import Control.Arrow import Control.Category import Control.Monad ((<=<), unless) -import Control.Monad.Reader (liftIO) import Prelude hiding ((.), id) -import System.IO (hPutStrLn, stderr) import Text.Hakyll.File (toDestination, isFileMoreRecent) import Text.Hakyll.HakyllMonad @@ -65,7 +63,7 @@ runHakyllActionIfNeeded action = do Right _ -> error "No url when checking dependencies." destination <- toDestination url valid <- isFileMoreRecent destination $ actionDependencies action - unless valid $ do liftIO $ hPutStrLn stderr $ "Rendering " ++ destination + unless valid $ do logHakyll $ "Rendering " ++ destination runHakyllAction action -- | Chain a number of @HakyllAction@ computations. diff --git a/src/Text/Hakyll/HakyllMonad.hs b/src/Text/Hakyll/HakyllMonad.hs index 3ec78c4..2140ea7 100644 --- a/src/Text/Hakyll/HakyllMonad.hs +++ b/src/Text/Hakyll/HakyllMonad.hs @@ -5,11 +5,14 @@ module Text.Hakyll.HakyllMonad , Hakyll , askHakyll , getAdditionalContext + , logHakyll ) where +import Control.Monad.Trans (liftIO) import Control.Monad.Reader (ReaderT, ask) import Control.Monad (liftM) import qualified Data.Map as M +import System.IO (hPutStrLn, stderr) import Text.Pandoc (ParserState, WriterOptions) @@ -65,3 +68,8 @@ getAdditionalContext :: HakyllConfiguration -> Context getAdditionalContext configuration = let (Context c) = additionalContext configuration in Context $ M.insert "absolute" (absoluteUrl configuration) c + +-- | Write some log information. +-- +logHakyll :: String -> Hakyll () +logHakyll = liftIO . hPutStrLn stderr -- cgit v1.2.3