diff --git a/LICENSE.markdown b/LICENSE.markdown --- a/LICENSE.markdown +++ b/LICENSE.markdown @@ -1,6 +1,6 @@ MIT License -Copyright (c) 2022 Taylor Fausak +Copyright (c) 2023 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 diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -1,6 +1,6 @@ # JSON Feed -[![Travis CI](https://travis-ci.org/tfausak/json-feed.svg?branch=master)](https://travis-ci.org/tfausak/json-feed) +[![Workflow](https://github.com/tfausak/json-feed/actions/workflows/workflow.yaml/badge.svg)](https://github.com/tfausak/json-feed/actions/workflows/workflow.yaml) [![Hackage](https://img.shields.io/hackage/v/json-feed)](https://hackage.haskell.org/package/json-feed) [![Stackage](https://www.stackage.org/package/json-feed/badge/nightly?label=stackage)](https://www.stackage.org/package/json-feed) diff --git a/json-feed.cabal b/json-feed.cabal --- a/json-feed.cabal +++ b/json-feed.cabal @@ -1,7 +1,7 @@ cabal-version: 2.2 name: json-feed -version: 2.0.0.4 +version: 2.0.0.5 synopsis: JSON Feed description: @@ -40,13 +40,13 @@ common library build-depends: - base >= 4.13.0 && < 4.18 + base >= 4.15.0 && < 4.18 , aeson >= 1.4.7 && < 1.6 || >= 2.0.0 && < 2.2 - , bytestring >= 0.10.10 && < 0.12 + , bytestring >= 0.10.12 && < 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 || >= 2.0 && < 2.1 + , text >= 1.2.5 && < 1.3 || >= 2.0 && < 2.1 , time >= 1.9.3 && < 1.13 default-language: Haskell2010 ghc-options: @@ -56,20 +56,17 @@ -Wno-missed-specialisations -Wno-missing-deriving-strategies -Wno-missing-exported-signatures + -Wno-missing-safe-haskell-mode + -Wno-prepositive-qualified-module -Wno-unsafe - 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 + if flag(pedantic) + ghc-options: -Werror + common executable import: library @@ -85,7 +82,7 @@ exposed-modules: JsonFeed hs-source-dirs: source/library -test-suite test +test-suite json-feed-test-suite import: executable build-depends: diff --git a/source/library/JsonFeed.hs b/source/library/JsonFeed.hs --- a/source/library/JsonFeed.hs +++ b/source/library/JsonFeed.hs @@ -2,106 +2,105 @@ -- | module JsonFeed - ( parseFeed - , renderFeed - -- * Types - , Feed(..) - , Author(..) - , Item(..) - , Attachment(..) - , Hub(..) - -- * Wrappers - , Html(..) - , Mime(..) - , Url(..) - ) where + ( parseFeed, + renderFeed, + -- * Types + Feed (..), + Author (..), + Item (..), + Attachment (..), + Hub (..), + + -- * Wrappers + Html (..), + Mime (..), + Url (..), + ) +where + import Data.Aeson (FromJSON, ToJSON, Value) +import qualified Data.Aeson as Json (eitherDecode, encode) import Data.Aeson.Types (Options) +import qualified Data.Aeson.Types as Json import Data.ByteString.Lazy (ByteString) +import qualified Data.List as List import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text import Data.Time (UTCTime) import GHC.Generics (Generic) import Network.Mime (MimeType) import Network.URI (URI) +import qualified Network.URI as 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. + { -- | 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. + feedAuthor :: Maybe Author, + -- | Provides more detail, beyond the title, on what the feed is about. A + -- feed reader may display this text. + feedDescription :: Maybe Text, + -- | 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. + feedExpired :: Maybe Bool, + -- | 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. + feedFavicon :: 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. + feedFeedUrl :: 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. + feedHomePageUrl :: Maybe Url, + -- | 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. + feedHubs :: Maybe [Hub], + -- | 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. + feedIcon :: Maybe Url, + -- | An array of objects that describe each object in the list. + feedItems :: [Item], + -- | 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). + feedNextUrl :: Maybe Url, + -- | The name of the feed, which will often correspond to the name of the + -- website (blog, for instance), though not necessarily. + feedTitle :: 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. + feedUserComment :: Maybe Text, + -- | The URL of the version of the format the feed uses. + feedVersion :: Url } deriving (Eq, Generic, Show) @@ -111,19 +110,18 @@ 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. + { -- | 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. + authorAvatar :: Maybe Url, + -- | The author's name. + authorName :: Maybe Text, + -- | 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. + authorUrl :: Maybe Url } deriving (Eq, Generic, Show) @@ -137,65 +135,64 @@ 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. + { -- | Lists related resources. Podcasts, for instance, would include an + -- attachment that's an audio or video file. + itemAttachments :: Maybe [Attachment], + -- | 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. + itemAuthor :: Maybe Author, + -- | 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. + itemBannerImage :: Maybe Url, + -- | '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.) + itemContentHtml :: Maybe Html, + -- | See 'itemContentHtml'. + itemContentText :: Maybe Text, + -- | Specifies the modification date in RFC 3339 format. + itemDateModified :: Maybe UTCTime, + -- | Specifies the date in RFC 3339 format. (Example: + -- @2010-02-07T14:04:00-05:00@.) + itemDatePublished :: Maybe UTCTime, + -- | 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. + itemExternalUrl :: Maybe Url, + -- | 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. + itemId :: Value, + -- | 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). + itemImage :: Maybe Url, + -- | 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'. + itemSummary :: 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. + itemTags :: Maybe [Text], + -- | Plain text. Microblog items in particular may omit titles. + itemTitle :: Maybe Text, + -- | 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. + itemUrl :: Maybe Url } deriving (Eq, Generic, Show) @@ -209,23 +206,22 @@ 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. + { -- | Specifies how long it takes to listen to or watch, when played at normal + -- speed. + attachmentDurationInSeconds :: Maybe Natural, + -- | Specifies the type of the attachment, such as @audio/mpeg@. + attachmentMimeType :: Mime, + -- | Specifies how large the file is. + attachmentSizeInBytes :: Maybe Natural, + -- | 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. + attachmentTitle :: Maybe Text, + -- | Specifies the location of the attachment. + attachmentUrl :: Url } deriving (Eq, Generic, Show) @@ -235,10 +231,9 @@ instance ToJSON Attachment where toJSON = Json.genericToJSON (jsonOptions "attachment") - data Hub = Hub - { hubType :: Text - , hubUrl :: Url + { hubType :: Text, + hubUrl :: Url } deriving (Eq, Generic, Show) @@ -248,69 +243,70 @@ instance ToJSON Hub where toJSON = Json.genericToJSON (jsonOptions "hub") - newtype Html = Html { htmlValue :: [Tag Text] - } deriving (Eq, Show) + } + deriving (Eq, Show) instance FromJSON Html where - parseJSON = Json.withText - "Html" - (\text -> pure Html { htmlValue = Html.parseTags text }) + 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) + } + deriving (Eq, Show) instance FromJSON Mime where - parseJSON = Json.withText - "Mime" - (\text -> pure Mime { mimeValue = Text.encodeUtf8 text }) + 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) + } + 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) - ) + 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 } - + 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] - ) - + 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 +dropPrefix prefix string = + if prefix `List.isPrefixOf` string + then Just (drop (length prefix) string) + else Nothing diff --git a/source/test-suite/Main.hs b/source/test-suite/Main.hs --- a/source/test-suite/Main.hs +++ b/source/test-suite/Main.hs @@ -1,16 +1,15 @@ module Main - ( main - ) where - -import System.FilePath ((<.>), ()) + ( main, + ) +where import qualified Control.Monad as Monad import qualified Data.ByteString.Lazy as ByteString import qualified Data.Either as Either import qualified JsonFeed +import System.FilePath ((<.>), ()) import qualified Test.Hspec as Hspec - main :: IO () main = Hspec.hspec . Hspec.parallel . Hspec.describe "JsonFeed" $ do Monad.forM_ feeds $ \feed -> do @@ -21,15 +20,15 @@ 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" + [ "allenpike.com", + "daringfireball.net", + "flyingmeat.com", + "hypercritical.co", + "inessential.com", + "jsonfeed.org", + "manton.org", + "maybepizza.com", + "shapeof.com", + "therecord.co", + "timetable.manton.org" ]