From 36e4bf881b707948835bbae284ac444c80c67cc2 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Wed, 2 Dec 2009 13:49:42 +0100
Subject: Initial commit.

---
 src/Text/Hakyll/Page.hs   | 47 +++++++++++++++++++++++++++++++++++++++++++++++
 src/Text/Hakyll/Render.hs | 40 ++++++++++++++++++++++++++++++++++++++++
 src/Text/Hakyll/Util.hs   | 21 +++++++++++++++++++++
 3 files changed, 108 insertions(+)
 create mode 100644 src/Text/Hakyll/Page.hs
 create mode 100644 src/Text/Hakyll/Render.hs
 create mode 100644 src/Text/Hakyll/Util.hs

(limited to 'src/Text/Hakyll')

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)
-- 
cgit v1.2.3