packages feed

poppy-codegen-1.0.0: test/Poppy/Codegen/golden/ShelfReadClient.hs.golden

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{- | Generated Client. Do not edit.

Nested writes live on 'create' / 'update'.
  create-time relation fields are [CreateChild | ConnectChild unique]
  update-time relation fields are Maybe <Rel>Update (replaceWith, create, connect, delete, update, upsert;
  disconnect when the child foreign key is nullable)
-}
module Schema.Client.Shelf
  ( findMany,
    findUnique,
    findUniqueOrFail,
    findFirst,
    findFirstOrFail,
    count,
    create,
    createMany,
    update,
    updateMany,
    upsert,
    delete,
    deleteMany,
    ShelfCreateScalars,
    ShelfUpdateScalars,
    BookNestedCreate (..),
    BookNestedUpsert (..),
    BooksUpdate (..),
    emptyBooksUpdate,
    TagNestedCreate (..),
    TagNestedUpsert (..),
    TagsUpdate (..),
    emptyTagsUpdate,
    ShelfQuery (..),
    ShelfUnique (..),
    ShelfUniqueKey (..),
    ShelfUniqueQuery (..),
    emptyQuery,
    uniqueQuery,
    shelfUniqueWhere,
    OmitSelect (..),
    Picked (..),
    ShelfCreate (..),
    ShelfRow (..),
    ShelfSelect (..),
    ShelfPicked (..),
    shelfSelect,
    ShelfUpdate (..),
    ShelfTable,
    shelfId
  )
where

import Data.Maybe (isJust)
import Data.Text (Text)
import Data.UUID (UUID)
import Poppy.Internal.Generated
  ( Db,
    transactionEither,
    fieldColumn,
    toField,
    ORMError (..),
    fromUniqueRows,
    requireFound,
    uniqueOrFail,
    OrderBy,
    applyQueryModifiers,
    matching,
    selectColumns,
    OmitSelect (..),
    Picked (..),
    prepareIncludeRootQuery,
    Where,
    and_,
    eq
  )
import qualified Poppy.Internal.Generated as Delete
  ( deleteMany,
    deleteWhere,
    whereDelete,
    emptyDelete
  )
import qualified Poppy.Internal.Generated as Insert
  ( insert,
    insertMany,
    upsert
  )
import qualified Poppy.Internal.Generated as Ops
  ( findMany,
    findManyWith,
    findFirst,
    findFirstWith,
    count
  )
import qualified Poppy.Internal.Generated as Update
  ( updateWhere,
    updateMany
  )

import Schema.Shelf (ShelfRow (..), ShelfSelect (..), ShelfPicked (..), shelfSelect, shelfSelectColumns, parseShelfPicked, ShelfTable, shelfId)
import qualified Schema.Shelf as ShelfSchema (ShelfCreate (..), ShelfUpdate (..))

import Schema.Include.Shelf (LoadShelf (..), ShelfInclude (..), ShelfRead, toShelfWithPicked)
import Schema.Book (BookRow (..), BookTable, bookId, bookShelfId, BookCreate (..), BookUpdate (..))
import Schema.Tag (TagRow (..), TagTable, tagId, tagShelfId, TagCreate (..), TagUpdate (..))
import qualified Schema.Client.Book as Book (BookUnique (..), bookUniqueWhere)
import qualified Schema.Client.Tag as Tag (TagUnique (..), tagUniqueWhere)

data ShelfUnique
  = ById UUID
  deriving (Eq, Show)

data ShelfUniqueKey
  = OnId
  deriving (Eq, Show)

shelfUniqueWhere :: ShelfUnique -> Where ShelfTable
shelfUniqueWhere = \case
  ById v1 -> eq shelfId v1

shelfConflictCols :: ShelfUniqueKey -> [Text]
shelfConflictCols = \case
  OnId -> ["id"]

data BookNestedCreate
  = CreateBook
      { id :: Maybe UUID, title :: Text
      }
  | ConnectBook Book.BookUnique
  deriving (Show, Eq)
data TagNestedCreate
  = CreateTag
      { id :: Maybe UUID, label :: Text
      }
  | ConnectTag Tag.TagUnique
  deriving (Show, Eq)
