{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StrictData #-}

-- |
--  Module      : Database.PostgreSQL.Entity.Internal.BlogPost
--  Copyright   : © Clément Delafargue, 2018
--                  Théophile Choutri, 2021
--                  Koz Ross, 2021
--  License     : MIT
--  Maintainer  : theophile@choutri.eu
--  Stability   : stable
--
--  Adapted from Clément Delafargue's [Yet Another Unsafe DB Layer](https://tech.fretlink.com/yet-another-unsafe-db-layer/)
--  article.
--
--  The models described in this module are used throughout the library's tests and docspecs.
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)

-- | Wrapper around the UUID type
newtype AuthorId = AuthorId {AuthorId -> UUID
getAuthorId :: UUID}
  deriving
    (AuthorId -> AuthorId -> Bool
(AuthorId -> AuthorId -> Bool)
-> (AuthorId -> AuthorId -> Bool) -> Eq AuthorId
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
FieldParser AuthorId -> FromField AuthorId
forall a. FieldParser a -> FromField a
fromField :: FieldParser AuthorId
$cfromField :: FieldParser AuthorId
FromField, Eq AuthorId
Eq AuthorId
-> (AuthorId -> AuthorId -> Ordering)
-> (AuthorId -> AuthorId -> Bool)
-> (AuthorId -> AuthorId -> Bool)
-> (AuthorId -> AuthorId -> Bool)
-> (AuthorId -> AuthorId -> Bool)
-> (AuthorId -> AuthorId -> AuthorId)
-> (AuthorId -> AuthorId -> AuthorId)
-> Ord 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
$cp1Ord :: Eq AuthorId
Ord, Int -> AuthorId -> ShowS
[AuthorId] -> ShowS
AuthorId -> String
(Int -> AuthorId -> ShowS)
-> (AuthorId -> String) -> ([AuthorId] -> ShowS) -> Show AuthorId
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
(AuthorId -> Action) -> ToField AuthorId
forall a. (a -> Action) -> ToField a
toField :: AuthorId -> Action
$ctoField :: AuthorId -> Action
ToField)
    via UUID

