{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StrictData #-}

-- | Type definitions, note that all fields are strict
module Web.Telegraph.Types where

import Control.Exception
import Data.Aeson hiding (Result (..))
import Data.Maybe
import Data.Text (Text, unpack)
import Deriving.Aeson
import Deriving.Aeson.Stock
import Generic.Data.Surgery

-- | A Telegraph account
data Account = Account
  { -- | Account name, helps users with several accounts remember which they are currently using
    --
    -- Displayed to the user above the "Edit/Publish" button on Telegra.ph, other users don't see this name
    Account -> Text
shortName :: {-# UNPACK #-} Text,
    -- | Default author name used when creating new articles
    Account -> Text
authorName :: {-# UNPACK #-} Text,
    -- | Profile link, opened when users click on the author's name below the title
    --
    -- Can be any link, not necessarily to a Telegram profile or channel
    Account -> Text
authorUrl :: {-# UNPACK #-} Text,
    -- | Access token of the Telegraph account
    Account -> Maybe Text
accessToken :: Maybe Text,
    -- | URL to authorize a browser on telegra.ph and connect it to a Telegraph account
    --
    -- This URL is valid for only one use and for 5 minutes only
    Account -> Maybe Text
authUrl :: Maybe Text,
    -- | Number of pages belonging to the Telegraph account
    Account -> Maybe Int
pageCount :: Maybe Int
  }
  deriving (Int -> Account -> ShowS
[Account] -> ShowS
Account -> String
(Int -> Account -> ShowS)
-> (Account -> String) -> ([Account] -> ShowS) -> Show Account
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Account] -> ShowS
$cshowList :: [Account] -> ShowS
show :: Account -> String
$cshow :: Account -> String
showsPrec :: Int -> Account -> ShowS
$cshowsPrec :: Int -> Account -> ShowS
Show, Account -> Account -> Bool
(Account -> Account -> Bool)
-> (Account -> Account -> Bool) -> Eq Account
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Account -> Account -> Bool
$c/= :: Account -> Account -> Bool
== :: Account -> Account -> Bool
$c== :: Account -> Account -> Bool
Eq, (forall x. Account -> Rep Account x)
-> (forall x. Rep Account x -> Account) -> Generic Account
forall x. Rep Account x -> Account
forall x. Account -> Rep Account x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Account x -> Account
$cfrom :: forall x. Account -> Rep Account x
Generic)
  deriving (Value -> Parser [Account]
Value -> Parser Account
(Value -> Parser Account)
-> (Value -> Parser [Account]) -> FromJSON Account
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Account]
$cparseJSONList :: Value -> Parser [Account]
parseJSON :: Value -> Parser Account
$cparseJSON :: Value -> Parser Account
FromJSON, [Account] -> Encoding
[Account] -> Value
Account -> Encoding
Account -> Value
(Account -> Value)
-> (Account -> Encoding)
-> ([Account] -> Value)
-> ([Account] -> Encoding)
-> ToJSON Account
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Account] -> Encoding
$ctoEncodingList :: [Account] -> Encoding
toJSONList :: [Account] -> Value
$ctoJSONList :: [Account] -> Value
toEncoding :: Account -> Encoding
$ctoEncoding :: Account -> Encoding
toJSON :: Account -> Value
$ctoJSON :: Account -> Value
ToJSON) via CustomJSON '[FieldLabelModifier CamelToSnake, OmitNothingFields] Account

-- | A list of Telegraph articles belonging to an account
--
-- Most recently created articles first
data PageList = PageList
  { -- | Total number of pages belonging to the target Telegraph account
    PageList -> Int
totalCount :: {-# UNPACK #-} Int,
    -- | Requested pages of the target Telegraph account
    PageList -> [Page]
pages :: [Page]
  }
  deriving (Int -> PageList -> ShowS
[PageList] -> ShowS
PageList -> String
(Int -> PageList -> ShowS)
-> (PageList -> String) -> ([PageList] -> ShowS) -> Show PageList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PageList] -> ShowS
$cshowList :: [PageList] -> ShowS
show :: PageList -> String
$cshow :: PageList -> String
showsPrec :: Int -> PageList -> ShowS
$cshowsPrec :: Int -> PageList -> ShowS
Show, PageList -> PageList -> Bool
(PageList -> PageList -> Bool)
-> (PageList -> PageList -> Bool) -> Eq PageList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PageList -> PageList -> Bool
$c/= :: PageList -> PageList -> Bool
== :: PageList -> PageList -> Bool
$c== :: PageList -> PageList -> Bool
Eq, (forall x. PageList -> Rep PageList x)
-> (forall x. Rep PageList x -> PageList) -> Generic PageList
forall x. Rep PageList x -> PageList
forall x. PageList -> Rep PageList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PageList x -> PageList
$cfrom :: forall x. PageList -> Rep PageList x
Generic)
  deriving (Value -> Parser [PageList]
Value -> Parser PageList
(Value -> Parser PageList)
-> (Value -> Parser [PageList]) -> FromJSON PageList
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PageList]
$cparseJSONList :: Value -> Parser [PageList]
parseJSON :: Value -> Parser PageList
$cparseJSON :: Value -> Parser PageList
FromJSON, [PageList] -> Encoding
[PageList] -> Value
PageList -> Encoding
PageList -> Value
(PageList -> Value)
-> (PageList -> Encoding)
-> ([PageList] -> Value)
-> ([PageList] -> Encoding)
-> ToJSON PageList
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PageList] -> Encoding
$ctoEncodingList :: [PageList] -> Encoding
toJSONList :: [PageList] -> Value
$ctoJSONList :: [PageList] -> Value
toEncoding :: PageList -> Encoding
$ctoEncoding :: PageList -> Encoding
toJSON :: PageList -> Value
$ctoJSON :: PageList -> Value
ToJSON) via Snake PageList

