{-# 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 (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 Database.PostgreSQL.Entity (insert)
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, 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, 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 (Text
Vector Field
Field
Text -> Field -> Vector Field -> Entity Author
forall e. Text -> Field -> Vector Field -> Entity e
fields :: Vector Field
$cfields :: Vector Field
primaryKey :: Field
$cprimaryKey :: Field
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, 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

-- | 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 -> Vector UUID
uuidList   :: Vector UUID
               -- ^ 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, 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 :: uuid[] |]
           , [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

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