{-# 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 :: 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
  -- ^ 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.
  , Feed -> Maybe Text
feedDescription :: Maybe Text
  -- ^ Provides more detail, beyond the title, on what the feed is about. A
  -- feed reader may display this text.
  , Feed -> Maybe Bool
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.
  , Feed -> Maybe Url
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.
  , Feed -> Maybe Url
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.
  , Feed -> Maybe Url
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.
  , Feed -> Maybe [Hub]
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.
  , Feed -> Maybe Url
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.
  , Feed -> [Item]
feedItems :: [Item]
  -- ^ An array of objects that describe each object in the list.
  , Feed -> Maybe Url
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).
  , Feed -> Text
feedTitle :: Text
  -- ^ The name of the feed, which will often correspond to the name of the
  -- website (blog, for instance), though not necessarily.
  , Feed -> Maybe Text
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.
  , Feed -> Url
feedVersion :: Url
  -- ^ The URL of the version of the format the feed uses.
  }
  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
  -- ^ 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.
  , Author -> Maybe Text
authorName :: Maybe Text
  -- ^ The author's name.
  , Author -> Maybe Url
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 (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. Semigroup 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]
  -- ^ Lists related resources. Podcasts, for instance, would include an
  -- attachment that's an audio or video file.
  , Item -> Maybe Author
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.
  , Item -> Maybe Url
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.
  , Item -> Maybe Html
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.)
  , Item -> Maybe Text
itemContentText :: Maybe Text
  -- ^ See 'itemContentHtml'.
  , Item -> Maybe UTCTime
itemDateModified :: Maybe UTCTime
  -- ^ Specifies the modification date in RFC 3339 format.
  , Item -> Maybe UTCTime
itemDatePublished :: Maybe UTCTime
  -- ^ Specifies the date in RFC 3339 format. (Example:
  -- @2010-02-07T14:04:00-05:00@.)
  , Item -> Maybe Url
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.
  , Item -> Value
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.
  , Item -> Maybe Url
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).
  , Item -> Maybe Text
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'.
  , Item -> Maybe [Text]
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.
  , Item -> Maybe Text
itemTitle :: Maybe Text
  -- ^ Plain text. Microblog items in particular may omit titles.
  , Item -> Maybe Url
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 (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. Semigroup 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
  -- ^ Specifies how long it takes to listen to or watch, when played at normal
  -- speed.
  , Attachment -> Mime
attachmentMimeType :: Mime
  -- ^ Specifies the type of the attachment, such as @audio/mpeg@.
  , Attachment -> Maybe Natural
attachmentSizeInBytes :: Maybe Natural
  -- ^ Specifies how large the file is.
  , Attachment -> Maybe Text
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.
  , Attachment -> Url
attachmentUrl :: Url
  -- ^ Specifies the location of the attachment.
  }
  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. Semigroup 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
prefix String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isPrefixOf` 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