From 2066be06213cd70fdeae42a6194bc645a15d9835 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Mon, 2 Aug 2010 12:59:22 +0200
Subject: Add inHakyllDirectory function and test cases

---
 src/Text/Hakyll/File.hs        | 22 ++++++++++++++++++++++
 src/Text/Hakyll/HakyllMonad.hs |  2 ++
 2 files changed, 24 insertions(+)

(limited to 'src/Text/Hakyll')

diff --git a/src/Text/Hakyll/File.hs b/src/Text/Hakyll/File.hs
index 84d8183..96d05be 100644
--- a/src/Text/Hakyll/File.hs
+++ b/src/Text/Hakyll/File.hs
@@ -5,6 +5,7 @@ module Text.Hakyll.File
     , toCache
     , toUrl
     , toRoot
+    , inHakyllDirectory
     , removeSpaces
     , makeDirectories
     , getRecursiveContents
@@ -16,6 +17,7 @@ module Text.Hakyll.File
     ) where
 
 import System.Directory
+import Control.Applicative ((<$>))
 import System.FilePath
 import System.Time (ClockTime)
 import Control.Monad
@@ -85,6 +87,26 @@ toRoot = emptyException . joinPath . map parent . splitPath
     emptyException [] = "."
     emptyException x  = x
 
+-- | 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.
+--
+-- Example:
+--
+-- > inHakyllDirectory "_cache/pages/index.html"
+--
+-- Result:
+--
+-- > True
+--
+inHakyllDirectory :: FilePath -> Hakyll Bool
+inHakyllDirectory path =
+    or <$> mapM (liftM inDirectory . askHakyll) [siteDirectory, cacheDirectory]
+  where
+    inDirectory dir = case splitDirectories path of
+        [] -> False
+        (x : _) -> x == dir
+
 -- | Swaps spaces for '-'.
 removeSpaces :: FilePath -> FilePath
 removeSpaces = map swap
diff --git a/src/Text/Hakyll/HakyllMonad.hs b/src/Text/Hakyll/HakyllMonad.hs
index f17ae52..3ec78c4 100644
--- a/src/Text/Hakyll/HakyllMonad.hs
+++ b/src/Text/Hakyll/HakyllMonad.hs
@@ -59,6 +59,8 @@ data HakyllConfiguration = HakyllConfiguration
 askHakyll :: (HakyllConfiguration -> a) -> Hakyll a
 askHakyll = flip liftM ask
 
+-- | Obtain the globally available, additional context.
+--
 getAdditionalContext :: HakyllConfiguration -> Context
 getAdditionalContext configuration =
     let (Context c) = additionalContext configuration
-- 
cgit v1.2.3