git.iko.soy/hakyll
on master help sign in
Add copyBodyToField, copyBodyFromField methods
commit379cd0eed48848ddf67c3de4def4f807372e713c authorJasper Van der Jeugt <jaspervdj@gmail.com> dateTue 29 Mar 2011, 18:19 (16 years ago) parent8bd45b9
3 files changed+73
compare with master
unifiedsplit
src/Hakyll/Web/Page/Metadata.hs+16 tests/Hakyll/Web/Page/Metadata/Tests.hs+54 tests/TestSuite.hs+3
src/Hakyll/Web/Page/Metadata.hs+16
@@ -11,6 +11,8 @@ module Hakyll.Web.Page.Metadata
1111 , copyField
1212 , renderDateField
1313 , renderDateFieldWith
14+ , copyBodyToField
15+ , copyBodyFromField
1416 ) where
1517
1618import Prelude hiding (id)
@@ -138,3 +140,17 @@ renderDateFieldWith locale key format defaultValue =
138140 "%Y-%m-%d"
139141 dateString :: Maybe UTCTime
140142 return $ formatTime locale format time
143+
144+-- | Copy the body of a page to a metadata field
145+--
146+copyBodyToField :: String -- ^ Destination key
147+ -> Page String -- ^ Target page
148+ -> Page String -- ^ Resulting page
149+copyBodyToField key page = setField key (pageBody page) page
150+
151+-- | Copy a metadata field to the page body
152+--
153+copyBodyFromField :: String -- ^ Source key
154+ -> Page String -- ^ Target page
155+ -> Page String -- ^ Resulting page
156+copyBodyFromField key page = fmap (const $ getField key page) page
tests/Hakyll/Web/Page/Metadata/Tests.hsnew file+54
@@ -0,0 +1,54 @@
1+module Hakyll.Web.Page.Metadata.Tests
2+ ( tests
3+ ) where
4+
5+import Test.Framework
6+import Test.HUnit hiding (Test)
7+
8+import qualified Data.Map as M
9+import Data.Monoid (mempty)
10+import Data.Char (toLower)
11+
12+import Hakyll.Web.Page
13+import Hakyll.Web.Page.Metadata
14+import TestSuite.Util
15+
16+tests :: [Test]
17+tests = concat $
18+ [ fromAssertions "getField"
19+ [ "bar" @=? getField "foo" (Page (M.singleton "foo" "bar") "body\n")
20+ , "" @=? getField "foo" (Page M.empty "body")
21+ ]
22+
23+ , fromAssertions "getFieldMaybe"
24+ [ Just "bar" @=? getFieldMaybe "foo" (Page (M.singleton "foo" "bar") "")
25+ , Nothing @=? getFieldMaybe "foo" (Page M.empty "body")
26+ ]
27+
28+ , fromAssertions "setField"
29+ [ (Page (M.singleton "bar" "foo") "") @=? setField "bar" "foo" mempty
30+ , (Page (M.singleton "bar" "foo") "") @=?
31+ setField "bar" "foo" (Page (M.singleton "bar" "qux") "")
32+ ]
33+
34+ , fromAssertions "trySetField"
35+ [ (Page (M.singleton "bar" "foo") "") @=? trySetField "bar" "foo" mempty
36+ , (Page (M.singleton "bar" "qux") "") @=?
37+ trySetField "bar" "foo" (Page (M.singleton "bar" "qux") "")
38+ ]
39+
40+ , fromAssertions "setFieldA"
41+ [ (Page (M.singleton "bar" "foo") "") @=?
42+ setFieldA "bar" (map toLower) (mempty, "FOO")
43+ ]
44+
45+ , fromAssertions "copyBodyToField"
46+ [ (Page (M.singleton "bar" "foo") "foo") @=?
47+ copyBodyToField "bar" (Page M.empty "foo")
48+ ]
49+
50+ , fromAssertions "copyBodyFromField"
51+ [ (Page (M.singleton "bar" "foo") "foo") @=?
52+ copyBodyFromField "bar" (Page (M.singleton "bar" "foo") "qux")
53+ ]
54+ ]
tests/TestSuite.hs+3
@@ -7,6 +7,7 @@ import qualified Hakyll.Core.DependencyAnalyzer.Tests
77import qualified Hakyll.Core.Identifier.Tests
88import qualified Hakyll.Core.Routes.Tests
99import qualified Hakyll.Web.Page.Tests
10+import qualified Hakyll.Web.Page.Metadata.Tests
1011import qualified Hakyll.Web.RelativizeUrls.Tests
1112import qualified Hakyll.Web.Template.Tests
1213import qualified Hakyll.Web.Util.Url.Tests
@@ -23,6 +24,8 @@ main = defaultMain
2324 Hakyll.Core.Routes.Tests.tests
2425 , testGroup "Hakyll.Web.Page.Tests"
2526 Hakyll.Web.Page.Tests.tests
27+ , testGroup "Hakyll.Web.Page.Metadata.Tests"
28+ Hakyll.Web.Page.Metadata.Tests.tests
2629 , testGroup "Hakyll.Web.RelativizeUrls.Tests"
2730 Hakyll.Web.RelativizeUrls.Tests.tests
2831 , testGroup "Hakyll.Web.Template.Tests"