{-# LANGUAGE DeriveGeneric #-}
module JsonFeed
( parseFeed,
renderFeed,
Feed (..),
Author (..),
Item (..),
Attachment (..),
Hub (..),
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 Text.HTML.TagSoup as Html
parseFeed :: ByteString -> Either String Feed
parseFeed :: ByteString -> Either String Feed
parseFeed = forall a. FromJSON a => ByteString -> Either String a
Json.eitherDecode
renderFeed :: Feed -> ByteString
renderFeed :: Feed -> ByteString
renderFeed = 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
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. 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
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 = 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 = 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
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. 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
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 <- 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) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid Author: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Author
author)
(Maybe Url, Maybe Text, Maybe Url)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Author
author
instance ToJSON Author where
toJSON :: Author -> Value
toJSON = 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
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. 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
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 <- 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) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid Item: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Item
item)
(Maybe Html, Maybe Text)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Item
item
instance ToJSON Item where
toJSON :: Item -> Value
toJSON = 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
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. 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
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 = 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 = 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
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. 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
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 = 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 = 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
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
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 =
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Json.withText
String
"Html"
(\Text
text -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Html {htmlValue :: [Tag Text]
htmlValue = 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 (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
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
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 =
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Json.withText
String
"Mime"
(\Text
text -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
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
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 =
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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Url {urlValue :: URI
urlValue = URI
uri}
Maybe URI
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"invalid Url: " forall a. Semigroup a => a -> a -> a
<> 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 (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 ->
forall a. HasCallStack => String -> a
error
( [String] -> String
unwords
[String
"unsafeDropPrefix:", forall a. Show a => a -> String
show String
prefix, String
"is not a prefix of", 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
prefix forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` String
string
then forall a. a -> Maybe a
Just (forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
prefix) String
string)
else forall a. Maybe a
Nothing