Add inHakyllDirectory function and test cases

3 files changed, 32 insertions, 0 deletions

diff --git a/src/Text/Hakyll.hs b/src/Text/Hakyll.hs
index 7fd2eaa..15cfda4 100644
--- a/src/Text/Hakyll.hs
+++ b/src/Text/Hakyll.hs
@@ -11,6 +11,7 @@ module Text.Hakyll
     ( defaultHakyllConfiguration
     , hakyll
     , hakyllWithConfiguration
+    , runDefaultHakyll
     ) where
 
 import Control.Concurrent (forkIO, threadDelay)
@@ -144,3 +145,10 @@ server port preRespond = do
     root <- askHakyll siteDirectory
     let preRespondIO = runReaderT preRespond configuration
     liftIO $ simpleServer (fromIntegral port) root preRespondIO
+
+-- | Run a Hakyll action with default settings. This is mostly aimed at testing
+-- code.
+--
+runDefaultHakyll :: Hakyll a -> IO a
+runDefaultHakyll f =
+    runReaderT f $ defaultHakyllConfiguration "http://example.com"
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