-- | Author data-type
data Author = Author
  { Author -> AuthorId
authorId :: AuthorId
  , Author -> Text
name :: Text
  , Author -> UTCTime
createdAt :: UTCTime
  }
  deriving stock (Author -> Author -> Bool
(Author -> Author -> Bool)
-> (Author -> Author -> Bool) -> Eq Author
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. Author -> Rep Author x)
-> (forall x. Rep Author x -> Author) -> Generic Author
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
Eq Author
-> (Author -> Author -> Ordering)
-> (Author -> Author -> Bool)
-> (Author -> Author -> Bool)
-> (Author -> Author -> Bool)
-> (Author -> Author -> Bool)
-> (Author -> Author -> Author)
-> (Author -> Author -> Author)
-> Ord 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
$cp1Ord :: Eq Author
Ord, Int -> Author -> ShowS
[Author] -> ShowS
Author -> String
(Int -> Author -> ShowS)
-> (Author -> String) -> ([Author] -> ShowS) -> Show Author
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
RowParser Author -> FromRow Author
forall a. RowParser a -> FromRow a
fromRow :: RowParser Author
$cfromRow :: RowParser Author
FromRow, Author -> [Action]
(Author -> [Action]) -> ToRow Author
forall a. (a -> [Action]) -> ToRow a
toRow :: Author -> [Action]
$ctoRow :: Author -> [Action]
ToRow)
  deriving
    (Maybe Text
Text
Vector Field
Field
Text -> Maybe Text -> Field -> Vector Field -> Entity Author
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
forall r a. HasField x r a => r -> a
getField @x

-- | Wrapper around the UUID type
newtype BlogPostId = BlogPostId {BlogPostId -> UUID
getBlogPostId :: UUID}
  deriving
    (BlogPostId -> BlogPostId -> Bool
(BlogPostId -> BlogPostId -> Bool)
-> (BlogPostId -> BlogPostId -> Bool) -> Eq BlogPostId
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
FieldParser BlogPostId -> FromField BlogPostId
forall a. FieldParser a -> FromField a
fromField :: FieldParser BlogPostId
$cfromField :: FieldParser BlogPostId
FromField, Eq BlogPostId
Eq BlogPostId
-> (BlogPostId -> BlogPostId -> Ordering)
-> (BlogPostId -> BlogPostId -> Bool)
-> (BlogPostId -> BlogPostId -> Bool)
-> (BlogPostId -> BlogPostId -> Bool)
-> (BlogPostId -> BlogPostId -> Bool)
-> (BlogPostId -> BlogPostId -> BlogPostId)
-> (BlogPostId -> BlogPostId -> BlogPostId)
-> Ord 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
$cp1Ord :: Eq BlogPostId
Ord, Int -> BlogPostId -> ShowS
[BlogPostId] -> ShowS
BlogPostId -> String
(Int -> BlogPostId -> ShowS)
-> (BlogPostId -> String)
-> ([BlogPostId] -> ShowS)
-> Show BlogPostId
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
(BlogPostId -> Action) -> ToField BlogPostId
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. UUIDList -> Rep UUIDList x)
-> (forall x. Rep UUIDList x -> UUIDList) -> Generic UUIDList
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
(Int -> UUIDList -> ShowS)
-> (UUIDList -> String) -> ([UUIDList] -> ShowS) -> Show UUIDList
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
(UUIDList -> UUIDList -> Bool)
-> (UUIDList -> UUIDList -> Bool) -> Eq UUIDList
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
FieldParser UUIDList -> FromField UUIDList
forall a. FieldParser a -> FromField a
fromField :: FieldParser UUIDList
$cfromField :: FieldParser UUIDList
FromField, Eq UUIDList
Eq UUIDList
-> (UUIDList -> UUIDList -> Ordering)
-> (UUIDList -> UUIDList -> Bool)
-> (UUIDList -> UUIDList -> Bool)
-> (UUIDList -> UUIDList -> Bool)
-> (UUIDList -> UUIDList -> Bool)
-> (UUIDList -> UUIDList -> UUIDList)
-> (UUIDList -> UUIDList -> UUIDList)
-> Ord 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
$cp1Ord :: Eq UUIDList
Ord)
    via Vector UUID

instance ToField UUIDList where
  toField :: UUIDList -> Action
toField (UUIDList Vector UUID
vec) =
    if Vector UUID -> Bool
forall a. Vector a -> Bool
Vector.null Vector UUID
vec
      then Builder -> Action
Plain (ByteString -> Builder
byteString ByteString
"'{}'")
      else
        [Action] -> Action
Many ([Action] -> Action) -> [Action] -> Action
forall a b. (a -> b) -> a -> b
$
          Builder -> Action
Plain (ByteString -> Builder
byteString ByteString
"ARRAY[")
            Action -> [Action] -> [Action]
forall a. a -> [a] -> [a]
: (Action -> [Action] -> [Action]
forall a. a -> [a] -> [a]
List.intersperse (Builder -> Action
Plain (Char -> Builder
char8 Char
',')) ([Action] -> [Action])
-> ([UUID] -> [Action]) -> [UUID] -> [Action]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UUID -> Action) -> [UUID] -> [Action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UUID -> Action
forall a. ToField a => a -> Action
toField ([UUID] -> [Action]) -> [UUID] -> [Action]
forall a b. (a -> b) -> a -> b
$ Vector UUID -> [UUID]
forall a. Vector a -> [a]
Vector.toList Vector UUID
vec)
            [Action] -> [Action] -> [Action]
forall a. [a] -> [a] -> [a]
++ [Builder -> Action
Plain (Char -> Builder
char8 Char
']')]
            [Action] -> [Action] -> [Action]
forall a. [a] -> [a] -> [a]
++ [Builder -> Action
Plain (ByteString -> Builder
byteString ByteString
" :: uuid[]")]

