module Conduit.Features.Articles.Types where

import Conduit.Features.Account.Types (UserProfile)
import Conduit.Utils (InObj(..))
import Data.Aeson (ToJSON(..), object, (.=))
import Data.Aeson.Types (Value)
import Data.Time (UTCTime)

newtype ArticleID = ArticleID { ArticleID -> Int64
unID :: Int64 } 
  deriving newtype (Int -> ArticleID -> ShowS
[ArticleID] -> ShowS
ArticleID -> String
(Int -> ArticleID -> ShowS)
-> (ArticleID -> String)
-> ([ArticleID] -> ShowS)
-> Show ArticleID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArticleID -> ShowS
showsPrec :: Int -> ArticleID -> ShowS
$cshow :: ArticleID -> String
show :: ArticleID -> String
$cshowList :: [ArticleID] -> ShowS
showList :: [ArticleID] -> ShowS
Show, ReadPrec [ArticleID]
ReadPrec ArticleID
Int -> ReadS ArticleID
ReadS [ArticleID]
(Int -> ReadS ArticleID)
-> ReadS [ArticleID]
-> ReadPrec ArticleID
-> ReadPrec [ArticleID]
-> Read ArticleID
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ArticleID
readsPrec :: Int -> ReadS ArticleID
$creadList :: ReadS [ArticleID]
readList :: ReadS [ArticleID]
$creadPrec :: ReadPrec ArticleID
readPrec :: ReadPrec ArticleID
$creadListPrec :: ReadPrec [ArticleID]
readListPrec :: ReadPrec [ArticleID]
Read, ArticleID -> ArticleID -> Bool
(ArticleID -> ArticleID -> Bool)
-> (ArticleID -> ArticleID -> Bool) -> Eq ArticleID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArticleID -> ArticleID -> Bool
== :: ArticleID -> ArticleID -> Bool
$c/= :: ArticleID -> ArticleID -> Bool
/= :: ArticleID -> ArticleID -> Bool
Eq, [ArticleID] -> Value
[ArticleID] -> Encoding
ArticleID -> Bool
ArticleID -> Value
ArticleID -> Encoding
(ArticleID -> Value)
-> (ArticleID -> Encoding)
-> ([ArticleID] -> Value)
-> ([ArticleID] -> Encoding)
-> (ArticleID -> Bool)
-> ToJSON ArticleID
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ArticleID -> Value
toJSON :: ArticleID -> Value
$ctoEncoding :: ArticleID -> Encoding
toEncoding :: ArticleID -> Encoding
$ctoJSONList :: [ArticleID] -> Value
toJSONList :: [ArticleID] -> Value
$ctoEncodingList :: [ArticleID] -> Encoding
toEncodingList :: [ArticleID] -> Encoding
$comitField :: ArticleID -> Bool
omitField :: ArticleID -> Bool
ToJSON)

newtype Slug = Slug { Slug -> Text
unSlug :: Text }
  deriving (Int -> Slug -> ShowS
[Slug] -> ShowS
Slug -> String
(Int -> Slug -> ShowS)
-> (Slug -> String) -> ([Slug] -> ShowS) -> Show Slug
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Slug -> ShowS
showsPrec :: Int -> Slug -> ShowS
$cshow :: Slug -> String
show :: Slug -> String
$cshowList :: [Slug] -> ShowS
showList :: [Slug] -> ShowS
Show, Slug -> Slug -> Bool
(Slug -> Slug -> Bool) -> (Slug -> Slug -> Bool) -> Eq Slug
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Slug -> Slug -> Bool
== :: Slug -> Slug -> Bool
$c/= :: Slug -> Slug -> Bool
/= :: Slug -> Slug -> Bool
Eq)
  deriving newtype ([Slug] -> Value
[Slug] -> Encoding
Slug -> Bool
Slug -> Value
Slug -> Encoding
(Slug -> Value)
-> (Slug -> Encoding)
-> ([Slug] -> Value)
-> ([Slug] -> Encoding)
-> (Slug -> Bool)
-> ToJSON Slug
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Slug -> Value
toJSON :: Slug -> Value
$ctoEncoding :: Slug -> Encoding
toEncoding :: Slug -> Encoding
$ctoJSONList :: [Slug] -> Value
toJSONList :: [Slug] -> Value
$ctoEncodingList :: [Slug] -> Encoding
toEncodingList :: [Slug] -> Encoding
$comitField :: Slug -> Bool
omitField :: Slug -> Bool
ToJSON)

