diff options
Diffstat (limited to 'src/Hakyll/Core/Util')
-rw-r--r-- | src/Hakyll/Core/Util/Arrow.hs | 25 | ||||
-rw-r--r-- | src/Hakyll/Core/Util/File.hs | 90 | ||||
-rw-r--r-- | src/Hakyll/Core/Util/String.hs | 48 |
3 files changed, 163 insertions, 0 deletions
diff --git a/src/Hakyll/Core/Util/Arrow.hs b/src/Hakyll/Core/Util/Arrow.hs new file mode 100644 index 0000000..1896e11 --- /dev/null +++ b/src/Hakyll/Core/Util/Arrow.hs @@ -0,0 +1,25 @@ +-- | Various arrow utility functions +-- +module Hakyll.Core.Util.Arrow + ( constA + , sequenceA + , unitA + ) where + +import Control.Arrow (Arrow, (&&&), arr, (>>^)) + +constA :: Arrow a + => c + -> a b c +constA = arr . const + +sequenceA :: Arrow a + => [a b c] + -> a b [c] +sequenceA = foldl reduce $ constA [] + where + reduce la xa = xa &&& la >>^ arr (uncurry (:)) + +unitA :: Arrow a + => a b () +unitA = constA () diff --git a/src/Hakyll/Core/Util/File.hs b/src/Hakyll/Core/Util/File.hs new file mode 100644 index 0000000..9babc8b --- /dev/null +++ b/src/Hakyll/Core/Util/File.hs @@ -0,0 +1,90 @@ +-- | A module containing various file utility functions +-- +module Hakyll.Core.Util.File + ( makeDirectories + , getRecursiveContents + , isFileObsolete + , isFileInternal + ) where + +import Control.Applicative ((<$>)) +import System.Time (ClockTime) +import Control.Monad (forM, filterM) +import Data.List (isPrefixOf) +import System.Directory ( createDirectoryIfMissing, doesDirectoryExist + , doesFileExist, getModificationTime + , getDirectoryContents + ) +import System.FilePath ( normalise, takeDirectory, splitPath + , dropTrailingPathSeparator, (</>) + ) + +import Hakyll.Core.Configuration + +-- | Given a path to a file, try to make the path writable by making +-- all directories on the path. +-- +makeDirectories :: FilePath -> IO () +makeDirectories = createDirectoryIfMissing True . takeDirectory + +-- | Get all contents of a directory. Note that files starting with a dot (.) +-- will be ignored. +-- +getRecursiveContents :: Bool -- ^ Include directories? + -> FilePath -- ^ Directory to search + -> IO [FilePath] -- ^ List of files found +getRecursiveContents includeDirs topdir = do + topdirExists <- doesDirectoryExist topdir + if not topdirExists + then return [] + else do + names <- filter isProper <$> getDirectoryContents topdir + paths <- forM names $ \name -> do + let path = normalise $ topdir </> name + isDirectory <- doesDirectoryExist path + if isDirectory then getRecursiveContents includeDirs path + else return [path] + return $ if includeDirs then topdir : concat paths + else concat paths + where + isProper = not . (== ".") . take 1 + +-- | Check if a timestamp is obsolete compared to the timestamps of a number of +-- files. When they are no files, it is never obsolete. +-- +isObsolete :: ClockTime -- ^ The time to check. + -> [FilePath] -- ^ Dependencies of the cached file. + -> IO Bool +isObsolete _ [] = return False +isObsolete timeStamp depends = do + depends' <- filterM doesFileExist depends + dependsModified <- mapM getModificationTime depends' + return (timeStamp < maximum dependsModified) + +-- | Check if a file is obsolete, given it's dependencies. When the file does +-- not exist, it is always obsolete. Other wise, it is obsolete if any of it's +-- dependencies has a more recent modification time than the file. +-- +isFileObsolete :: FilePath -- ^ The cached file + -> [FilePath] -- ^ Dependencies of the cached file + -> IO Bool +isFileObsolete file depends = do + exists <- doesFileExist file + if not exists + then return True + else do timeStamp <- getModificationTime file + isObsolete timeStamp depends + +-- | Check if a file is meant for Hakyll internal use, i.e. if it is located in +-- the destination or store directory +-- +isFileInternal :: HakyllConfiguration -- ^ Configuration + -> FilePath -- ^ File to check + -> Bool -- ^ If the given file is internal +isFileInternal configuration file = + any (`isPrefixOf` split file) dirs + where + split = map dropTrailingPathSeparator . splitPath + dirs = map (split . ($ configuration)) [ destinationDirectory + , storeDirectory + ] diff --git a/src/Hakyll/Core/Util/String.hs b/src/Hakyll/Core/Util/String.hs new file mode 100644 index 0000000..7f75a36 --- /dev/null +++ b/src/Hakyll/Core/Util/String.hs @@ -0,0 +1,48 @@ +-- | Miscellaneous string manipulation functions. +-- +module Hakyll.Core.Util.String + ( trim + , replaceAll + , splitAll + ) where + +import Data.Char (isSpace) +import Data.Maybe (listToMaybe) + +import Text.Regex.PCRE ((=~~)) + +-- | Trim a string (drop spaces, tabs and newlines at both sides). +-- +trim :: String -> String +trim = reverse . trim' . reverse . trim' + where + trim' = dropWhile isSpace + +-- | A simple (but inefficient) regex replace funcion +-- +replaceAll :: String -- ^ Pattern + -> (String -> String) -- ^ Replacement (called on capture) + -> String -- ^ Source string + -> String -- ^ Result +replaceAll pattern f source = replaceAll' source + where + replaceAll' src = case listToMaybe (src =~~ pattern) of + Nothing -> src + Just (o, l) -> + let (before, tmp) = splitAt o src + (capture, after) = splitAt l tmp + in before ++ f capture ++ replaceAll' after + +-- | A simple regex split function. The resulting list will contain no empty +-- strings. +-- +splitAll :: String -- ^ Pattern + -> String -- ^ String to split + -> [String] -- ^ Result +splitAll pattern = filter (not . null) . splitAll' + where + splitAll' src = case listToMaybe (src =~~ pattern) of + Nothing -> [src] + Just (o, l) -> + let (before, tmp) = splitAt o src + in before : splitAll' (drop l tmp) |