data BookNestedUpsert = BookNestedUpsert
  { where_ :: Book.BookUnique
  , create :: BookNestedCreate
  , update :: BookUpdate
  }
  deriving (Show, Eq)
data TagNestedUpsert = TagNestedUpsert
  { where_ :: Tag.TagUnique
  , create :: TagNestedCreate
  , update :: TagUpdate
  }
  deriving (Show, Eq)
data BooksUpdate = BooksUpdate
  { replaceWith :: Maybe [BookNestedCreate]
  , create :: [BookNestedCreate]
  , createMany :: [BookNestedCreate]
  , connect :: [Book.BookUnique]
  , delete :: [Book.BookUnique]
  , update :: [(Book.BookUnique, BookUpdate)]
  , upsert :: [BookNestedUpsert]
  }
  deriving (Show, Eq)

emptyBooksUpdate :: BooksUpdate
emptyBooksUpdate =
  BooksUpdate
    { replaceWith = Nothing
    , create = []
    , createMany = []
    , connect = []
    , delete = []
    , update = []
    , upsert = []
    }
data TagsUpdate = TagsUpdate
  { replaceWith :: Maybe [TagNestedCreate]
  , create :: [TagNestedCreate]
  , createMany :: [TagNestedCreate]
  , connect :: [Tag.TagUnique]
  , delete :: [Tag.TagUnique]
  , update :: [(Tag.TagUnique, TagUpdate)]
  , upsert :: [TagNestedUpsert]
  }
  deriving (Show, Eq)

emptyTagsUpdate :: TagsUpdate
emptyTagsUpdate =
  TagsUpdate
    { replaceWith = Nothing
    , create = []
    , createMany = []
    , connect = []
    , delete = []
    , update = []
    , upsert = []
    }
data ShelfCreate = ShelfCreate
  { id :: Maybe UUID,
    name :: Text,
    books :: [BookNestedCreate],
    tags :: [TagNestedCreate]
  }
  deriving (Show, Eq)

type ShelfCreateScalars = ShelfSchema.ShelfCreate

toShelfCreateScalars :: ShelfCreate -> ShelfCreateScalars
toShelfCreateScalars input =
  ShelfSchema.ShelfCreate
    { id = input.id,
      name = input.name
    }
data ShelfUpdate = ShelfUpdate
  { name :: Maybe Text,
    books :: Maybe BooksUpdate,
    tags :: Maybe TagsUpdate
  }
  deriving (Show, Eq)

type ShelfUpdateScalars = ShelfSchema.ShelfUpdate

toShelfUpdateScalars :: ShelfUpdate -> ShelfUpdateScalars
toShelfUpdateScalars input =
  ShelfSchema.ShelfUpdate
    { name = input.name
    }

create :: ShelfCreate -> Db (Either ORMError ShelfRow)
create input =
  if hasShelfNestedCreate input
    then transactionEither (createWithNested input)
    else Insert.insert @ShelfTable @ShelfRow (toShelfCreateScalars input)

hasShelfNestedCreate :: ShelfCreate -> Bool
hasShelfNestedCreate input =
  not (null input.books) || not (null input.tags)

createWithNested :: ShelfCreate -> Db (Either ORMError ShelfRow)
createWithNested input = do
  rootResult <- Insert.insert @ShelfTable @ShelfRow (toShelfCreateScalars input)
  case rootResult of
    Left err -> pure (Left err)
    Right row -> do
      nestedResult <-
        sequenceNested
          [ applyBooksCreate row.id input.books
          , applyTagsCreate row.id input.tags
          ]
      case nestedResult of
        Left err -> pure (Left err)
        Right () -> pure (Right row)

createMany :: [ShelfCreateScalars] -> Db (Either ORMError Int)
createMany = Insert.insertMany @ShelfTable

update :: ShelfUnique -> ShelfUpdate -> Db (Either ORMError ShelfRow)
update key input =
  if hasShelfNestedUpdate input
    then transactionEither (updateWithNested key input)
    else Update.updateWhere @ShelfTable @ShelfRow (shelfUniqueWhere key) (toShelfUpdateScalars input)

