{-# LANGUAGE DeriveGeneric #-}
module JsonFeed
( parseFeed
, renderFeed
, Feed (..)
, Author (..)
, Item (..)
, Attachment (..)
, Hub (..)
, 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 :: ByteString -> Either String Feed
parseFeed = ByteString -> Either String Feed
forall a. FromJSON a => ByteString -> Either String a
Json.eitherDecode
renderFeed :: Feed -> ByteString
renderFeed :: Feed -> ByteString
renderFeed = Feed -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encode
data Feed = Feed
{ Feed -> Maybe Author
feedAuthor :: Maybe Author
, Feed -> Maybe Text
feedDescription :: Maybe Text
, Feed -> Maybe Bool
feedExpired :: Maybe Bool
, Feed -> Maybe Url
feedFavicon :: Maybe Url
, Feed -> Maybe Url
feedFeedUrl :: Maybe Url
, Feed -> Maybe Url
feedHomePageUrl :: Maybe Url
, Feed -> Maybe [Hub]
feedHubs :: Maybe [Hub]
, Feed -> Maybe Url
feedIcon :: Maybe Url
, Feed -> [Item]
feedItems :: [Item]
, Feed -> Maybe Url
feedNextUrl :: Maybe Url
, Feed -> Text
feedTitle :: Text
, :: Maybe Text
, Feed -> Url
feedVersion :: Url
} deriving (Feed -> Feed -> Bool
(Feed -> Feed -> Bool) -> (Feed -> Feed -> Bool) -> Eq Feed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Feed -> Feed -> Bool
$c/= :: Feed -> Feed -> Bool
== :: Feed -> Feed -> Bool
$c== :: Feed -> Feed -> Bool
Eq, (forall x. Feed -> Rep Feed x)
-> (forall x. Rep Feed x -> Feed) -> Generic Feed
forall x. Rep Feed x -> Feed
forall x. Feed -> Rep Feed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Feed x -> Feed
$cfrom :: forall x. Feed -> Rep Feed x
Generic, Int -> Feed -> ShowS
[Feed] -> ShowS
Feed -> String
(Int -> Feed -> ShowS)
-> (Feed -> String) -> ([Feed] -> ShowS) -> Show Feed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Feed] -> ShowS
$cshowList :: [Feed] -> ShowS
show :: Feed -> String
$cshow :: Feed -> String
showsPrec :: Int -> Feed -> ShowS
$cshowsPrec :: Int -> Feed -> ShowS
Show)
instance FromJSON Feed where
parseJSON :: Value -> Parser Feed
parseJSON = Options -> Value -> Parser Feed
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Json.genericParseJSON (String -> Options
jsonOptions String
"feed")
instance ToJSON Feed where
toJSON :: Feed -> Value
toJSON = Options -> Feed -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Json.genericToJSON (String -> Options
jsonOptions String
"feed")
data Author = Author
{ Author -> Maybe Url
authorAvatar :: Maybe Url
, Author -> Maybe Text
authorName :: Maybe Text
, Author -> Maybe Url
authorUrl :: Maybe Url
} deriving (Author -> Author -> Bool
(Author -> Author -> Bool)
-> (Author -> Author -> Bool) -> Eq Author
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Author -> Author -> Bool
$c/= :: Author -> Author -> Bool
== :: Author -> Author -> Bool
$c== :: Author -> Author -> Bool
Eq, (forall x. Author -> Rep Author x)
-> (forall x. Rep Author x -> Author) -> Generic Author
forall x. Rep Author x -> Author
forall x. Author -> Rep Author x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Author x -> Author
$cfrom :: forall x. Author -> Rep Author x
Generic, Int -> Author -> ShowS
[Author] -> ShowS
Author -> String
(Int -> Author -> ShowS)
-> (Author -> String) -> ([Author] -> ShowS) -> Show Author
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Author] -> ShowS
$cshowList :: [Author] -> ShowS
show :: Author -> String
$cshow :: Author -> String
showsPrec :: Int -> Author -> ShowS
$cshowsPrec :: Int -> Author -> ShowS
Show)
instance FromJSON Author where
parseJSON :: Value -> Parser Author
parseJSON Value
value = do
Author
author <- Options -> Value -> Parser Author
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Json.genericParseJSON (String -> Options
jsonOptions String
"author") Value
value
case (Author -> Maybe Url
authorAvatar Author
author, Author -> Maybe Text
authorName Author
author, Author -> Maybe Url
authorUrl Author
author) of
(Maybe Url
Nothing, Maybe Text
Nothing, Maybe Url
Nothing) -> String -> Parser Author
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid Author: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Author -> String
forall a. Show a => a -> String
show Author
author)
(Maybe Url, Maybe Text, Maybe Url)
_ -> Author -> Parser Author
forall (f :: * -> *) a. Applicative f => a -> f a
pure Author
author
instance ToJSON Author where
toJSON :: Author -> Value
toJSON = Options -> Author -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Json.genericToJSON (String -> Options
jsonOptions String
"author")
data Item = Item
{ Item -> Maybe [Attachment]
itemAttachments :: Maybe [Attachment]
, Item -> Maybe Author
itemAuthor :: Maybe Author
, Item -> Maybe Url
itemBannerImage :: Maybe Url
, Item -> Maybe Html
itemContentHtml :: Maybe Html
, Item -> Maybe Text
itemContentText :: Maybe Text
, Item -> Maybe UTCTime
itemDateModified :: Maybe UTCTime
, Item -> Maybe UTCTime
itemDatePublished :: Maybe UTCTime
, Item -> Maybe Url
itemExternalUrl :: Maybe Url
, Item -> Value
itemId :: Value
, Item -> Maybe Url
itemImage :: Maybe Url
, Item -> Maybe Text
itemSummary :: Maybe Text
, Item -> Maybe [Text]
itemTags :: Maybe [Text]
, Item -> Maybe Text
itemTitle :: Maybe Text
, Item -> Maybe Url
itemUrl :: Maybe Url
} deriving (Item -> Item -> Bool
(Item -> Item -> Bool) -> (Item -> Item -> Bool) -> Eq Item
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Item -> Item -> Bool
$c/= :: Item -> Item -> Bool
== :: Item -> Item -> Bool
$c== :: Item -> Item -> Bool
Eq, (forall x. Item -> Rep Item x)
-> (forall x. Rep Item x -> Item) -> Generic Item
forall x. Rep Item x -> Item
forall x. Item -> Rep Item x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Item x -> Item
$cfrom :: forall x. Item -> Rep Item x
Generic, Int -> Item -> ShowS
[Item] -> ShowS
Item -> String
(Int -> Item -> ShowS)
-> (Item -> String) -> ([Item] -> ShowS) -> Show Item
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Item] -> ShowS
$cshowList :: [Item] -> ShowS
show :: Item -> String
$cshow :: Item -> String
showsPrec :: Int -> Item -> ShowS
$cshowsPrec :: Int -> Item -> ShowS
Show)
instance FromJSON Item where
parseJSON :: Value -> Parser Item
parseJSON Value
value = do
Item
item <- Options -> Value -> Parser Item
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Json.genericParseJSON (String -> Options
jsonOptions String
"item") Value
value
case (Item -> Maybe Html
itemContentHtml Item
item, Item -> Maybe Text
itemContentText Item
item) of
(Maybe Html
Nothing, Maybe Text
Nothing) -> String -> Parser Item
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid Item: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Item -> String
forall a. Show a => a -> String
show Item
item)
(Maybe Html, Maybe Text)
_ -> Item -> Parser Item
forall (f :: * -> *) a. Applicative f => a -> f a
pure Item
item
instance ToJSON Item where
toJSON :: Item -> Value
toJSON = Options -> Item -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Json.genericToJSON (String -> Options
jsonOptions String
"item")
data Attachment = Attachment
{ Attachment -> Maybe Natural
attachmentDurationInSeconds :: Maybe Natural
, Attachment -> Mime
attachmentMimeType :: Mime
, Attachment -> Maybe Natural
attachmentSizeInBytes :: Maybe Natural
, Attachment -> Maybe Text
attachmentTitle :: Maybe Text
, Attachment -> Url
attachmentUrl :: Url
} deriving (Attachment -> Attachment -> Bool
(Attachment -> Attachment -> Bool)
-> (Attachment -> Attachment -> Bool) -> Eq Attachment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attachment -> Attachment -> Bool
$c/= :: Attachment -> Attachment -> Bool
== :: Attachment -> Attachment -> Bool
$c== :: Attachment -> Attachment -> Bool
Eq, (forall x. Attachment -> Rep Attachment x)
-> (forall x. Rep Attachment x -> Attachment) -> Generic Attachment
forall x. Rep Attachment x -> Attachment
forall x. Attachment -> Rep Attachment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Attachment x -> Attachment
$cfrom :: forall x. Attachment -> Rep Attachment x
Generic, Int -> Attachment -> ShowS
[Attachment] -> ShowS
Attachment -> String
(Int -> Attachment -> ShowS)
-> (Attachment -> String)
-> ([Attachment] -> ShowS)
-> Show Attachment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attachment] -> ShowS
$cshowList :: [Attachment] -> ShowS
show :: Attachment -> String
$cshow :: Attachment -> String
showsPrec :: Int -> Attachment -> ShowS
$cshowsPrec :: Int -> Attachment -> ShowS
Show)
instance FromJSON Attachment where
parseJSON :: Value -> Parser Attachment
parseJSON = Options -> Value -> Parser Attachment
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Json.genericParseJSON (String -> Options
jsonOptions String
"attachment")
instance ToJSON Attachment where
toJSON :: Attachment -> Value
toJSON = Options -> Attachment -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Json.genericToJSON (String -> Options
jsonOptions String
"attachment")
data Hub = Hub
{ Hub -> Text
hubType :: Text
, Hub -> Url
hubUrl :: Url
} deriving (Hub -> Hub -> Bool
(Hub -> Hub -> Bool) -> (Hub -> Hub -> Bool) -> Eq Hub
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hub -> Hub -> Bool
$c/= :: Hub -> Hub -> Bool
== :: Hub -> Hub -> Bool
$c== :: Hub -> Hub -> Bool
Eq, (forall x. Hub -> Rep Hub x)
-> (forall x. Rep Hub x -> Hub) -> Generic Hub
forall x. Rep Hub x -> Hub
forall x. Hub -> Rep Hub x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Hub x -> Hub
$cfrom :: forall x. Hub -> Rep Hub x
Generic, Int -> Hub -> ShowS
[Hub] -> ShowS
Hub -> String
(Int -> Hub -> ShowS)
-> (Hub -> String) -> ([Hub] -> ShowS) -> Show Hub
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hub] -> ShowS
$cshowList :: [Hub] -> ShowS
show :: Hub -> String
$cshow :: Hub -> String
showsPrec :: Int -> Hub -> ShowS
$cshowsPrec :: Int -> Hub -> ShowS
Show)
instance FromJSON Hub where
parseJSON :: Value -> Parser Hub
parseJSON = Options -> Value -> Parser Hub
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Json.genericParseJSON (String -> Options
jsonOptions String
"hub")
instance ToJSON Hub where
toJSON :: Hub -> Value
toJSON = Options -> Hub -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Json.genericToJSON (String -> Options
jsonOptions String
"hub")
newtype Html = Html
{ Html -> [Tag Text]
htmlValue :: [Tag Text]
} deriving (Html -> Html -> Bool
(Html -> Html -> Bool) -> (Html -> Html -> Bool) -> Eq Html
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Html -> Html -> Bool
$c/= :: Html -> Html -> Bool
== :: Html -> Html -> Bool
$c== :: Html -> Html -> Bool
Eq, Int -> Html -> ShowS
[Html] -> ShowS
Html -> String
(Int -> Html -> ShowS)
-> (Html -> String) -> ([Html] -> ShowS) -> Show Html
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Html] -> ShowS
$cshowList :: [Html] -> ShowS
show :: Html -> String
$cshow :: Html -> String
showsPrec :: Int -> Html -> ShowS
$cshowsPrec :: Int -> Html -> ShowS
Show)
instance FromJSON Html where
parseJSON :: Value -> Parser Html
parseJSON = String -> (Text -> Parser Html) -> Value -> Parser Html
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Json.withText String
"Html" (\Text
text ->
Html -> Parser Html
forall (f :: * -> *) a. Applicative f => a -> f a
pure Html :: [Tag Text] -> Html
Html { htmlValue :: [Tag Text]
htmlValue = Text -> [Tag Text]
forall str. StringLike str => str -> [Tag str]
Html.parseTags Text
text })
instance ToJSON Html where
toJSON :: Html -> Value
toJSON Html
html = Text -> Value
Json.String ([Tag Text] -> Text
forall str. StringLike str => [Tag str] -> str
Html.renderTags (Html -> [Tag Text]
htmlValue Html
html))
newtype Mime = Mime
{ Mime -> MimeType
mimeValue :: MimeType
} deriving (Mime -> Mime -> Bool
(Mime -> Mime -> Bool) -> (Mime -> Mime -> Bool) -> Eq Mime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mime -> Mime -> Bool
$c/= :: Mime -> Mime -> Bool
== :: Mime -> Mime -> Bool
$c== :: Mime -> Mime -> Bool
Eq, Int -> Mime -> ShowS
[Mime] -> ShowS
Mime -> String
(Int -> Mime -> ShowS)
-> (Mime -> String) -> ([Mime] -> ShowS) -> Show Mime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mime] -> ShowS
$cshowList :: [Mime] -> ShowS
show :: Mime -> String
$cshow :: Mime -> String
showsPrec :: Int -> Mime -> ShowS
$cshowsPrec :: Int -> Mime -> ShowS
Show)
instance FromJSON Mime where
parseJSON :: Value -> Parser Mime
parseJSON = String -> (Text -> Parser Mime) -> Value -> Parser Mime
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Json.withText String
"Mime" (\Text
text ->
Mime -> Parser Mime
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mime :: MimeType -> Mime
Mime { mimeValue :: MimeType
mimeValue = Text -> MimeType
Text.encodeUtf8 Text
text })
instance ToJSON Mime where
toJSON :: Mime -> Value
toJSON Mime
mime = Text -> Value
Json.String (MimeType -> Text
Text.decodeUtf8 (Mime -> MimeType
mimeValue Mime
mime))
newtype Url = Url
{ Url -> URI
urlValue :: URI
} deriving (Url -> Url -> Bool
(Url -> Url -> Bool) -> (Url -> Url -> Bool) -> Eq Url
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Url -> Url -> Bool
$c/= :: Url -> Url -> Bool
== :: Url -> Url -> Bool
$c== :: Url -> Url -> Bool
Eq, Int -> Url -> ShowS
[Url] -> ShowS
Url -> String
(Int -> Url -> ShowS)
-> (Url -> String) -> ([Url] -> ShowS) -> Show Url
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Url] -> ShowS
$cshowList :: [Url] -> ShowS
show :: Url -> String
$cshow :: Url -> String
showsPrec :: Int -> Url -> ShowS
$cshowsPrec :: Int -> Url -> ShowS
Show)
instance FromJSON Url where
parseJSON :: Value -> Parser Url
parseJSON = String -> (Text -> Parser Url) -> Value -> Parser Url
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Json.withText String
"Url" (\Text
text ->
case String -> Maybe URI
Uri.parseURI (Text -> String
Text.unpack Text
text) of
Just URI
uri -> Url -> Parser Url
forall (f :: * -> *) a. Applicative f => a -> f a
pure Url :: URI -> Url
Url { urlValue :: URI
urlValue = URI
uri }
Maybe URI
Nothing -> String -> Parser Url
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid Url: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
text))
instance ToJSON Url where
toJSON :: Url -> Value
toJSON Url
url = Text -> Value
Json.String (String -> Text
Text.pack (URI -> String
forall a. Show a => a -> String
show (Url -> URI
urlValue Url
url)))
jsonOptions :: String -> Options
jsonOptions :: String -> Options
jsonOptions String
prefix =
Options
Json.defaultOptions
{ fieldLabelModifier :: ShowS
Json.fieldLabelModifier = String -> ShowS
fieldLabelModifier String
prefix
}
fieldLabelModifier :: String -> String -> String
fieldLabelModifier :: String -> ShowS
fieldLabelModifier String
prefix String
string =
Char -> ShowS
Json.camelTo2 Char
'_' (String -> ShowS
unsafeDropPrefix String
prefix String
string)
unsafeDropPrefix :: String -> String -> String
unsafeDropPrefix :: String -> ShowS
unsafeDropPrefix String
prefix String
string =
case String -> String -> Maybe String
dropPrefix String
prefix String
string of
Just String
suffix -> String
suffix
Maybe String
Nothing -> ShowS
forall a. HasCallStack => String -> a
error ([String] -> String
unwords
[ String
"unsafeDropPrefix:"
, ShowS
forall a. Show a => a -> String
show String
prefix
, String
"is not a prefix of"
, ShowS
forall a. Show a => a -> String
show String
string
])
dropPrefix :: String -> String -> Maybe String
dropPrefix :: String -> String -> Maybe String
dropPrefix String
prefix String
string =
if String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
List.isPrefixOf String
prefix String
string
then String -> Maybe String
forall a. a -> Maybe a
Just (Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
prefix) String
string)
else Maybe String
forall a. Maybe a
Nothing