Add a simple static configuration

5 files changed, 94 insertions, 17 deletions

diff --git a/hakyll.cabal b/hakyll.cabal
index cfca318..ba8199b 100644
--- a/hakyll.cabal
+++ b/hakyll.cabal
@@ -54,6 +54,7 @@ library
                     Text.Hakyll.Util
                     Text.Hakyll.Tags
                     Text.Hakyll.Feed
+                    Text.Hakyll.Configurations.Static
   other-modules:    Paths_hakyll
                     Text.Hakyll.Internal.Cache
                     Text.Hakyll.Internal.CompressCss
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