hasShelfNestedUpdate :: ShelfUpdate -> Bool
hasShelfNestedUpdate input =
  isJust input.books || isJust input.tags

updateWithNested :: ShelfUnique -> ShelfUpdate -> Db (Either ORMError ShelfRow)
updateWithNested key input = do
  updateResult <- Update.updateWhere @ShelfTable @ShelfRow (shelfUniqueWhere key) (toShelfUpdateScalars input)
  case updateResult of
    Left err -> pure (Left err)
    Right row -> do
      nestedResult <-
        sequenceNested
          [ maybe (pure (Right ())) (applyBooksUpdate row.id) input.books
          , maybe (pure (Right ())) (applyTagsUpdate row.id) input.tags
          ]
      case nestedResult of
        Left err -> pure (Left err)
        Right () -> pure (Right row)

updateMany :: Where ShelfTable -> ShelfUpdateScalars -> Db (Either ORMError Int)
updateMany = Update.updateMany @ShelfTable

upsert :: ShelfUniqueKey -> ShelfCreateScalars -> ShelfUpdateScalars -> Db (Either ORMError ShelfRow)
upsert key createInput updateInput =
  Insert.upsert @ShelfTable @ShelfRow (shelfConflictCols key) createInput updateInput

sequenceNested :: [Db (Either ORMError ())] -> Db (Either ORMError ())
sequenceNested [] = pure (Right ())
sequenceNested (action : rest) = do
  result <- action
  case result of
    Left err -> pure (Left err)
    Right () -> sequenceNested rest
applyBooksCreate :: UUID -> [BookNestedCreate] -> Db (Either ORMError ())
applyBooksCreate = insertBooks
applyBooksUpdate :: UUID -> BooksUpdate -> Db (Either ORMError ())
applyBooksUpdate parentId ops = do
  replaced <- case ops.replaceWith of
    Nothing -> pure (Right ())
    Just items -> replaceBooks parentId items
  case replaced of
    Left err -> pure (Left err)
    Right () ->
      sequenceNested
        [ deleteBooks parentId ops.delete
        , updateBooksRows parentId ops.update
        , upsertBooks parentId ops.upsert
        , insertBooks parentId ops.create
        , insertBooks parentId ops.createMany
        , connectBooks parentId ops.connect
        ]
replaceBooks :: UUID -> [BookNestedCreate] -> Db (Either ORMError ())
replaceBooks parentId items = do
  result <-
    Delete.deleteWhere $
      Delete.whereDelete (fieldColumn bookShelfId <> " = ?") [toField parentId] (Delete.emptyDelete @BookTable)
  case result of
    Left err -> pure (Left err)
    Right _ -> insertBooks parentId items
insertBooks :: UUID -> [BookNestedCreate] -> Db (Either ORMError ())
insertBooks parentId = go
  where
    go [] = pure (Right ())
    go (nested : rest) = do
      result <- case nested of
        ConnectBook key -> connectBooks parentId [key]
        CreateBook {id, title} -> do
          inserted <- Insert.insert @BookTable @BookRow BookCreate
            { id = id,
              title = title,
              shelfId = parentId
            }
          pure $ case inserted of
            Left err -> Left err
            Right _ -> Right ()
      case result of
        Left err -> pure (Left err)
        Right () -> go rest
deleteBooks :: UUID -> [Book.BookUnique] -> Db (Either ORMError ())
deleteBooks _ [] = pure (Right ())
deleteBooks parentId keys = sequenceNested (map deleteOne keys)
  where
    deleteOne key = do
      result <- Delete.deleteMany @BookTable
        (Book.bookUniqueWhere key `and_` eq bookShelfId parentId)
      pure $ case result of
        Left err -> Left err
        Right _ -> Right ()
updateBooksRows :: UUID -> [(Book.BookUnique, BookUpdate)] -> Db (Either ORMError ())
updateBooksRows parentId = go
  where
    go [] = pure (Right ())
    go ((key, nested) : rest) = do
      let patched = BookUpdate { shelfId = Nothing, title = nested.title }
      result <-
        Update.updateWhere @BookTable @BookRow
          (Book.bookUniqueWhere key `and_` eq bookShelfId parentId)
          patched
      case result of
        Left err -> pure (Left err)
        Right _ -> go rest