-- | The BlogPost data-type. Look at its 'Entity' instance declaration for how to handle
-- a "uuid[]" PostgreSQL type.
data BlogPost = BlogPost
  { BlogPost -> BlogPostId
blogPostId :: BlogPostId
  -- ^ Primary key
  , BlogPost -> AuthorId
authorId :: AuthorId
  -- ^ Foreign keys, for which we need an explicit type annotation
  , BlogPost -> UUIDList
uuidList :: UUIDList
  -- ^ A type that will need an explicit type annotation in the schema
  , BlogPost -> Text
title :: Text
  , BlogPost -> Text
content :: Text
  , BlogPost -> UTCTime
createdAt :: UTCTime
  }
  deriving stock (BlogPost -> BlogPost -> Bool
(BlogPost -> BlogPost -> Bool)
-> (BlogPost -> BlogPost -> Bool) -> Eq BlogPost
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. BlogPost -> Rep BlogPost x)
-> (forall x. Rep BlogPost x -> BlogPost) -> Generic BlogPost
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
Eq BlogPost
-> (BlogPost -> BlogPost -> Ordering)
-> (BlogPost -> BlogPost -> Bool)
-> (BlogPost -> BlogPost -> Bool)
-> (BlogPost -> BlogPost -> Bool)
-> (BlogPost -> BlogPost -> Bool)
-> (BlogPost -> BlogPost -> BlogPost)
-> (BlogPost -> BlogPost -> BlogPost)
-> Ord 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
$cp1Ord :: Eq BlogPost
Ord, Int -> BlogPost -> ShowS
[BlogPost] -> ShowS
BlogPost -> String
(Int -> BlogPost -> ShowS)
-> (BlogPost -> String) -> ([BlogPost] -> ShowS) -> Show BlogPost
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
RowParser BlogPost -> FromRow BlogPost
forall a. RowParser a -> FromRow a
fromRow :: RowParser BlogPost
$cfromRow :: RowParser BlogPost
FromRow, BlogPost -> [Action]
(BlogPost -> [Action]) -> ToRow BlogPost
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
forall 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 |]
    ]

-- | A specialisation of the 'Database.PostgreSQL.Entity.insert' function.
-- @insertBlogPost = insert \@BlogPost@
insertBlogPost :: BlogPost -> DBT IO ()
insertBlogPost :: BlogPost -> DBT IO ()
insertBlogPost = forall e values (m :: * -> *).
(Entity e, ToRow values, MonadIO m) =>
values -> DBT m ()
forall values (m :: * -> *).
(Entity BlogPost, 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 ()
forall values (m :: * -> *).
(Entity BlogPost, ToRow values, MonadIO m) =>
values -> Vector Field -> DBT m ()
upsert @BlogPost

-- | A function to insert many blogposts at once.
bulkInsertBlogPosts :: [BlogPost] -> DBT IO ()
bulkInsertBlogPosts :: [BlogPost] -> DBT IO ()
bulkInsertBlogPosts = forall e values (m :: * -> *).
(Entity e, ToRow values, MonadIO m) =>
[values] -> DBT m ()
forall values (m :: * -> *).
(Entity BlogPost, ToRow values, MonadIO m) =>
[values] -> DBT m ()
insertMany @BlogPost

-- | A specialisation of the 'Database.PostgreSQL.Entity.insert function.
-- @insertAuthor = insert \@Author@
insertAuthor :: Author -> DBT IO ()
insertAuthor :: Author -> DBT IO ()
insertAuthor = forall e values (m :: * -> *).
(Entity e, ToRow values, MonadIO m) =>
values -> DBT m ()
forall values (m :: * -> *).
(Entity Author, ToRow values, MonadIO m) =>
values -> DBT m ()
insert @Author

--

-- | A function to insert many authors at once.
bulkInsertAuthors :: [Author] -> DBT IO ()
bulkInsertAuthors :: [Author] -> DBT IO ()
bulkInsertAuthors = forall e values (m :: * -> *).
(Entity e, ToRow values, MonadIO m) =>
[values] -> DBT m ()
forall values (m :: * -> *).
(Entity Author, 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 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"public"
  primaryKey :: Field
primaryKey = [field| category |]
  fields :: Vector Field
fields =
    [ [field| category |]
    , [field| labels |]
    ]