Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Allow `sourcedir`, `datadir`, `filesdir` to specify a list of dirs.

When looking for a file, search the list of directories in order.
  • Loading branch information...
commit 04b99bf604c24b97de914fb0a1b2d3dafa616651 1 parent 95c4749
@league league authored
View
26 Yst/Build.hs
@@ -39,26 +39,30 @@ import System.IO.UTF8
import System.IO (stderr)
import Control.Monad
-dependencies :: Site -> String -> [FilePath]
-dependencies site url =
+findSource :: Site -> FilePath -> IO FilePath
+findSource = searchPath . sourceDir
+
+dependencies :: Site -> String -> IO [FilePath]
+dependencies site url = do
let page = case M.lookup url (pageIndex site) of
Nothing -> error $ "Tried to get dependencies for nonexistent page: " ++ url
Just pg -> pg
- layout = sourceDir site </> stripStExt (fromMaybe (defaultLayout site) $ layoutFile page) <.> "st"
- requires = map (sourceDir site </>) $ requiresFiles page
- srcdir = sourceDir site </>
+ layout <- findSource site $ stripStExt (fromMaybe (defaultLayout site) $ layoutFile page) <.> "st"
+ requires <- mapM (findSource site) $ requiresFiles page
+ srcdir <- findSource site $
case sourceFile page of
TemplateFile f -> stripStExt f <.> "st"
SourceFile f -> f
- fileFromSpec (DataFromFile f _) = Just f
+ let fileFromSpec (DataFromFile f _) = Just f
fileFromSpec (DataFromSqlite3 f _ _) = Just f
fileFromSpec _ = Nothing
- dataFiles = map (dataDir site </>) $ mapMaybe (\(_,s) -> fileFromSpec s) $ pageData page
- in indexFile site : layout : srcdir : (requires ++ dataFiles)
+ dataFiles <- mapM (searchPath $ dataDir site) $ mapMaybe (\(_,s) -> fileFromSpec s) $ pageData page
+ return $ indexFile site : layout : srcdir : (requires ++ dataFiles)
buildSite :: Site -> IO ()
buildSite site = do
- files <- liftM (filter (/=".") . map (makeRelative $ filesDir site)) $ getDirectoryContentsRecursive $ filesDir site
+ let filesIn dir = liftM (filter (/=".") . map (makeRelative dir)) $ getDirectoryContentsRecursive dir
+ files <- liftM concat $ mapM filesIn $ filesDir site
let pages = M.keys $ pageIndex site
let overlap = files `intersect` pages
unless (null overlap) $ forM_ overlap
@@ -73,7 +77,7 @@ buildSite site = do
updateFile :: Site -> FilePath -> IO ()
updateFile site file = do
let destpath = deployDir site </> file
- let srcpath = filesDir site </> file
+ srcpath <- searchPath (filesDir site) file
srcmod <- getModificationTime srcpath
destmod <- catch (getModificationTime destpath) (\_ -> return $ TOD 0 0)
if srcmod > destmod
@@ -86,7 +90,7 @@ updateFile site file = do
updatePage :: Site -> Page -> IO ()
updatePage site page = do
let destpath = deployDir site </> pageUrl page
- let deps = dependencies site $ pageUrl page
+ deps <- dependencies site $ pageUrl page
forM_ deps $ \dep -> do
exists <- doesFileExist dep
unless exists $ do
View
6 Yst/Config.hs
@@ -33,9 +33,9 @@ parseConfigFile configfile = do
let indexfile = getStrAttrWithDefault "indexfile" "index.yaml" xs
(ind, nav) <- parseIndexFile indexfile
return Site{ siteTitle = getStrAttrWithDefault "title" "" xs
- , sourceDir = getStrAttrWithDefault "sourcedir" "." xs
- , dataDir = getStrAttrWithDefault "datadir" "." xs
- , filesDir = getStrAttrWithDefault "filesdir" "files" xs
+ , sourceDir = getStrListWithDefault "sourcedir" "." xs
+ , dataDir = getStrListWithDefault "datadir" "." xs
+ , filesDir = getStrListWithDefault "filesdir" "files" xs
, deployDir = getStrAttrWithDefault "deploydir" "site" xs
, defaultLayout = getStrAttrWithDefault "layout" "layout" xs
, indexFile = indexfile
View
9 Yst/Data.hs
@@ -29,15 +29,18 @@ import Data.Char
import Data.Maybe (fromMaybe)
import Data.List (sortBy, nub, isPrefixOf)
import Text.ParserCombinators.Parsec
-import System.FilePath (takeExtension, (</>))
+import System.FilePath (takeExtension)
+
+findData :: Site -> FilePath -> IO FilePath
+findData = searchPath . dataDir
getData :: Site -> DataSpec -> IO Node
getData site (DataFromFile file opts) = do
- raw <- catch (readDataFile $ dataDir site </> file)
+ raw <- catch (findData site file >>= readDataFile)
(\e -> errorExit 15 ("Error reading data from " ++ file ++ ": " ++ show e) >> return undefined)
return $ foldl applyDataOption raw opts
getData site (DataFromSqlite3 database query opts) = do
- raw <- catch (readSqlite3 (dataDir site </> database) query)
+ raw <- catch (findData site database >>= \d -> readSqlite3 d query)
(\e -> errorExit 15 ("Error reading Sqlite3 database from " ++ database ++ ": " ++ show e) >> return undefined)
return $ foldl applyDataOption raw opts
getData _ (DataConstant n) = return n
View
7 Yst/Render.hs
@@ -104,13 +104,14 @@ renderPage :: Site -> Page -> IO String
renderPage site page = do
let menuHtml = renderNav (pageUrl page) (navigation site)
let layout = fromMaybe (defaultLayout site) $ layoutFile page
- srcDir <- canonicalizePath $ sourceDir site
- g <- directoryGroupRecursive srcDir
+ srcDirs <- mapM canonicalizePath $ sourceDir site
+ gs <- mapM directoryGroupRecursive srcDirs
+ let g = foldl1 mergeSTGroups gs
attrs <- forM (pageData page) $ \(k, v) -> getData site v >>= \n -> return (k,n)
todaysDate <- liftM utctDay getCurrentTime
rawContents <-
case sourceFile page of
- SourceFile sf -> liftM (filter (/='\r')) $ readFile (srcDir </> sf)
+ SourceFile sf -> liftM (filter (/='\r')) $ searchPath srcDirs sf >>= readFile
TemplateFile tf -> do
templ <- getTemplate tf g
return $ render (setManyAttrib attrs templ)
View
6 Yst/Types.hs
@@ -26,9 +26,9 @@ import qualified Data.Map as M
data Site = Site {
siteTitle :: String
- , sourceDir :: FilePath
- , dataDir :: FilePath
- , filesDir :: FilePath
+ , sourceDir :: [FilePath]
+ , dataDir :: [FilePath]
+ , filesDir :: [FilePath]
, deployDir :: FilePath
, defaultLayout :: FilePath
, indexFile :: FilePath
View
20 Yst/Util.hs
@@ -16,7 +16,7 @@ along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
-module Yst.Util (stripBlanks, parseAsDate, stripStExt, getStrAttrWithDefault, fromNString, getDirectoryContentsRecursive, errorExit)
+module Yst.Util (stripBlanks, parseAsDate, stripStExt, getStrAttrWithDefault, getStrListWithDefault, fromNString, getDirectoryContentsRecursive, searchPath, errorExit)
where
import Yst.Types
import System.Exit
@@ -59,6 +59,17 @@ getStrAttrWithDefault attr def xs =
Just _ -> error $ attr ++ " must have string value."
Nothing -> def
+getStrListWithDefault :: String -> String -> [(String, Node)] -> [String]
+getStrListWithDefault attr def xs =
+ case lookup attr xs of
+ Just (NString s) -> [s]
+ Just (NList ys) -> map nodeToString ys
+ Just _ -> formatError
+ Nothing -> [def]
+ where nodeToString (NString s) = s
+ nodeToString _ = formatError
+ formatError = error $ attr ++ " must be a string or list of strings."
+
fromNString :: Node -> String
fromNString (NString s) = s
fromNString x = error $ "Expected string value, got " ++ show x
@@ -74,5 +85,12 @@ getDirectoryContentsRecursive path = do
return (concat children)
else return [path]
+searchPath :: [FilePath] -> FilePath -> IO FilePath
+searchPath [] file = return file -- may or may not exist, but we tried.
+searchPath (dir:dirs) file = do
+ exists <- doesFileExist curFile
+ if exists then return curFile else searchPath dirs file
+ where curFile = dir </> file
+
errorExit :: Int -> String -> IO ()
errorExit lvl msg = hPutStrLn stderr msg >> exitWith (ExitFailure lvl)

0 comments on commit 04b99bf

Please sign in to comment.
Something went wrong with that request. Please try again.