upsertBooks :: UUID -> [BookNestedUpsert] -> Db (Either ORMError ())
upsertBooks parentId = go
  where
    go [] = pure (Right ())
    go (item : rest) = do
      existing <- Ops.findMany @BookTable @BookRow (matching (Book.bookUniqueWhere item.where_))
      result <- case fromUniqueRows existing of
        Left err -> pure (Left err)
        Right Nothing -> insertBooks parentId [item.create]
        Right (Just row) ->
          if row.shelfId == parentId
            then do
              let patched = BookUpdate { shelfId = Nothing, title = item.update.title }
              updated <-
                Update.updateWhere @BookTable @BookRow
                  (Book.bookUniqueWhere item.where_ `and_` eq bookShelfId parentId)
                  patched
              pure $ case updated of
                Left err -> Left err
                Right _ -> Right ()
            else pure (Left (UniqueViolation "nested upsert would reparent a row owned by another parent"))
      case result of
        Left err -> pure (Left err)
        Right () -> go rest
connectBooks :: UUID -> [Book.BookUnique] -> Db (Either ORMError ())
connectBooks _ [] = pure (Right ())
connectBooks parentId keys = sequenceNested (map connectOne keys)
  where
    connectOne key = do
      result <-
        Update.updateWhere @BookTable @BookRow
          (Book.bookUniqueWhere key)
          (BookUpdate
            { shelfId = Just parentId,
              title = Nothing
            })
      pure $ case result of
        Left err -> Left err
        Right _ -> Right ()
applyTagsCreate :: UUID -> [TagNestedCreate] -> Db (Either ORMError ())
applyTagsCreate = insertTags
applyTagsUpdate :: UUID -> TagsUpdate -> Db (Either ORMError ())
applyTagsUpdate parentId ops = do
  replaced <- case ops.replaceWith of
    Nothing -> pure (Right ())
    Just items -> replaceTags parentId items
  case replaced of
    Left err -> pure (Left err)
    Right () ->
      sequenceNested
        [ deleteTags parentId ops.delete
        , updateTagsRows parentId ops.update
        , upsertTags parentId ops.upsert
        , insertTags parentId ops.create
        , insertTags parentId ops.createMany
        , connectTags parentId ops.connect
        ]
replaceTags :: UUID -> [TagNestedCreate] -> Db (Either ORMError ())
replaceTags parentId items = do
  result <-
    Delete.deleteWhere $
      Delete.whereDelete (fieldColumn tagShelfId <> " = ?") [toField parentId] (Delete.emptyDelete @TagTable)
  case result of
    Left err -> pure (Left err)
    Right _ -> insertTags parentId items
insertTags :: UUID -> [TagNestedCreate] -> Db (Either ORMError ())
insertTags parentId = go
  where
    go [] = pure (Right ())
    go (nested : rest) = do
      result <- case nested of
        ConnectTag key -> connectTags parentId [key]
        CreateTag {id, label} -> do
          inserted <- Insert.insert @TagTable @TagRow TagCreate
            { id = id,
              label = label,
              shelfId = parentId
            }
          pure $ case inserted of
            Left err -> Left err
            Right _ -> Right ()
      case result of
        Left err -> pure (Left err)
        Right () -> go rest
deleteTags :: UUID -> [Tag.TagUnique] -> Db (Either ORMError ())
deleteTags _ [] = pure (Right ())
deleteTags parentId keys = sequenceNested (map deleteOne keys)
  where
    deleteOne key = do
      result <- Delete.deleteMany @TagTable
        (Tag.tagUniqueWhere key `and_` eq tagShelfId parentId)
      pure $ case result of
        Left err -> Left err
        Right _ -> Right ()
updateTagsRows :: UUID -> [(Tag.TagUnique, TagUpdate)] -> Db (Either ORMError ())
updateTagsRows parentId = go
  where
    go [] = pure (Right ())
    go ((key, nested) : rest) = do
      let patched = TagUpdate { shelfId = Nothing, label = nested.label }
      result <-
        Update.updateWhere @TagTable @TagRow
          (Tag.tagUniqueWhere key `and_` eq tagShelfId parentId)
          patched
      case result of
        Left err -> pure (Left err)
        Right _ -> go rest
