{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      : Network.Reddit.Types.Wiki
-- Copyright   : (c) 2021 Rory Tyler Hayford
-- License     : BSD-3-Clause
-- Maintainer  : rory.hayford@protonmail.com
-- Stability   : experimental
-- Portability : GHC
--
module Network.Reddit.Types.Wiki
    ( WikiPage(..)
    , WikiRevisionID(WikiRevisionID)
    , WikiPageName
    , mkWikiPageName
    , WikiPageListing
    , WikiRevision(..)
    , WikiPageSettings(..)
    , WikiPermLevel(..)
    ) where

import           Data.Aeson
                 ( (.:)
                 , (.:?)
                 , Array
                 , FromJSON(..)
                 , withArray
                 , withObject
                 , withScientific
                 , withText
                 )
import           Data.Coerce                   ( coerce )
import           Data.Sequence                 ( Seq )
import           Data.Text                     ( Text )
import qualified Data.Text                     as T
import           Data.Time                     ( UTCTime )
import           Data.Traversable              ( for )

import           GHC.Exts                      ( IsList(toList, fromList) )
import           GHC.Generics                  ( Generic )

import           Network.Reddit.Types.Internal

import           Web.HttpApiData               ( ToHttpApiData(..) )

-- | An individual subreddit wikipage along with its revision information
data WikiPage = WikiPage
    { -- | The page content, as markdown
      WikiPage -> Body
content      :: Body
    , WikiPage -> Body
contentHTML  :: Body
    , WikiPage -> Username
revisionBy   :: Username
    , WikiPage -> UTCTime
revisionDate :: UTCTime
      -- | Indicates whether the authenticated user
      -- can revise this particular wikipage
    , WikiPage -> Bool
mayRevise    :: Bool
    }
    deriving stock ( Int -> WikiPage -> ShowS
[WikiPage] -> ShowS
WikiPage -> String
(Int -> WikiPage -> ShowS)
-> (WikiPage -> String) -> ([WikiPage] -> ShowS) -> Show WikiPage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WikiPage] -> ShowS
$cshowList :: [WikiPage] -> ShowS
show :: WikiPage -> String
$cshow :: WikiPage -> String
showsPrec :: Int -> WikiPage -> ShowS
$cshowsPrec :: Int -> WikiPage -> ShowS
Show, WikiPage -> WikiPage -> Bool
(WikiPage -> WikiPage -> Bool)
-> (WikiPage -> WikiPage -> Bool) -> Eq WikiPage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WikiPage -> WikiPage -> Bool
$c/= :: WikiPage -> WikiPage -> Bool
== :: WikiPage -> WikiPage -> Bool
$c== :: WikiPage -> WikiPage -> Bool
Eq, (forall x. WikiPage -> Rep WikiPage x)
-> (forall x. Rep WikiPage x -> WikiPage) -> Generic WikiPage
forall x. Rep WikiPage x -> WikiPage
forall x. WikiPage -> Rep WikiPage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WikiPage x -> WikiPage
$cfrom :: forall x. WikiPage -> Rep WikiPage x
Generic )

instance FromJSON WikiPage where
    parseJSON :: Value -> Parser WikiPage
parseJSON = RedditKind
-> String
-> (Object -> Parser WikiPage)
-> Value
-> Parser WikiPage
forall b a.
FromJSON b =>
RedditKind -> String -> (b -> Parser a) -> Value -> Parser a
withKind RedditKind
WikiPageKind String
"WikiPage" ((Object -> Parser WikiPage) -> Value -> Parser WikiPage)
-> (Object -> Parser WikiPage) -> Value -> Parser WikiPage
forall a b. (a -> b) -> a -> b
$ \Object
o -> Body -> Body -> Username -> UTCTime -> Bool -> WikiPage
WikiPage
        (Body -> Body -> Username -> UTCTime -> Bool -> WikiPage)
