{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StrictData #-}
module Database.PostgreSQL.Entity.Internal.BlogPost where
import Data.Text (Text)
import Data.Time (UTCTime)
import Data.UUID (UUID)
import Data.Vector (Vector)
import Database.PostgreSQL.Simple.FromField (FromField)
import Database.PostgreSQL.Simple.FromRow (FromRow (..))
import Database.PostgreSQL.Simple.ToField (Action (..), ToField (..))
import Database.PostgreSQL.Simple.ToRow (ToRow)
import Database.PostgreSQL.Transact (DBT)
import GHC.Generics (Generic)
import GHC.OverloadedLabels (IsLabel (..))
import GHC.Records (HasField (..))
import Data.ByteString.Builder (byteString, char8)
import qualified Data.List as List
import qualified Data.Vector as Vector
import Database.PostgreSQL.Entity (Field, insert, insertMany, upsert)
import Database.PostgreSQL.Entity.Internal.QQ (field)
import Database.PostgreSQL.Entity.Types (Entity (..), GenericEntity, PrimaryKey, TableName)
newtype AuthorId = AuthorId {AuthorId -> UUID
getAuthorId :: UUID}
deriving
(AuthorId -> AuthorId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthorId -> AuthorId -> Bool
$c/= :: AuthorId -> AuthorId -> Bool
== :: AuthorId -> AuthorId -> Bool
$c== :: AuthorId -> AuthorId -> Bool
Eq, FieldParser AuthorId
forall a. FieldParser a -> FromField a
fromField :: FieldParser AuthorId
$cfromField :: FieldParser AuthorId
FromField, Eq AuthorId
AuthorId -> AuthorId -> Bool
AuthorId -> AuthorId -> Ordering
AuthorId -> AuthorId -> AuthorId
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 :: AuthorId -> AuthorId -> AuthorId
$cmin :: AuthorId -> AuthorId -> AuthorId
max :: AuthorId -> AuthorId -> AuthorId
$cmax :: AuthorId -> AuthorId -> AuthorId
>= :: AuthorId -> AuthorId -> Bool
$c>= :: AuthorId -> AuthorId -> Bool
> :: AuthorId -> AuthorId -> Bool
$c> :: AuthorId -> AuthorId -> Bool
<= :: AuthorId -> AuthorId -> Bool
$c<= :: AuthorId -> AuthorId -> Bool
< :: AuthorId -> AuthorId -> Bool
$c< :: AuthorId -> AuthorId -> Bool
compare :: AuthorId -> AuthorId -> Ordering
$ccompare :: AuthorId -> AuthorId -> Ordering
Ord, Int -> AuthorId -> ShowS
[AuthorId] -> ShowS
AuthorId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthorId] -> ShowS
$cshowList :: [AuthorId] -> ShowS
show :: AuthorId -> String
$cshow :: AuthorId -> String
showsPrec :: Int -> AuthorId -> ShowS
$cshowsPrec :: Int -> AuthorId -> ShowS
Show, AuthorId -> Action
forall a. (a -> Action) -> ToField a
toField :: AuthorId -> Action
$ctoField :: AuthorId -> Action
ToField)
via UUID
data Author = Author
{ Author -> AuthorId
authorId :: AuthorId
, Author -> Text
name :: Text
, Author -> UTCTime
createdAt :: UTCTime
}
deriving stock (Author -> Author -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Author -> Author -> Bool
$c/= :: Author -> Author -> Bool
== :: Author -> Author -> Bool
$c== :: Author -> Author -> Bool
Eq, forall x. Rep Author x -> Author
forall x. Author -> Rep Author x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Author x -> Author
$cfrom :: forall x. Author -> Rep Author x
Generic, Eq Author
Author -> Author -> Bool
Author -> Author -> Ordering
Author -> Author -> Author
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 :: Author -> Author -> Author
$cmin :: Author -> Author -> Author
max :: Author -> Author -> Author
$cmax :: Author -> Author -> Author
>= :: Author -> Author -> Bool
$c>= :: Author -> Author -> Bool
> :: Author -> Author -> Bool
$c> :: Author -> Author -> Bool
<= :: Author -> Author -> Bool
$c<= :: Author -> Author -> Bool
< :: Author -> Author -> Bool
$c< :: Author -> Author -> Bool
compare :: Author -> Author -> Ordering
$ccompare :: Author -> Author -> Ordering
Ord, Int -> Author -> ShowS
[Author] -> ShowS
Author -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Author] -> ShowS
$cshowList :: [Author] -> ShowS
show :: Author -> String
$cshow :: Author -> String
showsPrec :: Int -> Author -> ShowS
$cshowsPrec :: Int -> Author -> ShowS
Show)
deriving anyclass (RowParser Author
forall a. RowParser a -> FromRow a
fromRow :: RowParser Author
$cfromRow :: RowParser Author
FromRow, Author -> [Action]
forall a. (a -> [Action]) -> ToRow a
toRow :: Author -> [Action]
$ctoRow :: Author -> [Action]
ToRow)
deriving
(Maybe Text
Text
Vector Field
Field
forall e. Text -> Maybe Text -> Field -> Vector Field -> Entity e
fields :: Vector Field
$cfields :: Vector Field
primaryKey :: Field
$cprimaryKey :: Field
schema :: Maybe Text
$cschema :: Maybe Text
tableName :: Text
$ctableName :: Text
Entity)
via (GenericEntity '[PrimaryKey "author_id", TableName "authors"] Author)
instance HasField x Author a => IsLabel x (Author -> a) where
fromLabel :: Author -> a
fromLabel = forall {k} (x :: k) r a. HasField x r a => r -> a
getField @x
newtype BlogPostId = BlogPostId {BlogPostId -> UUID
getBlogPostId :: UUID}
deriving
(BlogPostId -> BlogPostId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlogPostId -> BlogPostId -> Bool
$c/= :: BlogPostId -> BlogPostId -> Bool
== :: BlogPostId -> BlogPostId -> Bool
$c== :: BlogPostId -> BlogPostId -> Bool
Eq, FieldParser BlogPostId
forall a. FieldParser a -> FromField a
fromField :: FieldParser BlogPostId
$cfromField :: FieldParser BlogPostId
FromField, Eq BlogPostId
BlogPostId -> BlogPostId -> Bool
BlogPostId -> BlogPostId -> Ordering
BlogPostId -> BlogPostId -> BlogPostId
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 :: BlogPostId -> BlogPostId -> BlogPostId
$cmin :: BlogPostId -> BlogPostId -> BlogPostId
max :: BlogPostId -> BlogPostId -> BlogPostId
$cmax :: BlogPostId -> BlogPostId -> BlogPostId
>= :: BlogPostId -> BlogPostId -> Bool
$c>= :: BlogPostId -> BlogPostId -> Bool
> :: BlogPostId -> BlogPostId -> Bool
$c> :: BlogPostId -> BlogPostId -> Bool
<= :: BlogPostId -> BlogPostId -> Bool
$c<= :: BlogPostId -> BlogPostId -> Bool
< :: BlogPostId -> BlogPostId -> Bool
$c< :: BlogPostId -> BlogPostId -> Bool
compare :: BlogPostId -> BlogPostId -> Ordering
$ccompare :: BlogPostId -> BlogPostId -> Ordering
Ord, Int -> BlogPostId -> ShowS
[BlogPostId] -> ShowS
BlogPostId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlogPostId] -> ShowS
$cshowList :: [BlogPostId] -> ShowS
show :: BlogPostId -> String
$cshow :: BlogPostId -> String
showsPrec :: Int -> BlogPostId -> ShowS
$cshowsPrec :: Int -> BlogPostId -> ShowS
Show, BlogPostId -> Action
forall a. (a -> Action) -> ToField a
toField :: BlogPostId -> Action
$ctoField :: BlogPostId -> Action
ToField)
via UUID
newtype UUIDList = UUIDList {UUIDList -> Vector UUID
getUUIDList :: Vector UUID}
deriving stock (forall x. Rep UUIDList x -> UUIDList
forall x. UUIDList -> Rep UUIDList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UUIDList x -> UUIDList
$cfrom :: forall x. UUIDList -> Rep UUIDList x
Generic, Int -> UUIDList -> ShowS
[UUIDList] -> ShowS
UUIDList -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UUIDList] -> ShowS
$cshowList :: [UUIDList] -> ShowS
show :: UUIDList -> String
$cshow :: UUIDList -> String
showsPrec :: Int -> UUIDList -> ShowS
$cshowsPrec :: Int -> UUIDList -> ShowS
Show)
deriving
(UUIDList -> UUIDList -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UUIDList -> UUIDList -> Bool
$c/= :: UUIDList -> UUIDList -> Bool
== :: UUIDList -> UUIDList -> Bool
$c== :: UUIDList -> UUIDList -> Bool
Eq, FieldParser UUIDList
forall a. FieldParser a -> FromField a
fromField :: FieldParser UUIDList
$cfromField :: FieldParser UUIDList
FromField, Eq UUIDList
UUIDList -> UUIDList -> Bool
UUIDList -> UUIDList -> Ordering
UUIDList -> UUIDList -> UUIDList
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 :: UUIDList -> UUIDList -> UUIDList
$cmin :: UUIDList -> UUIDList -> UUIDList
max :: UUIDList -> UUIDList -> UUIDList
$cmax :: UUIDList -> UUIDList -> UUIDList
>= :: UUIDList -> UUIDList -> Bool
$c>= :: UUIDList -> UUIDList -> Bool
> :: UUIDList -> UUIDList -> Bool
$c> :: UUIDList -> UUIDList -> Bool
<= :: UUIDList -> UUIDList -> Bool
$c<= :: UUIDList -> UUIDList -> Bool
< :: UUIDList -> UUIDList -> Bool
$c< :: UUIDList -> UUIDList -> Bool
compare :: UUIDList -> UUIDList -> Ordering
$ccompare :: UUIDList -> UUIDList -> Ordering
Ord)
via Vector UUID
instance ToField UUIDList where
toField :: UUIDList -> Action
toField (UUIDList Vector UUID
vec) =
if forall a. Vector a -> Bool
Vector.null Vector UUID
vec
then Builder -> Action
Plain (ByteString -> Builder
byteString ByteString
"'{}'")
else
[Action] -> Action
Many forall a b. (a -> b) -> a -> b
$
Builder -> Action
Plain (ByteString -> Builder
byteString ByteString
"ARRAY[")
forall a. a -> [a] -> [a]
: (forall a. a -> [a] -> [a]
List.intersperse (Builder -> Action
Plain (Char -> Builder
char8 Char
',')) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToField a => a -> Action
toField forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
Vector.toList Vector UUID
vec)
forall a. [a] -> [a] -> [a]
++ [Builder -> Action
Plain (Char -> Builder
char8 Char
']')]
forall a. [a] -> [a] -> [a]
++ [Builder -> Action
Plain (ByteString -> Builder
byteString ByteString
" :: uuid[]")]
data BlogPost = BlogPost
{ BlogPost -> BlogPostId
blogPostId :: BlogPostId
, BlogPost -> AuthorId
authorId :: AuthorId
, BlogPost -> UUIDList
uuidList :: UUIDList
, BlogPost -> Text
title :: Text
, BlogPost -> Text
content :: Text
, BlogPost -> UTCTime
createdAt :: UTCTime
}
deriving stock (BlogPost -> BlogPost -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlogPost -> BlogPost -> Bool
$c/= :: BlogPost -> BlogPost -> Bool
== :: BlogPost -> BlogPost -> Bool
$c== :: BlogPost -> BlogPost -> Bool
Eq, forall x. Rep BlogPost x -> BlogPost
forall x. BlogPost -> Rep BlogPost x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlogPost x -> BlogPost
$cfrom :: forall x. BlogPost -> Rep BlogPost x
Generic, Eq BlogPost
BlogPost -> BlogPost -> Bool
BlogPost -> BlogPost -> Ordering
BlogPost -> BlogPost -> BlogPost
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 :: BlogPost -> BlogPost -> BlogPost
$cmin :: BlogPost -> BlogPost -> BlogPost
max :: BlogPost -> BlogPost -> BlogPost
$cmax :: BlogPost -> BlogPost -> BlogPost
>= :: BlogPost -> BlogPost -> Bool
$c>= :: BlogPost -> BlogPost -> Bool
> :: BlogPost -> BlogPost -> Bool
$c> :: BlogPost -> BlogPost -> Bool
<= :: BlogPost -> BlogPost -> Bool
$c<= :: BlogPost -> BlogPost -> Bool
< :: BlogPost -> BlogPost -> Bool
$c< :: BlogPost -> BlogPost -> Bool
compare :: BlogPost -> BlogPost -> Ordering
$ccompare :: BlogPost -> BlogPost -> Ordering
Ord, Int -> BlogPost -> ShowS
[BlogPost] -> ShowS
BlogPost -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlogPost] -> ShowS
$cshowList :: [BlogPost] -> ShowS
show :: BlogPost -> String
$cshow :: BlogPost -> String
showsPrec :: Int -> BlogPost -> ShowS
$cshowsPrec :: Int -> BlogPost -> ShowS
Show)
deriving anyclass (RowParser BlogPost
forall a. RowParser a -> FromRow a
fromRow :: RowParser BlogPost
$cfromRow :: RowParser BlogPost
FromRow, BlogPost -> [Action]
forall a. (a -> [Action]) -> ToRow a
toRow :: BlogPost -> [Action]
$ctoRow :: BlogPost -> [Action]
ToRow)
instance HasField x BlogPost a => IsLabel x (BlogPost -> a) where
fromLabel :: BlogPost -> a
fromLabel = forall {k} (x :: k) r a. HasField x r a => r -> a
getField @x
instance Entity BlogPost where
tableName :: Text
tableName = Text
"blogposts"
primaryKey :: Field
primaryKey = [field| blogpost_id |]
fields :: Vector Field
fields =
[ [field| blogpost_id |]
, [field| author_id |]
, [field| uuid_list |]
, [field| title |]
, [field| content |]
, [field| created_at |]
]
insertBlogPost :: BlogPost -> DBT IO ()
insertBlogPost :: BlogPost -> DBT IO ()
insertBlogPost = forall e values (m :: * -> *).
(Entity e, ToRow values, MonadIO m) =>
values -> DBT m ()
insert @BlogPost
upsertBlogPost :: BlogPost -> Vector Field -> DBT IO ()
upsertBlogPost :: BlogPost -> Vector Field -> DBT IO ()
upsertBlogPost = forall e values (m :: * -> *).
(Entity e, ToRow values, MonadIO m) =>
values -> Vector Field -> DBT m ()
upsert @BlogPost
bulkInsertBlogPosts :: [BlogPost] -> DBT IO ()
bulkInsertBlogPosts :: [BlogPost] -> DBT IO ()
bulkInsertBlogPosts = forall e values (m :: * -> *).
(Entity e, ToRow values, MonadIO m) =>
[values] -> DBT m ()
insertMany @BlogPost
insertAuthor :: Author -> DBT IO ()
insertAuthor :: Author -> DBT IO ()
insertAuthor = forall e values (m :: * -> *).
(Entity e, ToRow values, MonadIO m) =>
values -> DBT m ()
insert @Author
bulkInsertAuthors :: [Author] -> DBT IO ()
bulkInsertAuthors :: [Author] -> DBT IO ()
bulkInsertAuthors = forall e values (m :: * -> *).
(Entity e, ToRow values, MonadIO m) =>
[values] -> DBT m ()
insertMany @Author
data Tags = Tags
{ Tags -> Text
category :: Text
, Tags -> [Text]
labels :: [Text]
}
instance Entity Tags where
tableName :: Text
tableName = Text
"tags"
schema :: Maybe Text
schema = forall a. a -> Maybe a
Just Text
"public"
primaryKey :: Field
primaryKey = [field| category |]
fields :: Vector Field
fields =
[ [field| category |]
, [field| labels |]
]