hakyll (empty) → 0.1

raw patch · 6 files changed

+295/−0 lines, 6 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, directory, filepath, pandoc, template

Files

LICENSE +31/−0
Setup.hs +2/−0
hakyll.cabal +25/−0
src/Text/Hakyll/Page.hs +128/−0
src/Text/Hakyll/Render.hs +46/−0
src/Text/Hakyll/Util.hs +63/−0

+ LICENSE view

@@ -0,0 +1,31 @@+Copyright (c) 2009, Jasper Van der Jeugt+ +All rights reserved.+ +Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:+ +    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.+ +    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.+ +    * Neither the name of Jasper Van der Jeugt nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.+ +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ hakyll.cabal view

@@ -0,0 +1,25 @@+Name:           hakyll+Version:        0.1++Synopsis:       A simple static site generator library.+Description:+  A simple static site generator library , mainly aimed at+  creating blogs.+Author:         Jasper Van der Jeugt+Maintainer:     jaspervdj@gmail.com+Homepage:       http://github.com/jaspervdj/Hakyll+License:        BSD3+License-File:   LICENSE+Category:       Text+Cabal-Version:  >= 1.2++build-type:     Simple++library+  ghc-options: -Wall+  hs-source-dirs: src/+  build-depends:   base >= 4 && < 5, template, filepath, directory, containers, bytestring,+                   pandoc >= 1+  exposed-modules: Text.Hakyll.Render+                   Text.Hakyll.Page+                   Text.Hakyll.Util

+ src/Text/Hakyll/Page.hs view

@@ -0,0 +1,128 @@+module Text.Hakyll.Page +    ( Page,+      PageValue,+      addContext,+      getURL,+      getBody,+      readPage,+      pageFromList,+      concatPages,+      concatPagesWith+    ) where++import qualified Data.Map as M+import qualified Data.List as L+import qualified Data.ByteString.Lazy.Char8 as B+import Data.Maybe+import Control.Monad++import System.FilePath+import System.IO++import Text.Hakyll.Util+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++-- | We use a ByteString for obvious reasons.+type PageValue = B.ByteString++-- | Add a key-value mapping to the Page.+addContext :: String -> String -> Page -> Page+addContext key value = M.insert key (B.pack value)++-- | 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."++-- | 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++writerOptions :: WriterOptions+writerOptions = defaultWriterOptions++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++readMetaData :: Handle -> IO [(String, String)]+readMetaData handle = do+    line <- hGetLine handle+    if isDelimiter line then return []+                        else do others <- readMetaData handle+                                return $ (trimPair . break (== ':')) line : others+        where trimPair (key, value) = (trim key, trim $ tail value)++isDelimiter :: String -> Bool+isDelimiter = L.isPrefixOf "---"++-- | Used for caching of files.+cachePage :: Page -> IO ()+cachePage page = do+    let destination = toCache $ getURL page+    makeDirectories destination+    handle <- openFile destination WriteMode+    hPutStrLn handle "---"+    mapM_ (writePair handle) $ M.toList page+    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 ""++-- | 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+--   pages are not templates, so they should not contain $identifiers.+readPage :: FilePath -> IO Page+readPage pagePath = do+    -- Check cache.+    getFromCache <- isCacheFileValid cacheFile pagePath+    let path = if getFromCache then cacheFile else pagePath++    -- Read file.+    handle <- openFile path ReadMode+    line <- hGetLine handle+    (context, body) <- if isDelimiter line+                            then do md <- readMetaData handle+                                    c <- hGetContents handle+                                    return (md, c)+                            else hGetContents handle >>= \b -> return ([], line ++ b)++    -- 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++    -- Cache if needed+    if getFromCache then return () else cachePage page+    return page+    where url = addExtension (dropExtension pagePath) ".html"+          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"++-- | 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)

+ src/Text/Hakyll/Render.hs view

@@ -0,0 +1,46 @@+module Text.Hakyll.Render +    ( renderPage,+      renderAndWrite,+      static,+      staticDirectory+    ) where++import Text.Template+import qualified Data.ByteString.Lazy.Char8 as B+import qualified Data.Map as M+import Control.Monad++import System.Directory+import System.IO++import Text.Hakyll.Page+import Text.Hakyll.Util++createContext :: Page -> Context+createContext = M.fromList . map packPair . M.toList+    where packPair (a, b) = (B.pack a, b)++renderPage :: FilePath -> Page -> IO Page+renderPage templatePath page = 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++renderAndWrite :: FilePath -> Page -> IO ()+renderAndWrite templatePath page = do+    rendered <- renderPage templatePath page+    let destination = toDestination $ getURL rendered+    makeDirectories destination+    B.writeFile destination (getBody rendered)++static :: FilePath -> IO ()+static source = do+    makeDirectories destination+    copyFile source destination+    where destination = toDestination source++staticDirectory :: FilePath -> IO ()+staticDirectory dir = +    getRecursiveContents dir >>= mapM_ static

+ src/Text/Hakyll/Util.hs view

@@ -0,0 +1,63 @@+module Text.Hakyll.Util +    ( toDestination,+      toCache,+      makeDirectories,+      getRecursiveContents,+      trim,+      split,+      isCacheFileValid+    ) where++import System.Directory+import System.FilePath+import Control.Monad+import Data.Char+import Data.List++toDestination :: FilePath -> FilePath+toDestination path = "_site" </> path++toCache :: FilePath -> FilePath+toCache path = "_cache" </> path++-- | Given a path to a file, try to make the path writable by making+--   all directories on the path.+makeDirectories :: FilePath -> IO ()+makeDirectories path = createDirectoryIfMissing True dir+    where dir = takeDirectory path++-- | Get all contents of a directory. Note that files starting with a dot (.)+--   will be ignored.+getRecursiveContents :: FilePath -> IO [FilePath]+getRecursiveContents topdir = do+    names <- getDirectoryContents topdir+    let properNames = filter isProper names+    paths <- forM properNames $ \name -> do+        let path = topdir </> name+        isDirectory <- doesDirectoryExist path+        if isDirectory+            then getRecursiveContents path+            else return [path]+    return (concat paths)+    where isProper = not . (== '.') . head++-- | Trim a string (drop spaces and tabs at both sides).+trim :: String -> String+trim = reverse . trim' . reverse . trim'+    where trim' = dropWhile isSpace++-- | Split a list at a certain element.+split :: (Eq a) => a -> [a] -> [[a]]+split element = unfoldr splitOnce+    where splitOnce l = let r = break (== element) l+                        in case r of ([], []) -> Nothing+                                     (x, xs) -> if null xs+                                                    then Just (x, [])+                                                    else Just (x, tail xs)++-- | Check is a cache file is still valid.+isCacheFileValid :: FilePath -> FilePath -> IO Bool+isCacheFileValid cache file = doesFileExist cache >>= \exists ->+    if not exists then return False+                  else liftM2 (<=) (getModificationTime file)+                                   (getModificationTime cache)