-> Parser Body
-> Parser (Body -> Username -> UTCTime -> Bool -> WikiPage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Body -> Parser Body
forall a. FromJSON a => Object -> Body -> Parser a
.: Body
"content_md"
        Parser (Body -> Username -> UTCTime -> Bool -> WikiPage)
-> Parser Body -> Parser (Username -> UTCTime -> Bool -> WikiPage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Body -> Parser Body
forall a. FromJSON a => Object -> Body -> Parser a
.: Body
"content_html"
        Parser (Username -> UTCTime -> Bool -> WikiPage)
-> Parser Username -> Parser (UTCTime -> Bool -> WikiPage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Object -> Body -> Parser Username
forall a. FromJSON a => Object -> Body -> Parser a
.: Body
"name") (Object -> Parser Username) -> Parser Object -> Parser Username
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object -> Body -> Parser Object
forall a. FromJSON a => Object -> Body -> Parser a
.: Body
"data") (Object -> Parser Object) -> Parser Object -> Parser Object
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Body -> Parser Object
forall a. FromJSON a => Object -> Body -> Parser a
.: Body
"revision_by")
        Parser (UTCTime -> Bool -> WikiPage)
-> Parser UTCTime -> Parser (Bool -> WikiPage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer -> UTCTime
integerToUTC (Integer -> UTCTime) -> Parser Integer -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Body -> Parser Integer
forall a. FromJSON a => Object -> Body -> Parser a
.: Body
"revision_date")
        Parser (Bool -> WikiPage) -> Parser Bool -> Parser WikiPage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Body -> Parser Bool
forall a. FromJSON a => Object -> Body -> Parser a
.: Body
"may_revise"

-- | The name of an individual wiki page. The name forms part of the URL, and
-- should not contain spaces or uppercase characters
newtype WikiPageName = WikiPageName Text
    deriving stock ( Int -> WikiPageName -> ShowS
[WikiPageName] -> ShowS
WikiPageName -> String
(Int -> WikiPageName -> ShowS)
-> (WikiPageName -> String)
-> ([WikiPageName] -> ShowS)
-> Show WikiPageName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WikiPageName] -> ShowS
$cshowList :: [WikiPageName] -> ShowS
show :: WikiPageName -> String
$cshow :: WikiPageName -> String
showsPrec :: Int -> WikiPageName -> ShowS
$cshowsPrec :: Int -> WikiPageName -> ShowS
Show, (forall x. WikiPageName -> Rep WikiPageName x)
-> (forall x. Rep WikiPageName x -> WikiPageName)
-> Generic WikiPageName
forall x. Rep WikiPageName x -> WikiPageName
forall x. WikiPageName -> Rep WikiPageName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WikiPageName x -> WikiPageName
$cfrom :: forall x. WikiPageName -> Rep WikiPageName x
Generic )
    deriving newtype ( WikiPageName -> WikiPageName -> Bool
(WikiPageName -> WikiPageName -> Bool)
-> (WikiPageName -> WikiPageName -> Bool) -> Eq WikiPageName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WikiPageName -> WikiPageName -> Bool
$c/= :: WikiPageName -> WikiPageName -> Bool
== :: WikiPageName -> WikiPageName -> Bool
$c== :: WikiPageName -> WikiPageName -> Bool
Eq, Value -> Parser [WikiPageName]
Value -> Parser WikiPageName
(Value -> Parser WikiPageName)
-> (Value -> Parser [WikiPageName]) -> FromJSON WikiPageName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [WikiPageName]
$cparseJSONList :: Value -> Parser [WikiPageName]
parseJSON :: Value -> Parser WikiPageName
$cparseJSON :: Value -> Parser WikiPageName
FromJSON, WikiPageName -> ByteString
WikiPageName -> Builder
WikiPageName -> Body
(WikiPageName -> Body)
-> (WikiPageName -> Builder)
-> (WikiPageName -> ByteString)
-> (WikiPageName -> Body)
-> ToHttpApiData WikiPageName
forall a.
(a -> Body)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Body)
-> ToHttpApiData a
toQueryParam :: WikiPageName -> Body
$ctoQueryParam :: WikiPageName -> Body
toHeader :: WikiPageName -> ByteString
$ctoHeader :: WikiPageName -> ByteString
toEncodedUrlPiece :: WikiPageName -> Builder
$ctoEncodedUrlPiece :: WikiPageName -> Builder
toUrlPiece :: WikiPageName -> Body
$ctoUrlPiece :: WikiPageName -> Body
ToHttpApiData )

