wikimusic-api-1.1.0.1: src/WikiMusic/PostgreSQL/SongCommand.hs
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module WikiMusic.PostgreSQL.SongCommand () where
import Data.Map qualified as Map
import Data.Text (pack)
import Hasql.Decoders as D
import Hasql.Encoders as E
import Hasql.Pool qualified
import Hasql.Statement (Statement (..))
import Relude
import WikiMusic.Free.SongCommand
import WikiMusic.Interaction.Model.Song
import WikiMusic.Model.Artwork
import WikiMusic.Model.Comment
import WikiMusic.Model.Opinion
import WikiMusic.Model.Song
import WikiMusic.PostgreSQL.ReadAbstraction
import WikiMusic.PostgreSQL.WriteAbstraction
import WikiMusic.Protolude
insertArtistsOfSongs' :: (MonadIO m) => Env -> [ArtistOfSong] -> m (Map UUID ArtistOfSong)
insertArtistsOfSongs' env items = do
mapM_ (hasqlTransaction (env ^. #pool) stmt . toRow) items
pure $ Map.fromList $ map (\x -> (x ^. #identifier, x)) items
where
toRow x =
( x ^. #identifier,
x ^. #songIdentifier,
x ^. #artistIdentifier,
x ^. #createdAt,
x ^. #createdBy
)
bindParams' = bindParams 5
encoder =
contrazip5
(E.param . E.nonNullable $ E.uuid)
(E.param . E.nonNullable $ E.uuid)
(E.param . E.nonNullable $ E.uuid)
(E.param . E.nonNullable $ E.timestamptz)
(E.param . E.nonNullable $ E.uuid)
stmt = Statement query encoder D.noResult True
query =
encodeUtf8
[trimming|
INSERT INTO song_artists
(identifier, song_identifier, artist_identifier, created_at, created_by)
VALUES ($bindParams')
|]
insertSongs' :: (MonadIO m) => Env -> [Song] -> m (Map UUID Song)
insertSongs' env songs = do
mapM_ (hasqlTransaction (env ^. #pool) stmt . toRow) songs
now <- liftIO getCurrentTime
mapM_
( \x -> do
newUUID <- liftIO nextRandom
liftIO $ exec @SongCommand $ insertSongExternalSources env [toExternalSource x now newUUID]
)
songs
pure $ Map.fromList $ map (\x -> (x ^. #identifier, x)) songs
where
toExternalSource x now newUUID =
SongExternalSources
{ identifier = newUUID,
songIdentifier = x ^. #identifier,
spotifyUrl = x ^. #spotifyUrl,
youtubeUrl = x ^. #youtubeUrl,
soundcloudUrl = x ^. #soundcloudUrl,
wikipediaUrl = x ^. #wikipediaUrl,
createdAt = now,
createdBy = x ^. #createdBy,
lastEditedAt = Nothing
}
toRow x =
( x ^. #identifier,
x ^. #displayName,
x ^. #musicKey,
x ^. #musicTuning,
x ^. #musicCreationDate,
x ^. #albumName,
x ^. #albumInfoLink,
x ^. #createdBy,
fromIntegral $ x ^. #visibilityStatus,
x ^. #approvedBy,
x ^. #createdAt,
x ^. #lastEditedAt,
x ^. #description
)
bindParams' = bindParams 13
stmt = Statement query encoder D.noResult True
encoder =
contrazip13
(E.param . E.nonNullable $ E.uuid)
(E.param . E.nonNullable $ E.text)
(E.param . E.nullable $ E.text)
(E.param . E.nullable $ E.text)
(E.param . E.nullable $ E.text)
(E.param . E.nullable $ E.text)
(E.param . E.nullable $ E.text)
(E.param . E.nonNullable $ E.uuid)
(E.param . E.nonNullable $ E.int8)
(E.param . E.nullable $ E.uuid)
(E.param . E.nonNullable $ E.timestamptz)
(E.param . E.nullable $ E.timestamptz)
(E.param . E.nullable $ E.text)
query =
encodeUtf8
[trimming|
INSERT INTO songs
(identifier, display_name, music_key, music_tuning,
music_creation_date, album_name, album_info_link, created_by, visibility_status,
approved_by, created_at, last_edited_at, description)
VALUES ($bindParams')
|]
insertSongComments' :: (MonadIO m) => Env -> [SongComment] -> m (Map UUID SongComment)
insertSongComments' env comments = do
mapM_ (hasqlTransaction (env ^. #pool) stmt . toRow) comments
pure . fromList . map (\x -> (x ^. #comment % #identifier, x)) $ comments
where
toRow x =
( x ^. #comment % #identifier,
x ^. #songIdentifier,
x ^. #comment % #parentIdentifier,
x ^. #comment % #createdBy,
fromIntegral $ x ^. #comment % #visibilityStatus,
x ^. #comment % #contents,
x ^. #comment % #approvedBy,
x ^. #comment % #createdAt,
x ^. #comment % #lastEditedAt
)
encoder =
contrazip9
(E.param (E.nonNullable E.uuid))
(E.param (E.nonNullable E.uuid))
(E.param (E.nullable E.uuid))
(E.param (E.nonNullable E.uuid))
(E.param (E.nonNullable E.int8))
(E.param (E.nonNullable E.text))
(E.param (E.nullable E.uuid))
(E.param (E.nonNullable E.timestamptz))
(E.param (E.nullable E.timestamptz))
stmt = Statement query encoder D.noResult True
bindParams' = bindParams 9
query =
encodeUtf8
[trimming|
INSERT INTO song_comments
(identifier, song_identifier, parent_identifier, created_by,
visibility_status, contents, approved_by, created_at, last_edited_at)
VALUES ($bindParams')
|]
insertSongExternalSources' :: (MonadIO m) => Env -> [SongExternalSources] -> m (Map UUID SongExternalSources)
insertSongExternalSources' env externalSources = do
mapM_ (hasqlTransaction (env ^. #pool) stmt . toRow) externalSources
pure . fromList . map (\x -> (x ^. #identifier, x)) $ externalSources
where
stmt = Statement query encoder D.noResult True
encoder =
contrazip9
(E.param (E.nonNullable E.uuid))
(E.param (E.nonNullable E.uuid))
(E.param (E.nullable E.text))
(E.param (E.nullable E.text))
(E.param (E.nullable E.text))
(E.param (E.nullable E.text))
(E.param (E.nonNullable E.timestamptz))
(E.param (E.nullable E.timestamptz))
(E.param (E.nonNullable E.uuid))
bindParams' = bindParams 9
query =
encodeUtf8
[trimming|
INSERT INTO song_external_sources
(identifier, song_identifier, spotify_url, youtube_url,
soundcloud_url, wikipedia_url, created_at, last_edited_at, created_by)
VALUES ($bindParams')
|]
toRow x =
( x ^. #identifier,
x ^. #songIdentifier,
x ^. #spotifyUrl,
x ^. #youtubeUrl,
x ^. #soundcloudUrl,
x ^. #wikipediaUrl,
x ^. #createdAt,
x ^. #lastEditedAt,
x ^. #createdBy
)
insertSongArtworks' :: (MonadIO m) => Env -> [SongArtwork] -> m (Map UUID SongArtwork)
insertSongArtworks' env artworks = do
mapM_ (hasqlTransaction (env ^. #pool) stmt . toRow) artworks
pure . fromList . map (\x -> (x ^. #artwork % #identifier, x)) $ artworks
where
toRow x =
( x ^. #artwork % #identifier,
x ^. #songIdentifier,
x ^. #artwork % #createdBy,
fromIntegral $ x ^. #artwork % #visibilityStatus,
x ^. #artwork % #approvedBy,
x ^. #artwork % #contentUrl,
x ^. #artwork % #createdAt,
x ^. #artwork % #lastEditedAt,
x ^. #artwork % #contentCaption,
fromIntegral $ x ^. #artwork % #orderValue
)
stmt = Statement query encoder D.noResult True
encoder =
contrazip10
(E.param (E.nonNullable E.uuid))
(E.param (E.nonNullable E.uuid))
(E.param (E.nonNullable E.uuid))
(E.param (E.nonNullable E.int8))
(E.param (E.nullable E.uuid))
(E.param (E.nonNullable E.text))
(E.param (E.nonNullable E.timestamptz))
(E.param (E.nullable E.timestamptz))
(E.param (E.nullable E.text))
(E.param (E.nonNullable E.int8))
bindParams' = bindParams 10
query =
encodeUtf8
[trimming|
INSERT INTO song_artworks
(identifier, song_identifier, created_by, visibility_status,
approved_by, content_url, created_at, last_edited_at, content_caption, order_value)
VALUES ($bindParams')
|]
upsertSongOpinions' :: (MonadIO m) => Env -> [SongOpinion] -> m (Map UUID SongOpinion)
upsertSongOpinions' env opinions = do
mapM_ (hasqlTransaction (env ^. #pool) stmt . toRow) opinions
pure . fromList . map (\x -> (x ^. #opinion % #identifier, x)) $ opinions
where
bindParams' = bindParams 7
query =
encodeUtf8
[trimming|
INSERT INTO song_opinions
(identifier, song_identifier, created_by, is_like, is_dislike,
created_at, last_edited_at)
VALUES ( $bindParams' )
ON CONFLICT (song_identifier, created_by) DO
UPDATE SET is_like = $$4, is_dislike = $$5,
last_edited_at = $$6
|]
stmt = Statement query encoder D.noResult True
encoder =
contrazip7
(E.param (E.nonNullable E.uuid))
(E.param (E.nonNullable E.uuid))
(E.param (E.nonNullable E.uuid))
(E.param (E.nonNullable E.bool))
(E.param (E.nonNullable E.bool))
(E.param (E.nonNullable E.timestamptz))
(E.param (E.nullable E.timestamptz))
toRow x = do
( x ^. #opinion % #identifier,
x ^. #songIdentifier,
x ^. #opinion % #createdBy,
x ^. #opinion % #isLike,
not $ x ^. #opinion % #isLike,
x ^. #opinion % #createdAt,
x ^. #opinion % #lastEditedAt
)
deleteSongs' :: (MonadIO m) => Env -> [UUID] -> m (Either SongCommandError ())
deleteSongs' env identifiers = do
deleteArtworksOfSongsResult <- liftIO . exec @SongCommand $ deleteArtworksOfSongs env identifiers
deleteOpinionsOfSongsResult <- liftIO . exec @SongCommand $ deleteOpinionsOfSongs env identifiers
deleteCommentsOfSongsResult <- liftIO . exec @SongCommand $ deleteCommentsOfSongs env identifiers
deleteSongExternalSourcesResult <- liftIO . exec @SongCommand $ deleteSongExternalSources env identifiers
deleteSongsResult <- deleteStuffByUUID (env ^. #pool) "songs" "identifier" identifiers
deleteArtistsOfSongResult <- liftIO . exec @SongCommand $ deleteArtistsOfSongs env identifiers
deleteContentsOfSongResult <- liftIO . exec @SongCommand $ deleteContentsOfSongs env identifiers
pure $
deleteArtworksOfSongsResult
<> deleteOpinionsOfSongsResult
<> deleteSongExternalSourcesResult
<> deleteCommentsOfSongsResult
<> deleteArtistsOfSongResult
<> deleteContentsOfSongResult
<> first fromHasqlUsageError deleteSongsResult
updateSongArtworkOrder' :: (MonadIO m) => Env -> [SongArtworkOrderUpdate] -> m (Either a ())
updateSongArtworkOrder' env orderUpdates =
Right <$> mapM_ performUpdate orderUpdates
where
stmt = Statement query encoder D.noResult True
query =
encodeUtf8
[trimming|
UPDATE song_artworks SET order_value = $$2 WHERE identifier = $$1
|]
encoder =
contrazip2 (E.param . E.nonNullable $ E.uuid) (E.param . E.nonNullable $ E.int8)
toRow x = (x ^. #identifier, fromIntegral $ x ^. #orderValue)
performUpdate x = do
operationResults <- hasqlTransaction (env ^. #pool) stmt (toRow x)
pure $ first (pack . Relude.show) operationResults
updateSongs' :: (MonadIO m) => Env -> Map UUID (Song, Maybe SongDelta) -> m (Either Text ())
updateSongs' env deltas = do
liftIO $ mapM_ performUpdate deltas
exUpdate <- liftIO $ exec @SongCommand $ updateSongExternalSources env deltas
pure $ exUpdate <> Right ()
where
stmt = Statement query encoder D.noResult True
query =
encodeUtf8
[trimming|
UPDATE songs SET display_name = $$2, last_edited_at = $$3, description = $$4 WHERE identifier = $$1
|]
encoder =
contrazip4
(E.param (E.nonNullable E.uuid))
(E.param (E.nonNullable E.text))
(E.param (E.nullable E.timestamptz))
(E.param (E.nullable E.text))
toRow x xDelta now =
( x ^. #identifier,
fromMaybe (x ^. #displayName) (xDelta ^. #displayName),
Just now,
xDelta ^. #description
)
performUpdate (_, Nothing) = pure $ Right ()
performUpdate (x, Just xDelta) = do
now <- getCurrentTime
operationResults <- hasqlTransaction (env ^. #pool) stmt (toRow x xDelta now)
pure $ first (pack . Relude.show) operationResults
updateSongExternalSources' :: (MonadIO m) => Env -> Map UUID (Song, Maybe SongDelta) -> m (Either Text ())
updateSongExternalSources' env deltas =
Right <$> mapM_ performUpdate deltas
where
stmt = Statement query encoder D.noResult True
query =
encodeUtf8
[trimming|
UPDATE song_external_sources SET
spotify_url = $$2,
youtube_url = $$3,
wikipedia_url = $$4,
soundcloud_url = $$5
WHERE song_identifier = $$1
|]
encoder =
contrazip5
(E.param (E.nonNullable E.uuid))
(E.param (E.nullable E.text))
(E.param (E.nullable E.text))
(E.param (E.nullable E.text))
(E.param (E.nullable E.text))
toRow x xDelta =
( x ^. #identifier,
xDelta ^. #spotifyUrl,
xDelta ^. #youtubeUrl,
xDelta ^. #wikipediaUrl,
xDelta ^. #soundcloudUrl
)
performUpdate (_, Nothing) = pure $ Right ()
performUpdate (x, Just xDelta) = do
operationResults <- hasqlTransaction (env ^. #pool) stmt (toRow x xDelta)
pure $ first (pack . Relude.show) operationResults
newSongArtworkFromRequest' :: (MonadIO m) => UUID -> InsertSongArtworksRequestItem -> m SongArtwork
newSongArtworkFromRequest' createdBy req = do
newUUID <- liftIO nextRandom
now <- liftIO getCurrentTime
pure $
SongArtwork
{ songIdentifier = req ^. #songIdentifier,
artwork =
Artwork
{ identifier = newUUID,
createdBy = createdBy,
contentUrl = req ^. #contentUrl,
contentCaption = req ^. #contentCaption,
createdAt = now,
lastEditedAt = Nothing,
visibilityStatus = 0,
approvedBy = Nothing,
orderValue = req ^. #orderValue
}
}
newSongOpinionFromRequest' :: (MonadIO m) => UUID -> UpsertSongOpinionsRequestItem -> m SongOpinion
newSongOpinionFromRequest' createdBy req = do
newUUID <- liftIO nextRandom
now <- liftIO getCurrentTime
pure $
SongOpinion
{ songIdentifier = req ^. #songIdentifier,
opinion =
Opinion
{ identifier = newUUID,
createdBy = createdBy,
isLike = req ^. #isLike,
isDislike = not $ req ^. #isLike,
createdAt = now,
lastEditedAt = Nothing
}
}
updateSongContents' :: (MonadIO m) => Env -> [SongContentDelta] -> m (Either Text ())
updateSongContents' env songContentDeltas = do
now <- liftIO getCurrentTime
out <- mapM (performUpdate now) songContentDeltas
let outt = lefts out
if null outt
then pure . Right $ ()
else pure . Left $ unlines outt
where
stmt = Statement query encoder decoder True
query =
encodeUtf8
[trimming|
UPDATE song_contents SET version_name = $$2, instrument_type = $$3, ascii_legend = $$4, ascii_contents = $$5,
pdf_contents = $$6, guitarpro_contents = $$7, last_edited_at = $$8 WHERE identifier = $$1
|]
encoder =
contrazip8
(E.param (E.nonNullable E.uuid))
(E.param (E.nonNullable E.text))
(E.param (E.nullable E.text))
(E.param (E.nullable E.text))
(E.param (E.nullable E.text))
(E.param (E.nullable E.text))
(E.param (E.nullable E.text))
(E.param (E.nullable E.timestamptz))
decoder = D.noResult
toRow now x =
( x ^. #identifier,
x ^. #versionName,
x ^. #instrumentType,
x ^. #asciiLegend,
x ^. #asciiContents,
x ^. #pdfContents,
x ^. #guitarProContents,
Just now
)
performUpdate now x = do
operationResults <- hasqlTransaction (env ^. #pool) stmt (toRow now x)
pure $ first (pack . WikiMusic.Model.Song.show) operationResults
deleteArtistOfSong' :: (MonadIO m) => Env -> (UUID, UUID) -> m (Either SongCommandError ())
deleteArtistOfSong' env identifiers = do
stmtResult <- hasqlTransaction (env ^. #pool) stmt identifiers
pure $ first fromHasqlUsageError stmtResult
where
query =
encodeUtf8
[trimming|
DELETE FROM song_artists WHERE song_identifier = $$1 AND artist_identifier = $$2
|]
encoder =
contrazip2
(E.param . E.nonNullable $ E.uuid)
(E.param . E.nonNullable $ E.uuid)
stmt = Statement query encoder D.noResult True
newSongCommentFromRequest' :: (MonadIO m) => UUID -> InsertSongCommentsRequestItem -> m SongComment
newSongCommentFromRequest' createdBy x = do
newUUID <- liftIO nextRandom
now <- liftIO getCurrentTime
pure $
SongComment
{ songIdentifier = x ^. #songIdentifier,
comment =
Comment
{ identifier = newUUID,
parentIdentifier = x ^. #parentIdentifier,
createdBy = createdBy,
visibilityStatus = 0,
contents = x ^. #contents,
approvedBy = Nothing,
createdAt = now,
lastEditedAt = Nothing
}
}
insertSongContents' :: (MonadIO m) => Env -> [SongContent] -> m (Map UUID SongContent)
insertSongContents' env contents = do
mapM_ (hasqlTransaction (env ^. #pool) stmt . toRow) contents
pure $ Map.fromList $ map (\x -> (x ^. #identifier, x)) contents
where
decoder = D.noResult
encoder =
contrazip13
(E.param . E.nonNullable $ E.uuid)
(E.param . E.nonNullable $ E.uuid)
(E.param . E.nonNullable $ E.text)
(E.param . E.nonNullable $ E.uuid)
(E.param (E.nonNullable E.int8))
(E.param . E.nullable $ E.uuid)
(E.param . E.nonNullable $ E.text)
(E.param . E.nullable $ E.text)
(E.param . E.nullable $ E.text)
(E.param . E.nullable $ E.text)
(E.param . E.nullable $ E.text)
(E.param . E.nonNullable $ E.timestamptz)
(E.param . E.nullable $ E.timestamptz)
stmt = Statement query encoder decoder True
bindParams' = bindParams 13
toRow x =
( x ^. #identifier,
x ^. #songIdentifier,
x ^. #versionName,
x ^. #createdBy,
fromIntegral $ x ^. #visibilityStatus,
x ^. #approvedBy,
x ^. #instrumentType,
x ^. #asciiLegend,
x ^. #asciiContents,
x ^. #pdfContents,
x ^. #guitarProContents,
x ^. #createdAt,
x ^. #lastEditedAt
)
query =
encodeUtf8
[trimming|
INSERT INTO song_contents
(identifier, song_identifier, version_name, created_by, visibility_status, approved_by,
instrument_type, ascii_legend, ascii_contents, pdf_contents, guitarpro_contents, created_at, last_edited_at)
VALUES ($bindParams')
|]
newSongFromRequest' :: (MonadIO m) => UUID -> InsertSongsRequestItem -> m Song
newSongFromRequest' createdBy song = do
newUUID <- liftIO nextRandom
now <- liftIO getCurrentTime
pure $
Song
{ identifier = newUUID,
displayName = song ^. #displayName,
musicKey = song ^. #musicKey,
musicTuning = song ^. #musicTuning,
musicCreationDate = song ^. #musicCreationDate,
albumName = song ^. #albumName,
albumInfoLink = song ^. #albumInfoLink,
createdBy = createdBy,
visibilityStatus = 0,
approvedBy = Nothing,
createdAt = now,
lastEditedAt = Nothing,
artworks = Map.empty,
comments = [],
opinions = Map.empty,
contents = Map.empty,
spotifyUrl = song ^. #spotifyUrl,
youtubeUrl = song ^. #youtubeUrl,
soundcloudUrl = song ^. #soundcloudUrl,
wikipediaUrl = song ^. #wikipediaUrl,
artists = Map.empty,
viewCount = 0,
description = song ^. #description
}
newArtistOfSongFromRequest' :: (MonadIO m) => UUID -> InsertArtistsOfSongsRequestItem -> m ArtistOfSong
newArtistOfSongFromRequest' createdBy x = do
newUUID <- liftIO nextRandom
now <- liftIO getCurrentTime
pure $
ArtistOfSong
{ identifier = newUUID,
songIdentifier = x ^. #songIdentifier,
artistIdentifier = x ^. #artistIdentifier,
createdAt = now,
createdBy = createdBy
}
newSongContentFromRequest' :: (MonadIO m) => UUID -> InsertSongContentsRequestItem -> m SongContent
newSongContentFromRequest' createdBy x = do
newUUID <- liftIO nextRandom
now <- liftIO getCurrentTime
pure $
SongContent
{ identifier = newUUID,
songIdentifier = x ^. #songIdentifier,
versionName = x ^. #versionName,
visibilityStatus = 0,
approvedBy = Nothing,
instrumentType = x ^. #instrumentType,
asciiLegend = x ^. #asciiLegend,
asciiContents = x ^. #asciiContents,
pdfContents = x ^. #pdfContents,
guitarProContents = x ^. #guitarProContents,
createdAt = now,
createdBy = createdBy,
lastEditedAt = Nothing
}
instance Exec SongCommand where
execAlgebra (IncrementViewsByOne env identifiers next) = next =<< incrementViewsByOne' env identifiers "songs"
execAlgebra (InsertSongs env songs next) = next =<< insertSongs' env songs
execAlgebra (InsertSongComments env comments next) = next =<< insertSongComments' env comments
execAlgebra (InsertSongExternalSources env externalSources next) = next =<< insertSongExternalSources' env externalSources
execAlgebra (InsertSongArtworks env artworks next) = next =<< insertSongArtworks' env artworks
execAlgebra (UpsertSongOpinions env opinions next) = next =<< upsertSongOpinions' env opinions
execAlgebra (DeleteSongs env identifiers next) = next =<< deleteSongs' env identifiers
execAlgebra (DeleteSongComments env identifiers next) =
next . first fromHasqlUsageError =<< deleteStuffByUUID (env ^. #pool) "song_comments" "identifier" identifiers
execAlgebra (DeleteSongArtworks env identifiers next) =
next . first fromHasqlUsageError =<< deleteStuffByUUID (env ^. #pool) "song_artworks" "identifier" identifiers
execAlgebra (DeleteSongOpinions env identifiers next) =
next . first fromHasqlUsageError =<< deleteStuffByUUID (env ^. #pool) "song_opinions" "identifier" identifiers
execAlgebra (DeleteCommentsOfSongs env identifiers next) =
next . first fromHasqlUsageError =<< deleteStuffByUUID (env ^. #pool) "song_comments" "song_identifier" identifiers
execAlgebra (DeleteSongExternalSources env identifiers next) =
next . first fromHasqlUsageError =<< deleteStuffByUUID (env ^. #pool) "song_external_sources" "song_identifier" identifiers
execAlgebra (DeleteArtworksOfSongs env identifiers next) =
next . first fromHasqlUsageError =<< deleteStuffByUUID (env ^. #pool) "song_artworks" "song_identifier" identifiers
execAlgebra (DeleteOpinionsOfSongs env identifiers next) =
next . first fromHasqlUsageError =<< deleteStuffByUUID (env ^. #pool) "song_opinions" "song_identifier" identifiers
execAlgebra (UpdateSongArtworkOrder env orderUpdates next) = next =<< updateSongArtworkOrder' env orderUpdates
execAlgebra (UpdateSongs env deltas next) = next =<< updateSongs' env deltas
execAlgebra (UpdateSongContents env deltas next) = next =<< updateSongContents' env deltas
execAlgebra (UpdateSongExternalSources env deltas next) = next =<< updateSongExternalSources' env deltas
execAlgebra (NewSongCommentFromRequest createdBy req next) = next =<< newSongCommentFromRequest' createdBy req
execAlgebra (NewSongOpinionFromRequest createdBy req next) = next =<< newSongOpinionFromRequest' createdBy req
execAlgebra (NewSongArtworkFromRequest createdBy req next) = next =<< newSongArtworkFromRequest' createdBy req
execAlgebra (InsertSongContents env contents next) = next =<< insertSongContents' env contents
execAlgebra (InsertArtistsOfSongs env items next) = next =<< insertArtistsOfSongs' env items
execAlgebra (DeleteArtistsOfSongs env identifiers next) =
next . first fromHasqlUsageError =<< deleteStuffByUUID (env ^. #pool) "song_artists" "song_identifier" identifiers
execAlgebra (DeleteArtistOfSong env identifiers next) = next =<< deleteArtistOfSong' env identifiers
execAlgebra (NewSongFromRequest createdBy song next) = next =<< newSongFromRequest' createdBy song
execAlgebra (NewArtistOfSongFromRequest createdBy x next) = next =<< newArtistOfSongFromRequest' createdBy x
execAlgebra (NewSongContentFromRequest createdBy x next) = next =<< newSongContentFromRequest' createdBy x
execAlgebra (DeleteContentsOfSongs env identifiers next) = do
stmtResult <- deleteStuffByUUID (env ^. #pool) "song_contents" "song_identifier" identifiers
next $ first fromHasqlUsageError stmtResult
execAlgebra (DeleteSongContents env identifiers next) = do
stmtResult <- deleteStuffByUUID (env ^. #pool) "song_contents" "identifier" identifiers
next $ first fromHasqlUsageError stmtResult
fromHasqlUsageError :: Hasql.Pool.UsageError -> SongCommandError
fromHasqlUsageError = PersistenceError . pack . Relude.show