diff options
-rw-r--r-- | README.markdown | 3 | ||||
-rw-r--r-- | hakyll.cabal | 19 | ||||
-rw-r--r-- | src/Text/Hakyll/Page.hs | 47 | ||||
-rw-r--r-- | src/Text/Hakyll/Render.hs | 40 | ||||
-rw-r--r-- | src/Text/Hakyll/Util.hs | 21 |
5 files changed, 130 insertions, 0 deletions
diff --git a/README.markdown b/README.markdown new file mode 100644 index 0000000..be46f83 --- /dev/null +++ b/README.markdown @@ -0,0 +1,3 @@ +# Hakyll + +Hakyll is a simple static site generator in Haskell. diff --git a/hakyll.cabal b/hakyll.cabal new file mode 100644 index 0000000..8dd2f19 --- /dev/null +++ b/hakyll.cabal @@ -0,0 +1,19 @@ +Name: hackyll +Version: 0.1 + +Synopsis: A simple static site generator. +Description: + A simple static site generator, mainly aimed at creating + blogs. +Author: Jasper Van der Jeugt +Maintainer: jaspervdj@gmail.com +Cabal-Version: >= 1.2 + +build-type: Simple + +library + hs-source-dirs: src/ + build-depends: base > 4, template, filepath, directory, containers, bytestring, + pandoc >= 1 + exposed-modules: Text.Hakyll.Render + Text.Hakyll.Page diff --git a/src/Text/Hakyll/Page.hs b/src/Text/Hakyll/Page.hs new file mode 100644 index 0000000..6dc96aa --- /dev/null +++ b/src/Text/Hakyll/Page.hs @@ -0,0 +1,47 @@ +module Text.Hakyll.Page where + +import qualified Data.Map as M +import qualified Data.List as L +import System.FilePath +import Data.Maybe +import Text.Pandoc + +type Page = M.Map String String + +addContext :: String -> String -> Page -> Page +addContext key value = M.insert key value + +getURL :: Page -> String +getURL context = fromMaybe "404.html" $ M.lookup "url" context + +getBody :: Page -> String +getBody context = fromMaybe "" $ M.lookup "body" context + +readConfig :: [String] -> Page +readConfig lines = M.fromList $ map (trim . break (== ':')) lines + where trim (key, value) = (key, dropWhile (`elem` ": ") value) + +extractContext :: String -> Page +extractContext str = M.insert "body" (unlines body) (readConfig header) + where allLines = lines str + isDelimiter = L.isPrefixOf "---" + (header, body) | isDelimiter (head allLines) = let (h, b) = L.break (isDelimiter) (tail allLines) + in (h, tail b) + | otherwise = ([], allLines) + +writerOptions :: WriterOptions +writerOptions = defaultWriterOptions + +markdownToHTML :: String -> String +markdownToHTML = writeHtmlString writerOptions . + readMarkdown defaultParserState + +readPage :: FilePath -> IO Page +readPage path = do + content <- readFile path + let context = extractContext content + body = (if takeExtension path == ".markdown" then markdownToHTML else id) + (getBody context) + url = addExtension (dropExtension path) ".html" + return $ addContext "url" url $ addContext "body" body $ context + diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs new file mode 100644 index 0000000..3e17659 --- /dev/null +++ b/src/Text/Hakyll/Render.hs @@ -0,0 +1,40 @@ +module Text.Hakyll.Render where + +import Text.Template +import qualified Data.ByteString.Lazy.Char8 as B +import qualified Data.Map as M +import Control.Monad + +import System.FilePath +import System.Directory + +import Text.Hakyll.Page +import Text.Hakyll.Util + +toDestination :: FilePath -> FilePath +toDestination path = "_site" </> path + +createContext :: Page -> Context +createContext = M.fromList . map packPair . M.toList + where packPair (a, b) = (B.pack a, B.pack b) + +renderPage :: FilePath -> Page -> IO Page +renderPage templatePath page = do + template <- B.readFile templatePath + let body = substitute template (createContext page) + return $ addContext "body" (B.unpack body) page + +renderAndWrite :: FilePath -> Page -> IO () +renderAndWrite templatePath page = do + rendered <- renderPage templatePath page + writeFile (toDestination $ getURL rendered) (getBody rendered) + +static :: FilePath -> IO () +static source = do + touchDirectories destination + copyFile source destination + where destination = toDestination source + +staticDirectory :: FilePath -> IO () +staticDirectory dir = + getRecursiveContents dir >>= mapM_ static diff --git a/src/Text/Hakyll/Util.hs b/src/Text/Hakyll/Util.hs new file mode 100644 index 0000000..1b24d31 --- /dev/null +++ b/src/Text/Hakyll/Util.hs @@ -0,0 +1,21 @@ +module Text.Hakyll.Util where + +import System.Directory +import System.FilePath +import Control.Monad + +touchDirectories :: FilePath -> IO () +touchDirectories path = createDirectoryIfMissing True dir + where dir = takeDirectory path + +getRecursiveContents :: FilePath -> IO [FilePath] +getRecursiveContents topdir = do + names <- getDirectoryContents topdir + let properNames = filter (`notElem` [".", ".."]) names + paths <- forM properNames $ \name -> do + let path = topdir </> name + isDirectory <- doesDirectoryExist path + if isDirectory + then getRecursiveContents path + else return [path] + return (concat paths) |