-- | Smart constructor for 'WikiPageName's. Lowercases the contained text, and
-- replaces each space with a single underscore
mkWikiPageName :: Text -> WikiPageName
mkWikiPageName :: Body -> WikiPageName
mkWikiPageName = Body -> WikiPageName
coerce (Body -> WikiPageName) -> (Body -> Body) -> Body -> WikiPageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Body -> Body
T.toLower (Body -> Body) -> (Body -> Body) -> Body -> Body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Body -> Body -> Body -> Body
T.replace Body
" " Body
"_"

-- | Information regarding a single 'WikiPage' revision
data WikiRevision = WikiRevision
    { WikiRevision -> WikiRevisionID
revisionID :: WikiRevisionID
    , WikiRevision -> WikiPageName
page       :: WikiPageName
    , WikiRevision -> UTCTime
timestamp  :: UTCTime
    , WikiRevision -> Username
author     :: Username
      -- | The reason for editing the page, if any
    , WikiRevision -> Maybe Body
reason     :: Maybe Text
      -- | If the revision has been hidden
    , WikiRevision -> Maybe Bool
hidden     :: Maybe Bool
    }
    deriving stock ( Int -> WikiRevision -> ShowS
[WikiRevision] -> ShowS
WikiRevision -> String
(Int -> WikiRevision -> ShowS)
-> (WikiRevision -> String)
-> ([WikiRevision] -> ShowS)
-> Show WikiRevision
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WikiRevision] -> ShowS
$cshowList :: [WikiRevision] -> ShowS
show :: WikiRevision -> String
$cshow :: WikiRevision -> String
showsPrec :: Int -> WikiRevision -> ShowS
$cshowsPrec :: Int -> WikiRevision -> ShowS
Show, WikiRevision -> WikiRevision -> Bool
(WikiRevision -> WikiRevision -> Bool)
-> (WikiRevision -> WikiRevision -> Bool) -> Eq WikiRevision
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WikiRevision -> WikiRevision -> Bool
$c/= :: WikiRevision -> WikiRevision -> Bool
== :: WikiRevision -> WikiRevision -> Bool
$c== :: WikiRevision -> WikiRevision -> Bool
Eq, (forall x. WikiRevision -> Rep WikiRevision x)
-> (forall x. Rep WikiRevision x -> WikiRevision)
-> Generic WikiRevision
forall x. Rep WikiRevision x -> WikiRevision
forall x. WikiRevision -> Rep WikiRevision x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WikiRevision x -> WikiRevision
$cfrom :: forall x. WikiRevision -> Rep WikiRevision x
Generic )

instance FromJSON WikiRevision where
    parseJSON :: Value -> Parser WikiRevision
parseJSON = String
-> (Object -> Parser WikiRevision) -> Value -> Parser WikiRevision
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"WikiRevision" ((Object -> Parser WikiRevision) -> Value -> Parser WikiRevision)
-> (Object -> Parser WikiRevision) -> Value -> Parser WikiRevision
forall a b. (a -> b) -> a -> b
$ \Object
o -> WikiRevisionID
-> WikiPageName
-> UTCTime
-> Username
-> Maybe Body
-> Maybe Bool
-> WikiRevision
WikiRevision (WikiRevisionID
 -> WikiPageName
 -> UTCTime
 -> Username
 -> Maybe Body
 -> Maybe Bool
 -> WikiRevision)
-> Parser WikiRevisionID
-> Parser
     (WikiPageName
      -> UTCTime -> Username -> Maybe Body -> Maybe Bool -> WikiRevision)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Body -> Parser WikiRevisionID