newtype NoIDSlug = NoIDSlug { NoIDSlug -> Text
unSlug :: Text }
  deriving (Int -> NoIDSlug -> ShowS
[NoIDSlug] -> ShowS
NoIDSlug -> String
(Int -> NoIDSlug -> ShowS)
-> (NoIDSlug -> String) -> ([NoIDSlug] -> ShowS) -> Show NoIDSlug
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NoIDSlug -> ShowS
showsPrec :: Int -> NoIDSlug -> ShowS
$cshow :: NoIDSlug -> String
show :: NoIDSlug -> String
$cshowList :: [NoIDSlug] -> ShowS
showList :: [NoIDSlug] -> ShowS
Show, NoIDSlug -> NoIDSlug -> Bool
(NoIDSlug -> NoIDSlug -> Bool)
-> (NoIDSlug -> NoIDSlug -> Bool) -> Eq NoIDSlug
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NoIDSlug -> NoIDSlug -> Bool
== :: NoIDSlug -> NoIDSlug -> Bool
$c/= :: NoIDSlug -> NoIDSlug -> Bool
/= :: NoIDSlug -> NoIDSlug -> Bool
Eq)

inAuthorObj :: obj -> InObj obj
inAuthorObj :: forall obj. obj -> InObj obj
inAuthorObj = Key -> obj -> InObj obj
forall obj. Key -> obj -> InObj obj
InObj Key
"author"

data OneArticle = OneArticle
  { OneArticle -> UserProfile
author    :: UserProfile
  , OneArticle -> Slug
slug      :: Slug
  , OneArticle -> Text
title     :: Text
  , OneArticle -> Text
desc      :: Text
  , OneArticle -> Text
body      :: Text
  , OneArticle -> [Text]
tags      :: [Text]
  , OneArticle -> Bool
favorited :: Bool
  , OneArticle -> Int
numFavs   :: Int
  , OneArticle -> UTCTime
created   :: UTCTime
  , OneArticle -> UTCTime
updated   :: UTCTime
  } deriving (Int -> OneArticle -> ShowS
[OneArticle] -> ShowS
OneArticle -> String
(Int -> OneArticle -> ShowS)
-> (OneArticle -> String)
-> ([OneArticle] -> ShowS)
-> Show OneArticle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OneArticle -> ShowS
showsPrec :: Int -> OneArticle -> ShowS
$cshow :: OneArticle -> String
show :: OneArticle -> String
$cshowList :: [OneArticle] -> ShowS
showList :: [OneArticle] -> ShowS
Show)

instance ToJSON OneArticle where
  toJSON :: OneArticle -> Value
  toJSON :: OneArticle -> Value
toJSON OneArticle {Bool
Int
[Text]
Text
UTCTime
UserProfile
Slug
$sel:author:OneArticle :: OneArticle -> UserProfile
$sel:slug:OneArticle :: OneArticle -> Slug
$sel:title:OneArticle :: OneArticle -> Text
$sel:desc:OneArticle :: OneArticle -> Text
$sel:body:OneArticle :: OneArticle -> Text
$sel:tags:OneArticle :: OneArticle -> [Text]
$sel:favorited:OneArticle :: OneArticle -> Bool
$sel:numFavs:OneArticle :: OneArticle -> Int
$sel:created:OneArticle :: OneArticle -> UTCTime
$sel:updated:OneArticle :: OneArticle -> UTCTime
author :: UserProfile
slug :: Slug
title :: Text
desc :: Text
body :: Text
tags :: [Text]
favorited :: Bool
numFavs :: Int
created :: UTCTime
updated :: UTCTime
..} = [Pair] -> Value
object
    [ Key
"slug"           Key -> Slug -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Slug
slug
    , Key
"title"          Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
title
    , Key
"description"    Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
desc
    , Key
"body"           Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
body
    , Key
"tagList"        Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Text]
tags
    , Key
