Only add teaser when <!--more--> is there

src/Hakyll/Core/Util/String.hs

@@ -1,5 +1,5 @@
+--------------------------------------------------------------------------------
 -- | Miscellaneous string manipulation functions.
---
 module Hakyll.Core.Util.String
     ( trim
     , replaceAll
@@ -7,21 +7,24 @@ module Hakyll.Core.Util.String
     , needlePrefix
     ) where
 
+
+--------------------------------------------------------------------------------
 import Data.Char (isSpace)
 import Data.List (isPrefixOf)
 import Data.Maybe (listToMaybe)
-
 import Text.Regex.TDFA ((=~~))
 
+
+--------------------------------------------------------------------------------
 -- | Trim a string (drop spaces, tabs and newlines at both sides).
---
 trim :: String -> String
 trim = reverse . trim' . reverse . trim'
   where
     trim' = dropWhile isSpace
 
+
+--------------------------------------------------------------------------------
 -- | A simple (but inefficient) regex replace funcion
---
 replaceAll :: String              -- ^ Pattern
            -> (String -> String)  -- ^ Replacement (called on capture)
            -> String              -- ^ Source string
@@ -35,9 +38,10 @@ replaceAll pattern f source = replaceAll' source
                 (capture, after) = splitAt l tmp
             in before ++ f capture ++ replaceAll' after
 
+
+--------------------------------------------------------------------------------
 -- | A simple regex split function. The resulting list will contain no empty
 -- strings.
---
 splitAll :: String    -- ^ Pattern
          -> String    -- ^ String to split
          -> [String]  -- ^ Result
@@ -50,19 +54,24 @@ splitAll pattern = filter (not . null) . splitAll'
             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.
+
+--------------------------------------------------------------------------------
+-- | 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
+-- > needlePrefix "cd" "abcde" = "ab"
+--
+-- > needlePrefix "ab" "abc" = ""
+--
+-- > needlePrefix "ab" "xxab" = "xx"
+--
+-- > needlePrefix "a" "xx" = "xx"
+needlePrefix :: String -> String -> Maybe String
+needlePrefix needle haystack = go [] haystack
   where
-    go [] = []
-    go xss@(x:xs) | needle `isPrefixOf` xss = []
-                  | otherwise = x : go xs
+    go _   []                     = Nothing
+    go acc xss@(x:xs)
+        | needle `isPrefixOf` xss = Just $ reverse acc
+        | otherwise               = go (x : acc) xs

src/Hakyll/Web/Template/Context.hs

@@ -242,9 +242,13 @@ modificationTimeFieldWith locale key fmt = field key $ \i -> do
 teaserField :: String           -- ^ Key to use
             -> Snapshot         -- ^ Snapshot to load
             -> Context String   -- ^ Resulting context
-teaserField key snapshot = field key $ \item ->
-    (needlePrefix teaserSeparator . itemBody) <$>
-    loadSnapshot (itemIdentifier item) snapshot
+teaserField key snapshot = field key $ \item -> do
+    body <- itemBody <$> loadSnapshot (itemIdentifier item) snapshot
+    case needlePrefix teaserSeparator body of
+        Nothing -> fail $
+            "Hakyll.Web.Template.Context: no teaser defined for " ++
+            show (itemIdentifier item)
+        Just t -> return t
 
 
 --------------------------------------------------------------------------------

tests/Hakyll/Core/Util/String/Tests.hs

@@ -30,13 +30,13 @@ tests = testGroup "Hakyll.Core.Util.String.Tests" $ concat
         ]
 
     , fromAssertions "needlePrefix"
-        [ "ab" @=? needlePrefix "cd" "abcde"
-        , "xx" @=? needlePrefix "ab" "xxab"
-        , "xx" @=? needlePrefix "a" "xx"
-        , "x" @=? needlePrefix "ab" "xabxab"
-        , "" @=? needlePrefix "ab" "abc"
-        , "" @=? needlePrefix "ab" "abab"
-        , "" @=? needlePrefix "" ""
+        [ Just "ab" @=? needlePrefix "cd" "abcde"
+        , Just "xx" @=? needlePrefix "ab" "xxab"
+        , Nothing   @=? needlePrefix "a" "xx"
+        , Just "x"  @=? needlePrefix "ab" "xabxab"
+        , Just ""   @=? needlePrefix "ab" "abc"
+        , Just ""   @=? needlePrefix "ab" "abab"
+        , Nothing   @=? needlePrefix "" ""
         ]
     ]