forall a. FromJSON a => Object -> Body -> Parser a
.: Body
"id"
        Parser
  (WikiPageName
   -> UTCTime -> Username -> Maybe Body -> Maybe Bool -> WikiRevision)
-> Parser WikiPageName
-> Parser
     (UTCTime -> Username -> Maybe Body -> Maybe Bool -> WikiRevision)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Body -> Parser WikiPageName
forall a. FromJSON a => Object -> Body -> Parser a
.: Body
"page"
        Parser
  (UTCTime -> Username -> Maybe Body -> Maybe Bool -> WikiRevision)
-> Parser UTCTime
-> Parser (Username -> Maybe Body -> Maybe Bool -> WikiRevision)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer -> UTCTime
integerToUTC (Integer -> UTCTime) -> Parser Integer -> Parser UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Body -> Parser Integer
forall a. FromJSON a => Object -> Body -> Parser a
.: Body
"timestamp")
        Parser (Username -> Maybe Body -> Maybe Bool -> WikiRevision)
-> Parser Username
-> Parser (Maybe Body -> Maybe Bool -> WikiRevision)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Object -> Body -> Parser Username
forall a. FromJSON a => Object -> Body -> Parser a
.: Body
"name") (Object -> Parser Username) -> Parser Object -> Parser Username
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object -> Body -> Parser Object
forall a. FromJSON a => Object -> Body -> Parser a
.: Body
"data") (Object -> Parser Object) -> Parser Object -> Parser Object
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Body -> Parser Object
forall a. FromJSON a => Object -> Body -> Parser a
.: Body
"author")
        Parser (Maybe Body -> Maybe Bool -> WikiRevision)
-> Parser (Maybe Body) -> Parser (Maybe Bool -> WikiRevision)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser (Maybe Body)
-> (Body -> Parser (Maybe Body))
-> Maybe Body
-> Parser (Maybe Body)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Body -> Parser (Maybe Body)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Body
forall a. Maybe a
Nothing) Body -> Parser (Maybe Body)
forall a. FromJSON a => Body -> Parser (Maybe a)
nothingTxtNull (Maybe Body -> Parser (Maybe Body))
-> Parser (Maybe Body) -> Parser (Maybe Body)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Body -> Parser (Maybe Body)
forall a. FromJSON a => Object -> Body -> Parser (Maybe a)
.:? Body
"reason")
        Parser (Maybe Bool -> WikiRevision)
-> Parser (Maybe Bool) -> Parser WikiRevision
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Body -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Body -> Parser (Maybe a)
.:? Body
"revision_hidden"

-- The endpoints that list revisions are a @Listing@, but there are no additional
-- options that can be passed to them. Giving this dummy instance at least allows
-- using a @Listing ... WikiRevision@ with existing convenience functions
instance Paginable WikiRevision where
    type PaginateOptions WikiRevision = ()

    type PaginateThing WikiRevision = WikiRevisionID

    defaultOpts :: PaginateOptions WikiRevision
defaultOpts = ()

    optsToForm :: PaginateOptions WikiRevision -> Form
optsToForm PaginateOptions WikiRevision
_ = Form
forall a. Monoid a => a
mempty

    getFullname :: WikiRevision -> PaginateThing WikiRevision
getFullname WikiRevision { WikiRevisionID
revisionID :: WikiRevisionID
revisionID :: WikiRevision -> WikiRevisionID
revisionID } = PaginateThing WikiRevision
WikiRevisionID
revisionID