"createdAt"      Key -> UTCTime -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTCTime
created
    , Key
"updatedAt"      Key -> UTCTime -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTCTime
updated
    , Key
"favorited"      Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Bool
favorited
    , Key
"favoritesCount" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
numFavs
    , Key
"author"         Key -> UserProfile -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UserProfile
author
    ]

inArticleObj :: obj -> InObj obj
inArticleObj :: forall obj. obj -> InObj obj
inArticleObj = Key -> obj -> InObj obj
forall obj. Key -> obj -> InObj obj
InObj Key
"article"

newtype ManyArticles = ManyArticles
  { ManyArticles -> [OneArticle]
articles :: [OneArticle]
  } deriving (Int -> ManyArticles -> ShowS
[ManyArticles] -> ShowS
ManyArticles -> String
(Int -> ManyArticles -> ShowS)
-> (ManyArticles -> String)
-> ([ManyArticles] -> ShowS)
-> Show ManyArticles
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ManyArticles -> ShowS
showsPrec :: Int -> ManyArticles -> ShowS
$cshow :: ManyArticles -> String
show :: ManyArticles -> String
$cshowList :: [ManyArticles] -> ShowS
showList :: [ManyArticles] -> ShowS
Show)

instance ToJSON ManyArticles where
  toJSON :: ManyArticles -> Value
  toJSON :: ManyArticles -> Value
toJSON ManyArticles {[OneArticle]
$sel:articles:ManyArticles :: ManyArticles -> [OneArticle]
articles :: [OneArticle]
..} = [Pair] -> Value
object
    [ Key
"articles" Key -> [OneArticle] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [OneArticle]
articles
    , Key
"articlesCount" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [OneArticle] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [OneArticle]
articles
    ]

newtype CommentID = CommentID { CommentID -> Int64
unID :: Int64 } 
  deriving newtype (Int -> CommentID -> ShowS
[CommentID] -> ShowS
CommentID -> String
(Int -> CommentID -> ShowS)
-> (CommentID -> String)
-> ([CommentID] -> ShowS)
-> Show CommentID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommentID -> ShowS
showsPrec :: Int -> CommentID -> ShowS
$cshow :: CommentID -> String
show :: CommentID -> String
$cshowList :: [CommentID] -> ShowS
showList :: [CommentID] -> ShowS
Show, ReadPrec [CommentID]
ReadPrec CommentID
Int -> ReadS CommentID
ReadS [CommentID]
(Int -> ReadS CommentID)
-> ReadS [CommentID]
-> ReadPrec CommentID
-> ReadPrec [CommentID]
-> Read CommentID
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CommentID
readsPrec :: Int -> ReadS CommentID
$creadList :: ReadS [CommentID]
readList :: ReadS [CommentID]
$creadPrec :: ReadPrec CommentID
readPrec :: ReadPrec CommentID
$creadListPrec :: ReadPrec [CommentID]
readListPrec :: ReadPrec [CommentID]
Read, CommentID -> CommentID -> Bool
(CommentID -> CommentID -> Bool)
-> (CommentID -> CommentID -> Bool) -> Eq CommentID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommentID -> CommentID -> Bool
== :: CommentID -> CommentID -> Bool
$c/= :: CommentID -> CommentID -> Bool
/= :: CommentID -> CommentID -> Bool
Eq, [CommentID] -> Value
[CommentID] -> Encoding
CommentID -> Bool
CommentID -> Value
CommentID -> Encoding
(CommentID -> Value)
-> (CommentID -> Encoding)
-> ([CommentID] -> Value)
-> ([CommentID] -> Encoding)
-> (CommentID -> Bool)
-> ToJSON CommentID
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CommentID -> Value
toJSON :: CommentID -> Value
$ctoEncoding :: CommentID -> Encoding
toEncoding :: CommentID -> Encoding
$ctoJSONList :: [CommentID] -> Value
toJSONList :: [CommentID] -> Value
$ctoEncodingList :: [CommentID] -> Encoding
toEncodingList :: [CommentID] -> Encoding
$comitField :: CommentID -> Bool
omitField :: CommentID -> Bool
ToJSON)

