json-feed 1.0.15 → 2.0.0.0
raw patch · 7 files changed
+394/−359 lines, 7 filesdep ~basedep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, bytestring
API changes (from Hackage documentation)
Files
- CHANGELOG.markdown +4/−0
- LICENSE.markdown +1/−1
- json-feed.cabal +38/−12
- source/library/JsonFeed.hs +316/−0
- source/test-suite/Main.hs +35/−0
- src/lib/JsonFeed.hs +0/−313
- src/test/Main.hs +0/−33
+ CHANGELOG.markdown view
@@ -0,0 +1,4 @@+# Change log++JSON Feed follows the [Package Versioning Policy](https://pvp.haskell.org).+You can find release notes [on GitHub](https://github.com/tfausak/json-feed/releases).
LICENSE.markdown view
@@ -1,6 +1,6 @@ MIT License -Copyright (c) 2020 Taylor Fausak+Copyright (c) 2022 Taylor Fausak Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal
json-feed.cabal view
@@ -1,7 +1,7 @@-cabal-version: >= 1.10+cabal-version: 2.2 name: json-feed-version: 1.0.15+version: 2.0.0.0 synopsis: JSON Feed description:@@ -12,6 +12,7 @@ build-type: Simple category: Web extra-source-files:+ CHANGELOG.markdown README.markdown feeds/allenpike.com.json feeds/daringfireball.net.json@@ -32,39 +33,64 @@ location: https://github.com/tfausak/json-feed type: git -library+flag pedantic+ default: False+ description: Enables @-Werror@, which turns warnings into errors.+ manual: True++common library build-depends:- base >= 4.13.0 && < 4.16+ base >= 4.13.0 && < 4.17 , aeson >= 1.4.7 && < 1.6 || >= 2.0.0 && < 2.1- , bytestring >= 0.10.10 && < 0.11+ , bytestring >= 0.10.10 && < 0.12 , mime-types >= 0.1.0 && < 0.2 , network-uri >= 2.6.3 && < 2.7 , tagsoup >= 0.14.8 && < 0.15 , text >= 1.2.4 && < 1.3 , time >= 1.9.3 && < 1.10 default-language: Haskell2010- exposed-modules: JsonFeed ghc-options: -Weverything+ -Wno-all-missed-specialisations -Wno-implicit-prelude+ -Wno-missed-specialisations -Wno-missing-deriving-strategies -Wno-missing-exported-signatures -Wno-unsafe- hs-source-dirs: src/lib + if flag(pedantic)+ ghc-options: -Werror+ if impl(ghc >= 8.10) ghc-options: -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module + if impl(ghc >= 9.2)+ ghc-options:+ -Wno-missing-kind-signatures++common executable+ import: library++ build-depends: json-feed+ ghc-options:+ -rtsopts+ -threaded+ -Wno-unused-packages++library+ import: library++ exposed-modules: JsonFeed+ hs-source-dirs: source/library+ test-suite test+ import: executable+ build-depends:- base -any- , bytestring -any , filepath >= 1.4.2 && < 1.5 , hspec >= 2.7.6 && < 2.10- , json-feed -any- default-language: Haskell2010- hs-source-dirs: src/test+ hs-source-dirs: source/test-suite main-is: Main.hs type: exitcode-stdio-1.0
+ source/library/JsonFeed.hs view
@@ -0,0 +1,316 @@+{-# LANGUAGE DeriveGeneric #-}++-- | <https://jsonfeed.org>+module JsonFeed+ ( parseFeed+ , renderFeed+ -- * Types+ , Feed(..)+ , Author(..)+ , Item(..)+ , Attachment(..)+ , Hub(..)+ -- * Wrappers+ , Html(..)+ , Mime(..)+ , Url(..)+ ) where++import Data.Aeson (FromJSON, ToJSON, Value)+import Data.Aeson.Types (Options)+import Data.ByteString.Lazy (ByteString)+import Data.Text (Text)+import Data.Time (UTCTime)+import GHC.Generics (Generic)+import Network.Mime (MimeType)+import Network.URI (URI)+import Numeric.Natural (Natural)+import Text.HTML.TagSoup (Tag)++import qualified Data.Aeson as Json (eitherDecode, encode)+import qualified Data.Aeson.Types as Json+import qualified Data.List as List+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import qualified Network.URI as Uri+import qualified Text.HTML.TagSoup as Html+++parseFeed :: ByteString -> Either String Feed+parseFeed = Json.eitherDecode+++renderFeed :: Feed -> ByteString+renderFeed = Json.encode+++data Feed = Feed+ { feedAuthor :: Maybe Author+ -- ^ The feed author. The author object has several members. These are all+ -- optional --- but if you provide an author object, then at least one is+ -- required.+ , feedDescription :: Maybe Text+ -- ^ Provides more detail, beyond the title, on what the feed is about. A+ -- feed reader may display this text.+ , feedExpired :: Maybe Bool+ -- ^ Says whether or not the feed is finished --- that is, whether or not it+ -- will ever update again. A feed for a temporary event, such as an instance+ -- of the Olympics, could expire. If the value is 'True', then it's expired.+ -- Any other value, or the absence of 'feedExpired', means the feed may+ -- continue to update.+ , feedFavicon :: Maybe Url+ -- ^ The URL of an image for the feed suitable to be used in a source list.+ -- It should be square and relatively small, but not smaller than 64 x 64 (so+ -- that it can look good on retina displays). As with 'feedIcon', this image+ -- should use transparency where appropriate, since it may be rendered on a+ -- non-white background.+ , feedFeedUrl :: Maybe Url+ -- ^ The URL of the feed, and serves as the unique identifier for the feed.+ -- As with 'feedHomePageUrl', this should be considered required for feeds on+ -- the public web.+ , feedHomePageUrl :: Maybe Url+ -- ^ The URL of the resource that the feed describes. This resource may or+ -- may not actually be a "home" page, but it should be an HTML page. If a+ -- feed is published on the public web, this should be considered as+ -- required. But it may not make sense in the case of a file created on a+ -- desktop computer, when that file is not shared or is shared only+ -- privately.+ , feedHubs :: Maybe [Hub]+ -- ^ Describes endpoints that can be used to subscribe to real-time+ -- notifications from the publisher of this feed. Each object has a type and+ -- URL, both of which are required.+ , feedIcon :: Maybe Url+ -- ^ The URL of an image for the feed suitable to be used in a timeline, much+ -- the way an avatar might be used. It should be square and relatively large+ -- --- such as 512 x 512 --- so that it can be scaled-down and so that it can+ -- look good on retina displays. It should use transparency where+ -- appropriate, since it may be rendered on a non-white background.+ , feedItems :: [Item]+ -- ^ An array of objects that describe each object in the list.+ , feedNextUrl :: Maybe Url+ -- ^ The URL of a feed that provides the next /n/ items, where /n/ is+ -- determined by the publisher. This allows for pagination, but with the+ -- expectation that reader software is not required to use it and probably+ -- won't use it very often. 'feedNextUrl' must not be the same as+ -- 'feedFeedUrl', and it must not be the same as a previous 'feedNextUrl' (to+ -- avoid infinite loops).+ , feedTitle :: Text+ -- ^ The name of the feed, which will often correspond to the name of the+ -- website (blog, for instance), though not necessarily.+ , feedUserComment :: Maybe Text+ -- ^ A description of the purpose of the feed. This is for the use of people+ -- looking at the raw JSON, and should be ignored by feed readers.+ , feedVersion :: Url+ -- ^ The URL of the version of the format the feed uses.+ }+ deriving (Eq, Generic, Show)++instance FromJSON Feed where+ parseJSON = Json.genericParseJSON (jsonOptions "feed")++instance ToJSON Feed where+ toJSON = Json.genericToJSON (jsonOptions "feed")+++data Author = Author+ { authorAvatar :: Maybe Url+ -- ^ The URL for an image for the author. As with icon, it should be square+ -- and relatively large --- such as 512 x 512 --- and should use transparency+ -- where appropriate, since it may be rendered on a non-white background.+ , authorName :: Maybe Text+ -- ^ The author's name.+ , authorUrl :: Maybe Url+ -- ^ The URL of a site owned by the author. It could be a blog, micro-blog,+ -- Twitter account, and so on. Ideally the linked-to page provides a way to+ -- contact the author, but that's not required. The URL could be a @mailto:@+ -- link, though we suspect that will be rare.+ }+ deriving (Eq, Generic, Show)++instance FromJSON Author where+ parseJSON value = do+ author <- Json.genericParseJSON (jsonOptions "author") value+ case (authorAvatar author, authorName author, authorUrl author) of+ (Nothing, Nothing, Nothing) -> fail ("invalid Author: " <> show author)+ _ -> pure author++instance ToJSON Author where+ toJSON = Json.genericToJSON (jsonOptions "author")+++data Item = Item+ { itemAttachments :: Maybe [Attachment]+ -- ^ Lists related resources. Podcasts, for instance, would include an+ -- attachment that's an audio or video file.+ , itemAuthor :: Maybe Author+ -- ^ Has the same structure as the top-level 'feedAuthor'. If not specified+ -- in an item, then the top-level author, if present, is the author of the+ -- item.+ , itemBannerImage :: Maybe Url+ -- ^ The URL of an image to use as a banner. Some blogging systems (such as+ -- Medium) display a different banner image chosen to go with each post, but+ -- that image wouldn't otherwise appear in the content_html. A feed reader+ -- with a detail view may choose to show this banner image at the top of the+ -- detail view, possibly with the title overlaid.+ , itemContentHtml :: Maybe Html+ -- ^ 'itemContentHtml' and 'itemContentText' are each optional strings ---+ -- but one or both must be present. This is the HTML or plain text of the+ -- item. Important: the only place HTML is allowed in this format is in+ -- 'itemContentHtml'. A Twitter-like service might use 'itemContentText',+ -- while a blog might use 'itemContentHtml'. Use whichever makes sense for+ -- your resource. (It doesn't even have to be the same for each item in a+ -- feed.)+ , itemContentText :: Maybe Text+ -- ^ See 'itemContentHtml'.+ , itemDateModified :: Maybe UTCTime+ -- ^ Specifies the modification date in RFC 3339 format.+ , itemDatePublished :: Maybe UTCTime+ -- ^ Specifies the date in RFC 3339 format. (Example:+ -- @2010-02-07T14:04:00-05:00@.)+ , itemExternalUrl :: Maybe Url+ -- ^ The URL of a page elsewhere. This is especially useful for linkblogs. If+ -- 'itemUrl' links to where you're talking about a thing, then+ -- 'itemExternalUrl' links to the thing you're talking about.+ , itemId :: Value+ -- ^ Unique for the item in the feed over time. If an item is ever updated,+ -- the ID should be unchanged. New items should never use a previously-used+ -- ID. If an ID is presented as a number or other type, a JSON Feed reader+ -- must coerce it to a string. Ideally, the ID is the full URL of the+ -- resource described by the item, since URLs make great unique identifiers.+ , itemImage :: Maybe Url+ -- ^ The URL of the main image for the item. This image may also appear in+ -- the 'itemContentHtml' --- if so, it's a hint to the feed reader that this+ -- is the main, featured image. Feed readers may use the image as a preview+ -- (probably resized as a thumbnail and placed in a timeline).+ , itemSummary :: Maybe Text+ -- ^ A plain text sentence or two describing the item. This might be+ -- presented in a timeline, for instance, where a detail view would display+ -- all of 'itemContentHtml' or 'itemContentText'.+ , itemTags :: Maybe [Text]+ -- ^ Can have any plain text values you want. Tags tend to be just one word,+ -- but they may be anything. Note: they are not the equivalent of Twitter+ -- hashtags. Some blogging systems and other feed formats call these+ -- categories.+ , itemTitle :: Maybe Text+ -- ^ Plain text. Microblog items in particular may omit titles.+ , itemUrl :: Maybe Url+ -- ^ The URL of the resource described by the item. It's the permalink. This+ -- may be the same as the ID --- but should be present regardless.+ }+ deriving (Eq, Generic, Show)++instance FromJSON Item where+ parseJSON value = do+ item <- Json.genericParseJSON (jsonOptions "item") value+ case (itemContentHtml item, itemContentText item) of+ (Nothing, Nothing) -> fail ("invalid Item: " <> show item)+ _ -> pure item++instance ToJSON Item where+ toJSON = Json.genericToJSON (jsonOptions "item")+++data Attachment = Attachment+ { attachmentDurationInSeconds :: Maybe Natural+ -- ^ Specifies how long it takes to listen to or watch, when played at normal+ -- speed.+ , attachmentMimeType :: Mime+ -- ^ Specifies the type of the attachment, such as @audio/mpeg@.+ , attachmentSizeInBytes :: Maybe Natural+ -- ^ Specifies how large the file is.+ , attachmentTitle :: Maybe Text+ -- ^ Is a name for the attachment. Important: if there are multiple+ -- attachments, and two or more have the exact same title (when title is+ -- present), then they are considered as alternate representations of the+ -- same thing. In this way a podcaster, for instance, might provide an audio+ -- recording in different formats.+ , attachmentUrl :: Url+ -- ^ Specifies the location of the attachment.+ }+ deriving (Eq, Generic, Show)++instance FromJSON Attachment where+ parseJSON = Json.genericParseJSON (jsonOptions "attachment")++instance ToJSON Attachment where+ toJSON = Json.genericToJSON (jsonOptions "attachment")+++data Hub = Hub+ { hubType :: Text+ , hubUrl :: Url+ }+ deriving (Eq, Generic, Show)++instance FromJSON Hub where+ parseJSON = Json.genericParseJSON (jsonOptions "hub")++instance ToJSON Hub where+ toJSON = Json.genericToJSON (jsonOptions "hub")+++newtype Html = Html+ { htmlValue :: [Tag Text]+ } deriving (Eq, Show)++instance FromJSON Html where+ parseJSON = Json.withText+ "Html"+ (\text -> pure Html { htmlValue = Html.parseTags text })++instance ToJSON Html where+ toJSON html = Json.String (Html.renderTags (htmlValue html))+++newtype Mime = Mime+ { mimeValue :: MimeType+ } deriving (Eq, Show)++instance FromJSON Mime where+ parseJSON = Json.withText+ "Mime"+ (\text -> pure Mime { mimeValue = Text.encodeUtf8 text })++instance ToJSON Mime where+ toJSON mime = Json.String (Text.decodeUtf8 (mimeValue mime))+++newtype Url = Url+ { urlValue :: URI+ } deriving (Eq, Show)++instance FromJSON Url where+ parseJSON = Json.withText+ "Url"+ (\text -> case Uri.parseURI (Text.unpack text) of+ Just uri -> pure Url { urlValue = uri }+ Nothing -> fail ("invalid Url: " <> show text)+ )++instance ToJSON Url where+ toJSON url = Json.String (Text.pack (show (urlValue url)))+++jsonOptions :: String -> Options+jsonOptions prefix =+ Json.defaultOptions { Json.fieldLabelModifier = fieldLabelModifier prefix }+++fieldLabelModifier :: String -> String -> String+fieldLabelModifier prefix string =+ Json.camelTo2 '_' (unsafeDropPrefix prefix string)+++unsafeDropPrefix :: String -> String -> String+unsafeDropPrefix prefix string = case dropPrefix prefix string of+ Just suffix -> suffix+ Nothing -> error+ (unwords+ ["unsafeDropPrefix:", show prefix, "is not a prefix of", show string]+ )+++dropPrefix :: String -> String -> Maybe String+dropPrefix prefix string = if prefix `List.isPrefixOf` string+ then Just (drop (length prefix) string)+ else Nothing
+ source/test-suite/Main.hs view
@@ -0,0 +1,35 @@+module Main+ ( main+ ) where++import System.FilePath ((<.>), (</>))++import qualified Control.Monad as Monad+import qualified Data.ByteString.Lazy as ByteString+import qualified Data.Either as Either+import qualified JsonFeed+import qualified Test.Hspec as Hspec+++main :: IO ()+main = Hspec.hspec . Hspec.parallel . Hspec.describe "JsonFeed" $ do+ Monad.forM_ feeds $ \feed -> do+ Hspec.it ("parses the " <> feed <> " feed") $ do+ let file = "feeds" </> feed <.> "json"+ contents <- ByteString.readFile file+ JsonFeed.parseFeed contents `Hspec.shouldSatisfy` Either.isRight++feeds :: [String]+feeds =+ [ "allenpike.com"+ , "daringfireball.net"+ , "flyingmeat.com"+ , "hypercritical.co"+ , "inessential.com"+ , "jsonfeed.org"+ , "manton.org"+ , "maybepizza.com"+ , "shapeof.com"+ , "therecord.co"+ , "timetable.manton.org"+ ]
− src/lib/JsonFeed.hs
@@ -1,313 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}---- | <https://jsonfeed.org>-module JsonFeed- ( parseFeed- , renderFeed- -- * Types- , Feed (..)- , Author (..)- , Item (..)- , Attachment (..)- , Hub (..)- -- * Wrappers- , Html (..)- , Mime (..)- , Url (..)- ) where--import Data.Aeson (FromJSON, ToJSON, Value)-import Data.Aeson.Types (Options)-import Data.ByteString.Lazy (ByteString)-import Data.Text (Text)-import Data.Time (UTCTime)-import GHC.Generics (Generic)-import Network.Mime (MimeType)-import Network.URI (URI)-import Numeric.Natural (Natural)-import Text.HTML.TagSoup (Tag)--import qualified Data.Aeson as Json (eitherDecode, encode)-import qualified Data.Aeson.Types as Json-import qualified Data.List as List-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text-import qualified Network.URI as Uri-import qualified Text.HTML.TagSoup as Html---parseFeed :: ByteString -> Either String Feed-parseFeed = Json.eitherDecode---renderFeed :: Feed -> ByteString-renderFeed = Json.encode---data Feed = Feed- { feedAuthor :: Maybe Author- -- ^ The feed author. The author object has several members. These are all- -- optional --- but if you provide an author object, then at least one is- -- required.- , feedDescription :: Maybe Text- -- ^ Provides more detail, beyond the title, on what the feed is about. A- -- feed reader may display this text.- , feedExpired :: Maybe Bool- -- ^ Says whether or not the feed is finished --- that is, whether or not it- -- will ever update again. A feed for a temporary event, such as an instance- -- of the Olympics, could expire. If the value is 'True', then it's expired.- -- Any other value, or the absence of 'feedExpired', means the feed may- -- continue to update.- , feedFavicon :: Maybe Url- -- ^ The URL of an image for the feed suitable to be used in a source list.- -- It should be square and relatively small, but not smaller than 64 x 64 (so- -- that it can look good on retina displays). As with 'feedIcon', this image- -- should use transparency where appropriate, since it may be rendered on a- -- non-white background.- , feedFeedUrl :: Maybe Url- -- ^ The URL of the feed, and serves as the unique identifier for the feed.- -- As with 'feedHomePageUrl', this should be considered required for feeds on- -- the public web.- , feedHomePageUrl :: Maybe Url- -- ^ The URL of the resource that the feed describes. This resource may or- -- may not actually be a "home" page, but it should be an HTML page. If a- -- feed is published on the public web, this should be considered as- -- required. But it may not make sense in the case of a file created on a- -- desktop computer, when that file is not shared or is shared only- -- privately.- , feedHubs :: Maybe [Hub]- -- ^ Describes endpoints that can be used to subscribe to real-time- -- notifications from the publisher of this feed. Each object has a type and- -- URL, both of which are required.- , feedIcon :: Maybe Url- -- ^ The URL of an image for the feed suitable to be used in a timeline, much- -- the way an avatar might be used. It should be square and relatively large- -- --- such as 512 x 512 --- so that it can be scaled-down and so that it can- -- look good on retina displays. It should use transparency where- -- appropriate, since it may be rendered on a non-white background.- , feedItems :: [Item]- -- ^ An array of objects that describe each object in the list.- , feedNextUrl :: Maybe Url- -- ^ The URL of a feed that provides the next /n/ items, where /n/ is- -- determined by the publisher. This allows for pagination, but with the- -- expectation that reader software is not required to use it and probably- -- won't use it very often. 'feedNextUrl' must not be the same as- -- 'feedFeedUrl', and it must not be the same as a previous 'feedNextUrl' (to- -- avoid infinite loops).- , feedTitle :: Text- -- ^ The name of the feed, which will often correspond to the name of the- -- website (blog, for instance), though not necessarily.- , feedUserComment :: Maybe Text- -- ^ A description of the purpose of the feed. This is for the use of people- -- looking at the raw JSON, and should be ignored by feed readers.- , feedVersion :: Url- -- ^ The URL of the version of the format the feed uses.- } deriving (Eq, Generic, Show)--instance FromJSON Feed where- parseJSON = Json.genericParseJSON (jsonOptions "feed")--instance ToJSON Feed where- toJSON = Json.genericToJSON (jsonOptions "feed")---data Author = Author- { authorAvatar :: Maybe Url- -- ^ The URL for an image for the author. As with icon, it should be square- -- and relatively large --- such as 512 x 512 --- and should use transparency- -- where appropriate, since it may be rendered on a non-white background.- , authorName :: Maybe Text- -- ^ The author's name.- , authorUrl :: Maybe Url- -- ^ The URL of a site owned by the author. It could be a blog, micro-blog,- -- Twitter account, and so on. Ideally the linked-to page provides a way to- -- contact the author, but that's not required. The URL could be a @mailto:@- -- link, though we suspect that will be rare.- } deriving (Eq, Generic, Show)--instance FromJSON Author where- parseJSON value = do- author <- Json.genericParseJSON (jsonOptions "author") value- case (authorAvatar author, authorName author, authorUrl author) of- (Nothing, Nothing, Nothing) -> fail ("invalid Author: " ++ show author)- _ -> pure author--instance ToJSON Author where- toJSON = Json.genericToJSON (jsonOptions "author")---data Item = Item- { itemAttachments :: Maybe [Attachment]- -- ^ Lists related resources. Podcasts, for instance, would include an- -- attachment that's an audio or video file.- , itemAuthor :: Maybe Author- -- ^ Has the same structure as the top-level 'feedAuthor'. If not specified- -- in an item, then the top-level author, if present, is the author of the- -- item.- , itemBannerImage :: Maybe Url- -- ^ The URL of an image to use as a banner. Some blogging systems (such as- -- Medium) display a different banner image chosen to go with each post, but- -- that image wouldn't otherwise appear in the content_html. A feed reader- -- with a detail view may choose to show this banner image at the top of the- -- detail view, possibly with the title overlaid.- , itemContentHtml :: Maybe Html- -- ^ 'itemContentHtml' and 'itemContentText' are each optional strings ---- -- but one or both must be present. This is the HTML or plain text of the- -- item. Important: the only place HTML is allowed in this format is in- -- 'itemContentHtml'. A Twitter-like service might use 'itemContentText',- -- while a blog might use 'itemContentHtml'. Use whichever makes sense for- -- your resource. (It doesn't even have to be the same for each item in a- -- feed.)- , itemContentText :: Maybe Text- -- ^ See 'itemContentHtml'.- , itemDateModified :: Maybe UTCTime- -- ^ Specifies the modification date in RFC 3339 format.- , itemDatePublished :: Maybe UTCTime- -- ^ Specifies the date in RFC 3339 format. (Example:- -- @2010-02-07T14:04:00-05:00@.)- , itemExternalUrl :: Maybe Url- -- ^ The URL of a page elsewhere. This is especially useful for linkblogs. If- -- 'itemUrl' links to where you're talking about a thing, then- -- 'itemExternalUrl' links to the thing you're talking about.- , itemId :: Value- -- ^ Unique for the item in the feed over time. If an item is ever updated,- -- the ID should be unchanged. New items should never use a previously-used- -- ID. If an ID is presented as a number or other type, a JSON Feed reader- -- must coerce it to a string. Ideally, the ID is the full URL of the- -- resource described by the item, since URLs make great unique identifiers.- , itemImage :: Maybe Url- -- ^ The URL of the main image for the item. This image may also appear in- -- the 'itemContentHtml' --- if so, it's a hint to the feed reader that this- -- is the main, featured image. Feed readers may use the image as a preview- -- (probably resized as a thumbnail and placed in a timeline).- , itemSummary :: Maybe Text- -- ^ A plain text sentence or two describing the item. This might be- -- presented in a timeline, for instance, where a detail view would display- -- all of 'itemContentHtml' or 'itemContentText'.- , itemTags :: Maybe [Text]- -- ^ Can have any plain text values you want. Tags tend to be just one word,- -- but they may be anything. Note: they are not the equivalent of Twitter- -- hashtags. Some blogging systems and other feed formats call these- -- categories.- , itemTitle :: Maybe Text- -- ^ Plain text. Microblog items in particular may omit titles.- , itemUrl :: Maybe Url- -- ^ The URL of the resource described by the item. It's the permalink. This- -- may be the same as the ID --- but should be present regardless.- } deriving (Eq, Generic, Show)--instance FromJSON Item where- parseJSON value = do- item <- Json.genericParseJSON (jsonOptions "item") value- case (itemContentHtml item, itemContentText item) of- (Nothing, Nothing) -> fail ("invalid Item: " ++ show item)- _ -> pure item--instance ToJSON Item where- toJSON = Json.genericToJSON (jsonOptions "item")---data Attachment = Attachment- { attachmentDurationInSeconds :: Maybe Natural- -- ^ Specifies how long it takes to listen to or watch, when played at normal- -- speed.- , attachmentMimeType :: Mime- -- ^ Specifies the type of the attachment, such as @audio/mpeg@.- , attachmentSizeInBytes :: Maybe Natural- -- ^ Specifies how large the file is.- , attachmentTitle :: Maybe Text- -- ^ Is a name for the attachment. Important: if there are multiple- -- attachments, and two or more have the exact same title (when title is- -- present), then they are considered as alternate representations of the- -- same thing. In this way a podcaster, for instance, might provide an audio- -- recording in different formats.- , attachmentUrl :: Url- -- ^ Specifies the location of the attachment.- } deriving (Eq, Generic, Show)--instance FromJSON Attachment where- parseJSON = Json.genericParseJSON (jsonOptions "attachment")--instance ToJSON Attachment where- toJSON = Json.genericToJSON (jsonOptions "attachment")---data Hub = Hub- { hubType :: Text- , hubUrl :: Url- } deriving (Eq, Generic, Show)--instance FromJSON Hub where- parseJSON = Json.genericParseJSON (jsonOptions "hub")--instance ToJSON Hub where- toJSON = Json.genericToJSON (jsonOptions "hub")---newtype Html = Html- { htmlValue :: [Tag Text]- } deriving (Eq, Show)--instance FromJSON Html where- parseJSON = Json.withText "Html" (\text ->- pure Html { htmlValue = Html.parseTags text })--instance ToJSON Html where- toJSON html = Json.String (Html.renderTags (htmlValue html))---newtype Mime = Mime- { mimeValue :: MimeType- } deriving (Eq, Show)--instance FromJSON Mime where- parseJSON = Json.withText "Mime" (\text ->- pure Mime { mimeValue = Text.encodeUtf8 text })--instance ToJSON Mime where- toJSON mime = Json.String (Text.decodeUtf8 (mimeValue mime))---newtype Url = Url- { urlValue :: URI- } deriving (Eq, Show)--instance FromJSON Url where- parseJSON = Json.withText "Url" (\text ->- case Uri.parseURI (Text.unpack text) of- Just uri -> pure Url { urlValue = uri }- Nothing -> fail ("invalid Url: " ++ show text))--instance ToJSON Url where- toJSON url = Json.String (Text.pack (show (urlValue url)))---jsonOptions :: String -> Options-jsonOptions prefix =- Json.defaultOptions- { Json.fieldLabelModifier = fieldLabelModifier prefix- }---fieldLabelModifier :: String -> String -> String-fieldLabelModifier prefix string =- Json.camelTo2 '_' (unsafeDropPrefix prefix string)---unsafeDropPrefix :: String -> String -> String-unsafeDropPrefix prefix string =- case dropPrefix prefix string of- Just suffix -> suffix- Nothing -> error (unwords- [ "unsafeDropPrefix:"- , show prefix- , "is not a prefix of"- , show string- ])---dropPrefix :: String -> String -> Maybe String-dropPrefix prefix string =- if List.isPrefixOf prefix string- then Just (drop (length prefix) string)- else Nothing
− src/test/Main.hs
@@ -1,33 +0,0 @@-module Main (main) where--import System.FilePath ((</>), (<.>))--import qualified Control.Monad as Monad-import qualified Data.ByteString.Lazy as ByteString-import qualified Data.Either as Either-import qualified JsonFeed-import qualified Test.Hspec as Hspec---main :: IO ()-main = Hspec.hspec . Hspec.parallel . Hspec.describe "JsonFeed" $ do- Monad.forM_ feeds $ \feed -> do- Hspec.it ("parses the " ++ feed ++ " feed") $ do- let file = "feeds" </> feed <.> "json"- contents <- ByteString.readFile file- JsonFeed.parseFeed contents `Hspec.shouldSatisfy` Either.isRight--feeds :: [String]-feeds =- [ "allenpike.com"- , "daringfireball.net"- , "flyingmeat.com"- , "hypercritical.co"- , "inessential.com"- , "jsonfeed.org"- , "manton.org"- , "maybepizza.com"- , "shapeof.com"- , "therecord.co"- , "timetable.manton.org"- ]