-- | ID for a wikipage revision
newtype WikiRevisionID = WikiRevisionID Text
    deriving stock ( Int -> WikiRevisionID -> ShowS
[WikiRevisionID] -> ShowS
WikiRevisionID -> String
(Int -> WikiRevisionID -> ShowS)
-> (WikiRevisionID -> String)
-> ([WikiRevisionID] -> ShowS)
-> Show WikiRevisionID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WikiRevisionID] -> ShowS
$cshowList :: [WikiRevisionID] -> ShowS
show :: WikiRevisionID -> String
$cshow :: WikiRevisionID -> String
showsPrec :: Int -> WikiRevisionID -> ShowS
$cshowsPrec :: Int -> WikiRevisionID -> ShowS
Show, (forall x. WikiRevisionID -> Rep WikiRevisionID x)
-> (forall x. Rep WikiRevisionID x -> WikiRevisionID)
-> Generic WikiRevisionID
forall x. Rep WikiRevisionID x -> WikiRevisionID
forall x. WikiRevisionID -> Rep WikiRevisionID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WikiRevisionID x -> WikiRevisionID
$cfrom :: forall x. WikiRevisionID -> Rep WikiRevisionID x
Generic )
    deriving newtype ( WikiRevisionID -> WikiRevisionID -> Bool
(WikiRevisionID -> WikiRevisionID -> Bool)
-> (WikiRevisionID -> WikiRevisionID -> Bool) -> Eq WikiRevisionID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WikiRevisionID -> WikiRevisionID -> Bool
$c/= :: WikiRevisionID -> WikiRevisionID -> Bool
== :: WikiRevisionID -> WikiRevisionID -> Bool
$c== :: WikiRevisionID -> WikiRevisionID -> Bool
Eq, WikiRevisionID -> ByteString
WikiRevisionID -> Builder
WikiRevisionID -> Body
(WikiRevisionID -> Body)
-> (WikiRevisionID -> Builder)
-> (WikiRevisionID -> ByteString)
-> (WikiRevisionID -> Body)
-> ToHttpApiData WikiRevisionID
forall a.
(a -> Body)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Body)
-> ToHttpApiData a
toQueryParam :: WikiRevisionID -> Body
$ctoQueryParam :: WikiRevisionID -> Body
toHeader :: WikiRevisionID -> ByteString
$ctoHeader :: WikiRevisionID -> ByteString
toEncodedUrlPiece :: WikiRevisionID -> Builder
$ctoEncodedUrlPiece :: WikiRevisionID -> Builder
toUrlPiece :: WikiRevisionID -> Body
$ctoUrlPiece :: WikiRevisionID -> Body
ToHttpApiData )

instance FromJSON WikiRevisionID where
    parseJSON :: Value -> Parser WikiRevisionID
parseJSON = String
-> (Body -> Parser WikiRevisionID)
-> Value
-> Parser WikiRevisionID
forall a. String -> (Body -> Parser a) -> Value -> Parser a
withText String
"WikiRevisionID" (Body -> Body -> Parser WikiRevisionID
forall a. Coercible a Body => Body -> Body -> Parser a
breakOnType Body
"WikiRevision")

instance Thing WikiRevisionID where
    fullname :: WikiRevisionID -> Body
fullname (WikiRevisionID Body
r) = Body
"WikiRevision_" Body -> Body -> Body
forall a. Semigroup a => a -> a -> a
<> Body
r

-- | Wrapper for listings of @WikiPage@s, which have their own @RedditKind@
newtype WikiPageListing = WikiPageListing (Seq WikiPageName)
    deriving stock ( Int -> WikiPageListing -> ShowS
[WikiPageListing] -> ShowS
WikiPageListing -> String
(Int -> WikiPageListing -> ShowS)
-> (WikiPageListing -> String)
-> ([WikiPageListing] -> ShowS)
-> Show WikiPageListing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WikiPageListing] -> ShowS
$cshowList :: [WikiPageListing] -> ShowS
show :: WikiPageListing -> String
$cshow :: WikiPageListing -> String
showsPrec :: Int -> WikiPageListing -> ShowS
$cshowsPrec :: Int -> WikiPageListing -> ShowS
Show, (forall x. WikiPageListing -> Rep WikiPageListing x)
-> (forall x. Rep WikiPageListing x -> WikiPageListing)
-> Generic WikiPageListing
forall x. Rep WikiPageListing x -> WikiPageListing
forall x. WikiPageListing -> Rep WikiPageListing x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WikiPageListing x -> WikiPageListing
$cfrom :: forall x. WikiPageListing -> Rep WikiPageListing x
Generic )

