summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--README.markdown3
-rw-r--r--hakyll.cabal19
-rw-r--r--src/Text/Hakyll/Page.hs47
-rw-r--r--src/Text/Hakyll/Render.hs40
-rw-r--r--src/Text/Hakyll/Util.hs21
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)