diff --git a/hakyll.cabal b/hakyll.cabal --- a/hakyll.cabal +++ b/hakyll.cabal @@ -1,5 +1,5 @@ Name: hakyll -Version: 0.1 +Version: 0.2 Synopsis: A simple static site generator library. Description: @@ -21,5 +21,7 @@ build-depends: base >= 4 && < 5, template, filepath, directory, containers, bytestring, pandoc >= 1 exposed-modules: Text.Hakyll.Render + Text.Hakyll.Renderable + Text.Hakyll.Renderables Text.Hakyll.Page Text.Hakyll.Util diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs --- a/src/Text/Hakyll/Page.hs +++ b/src/Text/Hakyll/Page.hs @@ -1,13 +1,9 @@ module Text.Hakyll.Page ( Page, - PageValue, - addContext, - getURL, + fromContext, getBody, readPage, - pageFromList, - concatPages, - concatPagesWith + writePage ) where import qualified Data.Map as M @@ -20,43 +16,49 @@ import System.IO import Text.Hakyll.Util +import Text.Hakyll.Renderable import Text.Pandoc -- | A Page is basically key-value mapping. Certain keys have special -- meanings, like for example url, body and title. -type Page = M.Map String PageValue +data Page = Page (M.Map B.ByteString B.ByteString) --- | We use a ByteString for obvious reasons. -type PageValue = B.ByteString +-- | Create a Page from a key-value mapping. +fromContext :: (M.Map B.ByteString B.ByteString) -> Page +fromContext = Page --- | Add a key-value mapping to the Page. -addContext :: String -> String -> Page -> Page -addContext key value = M.insert key (B.pack value) +-- | Auxiliary function to pack a pair. +packPair :: (String, String) -> (B.ByteString, B.ByteString) +packPair (a, b) = (B.pack a, B.pack b) -- | Get the URL for a certain page. This should always be defined. If -- not, it will return trash.html. -getURL :: Page -> String -getURL context = let result = M.lookup "url" context - in case result of (Just url) -> B.unpack url - Nothing -> error "URL is not defined." +getPageURL :: Page -> String +getPageURL (Page page) = + let result = M.lookup (B.pack "url") page + in case result of (Just url) -> B.unpack url + Nothing -> error "URL is not defined." -- | Get the body for a certain page. When not defined, the body will be -- empty. -getBody :: Page -> PageValue -getBody context = fromMaybe B.empty $ M.lookup "body" context +getBody :: Page -> B.ByteString +getBody (Page page) = fromMaybe B.empty $ M.lookup (B.pack "body") page +-- | The default writer options for pandoc rendering. writerOptions :: WriterOptions writerOptions = defaultWriterOptions +-- | Get a render function for a given extension. renderFunction :: String -> (String -> String) renderFunction ".html" = id renderFunction ext = writeHtmlString writerOptions . - renderFunction' ext defaultParserState - where renderFunction' ".markdown" = readMarkdown - renderFunction' ".md" = readMarkdown - renderFunction' ".tex" = readLaTeX - renderFunction' _ = readMarkdown + readFunction ext defaultParserState + where readFunction ".markdown" = readMarkdown + readFunction ".md" = readMarkdown + readFunction ".tex" = readLaTeX + readFunction _ = readMarkdown +-- | Read metadata header from a file handle. readMetaData :: Handle -> IO [(String, String)] readMetaData handle = do line <- hGetLine handle @@ -65,22 +67,25 @@ return $ (trimPair . break (== ':')) line : others where trimPair (key, value) = (trim key, trim $ tail value) +-- | Check if the given string is a metadata delimiter. isDelimiter :: String -> Bool isDelimiter = L.isPrefixOf "---" -- | Used for caching of files. cachePage :: Page -> IO () -cachePage page = do +cachePage page@(Page mapping) = do let destination = toCache $ getURL page makeDirectories destination handle <- openFile destination WriteMode hPutStrLn handle "---" - mapM_ (writePair handle) $ M.toList page + mapM_ (writePair handle) $ M.toList $ M.delete (B.pack "body") mapping hPutStrLn handle "---" B.hPut handle $ getBody page hClose handle - where writePair _ ("body", _) = return () - writePair h (k, v) = hPutStr h (k ++ ": ") >> B.hPut h v >> hPutStrLn h "" + where writePair h (k, v) = B.hPut h k >> + B.hPut h (B.pack ": ") >> + B.hPut h v >> + hPutStrLn h "" -- | Read a page from a file. Metadata is supported, and if the filename -- has a .markdown extension, it will be rendered using pandoc. Note that @@ -88,7 +93,7 @@ readPage :: FilePath -> IO Page readPage pagePath = do -- Check cache. - getFromCache <- isCacheFileValid cacheFile pagePath + getFromCache <- isCacheValid cacheFile [pagePath] let path = if getFromCache then cacheFile else pagePath -- Read file. @@ -103,26 +108,24 @@ -- Render file let rendered = B.pack $ (renderFunction $ takeExtension path) body seq rendered $ hClose handle - let page = M.insert "body" rendered $ addContext "url" url $ pageFromList context + let page = fromContext $ M.fromList $ + [(B.pack "body", rendered), packPair ("url", url)] ++ map packPair context -- Cache if needed if getFromCache then return () else cachePage page return page - where url = addExtension (dropExtension pagePath) ".html" + where url = toURL pagePath cacheFile = toCache url --- | Create a key-value mapping page from an association list. -pageFromList :: [(String, String)] -> Page -pageFromList = M.fromList . map packPair - where packPair (k, v) = let pv = B.pack v - in seq pv (k, pv) - --- | Concat the bodies of pages, and return the result. -concatPages :: [Page] -> PageValue -concatPages = concatPagesWith "body" +-- | Write a page to the site destination. +writePage :: Page -> IO () +writePage page = do + let destination = toDestination $ getURL page + makeDirectories destination + B.writeFile destination (getBody page) --- | Concat certain values of pages, and return the result. -concatPagesWith :: String -- ^ Key of which to concat the values. - -> [Page] -- ^ Pages to get the values from. - -> PageValue -- ^ The concatenation. -concatPagesWith key = B.concat . map (fromMaybe B.empty . M.lookup key) +-- Make pages renderable. +instance Renderable Page where + getDependencies = (:[]) . flip addExtension ".html" . dropExtension . getPageURL + getURL = getPageURL + toContext (Page mapping) = return mapping diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs --- a/src/Text/Hakyll/Render.hs +++ b/src/Text/Hakyll/Render.hs @@ -1,11 +1,13 @@ module Text.Hakyll.Render - ( renderPage, - renderAndWrite, + ( depends, + render, + renderAndConcat, + renderChain, static, staticDirectory ) where -import Text.Template +import Text.Template hiding (render) import qualified Data.ByteString.Lazy.Char8 as B import qualified Data.Map as M import Control.Monad @@ -14,33 +16,59 @@ import System.IO import Text.Hakyll.Page +import Text.Hakyll.Renderable import Text.Hakyll.Util -createContext :: Page -> Context -createContext = M.fromList . map packPair . M.toList - where packPair (a, b) = (B.pack a, b) +-- | Execute an IO action only when the cache is invalid. +depends :: FilePath -- ^ File to be rendered or created. + -> [FilePath] -- ^ Files the render depends on. + -> IO () -- ^ IO action to execute when the file is out of date. + -> IO () +depends file dependencies action = do + valid <- isCacheValid (toDestination file) dependencies + unless valid action -renderPage :: FilePath -> Page -> IO Page -renderPage templatePath page = do +-- | Render to a Page. +render :: Renderable a + => FilePath -- ^ Template to use for rendering. + -> a -- ^ Renderable object to render with given template. + -> IO Page -- ^ The body of the result will contain the render. +render templatePath renderable = do handle <- openFile templatePath ReadMode templateString <- liftM B.pack $ hGetContents handle seq templateString $ hClose handle - let body = substitute templateString (createContext page) - return $ addContext "body" (B.unpack body) page + context <- toContext renderable + let body = substitute templateString context + return $ fromContext (M.insert (B.pack "body") body context) -renderAndWrite :: FilePath -> Page -> IO () -renderAndWrite templatePath page = do - rendered <- renderPage templatePath page - let destination = toDestination $ getURL rendered - makeDirectories destination - B.writeFile destination (getBody rendered) +-- | Render each renderable with the given template, then concatenate the +-- result. +renderAndConcat :: Renderable a => FilePath -> [a] -> IO B.ByteString +renderAndConcat templatePath renderables = foldM concatRender' B.empty renderables + where concatRender' :: Renderable a => B.ByteString -> a -> IO B.ByteString + concatRender' chunk renderable = do + rendered <- render templatePath renderable + let body = getBody rendered + return $ B.append chunk $ body +-- | Chain a render action for a page with a number of templates. This will +-- also write the result to the site destination. This is the preferred way +-- to do general rendering. +renderChain :: Renderable a => [FilePath] -> a -> IO () +renderChain templates renderable = + depends (getURL renderable) (getDependencies renderable ++ templates) $ + do initialPage <- toContext renderable + result <- foldM (flip render) (fromContext initialPage) templates + writePage result + +-- | Mark a certain file as static, so it will just be copied when the site is +-- generated. static :: FilePath -> IO () -static source = do - makeDirectories destination - copyFile source destination +static source = depends destination [source] + (makeDirectories destination >> copyFile source destination) where destination = toDestination source +-- | Mark a whole directory as static. staticDirectory :: FilePath -> IO () staticDirectory dir = getRecursiveContents dir >>= mapM_ static diff --git a/src/Text/Hakyll/Renderable.hs b/src/Text/Hakyll/Renderable.hs new file mode 100644 --- /dev/null +++ b/src/Text/Hakyll/Renderable.hs @@ -0,0 +1,18 @@ +module Text.Hakyll.Renderable + ( Renderable(toContext, getDependencies, getURL) + ) where + +import System.FilePath +import Text.Template + +-- | A class for datatypes that can be rendered to pages. +class Renderable a where + -- | Get a context to do substitutions with. + toContext :: a -> IO Context + + -- | Get the dependencies for the renderable. This is used for cache + -- invalidation. + getDependencies :: a -> [FilePath] + + -- | Get the destination for the renderable. + getURL :: a -> FilePath diff --git a/src/Text/Hakyll/Renderables.hs b/src/Text/Hakyll/Renderables.hs new file mode 100644 --- /dev/null +++ b/src/Text/Hakyll/Renderables.hs @@ -0,0 +1,50 @@ +module Text.Hakyll.Renderables + ( CustomPage, + createCustomPage, + PagePath, + createPagePath + ) where + +import System.FilePath +import qualified Data.ByteString.Lazy.Char8 as B +import qualified Data.Map as M +import Control.Monad +import Text.Hakyll.Util +import Text.Hakyll.Page +import Text.Hakyll.Renderable + +-- | A custom page. +data CustomPage = CustomPage + { url :: String, + dependencies :: [FilePath], + mapping :: [(String, Either String (IO B.ByteString))] + } + +-- | Create a custom page. +createCustomPage :: String -- ^ Destination of the page, relative to _site. + -> [FilePath] -- ^ Dependencies of the page. + -> [(String, Either String (IO B.ByteString))] -- ^ Key - value mapping for rendering. + -> CustomPage +createCustomPage = CustomPage + +instance Renderable CustomPage where + getDependencies = dependencies + getURL = url + toContext page = do + values <- mapM (either (return . B.pack) (>>= return) . snd) (mapping page) + let keys = map (B.pack . fst) (mapping page) + return $ M.fromList $ (B.pack "url", B.pack $ url page) : zip keys values + +-- | PagePath is a class that wraps a FilePath. This is used to render Pages +-- without reading them first through use of caching. +data PagePath = PagePath FilePath + +-- | Create a PagePath from a FilePath. +createPagePath :: FilePath -> PagePath +createPagePath = PagePath + +-- We can render filepaths +instance Renderable PagePath where + getDependencies (PagePath path) = return path + getURL (PagePath path) = toURL path + toContext (PagePath path) = readPage path >>= toContext diff --git a/src/Text/Hakyll/Util.hs b/src/Text/Hakyll/Util.hs --- a/src/Text/Hakyll/Util.hs +++ b/src/Text/Hakyll/Util.hs @@ -1,11 +1,12 @@ module Text.Hakyll.Util ( toDestination, toCache, + toURL, makeDirectories, getRecursiveContents, trim, split, - isCacheFileValid + isCacheValid ) where import System.Directory @@ -14,12 +15,18 @@ import Data.Char import Data.List +-- | Convert a relative filepath to a filepath in the destination (_site). toDestination :: FilePath -> FilePath toDestination path = "_site" path +-- | Convert a relative filepath to a filepath in the cache (_cache). toCache :: FilePath -> FilePath toCache path = "_cache" path +-- | Get the url for a given page. +toURL :: FilePath -> FilePath +toURL = flip addExtension ".html" . dropExtension + -- | Given a path to a file, try to make the path writable by making -- all directories on the path. makeDirectories :: FilePath -> IO () @@ -56,8 +63,9 @@ else Just (x, tail xs) -- | Check is a cache file is still valid. -isCacheFileValid :: FilePath -> FilePath -> IO Bool -isCacheFileValid cache file = doesFileExist cache >>= \exists -> +isCacheValid :: FilePath -> [FilePath] -> IO Bool +isCacheValid cache depends = doesFileExist cache >>= \exists -> if not exists then return False - else liftM2 (<=) (getModificationTime file) - (getModificationTime cache) + else do dependsModified <- (mapM getModificationTime depends) >>= return . maximum + cacheModified <- getModificationTime cache + return (cacheModified >= dependsModified)