instance FromJSON WikiPageListing where
    parseJSON :: Value -> Parser WikiPageListing
parseJSON = RedditKind
-> String
-> (Array -> Parser WikiPageListing)
-> Value
-> Parser WikiPageListing
forall b a.
FromJSON b =>
RedditKind -> String -> (b -> Parser a) -> Value -> Parser a
withKind @Array RedditKind
WikiPageListingKind String
"WikiPageListing"
        ((Array -> Parser WikiPageListing)
 -> Value -> Parser WikiPageListing)
-> (Array -> Parser WikiPageListing)
-> Value
-> Parser WikiPageListing
forall a b. (a -> b) -> a -> b
$ ([WikiPageName] -> WikiPageListing)
-> Parser [WikiPageName] -> Parser WikiPageListing
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Seq WikiPageName -> WikiPageListing
WikiPageListing (Seq WikiPageName -> WikiPageListing)
-> ([WikiPageName] -> Seq WikiPageName)
-> [WikiPageName]
-> WikiPageListing
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WikiPageName] -> Seq WikiPageName
forall l. IsList l => [Item l] -> l
fromList) (Parser [WikiPageName] -> Parser WikiPageListing)
-> (Array -> Parser [WikiPageName])
-> Array
-> Parser WikiPageListing
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser WikiPageName) -> [Value] -> Parser [WikiPageName]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser WikiPageName
forall a. FromJSON a => Value -> Parser a
parseJSON ([Value] -> Parser [WikiPageName])
-> (Array -> [Value]) -> Array -> Parser [WikiPageName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Array -> [Value]
forall l. IsList l => l -> [Item l]
toList

-- | The settings that moderators have configured for a single 'WikiPage'
data WikiPageSettings = WikiPageSettings
    { WikiPageSettings -> WikiPermLevel
permlevel      :: WikiPermLevel
    , WikiPageSettings -> Bool
listed         :: Bool
    , WikiPageSettings -> Seq Username
allowedEditors :: Seq Username
    }
    deriving stock ( Int -> WikiPageSettings -> ShowS
[WikiPageSettings] -> ShowS
WikiPageSettings -> String
(Int -> WikiPageSettings -> ShowS)
-> (WikiPageSettings -> String)
-> ([WikiPageSettings] -> ShowS)
-> Show WikiPageSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WikiPageSettings] -> ShowS
$cshowList :: [WikiPageSettings] -> ShowS
show :: WikiPageSettings -> String
$cshow :: WikiPageSettings -> String
showsPrec :: Int -> WikiPageSettings -> ShowS
$cshowsPrec :: Int -> WikiPageSettings -> ShowS
Show, WikiPageSettings -> WikiPageSettings -> Bool
(WikiPageSettings -> WikiPageSettings -> Bool)
-> (WikiPageSettings -> WikiPageSettings -> Bool)
-> Eq WikiPageSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WikiPageSettings -> WikiPageSettings -> Bool
$c/= :: WikiPageSettings -> WikiPageSettings -> Bool
== :: WikiPageSettings -> WikiPageSettings -> Bool
$c== :: WikiPageSettings -> WikiPageSettings -> Bool
Eq, (forall x. WikiPageSettings -> Rep WikiPageSettings x)
-> (forall x. Rep WikiPageSettings x -> WikiPageSettings)
-> Generic WikiPageSettings
forall x. Rep WikiPageSettings x -> WikiPageSettings
forall x. WikiPageSettings -> Rep WikiPageSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WikiPageSettings x -> WikiPageSettings
$cfrom :: forall x. WikiPageSettings -> Rep WikiPageSettings x
Generic )

instance FromJSON WikiPageSettings where
    parseJSON :: Value -> Parser WikiPageSettings
parseJSON = RedditKind
-> String
-> (Object -> Parser WikiPageSettings)
-> Value
-> Parser WikiPageSettings
forall b a.
FromJSON b =>
RedditKind -> String -> (b -> Parser a) -> Value -> Parser a
withKind RedditKind
WikiPageSettingsKind String
"WikiPageSettings" ((Object -> Parser WikiPageSettings)
 -> Value -> Parser WikiPageSettings)