upsertTags :: UUID -> [TagNestedUpsert] -> Db (Either ORMError ())
upsertTags parentId = go
  where
    go [] = pure (Right ())
    go (item : rest) = do
      existing <- Ops.findMany @TagTable @TagRow (matching (Tag.tagUniqueWhere item.where_))
      result <- case fromUniqueRows existing of
        Left err -> pure (Left err)
        Right Nothing -> insertTags parentId [item.create]
        Right (Just row) ->
          if row.shelfId == parentId
            then do
              let patched = TagUpdate { shelfId = Nothing, label = item.update.label }
              updated <-
                Update.updateWhere @TagTable @TagRow
                  (Tag.tagUniqueWhere item.where_ `and_` eq tagShelfId parentId)
                  patched
              pure $ case updated of
                Left err -> Left err
                Right _ -> Right ()
            else pure (Left (UniqueViolation "nested upsert would reparent a row owned by another parent"))
      case result of
        Left err -> pure (Left err)
        Right () -> go rest
connectTags :: UUID -> [Tag.TagUnique] -> Db (Either ORMError ())
connectTags _ [] = pure (Right ())
connectTags parentId keys = sequenceNested (map connectOne keys)
  where
    connectOne key = do
      result <-
        Update.updateWhere @TagTable @TagRow
          (Tag.tagUniqueWhere key)
          (TagUpdate
            { shelfId = Just parentId,
              label = Nothing
            })
      pure $ case result of
        Left err -> Left err
        Right _ -> Right ()

data ShelfQuery include select = ShelfQuery
  { include_ :: include
  , select_ :: select
  , where_ :: Maybe (Where ShelfTable)
  , orderBy_ :: [OrderBy ShelfTable]
  , limit_ :: Maybe Int
  , offset_ :: Maybe Int
  }

data ShelfUniqueQuery include select = ShelfUniqueQuery
  { include_ :: include
  , select_ :: select
  , where_ :: ShelfUnique
  }

emptyQuery :: ShelfQuery () OmitSelect
emptyQuery =
  ShelfQuery {include_ = (), select_ = OmitSelect, where_ = Nothing, orderBy_ = [], limit_ = Nothing, offset_ = Nothing}

uniqueQuery :: ShelfUnique -> ShelfUniqueQuery () OmitSelect
uniqueQuery key =
  ShelfUniqueQuery {include_ = (), select_ = OmitSelect, where_ = key}

class ReadShelf include select where
  findMany :: ShelfQuery include select -> Db [ShelfRead include select]
  findUnique :: ShelfUniqueQuery include select -> Db (Either ORMError (Maybe (ShelfRead include select)))
  findUniqueOrFail :: ShelfUniqueQuery include select -> Db (Either ORMError (ShelfRead include select))
  findFirst :: ShelfQuery include select -> Db (Maybe (ShelfRead include select))
  findFirstOrFail :: ShelfQuery include select -> Db (Either ORMError (ShelfRead include select))

instance (LoadShelf books tags) => ReadShelf (ShelfInclude books tags) OmitSelect where
  findMany ShelfQuery {include_, where_, orderBy_, limit_, offset_} = do
    roots <- Ops.findMany @ShelfTable @ShelfRow (prepareIncludeRootQuery @ShelfTable (applyQueryModifiers where_ orderBy_ limit_ offset_))
    loadShelf include_ roots
  findUnique ShelfUniqueQuery {where_, include_} = do
    let w = shelfUniqueWhere where_
    roots <- Ops.findMany @ShelfTable @ShelfRow (prepareIncludeRootQuery @ShelfTable (matching w))
    rows <- loadShelf include_ roots
    pure (fromUniqueRows rows)
  findUniqueOrFail q = uniqueOrFail <$> findUnique q
  findFirst ShelfQuery {include_, where_, orderBy_, offset_} = do
    roots <- Ops.findMany @ShelfTable @ShelfRow (prepareIncludeRootQuery @ShelfTable (applyQueryModifiers where_ orderBy_ (Just 1) offset_))
    loaded <- loadShelf include_ roots
    pure $ case loaded of
      [] -> Nothing
      (row : _) -> Just row
  findFirstOrFail q = do
    result <- findFirst q
    pure $ requireFound result (RecordNotFound "No record found matching query")

