add category item

stackbuilders · Jun 6, 2017 · 40d5598 · 40d5598
1 parent d324808
commit 40d5598
Show file tree

Hide file tree

Showing 3 changed files with 41 additions and 4 deletions.
diff --git a/Text/Feed/Atom.hs b/Text/Feed/Atom.hs
@@ -21,7 +21,8 @@
 
 module Text.Feed.Atom
   ( -- * Types
-    Feed (..)
+    Category (..)
+  , Feed (..)
   , Person (..)
   , TypeAttribute (..)
     -- * Feed rendering
@@ -51,13 +52,15 @@ data Feed = Feed
     -- ^ The feed title type (Text, Html or XHtml)
   , feedAuthors :: ![Person]
     -- The feed authors
+  , feedCategories :: ![Category]
   } deriving (Eq, Ord, Show, Read)
 
 instance ToJSON Feed where
   toJSON Feed {..} = object
     [ "title" .= feedTitle
     , "titleType" .= feedTitleType
-    , "author" .= feedAuthors ]
+    , "author" .= feedAuthors
+    , "category" .= feedCategories ]
 
 -- | An enumeration for the Type attribute on Text constructs
 
@@ -85,6 +88,21 @@ instance ToJSON Person where
     , "uri"   .= personUri
     ]
 
+-- | The category of the element
+
+data Category = Category
+  { categoryTerm   :: !Text
+  , categoryScheme :: !(Maybe Text)
+  , categoryLabel  :: !(Maybe Text)
+  } deriving (Eq, Ord, Show, Read)
+
+instance ToJSON Category where
+  toJSON Category {..} = object
+    [ "term"   .= categoryTerm
+    , "scheme" .= categoryScheme
+    , "label"  .= categoryLabel
+    ]
+
 -- | Render a 'Feed' as a lazy 'TL.Text'.
 
 renderFeed :: Feed -> TL.Text

diff --git a/templates/atom.mustache b/templates/atom.mustache
@@ -12,4 +12,15 @@
     {{/ uri }}
   </author>
   {{/ author }}
+  {{# category }}
+  <category>
+    <term>{{ term }}</term>
+    {{# scheme }}
+    <scheme>{{ . }}</scheme>
+    {{/ scheme }}
+    {{# label }}
+    <label>{{ . }}</label>
+    {{/ label }}
+  </category>
+  {{/ category }}
 </feed>
diff --git a/tests/Text/Feed/AtomSpec.hs b/tests/Text/Feed/AtomSpec.hs
@@ -13,11 +13,10 @@ import qualified Text.Feed.Atom as Atom
 import Debug.Trace
 
 spec :: Spec
-spec = do
+spec =
   describe "Atom feed" $ do
     it "creates an Atom feed" $ do
       let atomFeed = testingAtomFeed
-
       traceShowId(Atom.renderFeed atomFeed) == "fixme"
 
 testingAtomFeed :: Atom.Feed
@@ -26,6 +25,7 @@ testingAtomFeed =
     { Atom.feedTitle = "Test title"
     , Atom.feedTitleType = Just Atom.TextType
     , Atom.feedAuthors = [testingAuthor "-1", testingAuthor "-2"]
+    , Atom.feedCategories = [testingCategory "-a", testingCategory "-b"]
     }
 
 testingAuthor :: Text -> Atom.Person
@@ -34,4 +34,12 @@ testingAuthor suffix =
     { Atom.personName = "Some Guy" <> suffix
     , Atom.personEmail = Just ("someguy@some.guy" <> suffix)
     , Atom.personUri = Just ("some.guy" <> suffix)
+    }
+
+testingCategory :: Text -> Atom.Category
+testingCategory suffix =
+  Atom.Category
+    { Atom.categoryTerm = "catTerm" <> suffix
+    , Atom.categoryScheme = Just ("catScheme" <> suffix)
+    , Atom.categoryLabel = Just ("catLabel" <> suffix)
     }