-> (Object -> Parser WikiPageSettings)
-> Value
-> Parser WikiPageSettings
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        WikiPermLevel -> Bool -> Seq Username -> WikiPageSettings
WikiPageSettings (WikiPermLevel -> Bool -> Seq Username -> WikiPageSettings)
-> Parser WikiPermLevel
-> Parser (Bool -> Seq Username -> WikiPageSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Body -> Parser WikiPermLevel
forall a. FromJSON a => Object -> Body -> Parser a
.: Body
"permlevel"
        Parser (Bool -> Seq Username -> WikiPageSettings)
-> Parser Bool -> Parser (Seq Username -> WikiPageSettings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Body -> Parser Bool
forall a. FromJSON a => Object -> Body -> Parser a
.: Body
"listed"
        Parser (Seq Username -> WikiPageSettings)
-> Parser (Seq Username) -> Parser WikiPageSettings
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Username] -> Seq Username
forall l. IsList l => [Item l] -> l
fromList ([Username] -> Seq Username)
-> Parser [Username] -> Parser (Seq Username)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser [Username]
editorsP (Value -> Parser [Username]) -> Parser Value -> Parser [Username]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Body -> Parser Value
forall a. FromJSON a => Object -> Body -> Parser a
.: Body
"editors"))
      where
        editorsP :: Value -> Parser [Username]
editorsP = String
-> (Array -> Parser [Username]) -> Value -> Parser [Username]
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"[User]" ((Array -> Parser [Username]) -> Value -> Parser [Username])
-> (Array -> Parser [Username]) -> Value -> Parser [Username]
forall a b. (a -> b) -> a -> b
$ \Array
as ->
            [Value] -> (Value -> Parser Username) -> Parser [Username]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Array -> [Item Array]
forall l. IsList l => l -> [Item l]
toList Array
as) ((Value -> Parser Username) -> Parser [Username])
-> ((Object -> Parser Username) -> Value -> Parser Username)
-> (Object -> Parser Username)
-> Parser [Username]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Object -> Parser Username) -> Value -> Parser Username
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"User" ((Object -> Parser Username) -> Parser [Username])
-> (Object -> Parser Username) -> Parser [Username]
forall a b. (a -> b) -> a -> b
$ \Object
o -> (Object -> Body -> Parser Username
forall a. FromJSON a => Object -> Body -> Parser a
.: Body
"name")
            (Object -> Parser Username) -> Parser Object -> Parser Username
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Body -> Parser Object
forall a. FromJSON a => Object -> Body -> Parser a
.: Body
"data"

