Merge pull request #143 from sphynx/master

Added teasers support

2 files changed, 33 insertions, 1 deletions

diff --git a/src/Hakyll/Core/Util/String.hs b/src/Hakyll/Core/Util/String.hs
index 514dd14..d9ec91c 100644
--- a/src/Hakyll/Core/Util/String.hs
+++ b/src/Hakyll/Core/Util/String.hs
@@ -4,9 +4,11 @@ module Hakyll.Core.Util.String
     ( trim
     , replaceAll
     , splitAll
+    , needlePrefix
     ) where
 
 import Data.Char (isSpace)
+import Data.List (isPrefixOf)
 import Data.Maybe (listToMaybe)
 
 import Text.Regex.TDFA ((=~~))
@@ -46,3 +48,21 @@ splitAll pattern = filter (not . null) . splitAll'
         Just (o, l) ->
             let (before, tmp) = splitAt o src
             in before : splitAll' (drop l tmp)
+
+
+-- | Find the first instance of needle (must be non-empty) in
+-- haystack. We return the prefix of haystack before needle is
+-- matched.
+--
+-- Examples:
+--   needlePrefix "cd" "abcde" = "ab"
+--   needlePrefix "ab" "abc" = ""
+--   needlePrefix "ab" "xxab" = "xx"
+--   needlePrefix "a" "xx" = "xx"
+--
+needlePrefix :: String -> String -> String
+needlePrefix needle haystack = go haystack
+  where
+    go [] = []
+    go xss@(x:xs) | needle `isPrefixOf` xss = []
+                  | otherwise = x : go xs
diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs
index 2b85b30..7751423 100644
--- a/src/Hakyll/Web/Template/Context.hs
+++ b/src/Hakyll/Web/Template/Context.hs
@@ -7,6 +7,7 @@ module Hakyll.Web.Template.Context
     , functionField
 
     , defaultContext
+    , teaserContext
     , bodyField
     , metadataField
     , urlField
@@ -40,7 +41,7 @@ import           Hakyll.Core.Identifier
 import           Hakyll.Core.Item
 import           Hakyll.Core.Metadata
 import           Hakyll.Core.Provider
-import           Hakyll.Core.Util.String       (splitAll)
+import           Hakyll.Core.Util.String       (splitAll, needlePrefix)
 import           Hakyll.Web.Html
 
 
@@ -90,6 +91,17 @@ defaultContext =
     titleField    "title"    `mappend`
     missingField
 
+--------------------------------------------------------------------------------
+teaserContext :: Snapshot -> Context String
+teaserContext snapshot = field "teaser" $ \item ->
+    (needlePrefix teaserSeparator . itemBody) <$>
+    loadSnapshot (itemIdentifier item) snapshot
+
+
+--------------------------------------------------------------------------------
+teaserSeparator :: String
+teaserSeparator = "<!-- teaser_end -->"
+
 
 --------------------------------------------------------------------------------
 bodyField :: String -> Context String