{-# 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
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

-- | Author data-type
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

-- | Wrapper around the UUID type
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[]")]

{-| 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
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 |]
    ]

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

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