diff options
| -rw-r--r-- | src/Hakyll/Web/Page/Metadata.hs | 16 | ||||
| -rw-r--r-- | tests/Hakyll/Web/Page/Metadata/Tests.hs | 54 | ||||
| -rw-r--r-- | tests/TestSuite.hs | 3 |
3 files changed, 73 insertions, 0 deletions
diff --git a/src/Hakyll/Web/Page/Metadata.hs b/src/Hakyll/Web/Page/Metadata.hs index b0545f3..79c616e 100644 --- a/src/Hakyll/Web/Page/Metadata.hs +++ b/src/Hakyll/Web/Page/Metadata.hs @@ -11,6 +11,8 @@ module Hakyll.Web.Page.Metadata , copyField , renderDateField , renderDateFieldWith + , copyBodyToField + , copyBodyFromField ) where import Prelude hiding (id) @@ -138,3 +140,17 @@ renderDateFieldWith locale key format defaultValue = "%Y-%m-%d" dateString :: Maybe UTCTime return $ formatTime locale format time + +-- | Copy the body of a page to a metadata field +-- +copyBodyToField :: String -- ^ Destination key + -> Page String -- ^ Target page + -> Page String -- ^ Resulting page +copyBodyToField key page = setField key (pageBody page) page + +-- | Copy a metadata field to the page body +-- +copyBodyFromField :: String -- ^ Source key + -> Page String -- ^ Target page + -> Page String -- ^ Resulting page +copyBodyFromField key page = fmap (const $ getField key page) page diff --git a/tests/Hakyll/Web/Page/Metadata/Tests.hs b/tests/Hakyll/Web/Page/Metadata/Tests.hs new file mode 100644 index 0000000..6fbd89a --- /dev/null +++ b/tests/Hakyll/Web/Page/Metadata/Tests.hs @@ -0,0 +1,54 @@ +module Hakyll.Web.Page.Metadata.Tests + ( tests + ) where + +import Test.Framework +import Test.HUnit hiding (Test) + +import qualified Data.Map as M +import Data.Monoid (mempty) +import Data.Char (toLower) + +import Hakyll.Web.Page +import Hakyll.Web.Page.Metadata +import TestSuite.Util + +tests :: [Test] +tests = concat $ + [ fromAssertions "getField" + [ "bar" @=? getField "foo" (Page (M.singleton "foo" "bar") "body\n") + , "" @=? getField "foo" (Page M.empty "body") + ] + + , fromAssertions "getFieldMaybe" + [ Just "bar" @=? getFieldMaybe "foo" (Page (M.singleton "foo" "bar") "") + , Nothing @=? getFieldMaybe "foo" (Page M.empty "body") + ] + + , fromAssertions "setField" + [ (Page (M.singleton "bar" "foo") "") @=? setField "bar" "foo" mempty + , (Page (M.singleton "bar" "foo") "") @=? + setField "bar" "foo" (Page (M.singleton "bar" "qux") "") + ] + + , fromAssertions "trySetField" + [ (Page (M.singleton "bar" "foo") "") @=? trySetField "bar" "foo" mempty + , (Page (M.singleton "bar" "qux") "") @=? + trySetField "bar" "foo" (Page (M.singleton "bar" "qux") "") + ] + + , fromAssertions "setFieldA" + [ (Page (M.singleton "bar" "foo") "") @=? + setFieldA "bar" (map toLower) (mempty, "FOO") + ] + + , fromAssertions "copyBodyToField" + [ (Page (M.singleton "bar" "foo") "foo") @=? + copyBodyToField "bar" (Page M.empty "foo") + ] + + , fromAssertions "copyBodyFromField" + [ (Page (M.singleton "bar" "foo") "foo") @=? + copyBodyFromField "bar" (Page (M.singleton "bar" "foo") "qux") + ] + ] diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs index ba77139..7fd288d 100644 --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -7,6 +7,7 @@ import qualified Hakyll.Core.DependencyAnalyzer.Tests import qualified Hakyll.Core.Identifier.Tests import qualified Hakyll.Core.Routes.Tests import qualified Hakyll.Web.Page.Tests +import qualified Hakyll.Web.Page.Metadata.Tests import qualified Hakyll.Web.RelativizeUrls.Tests import qualified Hakyll.Web.Template.Tests import qualified Hakyll.Web.Util.Url.Tests @@ -23,6 +24,8 @@ main = defaultMain Hakyll.Core.Routes.Tests.tests , testGroup "Hakyll.Web.Page.Tests" Hakyll.Web.Page.Tests.tests + , testGroup "Hakyll.Web.Page.Metadata.Tests" + Hakyll.Web.Page.Metadata.Tests.tests , testGroup "Hakyll.Web.RelativizeUrls.Tests" Hakyll.Web.RelativizeUrls.Tests.tests , testGroup "Hakyll.Web.Template.Tests" |