-- | Editing permission level configured for a single 'WikiPage'
data WikiPermLevel
    = FollowWikiSettings
    | ApprovedEditorsOnly
    | ModEditsOnly
    deriving stock ( Int -> WikiPermLevel -> ShowS
[WikiPermLevel] -> ShowS
WikiPermLevel -> String
(Int -> WikiPermLevel -> ShowS)
-> (WikiPermLevel -> String)
-> ([WikiPermLevel] -> ShowS)
-> Show WikiPermLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WikiPermLevel] -> ShowS
$cshowList :: [WikiPermLevel] -> ShowS
show :: WikiPermLevel -> String
$cshow :: WikiPermLevel -> String
showsPrec :: Int -> WikiPermLevel -> ShowS
$cshowsPrec :: Int -> WikiPermLevel -> ShowS
Show, WikiPermLevel -> WikiPermLevel -> Bool
(WikiPermLevel -> WikiPermLevel -> Bool)
-> (WikiPermLevel -> WikiPermLevel -> Bool) -> Eq WikiPermLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WikiPermLevel -> WikiPermLevel -> Bool
$c/= :: WikiPermLevel -> WikiPermLevel -> Bool
== :: WikiPermLevel -> WikiPermLevel -> Bool
$c== :: WikiPermLevel -> WikiPermLevel -> Bool
Eq, (forall x. WikiPermLevel -> Rep WikiPermLevel x)
-> (forall x. Rep WikiPermLevel x -> WikiPermLevel)
-> Generic WikiPermLevel
forall x. Rep WikiPermLevel x -> WikiPermLevel
forall x. WikiPermLevel -> Rep WikiPermLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WikiPermLevel x -> WikiPermLevel
$cfrom :: forall x. WikiPermLevel -> Rep WikiPermLevel x
Generic, Eq WikiPermLevel
Eq WikiPermLevel
-> (WikiPermLevel -> WikiPermLevel -> Ordering)
-> (WikiPermLevel -> WikiPermLevel -> Bool)
-> (WikiPermLevel -> WikiPermLevel -> Bool)
-> (WikiPermLevel -> WikiPermLevel -> Bool)
-> (WikiPermLevel -> WikiPermLevel -> Bool)
-> (WikiPermLevel -> WikiPermLevel -> WikiPermLevel)
-> (WikiPermLevel -> WikiPermLevel -> WikiPermLevel)
-> Ord WikiPermLevel
WikiPermLevel -> WikiPermLevel -> Bool
WikiPermLevel -> WikiPermLevel -> Ordering
WikiPermLevel -> WikiPermLevel -> WikiPermLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WikiPermLevel -> WikiPermLevel -> WikiPermLevel
$cmin :: WikiPermLevel -> WikiPermLevel -> WikiPermLevel
max :: WikiPermLevel -> WikiPermLevel -> WikiPermLevel
$cmax :: WikiPermLevel -> WikiPermLevel -> WikiPermLevel
>= :: WikiPermLevel -> WikiPermLevel -> Bool
$c>= :: WikiPermLevel -> WikiPermLevel -> Bool
> :: WikiPermLevel -> WikiPermLevel -> Bool
$c> :: WikiPermLevel -> WikiPermLevel -> Bool
<= :: WikiPermLevel -> WikiPermLevel -> Bool
$c<= :: WikiPermLevel -> WikiPermLevel -> Bool
< :: WikiPermLevel -> WikiPermLevel -> Bool
$c< :: WikiPermLevel -> WikiPermLevel -> Bool
compare :: WikiPermLevel -> WikiPermLevel -> Ordering
$ccompare :: WikiPermLevel -> WikiPermLevel -> Ordering
$cp1Ord :: Eq WikiPermLevel
Ord )

instance FromJSON WikiPermLevel where
    parseJSON :: Value -> Parser WikiPermLevel
parseJSON = String
-> (Scientific -> Parser WikiPermLevel)
-> Value
-> Parser WikiPermLevel
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"WikiPermLevel" ((Scientific -> Parser WikiPermLevel)
 -> Value -> Parser WikiPermLevel)
-> (Scientific -> Parser WikiPermLevel)
-> Value
-> Parser WikiPermLevel
forall a b. (a -> b) -> a -> b
$ \case
        Scientific
0.0 -> WikiPermLevel -> Parser WikiPermLevel
forall (f :: * -> *) a. Applicative f => a -> f a
pure WikiPermLevel
FollowWikiSettings
        Scientific
1.0 -> WikiPermLevel -> Parser WikiPermLevel
forall (f :: * -> *) a. Applicative f => a -> f a
pure WikiPermLevel
ApprovedEditorsOnly
        Scientific
2.0 -> WikiPermLevel -> Parser WikiPermLevel
forall (f :: * -> *) a. Applicative f => a -> f a
pure WikiPermLevel
ModEditsOnly
        Scientific
_   -> Parser WikiPermLevel
forall a. Monoid a => a
mempty

instance ToHttpApiData WikiPermLevel where
    toQueryParam :: WikiPermLevel -> Body
toQueryParam = \case
        WikiPermLevel
FollowWikiSettings  -> Body
"0"
        WikiPermLevel
ApprovedEditorsOnly -> Body
"1"
        WikiPermLevel
ModEditsOnly        -> Body
"2"