-- | A page on Telegraph
data Page = Page
  { -- | Path to the page
    Page -> Text
path :: {-# UNPACK #-} Text,
    -- | URL of the page
    Page -> Text
url :: {-# UNPACK #-} Text,
    -- | Title of the page
    Page -> Text
title :: {-# UNPACK #-} Text,
    -- | Description of the page
    Page -> Text
description :: {-# UNPACK #-} Text,
    -- | Name of the author, displayed below the title
    Page -> Maybe Text
authorName :: Maybe Text,
    -- | rofile link, opened when users click on the author's name below the title
    --
    -- Can be any link, not necessarily to a Telegram profile or channel
    Page -> Maybe Text
authorUrl :: Maybe Text,
    -- | Image URL of the page
    Page -> Maybe Text
imageUrl :: Maybe Text,
    -- | Content of the page
    Page -> Maybe [Node]
content :: Maybe [Node],
    -- | Number of page views for the page
    Page -> Int
views :: {-# UNPACK #-} Int,
    -- | True, if the target Telegraph account can edit the page
    Page -> Maybe Bool
canEdit :: Maybe Bool
  }
  deriving (Int -> Page -> ShowS
[Page] -> ShowS
Page -> String
(Int -> Page -> ShowS)
-> (Page -> String) -> ([Page] -> ShowS) -> Show Page
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Page] -> ShowS
$cshowList :: [Page] -> ShowS
show :: Page -> String
$cshow :: Page -> String
showsPrec :: Int -> Page -> ShowS
$cshowsPrec :: Int -> Page -> ShowS
Show, Page -> Page -> Bool
(Page -> Page -> Bool) -> (Page -> Page -> Bool) -> Eq Page
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Page -> Page -> Bool
$c/= :: Page -> Page -> Bool
== :: Page -> Page -> Bool
$c== :: Page -> Page -> Bool
Eq, (forall x. Page -> Rep Page x)
-> (forall x. Rep Page x -> Page) -> Generic Page
forall x. Rep Page x -> Page
forall x. Page -> Rep Page x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Page x -> Page
$cfrom :: forall x. Page -> Rep Page x
Generic)
  deriving (Value -> Parser [Page]
Value -> Parser Page
(Value -> Parser Page) -> (Value -> Parser [Page]) -> FromJSON Page
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Page]
$cparseJSONList :: Value -> Parser [Page]
parseJSON :: Value -> Parser Page
$cparseJSON :: Value -> Parser Page
FromJSON, [Page] -> Encoding
[Page] -> Value
Page -> Encoding
Page -> Value
(Page -> Value)
-> (Page -> Encoding)
-> ([Page] -> Value)
-> ([Page] -> Encoding)
-> ToJSON Page
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Page] -> Encoding
$ctoEncodingList :: [Page] -> Encoding
toJSONList :: [Page] -> Value
$ctoJSONList :: [Page] -> Value
toEncoding :: Page -> Encoding
$ctoEncoding :: Page -> Encoding
toJSON :: Page -> Value
$ctoJSON :: Page -> Value
ToJSON) via CustomJSON '[FieldLabelModifier CamelToSnake, OmitNothingFields] Page

-- | The number of page views for a Telegraph article
newtype PageViews = PageViews {PageViews -> Int
views :: Int}
  deriving (Int -> PageViews -> ShowS
[PageViews] -> ShowS
PageViews -> String
(Int -> PageViews -> ShowS)
-> (PageViews -> String)
-> ([PageViews] -> ShowS)
-> Show PageViews
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PageViews] -> ShowS
$cshowList :: [PageViews] -> ShowS
show :: PageViews -> String
$cshow :: PageViews -> String
showsPrec :: Int -> PageViews -> ShowS
$cshowsPrec :: Int -> PageViews -> ShowS
Show, PageViews -> PageViews -> Bool
(PageViews -> PageViews -> Bool)
-> (PageViews -> PageViews -> Bool) -> Eq PageViews
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PageViews -> PageViews -> Bool
$c/= :: PageViews -> PageViews -> Bool
== :: PageViews -> PageViews -> Bool
$c== :: PageViews -> PageViews -> Bool
Eq, (forall x. PageViews -> Rep PageViews x)
-> (forall x. Rep PageViews x -> PageViews) -> Generic PageViews
forall x. Rep PageViews x -> PageViews
forall x. PageViews -> Rep PageViews x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PageViews x -> PageViews
$cfrom :: forall x. PageViews -> Rep PageViews x
Generic)
  deriving (Value -> Parser [PageViews]
Value -> Parser PageViews
(Value -> Parser PageViews)
-> (Value -> Parser [PageViews]) -> FromJSON PageViews
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PageViews]
$cparseJSONList :: Value -> Parser [PageViews]
parseJSON :: Value -> Parser PageViews
$cparseJSON :: Value -> Parser PageViews
FromJSON, [PageViews] -> Encoding
[PageViews] -> Value
PageViews -> Encoding
PageViews -> Value
(PageViews -> Value)
-> (PageViews -> Encoding)
-> ([PageViews] -> Value)
-> ([PageViews] -> Encoding)
-> ToJSON PageViews
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PageViews] -> Encoding
$ctoEncodingList :: [PageViews] -> Encoding
toJSONList :: [PageViews] -> Value
$ctoJSONList :: [PageViews] -> Value
toEncoding :: PageViews -> Encoding
$ctoEncoding :: PageViews -> Encoding
toJSON :: PageViews -> Value
$ctoJSON :: PageViews -> Value
ToJSON) via Vanilla PageViews