instance ReadShelf () OmitSelect where
  findMany ShelfQuery {where_, orderBy_, limit_, offset_} =
    Ops.findMany @ShelfTable @ShelfRow (applyQueryModifiers where_ orderBy_ limit_ offset_)
  findUnique ShelfUniqueQuery {where_} = do
    let w = shelfUniqueWhere where_
    rows <- Ops.findMany @ShelfTable @ShelfRow (matching w)
    pure (fromUniqueRows rows)
  findUniqueOrFail q = uniqueOrFail <$> findUnique q
  findFirst ShelfQuery {where_, orderBy_, limit_, offset_} =
    Ops.findFirst @ShelfTable @ShelfRow (applyQueryModifiers where_ orderBy_ limit_ offset_)
  findFirstOrFail q = do
    result <- findFirst q
    pure $ requireFound result (RecordNotFound "No record found matching query")

instance (LoadShelf books tags) => ReadShelf (ShelfInclude books tags) ShelfSelect where
  findMany ShelfQuery {include_, select_, where_, orderBy_, limit_, offset_} = do
    roots <- Ops.findMany @ShelfTable @ShelfRow (prepareIncludeRootQuery @ShelfTable (applyQueryModifiers where_ orderBy_ limit_ offset_))
    loaded <- loadShelf include_ roots
    pure $ map (toShelfWithPicked select_) loaded
  findUnique ShelfUniqueQuery {where_, include_, select_} = do
    let w = shelfUniqueWhere where_
    roots <- Ops.findMany @ShelfTable @ShelfRow (prepareIncludeRootQuery @ShelfTable (matching w))
    loaded <- loadShelf include_ roots
    let rows = map (toShelfWithPicked select_) loaded
    pure (fromUniqueRows rows)
  findUniqueOrFail q = uniqueOrFail <$> findUnique q
  findFirst ShelfQuery {select_, include_, where_, orderBy_, offset_} = do
    roots <- Ops.findMany @ShelfTable @ShelfRow (prepareIncludeRootQuery @ShelfTable (applyQueryModifiers where_ orderBy_ (Just 1) offset_))
    loaded <- loadShelf include_ roots
    pure $ case loaded of
      [] -> Nothing
      (row : _) -> Just (toShelfWithPicked select_ row)
  findFirstOrFail q = do
    result <- findFirst q
    pure $ requireFound result (RecordNotFound "No record found matching query")

instance ReadShelf () ShelfSelect where
  findMany ShelfQuery {select_, where_, orderBy_, limit_, offset_} =
    Ops.findManyWith
      (parseShelfPicked select_)
      (selectColumns (shelfSelectColumns select_) . applyQueryModifiers where_ orderBy_ limit_ offset_)
  findUnique ShelfUniqueQuery {where_, select_} = do
    let w = shelfUniqueWhere where_
    rows <-
      Ops.findManyWith
        (parseShelfPicked select_)
        (selectColumns (shelfSelectColumns select_) . matching w)
    pure (fromUniqueRows rows)
  findUniqueOrFail q = uniqueOrFail <$> findUnique q
  findFirst ShelfQuery {select_, where_, orderBy_, limit_, offset_} =
    Ops.findFirstWith
      (parseShelfPicked select_)
      (selectColumns (shelfSelectColumns select_) . applyQueryModifiers where_ orderBy_ limit_ offset_)
  findFirstOrFail q = do
    result <- findFirst q
    pure $ requireFound result (RecordNotFound "No record found matching query")

count :: ShelfQuery include select -> Db Int
count ShelfQuery {where_, orderBy_, limit_, offset_} =
  Ops.count @ShelfTable (applyQueryModifiers where_ orderBy_ limit_ offset_)

delete :: ShelfUnique -> Db (Either ORMError Int)
delete key =
  Delete.deleteMany @ShelfTable (shelfUniqueWhere key)

deleteMany :: Where ShelfTable -> Db (Either ORMError Int)
deleteMany = Delete.deleteMany @ShelfTable