Initial commit.
This commit is contained in:
commit
36e4bf881b
5 changed files with 130 additions and 0 deletions
3
README.markdown
Normal file
3
README.markdown
Normal file
|
@ -0,0 +1,3 @@
|
|||
# Hakyll
|
||||
|
||||
Hakyll is a simple static site generator in Haskell.
|
19
hakyll.cabal
Normal file
19
hakyll.cabal
Normal file
|
@ -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
|
47
src/Text/Hakyll/Page.hs
Normal file
47
src/Text/Hakyll/Page.hs
Normal file
|
@ -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
|
||||
|
40
src/Text/Hakyll/Render.hs
Normal file
40
src/Text/Hakyll/Render.hs
Normal file
|
@ -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
|
21
src/Text/Hakyll/Util.hs
Normal file
21
src/Text/Hakyll/Util.hs
Normal file
|
@ -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)
|
Loading…
Reference in a new issue