-- | A DOM Node
data Node
  = Content {-# UNPACK #-} Text
  | Element {-# UNPACK #-} NodeElement
  deriving (Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
Show, Node -> Node -> Bool
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Eq, (forall x. Node -> Rep Node x)
-> (forall x. Rep Node x -> Node) -> Generic Node
forall x. Rep Node x -> Node
forall x. Node -> Rep Node x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Node x -> Node
$cfrom :: forall x. Node -> Rep Node x
Generic)
  deriving (Value -> Parser [Node]
Value -> Parser Node
(Value -> Parser Node) -> (Value -> Parser [Node]) -> FromJSON Node
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Node]
$cparseJSONList :: Value -> Parser [Node]
parseJSON :: Value -> Parser Node
$cparseJSON :: Value -> Parser Node
FromJSON, [Node] -> Encoding
[Node] -> Value
Node -> Encoding
Node -> Value
(Node -> Value)
-> (Node -> Encoding)
-> ([Node] -> Value)
-> ([Node] -> Encoding)
-> ToJSON Node
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Node] -> Encoding
$ctoEncodingList :: [Node] -> Encoding
toJSONList :: [Node] -> Value
$ctoJSONList :: [Node] -> Value
toEncoding :: Node -> Encoding
$ctoEncoding :: Node -> Encoding
toJSON :: Node -> Value
$ctoJSON :: Node -> Value
ToJSON) via CustomJSON '[SumUntaggedValue] Node

-- | A DOM elemen node
data NodeElement = NodeElement
  { -- | Name of the DOM element
    --
    -- Available tags: @a@, @aside@, @b@, @blockquote@, @br@, @code@, @em@, @figcaption@, @figure@,
    -- @h3@, @h4@, @hr@, @i@, @iframe@, @img@, @li@, @ol@, @p@, @pre@, @s@, @strong@, @u@, @ul@, @video@
    NodeElement -> Text
tag :: {-# UNPACK #-} Text,
    -- | Attributes of the DOM element
    --
    -- Key of object represents name of attribute, value represents value of attribute
    --
    -- Available attributes: @href@, @src@
    NodeElement -> [(Text, [Text])]
attrs :: [(Text, [Text])],
    -- | List of child nodes for the DOM element
    NodeElement -> [Node]
children :: [Node]
  }
  deriving (Int -> NodeElement -> ShowS
[NodeElement] -> ShowS
NodeElement -> String
(Int -> NodeElement -> ShowS)
-> (NodeElement -> String)
-> ([NodeElement] -> ShowS)
-> Show NodeElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeElement] -> ShowS
$cshowList :: [NodeElement] -> ShowS
show :: NodeElement -> String
$cshow :: NodeElement -> String
showsPrec :: Int -> NodeElement -> ShowS
$cshowsPrec :: Int -> NodeElement -> ShowS
Show, NodeElement -> NodeElement -> Bool
(NodeElement -> NodeElement -> Bool)
-> (NodeElement -> NodeElement -> Bool) -> Eq NodeElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeElement -> NodeElement -> Bool
$c/= :: NodeElement -> NodeElement -> Bool
== :: NodeElement -> NodeElement -> Bool
$c== :: NodeElement -> NodeElement -> Bool
Eq, (forall x. NodeElement -> Rep NodeElement x)
-> (forall x. Rep NodeElement x -> NodeElement)
-> Generic NodeElement
forall x. Rep NodeElement x -> NodeElement
forall x. NodeElement -> Rep NodeElement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NodeElement x -> NodeElement
$cfrom :: forall x. NodeElement -> Rep NodeElement x
Generic)
  deriving ([NodeElement] -> Encoding
[NodeElement] -> Value
NodeElement -> Encoding
NodeElement -> Value
(NodeElement -> Value)
-> (NodeElement -> Encoding)
-> ([NodeElement] -> Value)
-> ([NodeElement] -> Encoding)
-> ToJSON NodeElement
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [NodeElement] -> Encoding
$ctoEncodingList :: [NodeElement] -> Encoding
toJSONList :: [NodeElement] -> Value
$ctoJSONList :: [NodeElement] -> Value
toEncoding :: NodeElement -> Encoding
$ctoEncoding :: NodeElement -> Encoding
toJSON :: NodeElement -> Value
$ctoJSON :: NodeElement -> Value
ToJSON) via Vanilla NodeElement

instance FromJSON NodeElement where
  parseJSON :: Value -> Parser NodeElement