data OneComment = OneComment
  { OneComment -> UserProfile
author    :: UserProfile
  , OneComment -> CommentID
commentID :: CommentID
  , OneComment -> Text
body      :: Text
  , OneComment -> UTCTime
created   :: UTCTime
  , OneComment -> UTCTime
updated   :: UTCTime
  } deriving (Int -> OneComment -> ShowS
[OneComment] -> ShowS
OneComment -> String
(Int -> OneComment -> ShowS)
-> (OneComment -> String)
-> ([OneComment] -> ShowS)
-> Show OneComment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OneComment -> ShowS
showsPrec :: Int -> OneComment -> ShowS
$cshow :: OneComment -> String
show :: OneComment -> String
$cshowList :: [OneComment] -> ShowS
showList :: [OneComment] -> ShowS
Show)

instance ToJSON OneComment where
  toJSON :: OneComment -> Value
  toJSON :: OneComment -> Value
toJSON OneComment {Text
UTCTime
UserProfile
CommentID
$sel:author:OneComment :: OneComment -> UserProfile
$sel:commentID:OneComment :: OneComment -> CommentID
$sel:body:OneComment :: OneComment -> Text
$sel:created:OneComment :: OneComment -> UTCTime
$sel:updated:OneComment :: OneComment -> UTCTime
author :: UserProfile
commentID :: CommentID
body :: Text
created :: UTCTime
updated :: UTCTime
..} = [Pair] -> Value
object
    [ Key
"id"        Key -> CommentID -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CommentID
commentID
    , Key
"body"      Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
body
    , Key
"createdAt" Key -> UTCTime -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTCTime
created
    , Key
"updatedAt" Key -> UTCTime -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTCTime
updated
    , Key
"author"    Key -> UserProfile -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UserProfile
author
    ]

inCommentObj :: obj -> InObj obj
inCommentObj :: forall obj. obj -> InObj obj
inCommentObj = Key -> obj -> InObj obj
forall obj. Key -> obj -> InObj obj
InObj Key
"comment"

newtype ManyComments = ManyComments
  { ManyComments -> [OneComment]
comments :: [OneComment]
  } deriving (Int -> ManyComments -> ShowS
[ManyComments] -> ShowS
ManyComments -> String
(Int -> ManyComments -> ShowS)
-> (ManyComments -> String)
-> ([ManyComments] -> ShowS)
-> Show ManyComments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ManyComments -> ShowS
showsPrec :: Int -> ManyComments -> ShowS
$cshow :: ManyComments -> String
show :: ManyComments -> String
$cshowList :: [ManyComments] -> ShowS
showList :: [ManyComments] -> ShowS
Show, (forall x. ManyComments -> Rep ManyComments x)
-> (forall x. Rep ManyComments x -> ManyComments)
-> Generic ManyComments
forall x. Rep ManyComments x -> ManyComments
forall x. ManyComments -> Rep ManyComments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ManyComments -> Rep ManyComments x
from :: forall x. ManyComments -> Rep ManyComments x
$cto :: forall x. Rep ManyComments x -> ManyComments
to :: forall x. Rep ManyComments x -> ManyComments
Generic)
    deriving anyclass ([ManyComments] -> Value
[ManyComments] -> Encoding
ManyComments -> Bool
ManyComments -> Value
ManyComments -> Encoding
(ManyComments -> Value)
-> (ManyComments -> Encoding)
-> ([ManyComments] -> Value)
-> ([ManyComments] -> Encoding)
-> (ManyComments -> Bool)
-> ToJSON ManyComments
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ManyComments -> Value
toJSON :: ManyComments -> Value
$ctoEncoding :: ManyComments -> Encoding
toEncoding :: ManyComments -> Encoding
$ctoJSONList :: [ManyComments] -> Value
toJSONList :: [ManyComments] -> Value
$ctoEncodingList :: [ManyComments] -> Encoding
toEncodingList :: [ManyComments] -> Encoding
$comitField :: ManyComments -> Bool
omitField :: ManyComments -> Bool
ToJSON)

inTagsObj :: obj -> InObj obj
inTagsObj :: forall obj. obj -> InObj obj
inTagsObj = Key -> obj -> InObj obj
forall obj. Key -> obj -> InObj obj
InObj Key
"tags"