|
|
|
@@ -1,143 +0,0 @@ |
|
|
|
{-# LANGUAGE OverloadedStrings #-} |
|
|
|
|
|
|
|
{- |
|
|
|
|
|
|
|
This file is part of the package devalot-hakyll. It is subject to the |
|
|
|
license terms in the LICENSE file found in the top-level directory of |
|
|
|
this distribution and at git://pmade.com/devalot-hakyll/LICENSE. No |
|
|
|
part of devalot-hakyll package, including this file, may be copied, |
|
|
|
modified, propagated, or distributed except according to the terms |
|
|
|
contained in the LICENSE file. |
|
|
|
|
|
|
|
-} |
|
|
|
|
|
|
|
-------------------------------------------------------------------------------- |
|
|
|
module Hakyll.Web.Heist |
|
|
|
( loadDefaultHeist |
|
|
|
, loadHeist |
|
|
|
, applyTemplate |
|
|
|
, applyTemplateList |
|
|
|
, applyJoinTemplateList |
|
|
|
, Content |
|
|
|
, SpliceT |
|
|
|
, State |
|
|
|
) where |
|
|
|
|
|
|
|
-------------------------------------------------------------------------------- |
|
|
|
import Blaze.ByteString.Builder (toByteString) |
|
|
|
import Control.Error (runEitherT) |
|
|
|
import Control.Monad (liftM) |
|
|
|
import Control.Monad.Reader (ReaderT(..), ask) |
|
|
|
import Control.Monad.Trans (lift) |
|
|
|
import Data.ByteString (ByteString) |
|
|
|
import Data.Monoid ((<>)) |
|
|
|
import Text.XmlHtml (elementAttrs) |
|
|
|
import Data.ByteString.UTF8 (toString) |
|
|
|
import Data.List (intersperse) |
|
|
|
import qualified Data.Text as T |
|
|
|
|
|
|
|
-------------------------------------------------------------------------------- |
|
|
|
import Hakyll.Core.Compiler |
|
|
|
import Hakyll.Core.Item |
|
|
|
import Hakyll.Web.Template.Context |
|
|
|
|
|
|
|
-------------------------------------------------------------------------------- |
|
|
|
import Heist |
|
|
|
import qualified Heist.Compiled as C |
|
|
|
|
|
|
|
-------------------------------------------------------------------------------- |
|
|
|
type Content a = (Context a, Item a) |
|
|
|
type SpliceT a = ReaderT (Content a) Compiler |
|
|
|
type State a = HeistState (SpliceT a) |
|
|
|
|
|
|
|
-------------------------------------------------------------------------------- |
|
|
|
loadHeist :: FilePath |
|
|
|
-- ^ Directory containing the templates. |
|
|
|
-> [(T.Text, C.Splice (SpliceT a))] |
|
|
|
-- ^ List of compiled Heist slices. |
|
|
|
-> [(T.Text, AttrSplice (SpliceT a))] |
|
|
|
-- ^ List of Heist attribute slices. |
|
|
|
-> IO (HeistState (SpliceT a)) |
|
|
|
loadHeist baseDir a b = do |
|
|
|
tState <- runEitherT $ do |
|
|
|
templates <- loadTemplates baseDir |
|
|
|
let splices' = [("hakyll", hakyllSplice)] ++ a |
|
|
|
attrs = [("url", urlAttrSplice)] ++ b |
|
|
|
hc = HeistConfig [] defaultLoadTimeSplices splices' attrs templates |
|
|
|
initHeist hc |
|
|
|
either (error . concat) return tState |
|
|
|
|
|
|
|
-------------------------------------------------------------------------------- |
|
|
|
loadDefaultHeist :: FilePath -> IO (HeistState (SpliceT a)) |
|
|
|
loadDefaultHeist baseDir = loadHeist baseDir [] [] |
|
|
|
|
|
|
|
-------------------------------------------------------------------------------- |
|
|
|
applyTemplate :: HeistState (SpliceT a) -- ^ HeistState |
|
|
|
-> ByteString -- ^ Template name |
|
|
|
-> Context a -- ^ Context |
|
|
|
-> Item a -- ^ Page |
|
|
|
-> Compiler (Item String) -- ^ Resulting item |
|
|
|
applyTemplate state name context item = do |
|
|
|
case C.renderTemplate state name of |
|
|
|
Nothing -> fail badTplError |
|
|
|
Just (r,_) -> do builder <- runReaderT r (context, item) |
|
|
|
let body = toString $ toByteString builder |
|
|
|
return $ itemSetBody body item |
|
|
|
where badTplError = "failed to render template: " ++ toString name |
|
|
|
|
|
|
|
-------------------------------------------------------------------------------- |
|
|
|
applyTemplateList :: HeistState (SpliceT a) -- ^ HeistState |
|
|
|
-> ByteString |
|
|
|
-> Context a |
|
|
|
-> [Item a] |
|
|
|
-> Compiler String |
|
|
|
applyTemplateList = applyJoinTemplateList "" |
|
|
|
|
|
|
|
-------------------------------------------------------------------------------- |
|
|
|
applyJoinTemplateList :: String |
|
|
|
-> HeistState (SpliceT a) -- ^ HeistState |
|
|
|
-> ByteString |
|
|
|
-> Context a |
|
|
|
-> [Item a] |
|
|
|
-> Compiler String |
|
|
|
applyJoinTemplateList delimiter state name context items = do |
|
|
|
items' <- mapM (applyTemplate state name context) items |
|
|
|
return $ concat $ intersperse delimiter $ map itemBody items' |
|
|
|
|
|
|
|
-------------------------------------------------------------------------------- |
|
|
|
hakyllSplice :: C.Splice (SpliceT a) |
|
|
|
hakyllSplice = do |
|
|
|
node <- getParamNode |
|
|
|
return $ C.yieldRuntimeText $ do |
|
|
|
(context, item) <- lift ask |
|
|
|
let context' f = unContext (context <> missingField) f item |
|
|
|
case lookup "field" $ elementAttrs node of |
|
|
|
Nothing -> fail fieldError |
|
|
|
Just f -> liftStr $ context' $ T.unpack f |
|
|
|
where fieldError = "The `hakyll' splice is missing the `field' attribute" |
|
|
|
liftStr s = lift $ lift $ liftM T.pack s |
|
|
|
|
|
|
|
-------------------------------------------------------------------------------- |
|
|
|
urlAttrSplice :: AttrSplice (SpliceT a) |
|
|
|
urlAttrSplice _ = do |
|
|
|
(context, item) <- lift ask |
|
|
|
let url = unContext (context <> missingField) "url" item |
|
|
|
val <- lift $ lift $ liftM T.pack url |
|
|
|
return $ ("href", val) : [] |
