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

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

import Control.Exception
import Data.Aeson hiding (Result (..))
import Data.Aeson.TH
import Data.Maybe
import Data.Text (Text, unpack)
import GHC.Generics
import Generic.Data.Surgery
import Optics.TH
import Web.Telegraph.Utils

-- | 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)

-- | 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)

-- | 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)

-- | 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)

-- | 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)

-- | 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)

instance FromJSON NodeElement where
  parseJSON :: Value -> Parser NodeElement
parseJSON =
    (Data
   (M1
      D
      ('MetaData
         "NodeElement"
         "Web.Telegraph.Types"
         "telegraph-1.2.0-1GoZkpi2CtkFqjtACPJlam"
         '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.2.0-1GoZkpi2CtkFqjtACPJlam"
              '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.2.0-1GoZkpi2CtkFqjtACPJlam"
        '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.2.0-1GoZkpi2CtkFqjtACPJlam"
         '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.2.0-1GoZkpi2CtkFqjtACPJlam"
            '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.2.0-1GoZkpi2CtkFqjtACPJlam"
               '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.2.0-1GoZkpi2CtkFqjtACPJlam"
           '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.2.0-1GoZkpi2CtkFqjtACPJlam"
           '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.2.0-1GoZkpi2CtkFqjtACPJlam"
           '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.2.0-1GoZkpi2CtkFqjtACPJlam"
         '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.2.0-1GoZkpi2CtkFqjtACPJlam"
            '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.2.0-1GoZkpi2CtkFqjtACPJlam"
            '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.2.0-1GoZkpi2CtkFqjtACPJlam"
               '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.2.0-1GoZkpi2CtkFqjtACPJlam"
           '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.2.0-1GoZkpi2CtkFqjtACPJlam"
           '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.2.0-1GoZkpi2CtkFqjtACPJlam"
           '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.2.0-1GoZkpi2CtkFqjtACPJlam"
           '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.2.0-1GoZkpi2CtkFqjtACPJlam"
         '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.2.0-1GoZkpi2CtkFqjtACPJlam"
            '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.2.0-1GoZkpi2CtkFqjtACPJlam"
            '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.2.0-1GoZkpi2CtkFqjtACPJlam"
               '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.2.0-1GoZkpi2CtkFqjtACPJlam"
           '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.2.0-1GoZkpi2CtkFqjtACPJlam"
           '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.2.0-1GoZkpi2CtkFqjtACPJlam"
        '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.2.0-1GoZkpi2CtkFqjtACPJlam"
           '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.2.0-1GoZkpi2CtkFqjtACPJlam"
            '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.2.0-1GoZkpi2CtkFqjtACPJlam"
                  '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.2.0-1GoZkpi2CtkFqjtACPJlam"
              '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)

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)

-- | 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)

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

--------------------------------------------------
-- Utilities

deriveJSON snake ''Account
deriveJSON snake ''PageList
deriveJSON snake ''Page
deriveJSON snake ''PageViews
deriveJSON sumUntagged ''Node
deriveToJSON snake ''NodeElement
deriveJSON snake ''Image
deriveJSON sumUntagged ''UploadResult
makeFieldLabelsWith noPrefixFieldLabels ''Account
makeFieldLabelsWith noPrefixFieldLabels ''PageList
makeFieldLabelsWith noPrefixFieldLabels ''Page
makeFieldLabelsWith noPrefixFieldLabels ''PageViews
makeFieldLabelsWith noPrefixFieldLabels ''NodeElement
makeFieldLabelsWith noPrefixFieldLabels ''Image
makeFieldLabelsWith noPrefixFieldLabels ''UploadResult

makePrismLabels ''Result
makePrismLabels ''Node
makePrismLabels ''UploadResult