parseJSON =
    (Data
   (M1
      D
      ('MetaData
         "NodeElement"
         "Web.Telegraph.Types"
         "telegraph-1.0.0-inplace"
         'False)
      (M1
         C
         ('MetaCons "NodeElement" 'PrefixI 'True)
         (M1
            S
            ('MetaSel
               ('Just "tag")
               'NoSourceUnpackedness
               'NoSourceStrictness
               'DecidedLazy)
            (K1 R Text)
          :*: (M1
                 S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
               :*: M1
                     S (DefaultMetaSel ('Just "children")) (K1 R (Maybe [Node]))))))
   Any
 -> NodeElement)
-> Parser
     (Data
        (M1
           D
           ('MetaData
              "NodeElement"
              "Web.Telegraph.Types"
              "telegraph-1.0.0-inplace"
              'False)
           (M1
              C
              ('MetaCons "NodeElement" 'PrefixI 'True)
              (M1
                 S
                 ('MetaSel
                    ('Just "tag")
                    'NoSourceUnpackedness
                    'NoSourceStrictness
                    'DecidedLazy)
                 (K1 R Text)
               :*: (M1
                      S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
                    :*: M1
                          S (DefaultMetaSel ('Just "children")) (K1 R (Maybe [Node]))))))
        Any)
-> Parser NodeElement
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ( OR
  (M1
     D
     ('MetaData
        "NodeElement"
        "Web.Telegraph.Types"
        "telegraph-1.0.0-inplace"
        'False)
     (M1
        C
        ('MetaCons "NodeElement" 'PrefixI 'True)
        (M1
           S
           ('MetaSel
              ('Just "tag")
              'NoSourceUnpackedness
              'NoSourceStrictness
              'DecidedLazy)
           (K1 R Text)
         :*: (M1 S (DefaultMetaSel ('Just "attrs")) (K1 R [(Text, [Text])])
              :*: (M1 S (DefaultMetaSel ('Just "children")) (K1 R [Node])
                   :*: U1)))
      :+: V1))
  Any
-> NodeElement
forall a (l :: Type -> Type) x.
(Generic a, FromORRepLazy a l) =>
OR l x -> a
fromORLazy
          (OR
   (M1
      D
      ('MetaData
         "NodeElement"
         "Web.Telegraph.Types"
         "telegraph-1.0.0-inplace"
         'False)
      (M1
         C
         ('MetaCons "NodeElement" 'PrefixI 'True)
         (M1
            S
            ('MetaSel
               ('Just "tag")
               'NoSourceUnpackedness
               'NoSourceStrictness
               'DecidedLazy)
            (K1 R Text)
          :*: (M1 S (DefaultMetaSel ('Just "attrs")) (K1 R [(Text, [Text])])
               :*: (M1 S (DefaultMetaSel ('Just "children")) (K1 R [Node])
                    :*: U1)))
       :+: V1))
   Any
 -> NodeElement)
-> (Data
      (M1
         D
         ('MetaData
            "NodeElement"
            "Web.Telegraph.Types"
            "telegraph-1.0.0-inplace"
            'False)
         (M1
            C
            ('MetaCons "NodeElement" 'PrefixI 'True)
            (M1
               S
               ('MetaSel
                  ('Just "tag")
                  'NoSourceUnpackedness
                  'NoSourceStrictness
                  'DecidedLazy)
               (K1 R Text)
             :*: (M1
                    S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
                  :*: M1
                        S (DefaultMetaSel ('Just "children")) (K1 R (Maybe [Node]))))))
      Any
    -> OR
         (M1
            D
            ('MetaData
               "NodeElement"
               "Web.Telegraph.Types"
               "telegraph-1.0.0-inplace"
               'False)
            (M1
               C
               ('MetaCons "NodeElement" 'PrefixI 'True)
               (M1
                  S
                  ('MetaSel
                     ('Just "tag")
                     'NoSourceUnpackedness
                     'NoSourceStrictness
                     'DecidedLazy)
                  (K1 R Text)
                :*: (M1 S (DefaultMetaSel ('Just "attrs")) (K1 R [(Text, [Text])])
                     :*: (M1 S (DefaultMetaSel ('Just "children")) (K1 R [Node])
                          :*: U1)))
             :+: V1))
         Any)
-> Data
     (M1
        D
        ('MetaData
           "NodeElement"
           "Web.Telegraph.Types"
           "telegraph-1.0.0-inplace"
           'False)
        (M1
           C
           ('MetaCons "NodeElement" 'PrefixI 'True)
           (M1
              S
              ('MetaSel
                 ('Just "tag")
                 'NoSourceUnpackedness
                 'NoSourceStrictness
                 'DecidedLazy)
              (K1 R Text)
            :*: (M1
                   S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
                 :*: M1
                       S (DefaultMetaSel ('Just "children")) (K1 R (Maybe [Node]))))))
     Any
-> NodeElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [(Text, [Text])] -> [(Text, [Text])])
-> OR
     (M1
        D
        ('MetaData
           "NodeElement"
           "Web.Telegraph.Types"
           "telegraph-1.0.0-inplace"
           'False)
        (M1
           C
           ('MetaCons "NodeElement" 'PrefixI 'True)
           (M1
              S
              ('MetaSel
                 ('Just "tag")
                 'NoSourceUnpackedness
                 'NoSourceStrictness
                 'DecidedLazy)
              (K1 R Text)
            :*: (M1
                   S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
                 :*: (M1 S (DefaultMetaSel ('Just "children")) (K1 R [Node])
                      :*: U1)))
         :+: V1))
     Any
-> OR
     (M1
        D
        ('MetaData
           "NodeElement"
           "Web.Telegraph.Types"
           "telegraph-1.0.0-inplace"
           'False)
        (M1
           C
           ('MetaCons "NodeElement" 'PrefixI 'True)
           (M1
              S
              ('MetaSel
                 ('Just "tag")
                 'NoSourceUnpackedness
                 'NoSourceStrictness
                 'DecidedLazy)
              (K1 R Text)
            :*: (M1 S (DefaultMetaSel ('Just "attrs")) (K1 R [(Text, [Text])])
                 :*: (M1 S (DefaultMetaSel ('Just "children")) (K1 R [Node])
                      :*: U1)))
         :+: V1))
     Any
forall k (fd :: Symbol) (n :: Nat) t t' (lt :: k -> Type)
       (lt' :: k -> Type) (l :: k -> Type) (x :: k).
ModRField fd n t t' lt lt' l =>
(t -> t') -> OR lt x -> OR lt' x
modifyRField @"attrs" ([(Text, [Text])] -> Maybe [(Text, [Text])] -> [(Text, [Text])]
forall a. a -> Maybe a -> a
fromMaybe [])
          (OR
   (M1
      D
      ('MetaData
         "NodeElement"
         "Web.Telegraph.Types"
         "telegraph-1.0.0-inplace"
         'False)
      (M1
         C
         ('MetaCons "NodeElement" 'PrefixI 'True)
         (M1
            S
            ('MetaSel
               ('Just "tag")
               'NoSourceUnpackedness
               'NoSourceStrictness
               'DecidedLazy)
            (K1 R Text)
          :*: (M1
                 S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
               :*: (M1 S (DefaultMetaSel ('Just "children")) (K1 R [Node])
                    :*: U1)))
       :+: V1))
   Any
 -> OR
      (M1
         D
         ('MetaData
            "NodeElement"
            "Web.Telegraph.Types"
            "telegraph-1.0.0-inplace"
            'False)
         (M1
            C
            ('MetaCons "NodeElement" 'PrefixI 'True)
            (M1
               S
               ('MetaSel
                  ('Just "tag")
                  'NoSourceUnpackedness
                  'NoSourceStrictness
                  'DecidedLazy)
               (K1 R Text)
             :*: (M1 S (DefaultMetaSel ('Just "attrs")) (K1 R [(Text, [Text])])
                  :*: (M1 S (DefaultMetaSel ('Just "children")) (K1 R [Node])
                       :*: U1)))
          :+: V1))
      Any)
-> (Data
      (M1
         D
         ('MetaData
            "NodeElement"
            "Web.Telegraph.Types"
            "telegraph-1.0.0-inplace"
            'False)
         (M1
            C
            ('MetaCons "NodeElement" 'PrefixI 'True)
            (M1
               S
               ('MetaSel
                  ('Just "tag")
                  'NoSourceUnpackedness
                  'NoSourceStrictness
                  'DecidedLazy)
               (K1 R Text)
             :*: (M1
                    S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
                  :*: M1
                        S (DefaultMetaSel ('Just "children")) (K1 R (Maybe [Node]))))))
      Any
    -> OR
         (M1
            D
            ('MetaData
               "NodeElement"
               "Web.Telegraph.Types"
               "telegraph-1.0.0-inplace"
               'False)
            (M1
               C
               ('MetaCons "NodeElement" 'PrefixI 'True)
               (M1
                  S
                  ('MetaSel
                     ('Just "tag")
                     'NoSourceUnpackedness
                     'NoSourceStrictness
                     'DecidedLazy)
                  (K1 R Text)
                :*: (M1
                       S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
                     :*: (M1 S (DefaultMetaSel ('Just "children")) (K1 R [Node])
                          :*: U1)))
             :+: V1))
         Any)
-> Data
     (M1
        D
        ('MetaData
           "NodeElement"
           "Web.Telegraph.Types"
           "telegraph-1.0.0-inplace"
           'False)
        (M1
           C
           ('MetaCons "NodeElement" 'PrefixI 'True)
           (M1
              S
              ('MetaSel
                 ('Just "tag")
                 'NoSourceUnpackedness
                 'NoSourceStrictness
                 'DecidedLazy)
              (K1 R Text)
            :*: (M1
                   S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
                 :*: M1
                       S (DefaultMetaSel ('Just "children")) (K1 R (Maybe [Node]))))))
     Any
-> OR
     (M1
        D
        ('MetaData
           "NodeElement"
           "Web.Telegraph.Types"
           "telegraph-1.0.0-inplace"
           'False)
        (M1
           C
           ('MetaCons "NodeElement" 'PrefixI 'True)
           (M1
              S
              ('MetaSel
                 ('Just "tag")
                 'NoSourceUnpackedness
                 'NoSourceStrictness
                 'DecidedLazy)
              (K1 R Text)
            :*: (M1 S (DefaultMetaSel ('Just "attrs")) (K1 R [(Text, [Text])])
                 :*: (M1 S (DefaultMetaSel ('Just "children")) (K1 R [Node])
                      :*: U1)))
         :+: V1))
     Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [Node] -> [Node])
-> OR
     (M1
        D
        ('MetaData
           "NodeElement"
           "Web.Telegraph.Types"
           "telegraph-1.0.0-inplace"
           'False)
        (M1
           C
           ('MetaCons "NodeElement" 'PrefixI 'True)
           (M1
              S
              ('MetaSel
                 ('Just "tag")
                 'NoSourceUnpackedness
                 'NoSourceStrictness
                 'DecidedLazy)
              (K1 R Text)
            :*: (M1
                   S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
                 :*: (M1 S (DefaultMetaSel ('Just "children")) (K1 R (Maybe [Node]))
                      :*: U1)))
         :+: V1))
     Any
-> OR
     (M1
        D
        ('MetaData
           "NodeElement"
           "Web.Telegraph.Types"
           "telegraph-1.0.0-inplace"
           'False)
        (M1
           C
           ('MetaCons "NodeElement" 'PrefixI 'True)
           (M1
              S
              ('MetaSel
                 ('Just "tag")
                 'NoSourceUnpackedness
                 'NoSourceStrictness
                 'DecidedLazy)
              (K1 R Text)
            :*: (M1
                   S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
                 :*: (M1 S (DefaultMetaSel ('Just "children")) (K1 R [Node])
                      :*: U1)))
         :+: V1))
     Any
forall k (fd :: Symbol) (n :: Nat) t t' (lt :: k -> Type)
       (lt' :: k -> Type) (l :: k -> Type) (x :: k).
ModRField fd n t t' lt lt' l =>
(t -> t') -> OR lt x -> OR lt' x
modifyRField @"children" ([Node] -> Maybe [Node] -> [Node]
forall a. a -> Maybe a -> a
fromMaybe [])
          (OR
   (M1
      D
      ('MetaData
         "NodeElement"
         "Web.Telegraph.Types"
         "telegraph-1.0.0-inplace"
         'False)
      (M1
         C
         ('MetaCons "NodeElement" 'PrefixI 'True)
         (M1
            S
            ('MetaSel
               ('Just "tag")
               'NoSourceUnpackedness
               'NoSourceStrictness
               'DecidedLazy)
            (K1 R Text)
          :*: (M1
                 S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
               :*: (M1 S (DefaultMetaSel ('Just "children")) (K1 R (Maybe [Node]))
                    :*: U1)))
       :+: V1))
   Any
 -> OR
      (M1
         D
         ('MetaData
            "NodeElement"
            "Web.Telegraph.Types"
            "telegraph-1.0.0-inplace"
            'False)
         (M1
            C
            ('MetaCons "NodeElement" 'PrefixI 'True)
            (M1
               S
               ('MetaSel
                  ('Just "tag")
                  'NoSourceUnpackedness
                  'NoSourceStrictness
                  'DecidedLazy)
               (K1 R Text)
             :*: (M1
                    S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
                  :*: (M1 S (DefaultMetaSel ('Just "children")) (K1 R [Node])
                       :*: U1)))
          :+: V1))
      Any)
-> (Data
      (M1
         D
         ('MetaData
            "NodeElement"
            "Web.Telegraph.Types"
            "telegraph-1.0.0-inplace"
            'False)
         (M1
            C
            ('MetaCons "NodeElement" 'PrefixI 'True)
            (M1
               S
               ('MetaSel
                  ('Just "tag")
                  'NoSourceUnpackedness
                  'NoSourceStrictness
                  'DecidedLazy)
               (K1 R Text)
             :*: (M1
                    S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
                  :*: M1
                        S (DefaultMetaSel ('Just "children")) (K1 R (Maybe [Node]))))))
      Any
    -> OR
         (M1
            D
            ('MetaData
               "NodeElement"
               "Web.Telegraph.Types"
               "telegraph-1.0.0-inplace"
               'False)
            (M1
               C
               ('MetaCons "NodeElement" 'PrefixI 'True)
               (M1
                  S
                  ('MetaSel
                     ('Just "tag")
                     'NoSourceUnpackedness
                     'NoSourceStrictness
                     'DecidedLazy)
                  (K1 R Text)
                :*: (M1
                       S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
                     :*: (M1 S (DefaultMetaSel ('Just "children")) (K1 R (Maybe [Node]))
                          :*: U1)))
             :+: V1))
         Any)
-> Data
     (M1
        D
        ('MetaData
           "NodeElement"
           "Web.Telegraph.Types"
           "telegraph-1.0.0-inplace"
           'False)
        (M1
           C
           ('MetaCons "NodeElement" 'PrefixI 'True)
           (M1
              S
              ('MetaSel
                 ('Just "tag")
                 'NoSourceUnpackedness
                 'NoSourceStrictness
                 'DecidedLazy)
              (K1 R Text)
            :*: (M1
                   S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
                 :*: M1
                       S (DefaultMetaSel ('Just "children")) (K1 R (Maybe [Node]))))))
     Any
-> OR
     (M1
        D
        ('MetaData
           "NodeElement"
           "Web.Telegraph.Types"
           "telegraph-1.0.0-inplace"
           'False)
        (M1
           C
           ('MetaCons "NodeElement" 'PrefixI 'True)
           (M1
              S
              ('MetaSel
                 ('Just "tag")
                 'NoSourceUnpackedness
                 'NoSourceStrictness
                 'DecidedLazy)
              (K1 R Text)
            :*: (M1
                   S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
                 :*: (M1 S (DefaultMetaSel ('Just "children")) (K1 R [Node])
                      :*: U1)))
         :+: V1))
     Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data
  (M1
     D
     ('MetaData
        "NodeElement"
        "Web.Telegraph.Types"
        "telegraph-1.0.0-inplace"
        'False)
     (M1
        C
        ('MetaCons "NodeElement" 'PrefixI 'True)
        (M1
           S
           ('MetaSel
              ('Just "tag")
              'NoSourceUnpackedness
              'NoSourceStrictness
              'DecidedLazy)
           (K1 R Text)
         :*: (M1
                S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
              :*: M1
                    S (DefaultMetaSel ('Just "children")) (K1 R (Maybe [Node]))))))
  Any
-> OR
     (M1
        D
        ('MetaData
           "NodeElement"
           "Web.Telegraph.Types"
           "telegraph-1.0.0-inplace"
           'False)
        (M1
           C
           ('MetaCons "NodeElement" 'PrefixI 'True)
           (M1
              S
              ('MetaSel
                 ('Just "tag")
                 'NoSourceUnpackedness
                 'NoSourceStrictness
                 'DecidedLazy)
              (K1 R Text)
            :*: (M1
                   S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
                 :*: (M1 S (DefaultMetaSel ('Just "children")) (K1 R (Maybe [Node]))
                      :*: U1)))
         :+: V1))
     Any
forall (f :: Type -> Type) (l :: Type -> Type) x.
ToOR f l =>
Data f x -> OR l x
toOR'
      )
      (Parser
   (Data
      (M1
         D
         ('MetaData
            "NodeElement"
            "Web.Telegraph.Types"
            "telegraph-1.0.0-inplace"
            'False)
         (M1
            C
            ('MetaCons "NodeElement" 'PrefixI 'True)
            (M1
               S
               ('MetaSel
                  ('Just "tag")
                  'NoSourceUnpackedness
                  'NoSourceStrictness
                  'DecidedLazy)
               (K1 R Text)
             :*: (M1
                    S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
                  :*: M1
                        S (DefaultMetaSel ('Just "children")) (K1 R (Maybe [Node]))))))
      Any)
 -> Parser NodeElement)
-> (Value
    -> Parser
         (Data
            (M1
               D
               ('MetaData
                  "NodeElement"
                  "Web.Telegraph.Types"
                  "telegraph-1.0.0-inplace"
                  'False)
               (M1
                  C
                  ('MetaCons "NodeElement" 'PrefixI 'True)
                  (M1
                     S
                     ('MetaSel
                        ('Just "tag")
                        'NoSourceUnpackedness
                        'NoSourceStrictness
                        'DecidedLazy)
                     (K1 R Text)
                   :*: (M1
                          S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
                        :*: M1
                              S (DefaultMetaSel ('Just "children")) (K1 R (Maybe [Node]))))))
            Any))
-> Value
-> Parser NodeElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options
-> Value
-> Parser
     (Data
        (M1
           D
           ('MetaData
              "NodeElement"
              "Web.Telegraph.Types"
              "telegraph-1.0.0-inplace"
              'False)
           (M1
              C
              ('MetaCons "NodeElement" 'PrefixI 'True)
              (M1
                 S
                 ('MetaSel
                    ('Just "tag")
                    'NoSourceUnpackedness
                    'NoSourceStrictness
                    'DecidedLazy)
                 (K1 R Text)
               :*: (M1
                      S (DefaultMetaSel ('Just "attrs")) (K1 R (Maybe [(Text, [Text])]))
                    :*: M1
                          S (DefaultMetaSel ('Just "children")) (K1 R (Maybe [Node]))))))
        Any)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions

-- | The result of an API call
data Result a
  = Error {-# UNPACK #-} Text
  | Result a
  deriving (Int -> Result a -> ShowS
[Result a] -> ShowS
Result a -> String
(Int -> Result a -> ShowS)
-> (Result a -> String) -> ([Result a] -> ShowS) -> Show (Result a)
forall a. Show a => Int -> Result a -> ShowS
forall a. Show a => [Result a] -> ShowS
forall a. Show a => Result a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result a] -> ShowS
$cshowList :: forall a. Show a => [Result a] -> ShowS
show :: Result a -> String
$cshow :: forall a. Show a => Result a -> String
showsPrec :: Int -> Result a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Result a -> ShowS
Show, Result a -> Result a -> Bool
(Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool) -> Eq (Result a)
forall a. Eq a => Result a -> Result a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result a -> Result a -> Bool
$c/= :: forall a. Eq a => Result a -> Result a -> Bool
== :: Result a -> Result a -> Bool
$c== :: forall a. Eq a => Result a -> Result a -> Bool
Eq, (forall x. Result a -> Rep (Result a) x)
-> (forall x. Rep (Result a) x -> Result a) -> Generic (Result a)
forall x. Rep (Result a) x -> Result a
forall x. Result a -> Rep (Result a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Result a) x -> Result a
forall a x. Result a -> Rep (Result a) x
$cto :: forall a x. Rep (Result a) x -> Result a
$cfrom :: forall a x. Result a -> Rep (Result a) x
Generic)

instance FromJSON a => FromJSON (Result a) where
  parseJSON :: Value -> Parser (Result a)
parseJSON = String
-> (Object -> Parser (Result a)) -> Value -> Parser (Result a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"telegra.ph api call result" ((Object -> Parser (Result a)) -> Value -> Parser (Result a))
-> (Object -> Parser (Result a)) -> Value -> Parser (Result a)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Bool
ok <- Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"ok"
    if Bool
ok
      then a -> Result a
forall a. a -> Result a
Result (a -> Result a) -> Parser a -> Parser (Result a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"result"
      else Text -> Result a
forall a. Text -> Result a
Error (Text -> Result a) -> Parser Text -> Parser (Result a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"error"

-- | An image uploaded to Telegraph
newtype Image = Image
  { -- | The path to the image
    Image -> Text
src :: Text
  }
  deriving (Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
(Int -> Image -> ShowS)
-> (Image -> String) -> ([Image] -> ShowS) -> Show Image
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Image] -> ShowS
$cshowList :: [Image] -> ShowS
show :: Image -> String
$cshow :: Image -> String
showsPrec :: Int -> Image -> ShowS
$cshowsPrec :: Int -> Image -> ShowS
Show, Image -> Image -> Bool
(Image -> Image -> Bool) -> (Image -> Image -> Bool) -> Eq Image
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Image -> Image -> Bool
$c/= :: Image -> Image -> Bool
== :: Image -> Image -> Bool
$c== :: Image -> Image -> Bool
Eq, (forall x. Image -> Rep Image x)
-> (forall x. Rep Image x -> Image) -> Generic Image
forall x. Rep Image x -> Image
forall x. Image -> Rep Image x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Image x -> Image
$cfrom :: forall x. Image -> Rep Image x
Generic)
  deriving (Value -> Parser [Image]
Value -> Parser Image
(Value -> Parser Image)
-> (Value -> Parser [Image]) -> FromJSON Image
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Image]
$cparseJSONList :: Value -> Parser [Image]
parseJSON :: Value -> Parser Image
$cparseJSON :: Value -> Parser Image
FromJSON, [Image] -> Encoding
[Image] -> Value
Image -> Encoding
Image -> Value
(Image -> Value)
-> (Image -> Encoding)
-> ([Image] -> Value)
-> ([Image] -> Encoding)
-> ToJSON Image
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Image] -> Encoding
$ctoEncodingList :: [Image] -> Encoding
toJSONList :: [Image] -> Value
$ctoJSONList :: [Image] -> Value
toEncoding :: Image -> Encoding
$ctoEncoding :: Image -> Encoding
toJSON :: Image -> Value
$ctoJSON :: Image -> Value
ToJSON) via Vanilla Image

-- | The result of an image upload
data UploadResult
  = UploadError {UploadResult -> Text
error :: {-# UNPACK #-} Text}
  | Sources [Image]
  deriving (Int -> UploadResult -> ShowS
[UploadResult] -> ShowS
UploadResult -> String
(Int -> UploadResult -> ShowS)
-> (UploadResult -> String)
-> ([UploadResult] -> ShowS)
-> Show UploadResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UploadResult] -> ShowS
$cshowList :: [UploadResult] -> ShowS
show :: UploadResult -> String
$cshow :: UploadResult -> String
showsPrec :: Int -> UploadResult -> ShowS
$cshowsPrec :: Int -> UploadResult -> ShowS
Show, UploadResult -> UploadResult -> Bool
(UploadResult -> UploadResult -> Bool)
-> (UploadResult -> UploadResult -> Bool) -> Eq UploadResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UploadResult -> UploadResult -> Bool
$c/= :: UploadResult -> UploadResult -> Bool
== :: UploadResult -> UploadResult -> Bool
$c== :: UploadResult -> UploadResult -> Bool
Eq, (forall x. UploadResult -> Rep UploadResult x)
-> (forall x. Rep UploadResult x -> UploadResult)
-> Generic UploadResult
forall x. Rep UploadResult x -> UploadResult
forall x. UploadResult -> Rep UploadResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UploadResult x -> UploadResult
$cfrom :: forall x. UploadResult -> Rep UploadResult x
Generic)
  deriving (Value -> Parser [UploadResult]
Value -> Parser UploadResult
(Value -> Parser UploadResult)
-> (Value -> Parser [UploadResult]) -> FromJSON UploadResult
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [UploadResult]
$cparseJSONList :: Value -> Parser [UploadResult]
parseJSON :: Value -> Parser UploadResult
$cparseJSON :: Value -> Parser UploadResult
FromJSON, [UploadResult] -> Encoding
[UploadResult] -> Value
UploadResult -> Encoding
UploadResult -> Value
(UploadResult -> Value)
-> (UploadResult -> Encoding)
-> ([UploadResult] -> Value)
-> ([UploadResult] -> Encoding)
-> ToJSON UploadResult
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UploadResult] -> Encoding
$ctoEncodingList :: [UploadResult] -> Encoding
toJSONList :: [UploadResult] -> Value
$ctoJSONList :: [UploadResult] -> Value
toEncoding :: UploadResult -> Encoding
$ctoEncoding :: UploadResult -> Encoding
toJSON :: UploadResult -> Value
$ctoJSON :: UploadResult -> Value
ToJSON) via CustomJSON '[SumUntaggedValue] UploadResult

newtype TelegraphError
  = -- | An api call has failed, we cannot distinguish between minor errors (such as illformed author urls)
    -- and much serious errors, such as invalid accessTokens, so we always throw exceptions
    APICallFailure Text
  deriving newtype (TelegraphError -> TelegraphError -> Bool
(TelegraphError -> TelegraphError -> Bool)
-> (TelegraphError -> TelegraphError -> Bool) -> Eq TelegraphError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TelegraphError -> TelegraphError -> Bool
$c/= :: TelegraphError -> TelegraphError -> Bool
== :: TelegraphError -> TelegraphError -> Bool
$c== :: TelegraphError -> TelegraphError -> Bool
Eq)
  deriving anyclass (Show TelegraphError
Typeable TelegraphError
Typeable TelegraphError
-> Show TelegraphError
-> (TelegraphError -> SomeException)
-> (SomeException -> Maybe TelegraphError)
-> (TelegraphError -> String)
-> Exception TelegraphError
SomeException -> Maybe TelegraphError
TelegraphError -> String
TelegraphError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: TelegraphError -> String
$cdisplayException :: TelegraphError -> String
fromException :: SomeException -> Maybe TelegraphError
$cfromException :: SomeException -> Maybe TelegraphError
toException :: TelegraphError -> SomeException
$ctoException :: TelegraphError -> SomeException
$cp2Exception :: Show TelegraphError
$cp1Exception :: Typeable TelegraphError
Exception)

instance Show TelegraphError where
  show :: TelegraphError -> String
show (APICallFailure Text
e) = String
"API call failed with error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
e