{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoFieldSelectors #-}

module WikiMusic.Interaction.Song
  ( fetchSongsAction,
    insertSongsAction,
    insertSongCommentsAction,
    insertSongArtworksAction,
    upsertSongOpinionsAction,
    deleteSongsByIdentifierAction,
    deleteSongCommentsByIdentifierAction,
    deleteSongOpinionsByIdentifierAction,
    deleteSongArtworksByIdentifierAction,
    updateSongArtworksOrderAction,
    updateSongAction,
    insertArtistsOfSongAction,
    fetchSongAction,
    updateSongContentsAction,
    deleteSongContentsByIdentifierAction,
    insertSongContentsAction,
    searchSongsAction,
    deleteArtistsOfSongAction,
  )
where

import Data.Map qualified as Map
import Data.Text (pack, take, unpack)
import Relude
import WikiMusic.Free.Logger
import WikiMusic.Free.SongCommand
import WikiMusic.Free.SongQuery
import WikiMusic.Interaction.Model.Song
import WikiMusic.Model.Other
import WikiMusic.Model.Song
import WikiMusic.Protolude

fetchSongsAction ::
  (SongQuery :<: f, SongCommand :<: f) =>
  Env ->
  WikiMusicUser ->
  Limit ->
  Offset ->
  Maybe Text ->
  Maybe Text ->
  Free f (Either SongError GetSongsQueryResponse)
fetchSongsAction :: forall (f :: * -> *).
(SongQuery :<: f, SongCommand :<: f) =>
Env
-> WikiMusicUser
-> Limit
-> Offset
-> Maybe Text
-> Maybe Text
-> Free f (Either SongError GetSongsQueryResponse)
fetchSongsAction Env
env WikiMusicUser
authUser Limit
limit Offset
offset Maybe Text
maybeSortOrder Maybe Text
maybeInclude =
  WikiMusicUser
-> ([UserRole] -> Bool)
-> SongError
-> Free f (Either SongError GetSongsQueryResponse)
-> Free f (Either SongError GetSongsQueryResponse)
forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authUser [UserRole] -> Bool
isAtLeastDemo SongError
AccessUnauthorizedError (Free f (Either SongError GetSongsQueryResponse)
 -> Free f (Either SongError GetSongsQueryResponse))
-> Free f (Either SongError GetSongsQueryResponse)
-> Free f (Either SongError GetSongsQueryResponse)
forall a b. (a -> b) -> a -> b
$ do
    (Map UUID Song
songMap, [UUID]
sortOrderList) <- Env
-> SongSortOrder
-> Limit
-> Offset
-> Free f (Map UUID Song, [UUID])
forall (f :: * -> *).
(SongQuery :<: f) =>
Env
-> SongSortOrder
-> Limit
-> Offset
-> Free f (Map UUID Song, [UUID])
fetchSongs Env
env SongSortOrder
sortOrder Limit
limit Offset
offset

    Map UUID Song
enrichedSongs <-
      Env -> Map UUID Song -> EnrichSongParams -> Free f (Map UUID Song)
forall (f :: * -> *).
(SongQuery :<: f) =>
Env -> Map UUID Song -> EnrichSongParams -> Free f (Map UUID Song)
enrichedSongResponse
        Env
env
        Map UUID Song
songMap
        (EnrichSongParams
-> (Text -> EnrichSongParams) -> Maybe Text -> EnrichSongParams
forall b a. b -> (a -> b) -> Maybe a -> b
maybe EnrichSongParams
noEnrichment Text -> EnrichSongParams
parseInclude Maybe Text
maybeInclude)

    Either SongError GetSongsQueryResponse
-> Free f (Either SongError GetSongsQueryResponse)
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SongError GetSongsQueryResponse
 -> Free f (Either SongError GetSongsQueryResponse))
-> (GetSongsQueryResponse
    -> Either SongError GetSongsQueryResponse)
-> GetSongsQueryResponse
-> Free f (Either SongError GetSongsQueryResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetSongsQueryResponse -> Either SongError GetSongsQueryResponse
forall a b. b -> Either a b
Right (GetSongsQueryResponse
 -> Free f (Either SongError GetSongsQueryResponse))
-> GetSongsQueryResponse
-> Free f (Either SongError GetSongsQueryResponse)
forall a b. (a -> b) -> a -> b
$ GetSongsQueryResponse {$sel:songs:GetSongsQueryResponse :: Map UUID Song
songs = Map UUID Song
enrichedSongs, $sel:sortOrder:GetSongsQueryResponse :: [UUID]
sortOrder = [UUID]
sortOrderList}
  where
    sortOrder :: SongSortOrder
sortOrder = SongSortOrder -> Maybe SongSortOrder -> SongSortOrder
forall a. a -> Maybe a -> a
fromMaybe SongSortOrder
DescCreatedAt (String -> Maybe SongSortOrder
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe SongSortOrder)
-> (Text -> String) -> Text -> Maybe SongSortOrder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> Maybe SongSortOrder) -> Maybe Text -> Maybe SongSortOrder
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
maybeSortOrder)

searchSongsAction ::
  (SongQuery :<: f, SongCommand :<: f) =>
  Env ->
  WikiMusicUser ->
  Limit ->
  Offset ->
  Maybe Text ->
  Maybe Text ->
  Text ->
  Free f (Either SongError GetSongsQueryResponse)
searchSongsAction :: forall (f :: * -> *).
(SongQuery :<: f, SongCommand :<: f) =>
Env
-> WikiMusicUser
-> Limit
-> Offset
-> Maybe Text
-> Maybe Text
-> Text
-> Free f (Either SongError GetSongsQueryResponse)
searchSongsAction Env
env WikiMusicUser
authUser Limit
limit Offset
offset Maybe Text
maybeSortOrder Maybe Text
maybeInclude Text
searchInput =
  WikiMusicUser
-> ([UserRole] -> Bool)
-> SongError
-> Free f (Either SongError GetSongsQueryResponse)
-> Free f (Either SongError GetSongsQueryResponse)
forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authUser [UserRole] -> Bool
isAtLeastDemo SongError
AccessUnauthorizedError (Free f (Either SongError GetSongsQueryResponse)
 -> Free f (Either SongError GetSongsQueryResponse))
-> Free f (Either SongError GetSongsQueryResponse)
-> Free f (Either SongError GetSongsQueryResponse)
forall a b. (a -> b) -> a -> b
$ do
    (Map UUID Song
songMap, [UUID]
sortOrderList) <- Env
-> SearchInput
-> SongSortOrder
-> Limit
-> Offset
-> Free f (Map UUID Song, [UUID])
forall (f :: * -> *).
(SongQuery :<: f) =>
Env
-> SearchInput
-> SongSortOrder
-> Limit
-> Offset
-> Free f (Map UUID Song, [UUID])
searchSongs Env
env (Text -> SearchInput
SearchInput Text
searchInput) SongSortOrder
sortOrder Limit
limit Offset
offset

    Map UUID Song
enrichedSongs <-
      Env -> Map UUID Song -> EnrichSongParams -> Free f (Map UUID Song)
forall (f :: * -> *).
(SongQuery :<: f) =>
Env -> Map UUID Song -> EnrichSongParams -> Free f (Map UUID Song)
enrichedSongResponse
        Env
env
        Map UUID Song
songMap
        (EnrichSongParams
-> (Text -> EnrichSongParams) -> Maybe Text -> EnrichSongParams
forall b a. b -> (a -> b) -> Maybe a -> b
maybe EnrichSongParams
noEnrichment Text -> EnrichSongParams
parseInclude Maybe Text
maybeInclude)

    Either SongError GetSongsQueryResponse
-> Free f (Either SongError GetSongsQueryResponse)
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SongError GetSongsQueryResponse
 -> Free f (Either SongError GetSongsQueryResponse))
-> (GetSongsQueryResponse
    -> Either SongError GetSongsQueryResponse)
-> GetSongsQueryResponse
-> Free f (Either SongError GetSongsQueryResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetSongsQueryResponse -> Either SongError GetSongsQueryResponse
forall a b. b -> Either a b
Right (GetSongsQueryResponse
 -> Free f (Either SongError GetSongsQueryResponse))
-> GetSongsQueryResponse
-> Free f (Either SongError GetSongsQueryResponse)
forall a b. (a -> b) -> a -> b
$ GetSongsQueryResponse {$sel:songs:GetSongsQueryResponse :: Map UUID Song
songs = Map UUID Song
enrichedSongs, $sel:sortOrder:GetSongsQueryResponse :: [UUID]
sortOrder = [UUID]
sortOrderList}
  where
    sortOrder :: SongSortOrder
sortOrder = SongSortOrder -> Maybe SongSortOrder -> SongSortOrder
forall a. a -> Maybe a -> a
fromMaybe SongSortOrder
DescCreatedAt (String -> Maybe SongSortOrder
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe SongSortOrder)
-> (Text -> String) -> Text -> Maybe SongSortOrder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> Maybe SongSortOrder) -> Maybe Text -> Maybe SongSortOrder
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
maybeSortOrder)

fetchSongAction ::
  (SongQuery :<: f, SongCommand :<: f) =>
  Env ->
  WikiMusicUser ->
  UUID ->
  Maybe Text ->
  Maybe Text ->
  Free f (Either SongError GetSongsQueryResponse)
fetchSongAction :: forall (f :: * -> *).
(SongQuery :<: f, SongCommand :<: f) =>
Env
-> WikiMusicUser
-> UUID
-> Maybe Text
-> Maybe Text
-> Free f (Either SongError GetSongsQueryResponse)
fetchSongAction Env
env WikiMusicUser
authUser UUID
identifier Maybe Text
maybeSortOrder Maybe Text
maybeInclude =
  WikiMusicUser
-> ([UserRole] -> Bool)
-> SongError
-> Free f (Either SongError GetSongsQueryResponse)
-> Free f (Either SongError GetSongsQueryResponse)
forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authUser [UserRole] -> Bool
isAtLeastDemo SongError
AccessUnauthorizedError (Free f (Either SongError GetSongsQueryResponse)
 -> Free f (Either SongError GetSongsQueryResponse))
-> Free f (Either SongError GetSongsQueryResponse)
-> Free f (Either SongError GetSongsQueryResponse)
forall a b. (a -> b) -> a -> b
$ do
    (Map UUID Song
songMap, [UUID]
sortOrderList) <- Env -> SongSortOrder -> [UUID] -> Free f (Map UUID Song, [UUID])
forall (f :: * -> *).
(SongQuery :<: f) =>
Env -> SongSortOrder -> [UUID] -> Free f (Map UUID Song, [UUID])
fetchSongsByUUID Env
env SongSortOrder
sortOrder [UUID
identifier]

    Map UUID Song
enrichedSongs <-
      Env -> Map UUID Song -> EnrichSongParams -> Free f (Map UUID Song)
forall (f :: * -> *).
(SongQuery :<: f) =>
Env -> Map UUID Song -> EnrichSongParams -> Free f (Map UUID Song)
enrichedSongResponse
        Env
env
        Map UUID Song
songMap
        (EnrichSongParams
-> (Text -> EnrichSongParams) -> Maybe Text -> EnrichSongParams
forall b a. b -> (a -> b) -> Maybe a -> b
maybe EnrichSongParams
noEnrichment Text -> EnrichSongParams
parseInclude Maybe Text
maybeInclude)

    Either SongCommandError ()
_ <- Env -> [UUID] -> Free f (Either SongCommandError ())
forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [UUID] -> Free f (Either SongCommandError ())
incrementViewsByOne Env
env (Map UUID Song -> [UUID]
forall k a. Map k a -> [k]
Map.keys Map UUID Song
songMap)

    Either SongError GetSongsQueryResponse
-> Free f (Either SongError GetSongsQueryResponse)
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SongError GetSongsQueryResponse
 -> Free f (Either SongError GetSongsQueryResponse))
-> (GetSongsQueryResponse
    -> Either SongError GetSongsQueryResponse)
-> GetSongsQueryResponse
-> Free f (Either SongError GetSongsQueryResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetSongsQueryResponse -> Either SongError GetSongsQueryResponse
forall a b. b -> Either a b
Right (GetSongsQueryResponse
 -> Free f (Either SongError GetSongsQueryResponse))
-> GetSongsQueryResponse
-> Free f (Either SongError GetSongsQueryResponse)
forall a b. (a -> b) -> a -> b
$ GetSongsQueryResponse {$sel:songs:GetSongsQueryResponse :: Map UUID Song
songs = Map UUID Song
enrichedSongs, $sel:sortOrder:GetSongsQueryResponse :: [UUID]
sortOrder = [UUID]
sortOrderList}
  where
    sortOrder :: SongSortOrder
sortOrder = SongSortOrder -> Maybe SongSortOrder -> SongSortOrder
forall a. a -> Maybe a -> a
fromMaybe SongSortOrder
DescCreatedAt (String -> Maybe SongSortOrder
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe SongSortOrder)
-> (Text -> String) -> Text -> Maybe SongSortOrder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> Maybe SongSortOrder) -> Maybe Text -> Maybe SongSortOrder
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
maybeSortOrder)

insertSongsAction ::
  (SongQuery :<: f, SongCommand :<: f, Logger :<: f) =>
  Env ->
  WikiMusicUser ->
  InsertSongsRequest ->
  Free f (Either SongError InsertSongsCommandResponse)
insertSongsAction :: forall (f :: * -> *).
(SongQuery :<: f, SongCommand :<: f, Logger :<: f) =>
Env
-> WikiMusicUser
-> InsertSongsRequest
-> Free f (Either SongError InsertSongsCommandResponse)
insertSongsAction Env
env WikiMusicUser
authUser InsertSongsRequest
request =
  WikiMusicUser
-> ([UserRole] -> Bool)
-> SongError
-> Free f (Either SongError InsertSongsCommandResponse)
-> Free f (Either SongError InsertSongsCommandResponse)
forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authUser [UserRole] -> Bool
isAtLeastLowRank SongError
AccessUnauthorizedError (Free f (Either SongError InsertSongsCommandResponse)
 -> Free f (Either SongError InsertSongsCommandResponse))
-> Free f (Either SongError InsertSongsCommandResponse)
-> Free f (Either SongError InsertSongsCommandResponse)
forall a b. (a -> b) -> a -> b
$ do
    [Song]
newSongs <- (InsertSongsRequestItem -> Free f Song)
-> [InsertSongsRequestItem] -> Free f [Song]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (UUID -> InsertSongsRequestItem -> Free f Song
forall (f :: * -> *).
(SongCommand :<: f) =>
UUID -> InsertSongsRequestItem -> Free f Song
newSongFromRequest (WikiMusicUser
authUser WikiMusicUser -> Optic' A_Lens NoIx WikiMusicUser UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx WikiMusicUser UUID
#identifier)) (InsertSongsRequest
request InsertSongsRequest
-> Optic' An_Iso NoIx InsertSongsRequest [InsertSongsRequestItem]
-> [InsertSongsRequestItem]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx InsertSongsRequest [InsertSongsRequestItem]
#songs)

    let entityValidation :: Song -> (Text, Validation [Text])
entityValidation Song
x = (Song
x Song -> Optic' A_Lens NoIx Song Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song Text
#displayName, Song -> Validation [Text]
validateSong Song
x)
        validationResults :: Map Text (Validation [Text])
validationResults = [(Text, Validation [Text])] -> Map Text (Validation [Text])
[Item (Map Text (Validation [Text]))]
-> Map Text (Validation [Text])
forall l. IsList l => [Item l] -> l
fromList ([(Text, Validation [Text])] -> Map Text (Validation [Text]))
-> ([Song] -> [(Text, Validation [Text])])
-> [Song]
-> Map Text (Validation [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Song -> (Text, Validation [Text]))
-> [Song] -> [(Text, Validation [Text])]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text)
-> (Text, Validation [Text]) -> (Text, Validation [Text])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall b a. (Show a, IsString b) => a -> b
Relude.show) ((Text, Validation [Text]) -> (Text, Validation [Text]))
-> (Song -> (Text, Validation [Text]))
-> Song
-> (Text, Validation [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Song -> (Text, Validation [Text])
entityValidation) ([Song] -> Map Text (Validation [Text]))
-> [Song] -> Map Text (Validation [Text])
forall a b. (a -> b) -> a -> b
$ [Song]
newSongs
        newSongIdentifiers :: [UUID]
newSongIdentifiers = (Song -> UUID) -> [Song] -> [UUID]
forall a b. (a -> b) -> [a] -> [b]
map (Song -> Optic' A_Lens NoIx Song UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song UUID
#identifier) [Song]
newSongs

    Map Text (Validation [Text])
-> Free f (Either SongError InsertSongsCommandResponse)
-> Free f (Either SongError InsertSongsCommandResponse)
forall (f :: * -> *) b.
Applicative f =>
Map Text (Validation [Text])
-> f (Either SongError b) -> f (Either SongError b)
ifAllValid Map Text (Validation [Text])
validationResults (Free f (Either SongError InsertSongsCommandResponse)
 -> Free f (Either SongError InsertSongsCommandResponse))
-> Free f (Either SongError InsertSongsCommandResponse)
-> Free f (Either SongError InsertSongsCommandResponse)
forall a b. (a -> b) -> a -> b
$ do
      Map UUID Song
_ <- Env -> [Song] -> Free f (Map UUID Song)
forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [Song] -> Free f (Map UUID Song)
insertSongs Env
env [Song]
newSongs
      ()
_ <- Text -> Free f ()
forall (f :: * -> *). (Logger :<: f) => Text -> Free f ()
logInfo Text
"INSERTING NEW SONGS:"
      ()
_ <- Text -> Free f ()
forall (f :: * -> *). (Logger :<: f) => Text -> Free f ()
logInfo (Text -> Free f ()) -> ([Song] -> Text) -> [Song] -> Free f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> ([Song] -> String) -> [Song] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Song] -> String
forall b a. (Show a, IsString b) => a -> b
Relude.show ([Song] -> Free f ()) -> [Song] -> Free f ()
forall a b. (a -> b) -> a -> b
$ [Song]
newSongs
      (Map UUID Song
songMap, [UUID]
sortOrder) <- Env -> SongSortOrder -> [UUID] -> Free f (Map UUID Song, [UUID])
forall (f :: * -> *).
(SongQuery :<: f) =>
Env -> SongSortOrder -> [UUID] -> Free f (Map UUID Song, [UUID])
fetchSongsByUUID Env
env SongSortOrder
DescCreatedAt [UUID]
newSongIdentifiers

      Map UUID Song
enrichedInsertedSongs <- Env -> Map UUID Song -> EnrichSongParams -> Free f (Map UUID Song)
forall (f :: * -> *).
(SongQuery :<: f) =>
Env -> Map UUID Song -> EnrichSongParams -> Free f (Map UUID Song)
enrichedSongResponse Env
env Map UUID Song
songMap EnrichSongParams
fullEnrichment
      Either SongError InsertSongsCommandResponse
-> Free f (Either SongError InsertSongsCommandResponse)
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Either SongError InsertSongsCommandResponse
 -> Free f (Either SongError InsertSongsCommandResponse))
-> (InsertSongsCommandResponse
    -> Either SongError InsertSongsCommandResponse)
-> InsertSongsCommandResponse
-> Free f (Either SongError InsertSongsCommandResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InsertSongsCommandResponse
-> Either SongError InsertSongsCommandResponse
forall a b. b -> Either a b
Right
        (InsertSongsCommandResponse
 -> Free f (Either SongError InsertSongsCommandResponse))
-> InsertSongsCommandResponse
-> Free f (Either SongError InsertSongsCommandResponse)
forall a b. (a -> b) -> a -> b
$ InsertSongsQueryResponse
          { $sel:songs:InsertSongsQueryResponse :: Map UUID Song
songs = Map UUID Song
enrichedInsertedSongs,
            $sel:sortOrder:InsertSongsQueryResponse :: [UUID]
sortOrder = [UUID]
sortOrder,
            $sel:validationResults:InsertSongsQueryResponse :: Map Text (Validation [Text])
validationResults = Map Text (Validation [Text])
validationResults
          }

insertSongCommentsAction ::
  (SongCommand :<: f) =>
  Env ->
  WikiMusicUser ->
  InsertSongCommentsRequest ->
  Free f (Either SongError InsertSongCommentsCommandResponse)
insertSongCommentsAction :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env
-> WikiMusicUser
-> InsertSongCommentsRequest
-> Free f (Either SongError InsertSongCommentsCommandResponse)
insertSongCommentsAction Env
env WikiMusicUser
authUser InsertSongCommentsRequest
request =
  WikiMusicUser
-> ([UserRole] -> Bool)
-> SongError
-> Free f (Either SongError InsertSongCommentsCommandResponse)
-> Free f (Either SongError InsertSongCommentsCommandResponse)
forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authUser [UserRole] -> Bool
isAtLeastDemo SongError
AccessUnauthorizedError (Free f (Either SongError InsertSongCommentsCommandResponse)
 -> Free f (Either SongError InsertSongCommentsCommandResponse))
-> Free f (Either SongError InsertSongCommentsCommandResponse)
-> Free f (Either SongError InsertSongCommentsCommandResponse)
forall a b. (a -> b) -> a -> b
$ do
    [SongComment]
newComments <- (InsertSongCommentsRequestItem -> Free f SongComment)
-> [InsertSongCommentsRequestItem] -> Free f [SongComment]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (UUID -> InsertSongCommentsRequestItem -> Free f SongComment
forall (f :: * -> *).
(SongCommand :<: f) =>
UUID -> InsertSongCommentsRequestItem -> Free f SongComment
newSongCommentFromRequest (WikiMusicUser
authUser WikiMusicUser -> Optic' A_Lens NoIx WikiMusicUser UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx WikiMusicUser UUID
#identifier)) (InsertSongCommentsRequest
request InsertSongCommentsRequest
-> Optic'
     An_Iso
     NoIx
     InsertSongCommentsRequest
     [InsertSongCommentsRequestItem]
-> [InsertSongCommentsRequestItem]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  An_Iso
  NoIx
  InsertSongCommentsRequest
  [InsertSongCommentsRequestItem]
#songComments)
    let entityValidation :: SongComment -> (Text, Validation [Text])
entityValidation SongComment
x = (Int -> Text -> Text
Data.Text.take Int
20 (SongComment
x SongComment -> Optic' A_Lens NoIx SongComment Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx SongComment SongComment Comment Comment
#comment Optic A_Lens NoIx SongComment SongComment Comment Comment
-> Optic A_Lens NoIx Comment Comment Text Text
-> Optic' A_Lens NoIx SongComment Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Comment Comment Text Text
#contents), SongComment -> Validation [Text]
validateSongComment SongComment
x)
        validationResults :: Map Text (Validation [Text])
validationResults = [Item (Map Text (Validation [Text]))]
-> Map Text (Validation [Text])
forall l. IsList l => [Item l] -> l
fromList ([Item (Map Text (Validation [Text]))]
 -> Map Text (Validation [Text]))
-> [Item (Map Text (Validation [Text]))]
-> Map Text (Validation [Text])
forall a b. (a -> b) -> a -> b
$ (SongComment -> (Text, Validation [Text]))
-> [SongComment] -> [(Text, Validation [Text])]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text)
-> (Text, Validation [Text]) -> (Text, Validation [Text])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall b a. (Show a, IsString b) => a -> b
Relude.show) ((Text, Validation [Text]) -> (Text, Validation [Text]))
-> (SongComment -> (Text, Validation [Text]))
-> SongComment
-> (Text, Validation [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SongComment -> (Text, Validation [Text])
entityValidation) [SongComment]
newComments

    Map Text (Validation [Text])
-> Free f (Either SongError InsertSongCommentsCommandResponse)
-> Free f (Either SongError InsertSongCommentsCommandResponse)
forall (f :: * -> *) b.
Applicative f =>
Map Text (Validation [Text])
-> f (Either SongError b) -> f (Either SongError b)
ifAllValid Map Text (Validation [Text])
validationResults (Free f (Either SongError InsertSongCommentsCommandResponse)
 -> Free f (Either SongError InsertSongCommentsCommandResponse))
-> Free f (Either SongError InsertSongCommentsCommandResponse)
-> Free f (Either SongError InsertSongCommentsCommandResponse)
forall a b. (a -> b) -> a -> b
$ do
      Either SongCommandError ()
_ <- Env -> [SongComment] -> Free f (Either SongCommandError ())
forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [SongComment] -> Free f (Either SongCommandError ())
insertSongComments Env
env [SongComment]
newComments
      Either SongError InsertSongCommentsCommandResponse
-> Free f (Either SongError InsertSongCommentsCommandResponse)
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Either SongError InsertSongCommentsCommandResponse
 -> Free f (Either SongError InsertSongCommentsCommandResponse))
-> (InsertSongCommentsCommandResponse
    -> Either SongError InsertSongCommentsCommandResponse)
-> InsertSongCommentsCommandResponse
-> Free f (Either SongError InsertSongCommentsCommandResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InsertSongCommentsCommandResponse
-> Either SongError InsertSongCommentsCommandResponse
forall a b. b -> Either a b
Right
        (InsertSongCommentsCommandResponse
 -> Free f (Either SongError InsertSongCommentsCommandResponse))
-> InsertSongCommentsCommandResponse
-> Free f (Either SongError InsertSongCommentsCommandResponse)
forall a b. (a -> b) -> a -> b
$ InsertSongCommentsCommandResponse
          { $sel:songComments:InsertSongCommentsCommandResponse :: Map UUID SongComment
songComments = Map UUID SongComment
forall k a. Map k a
Map.empty,
            $sel:validationResults:InsertSongCommentsCommandResponse :: Map Text (Validation [Text])
validationResults = Map Text (Validation [Text])
validationResults
          }

upsertSongOpinionsAction ::
  (SongCommand :<: f) =>
  Env ->
  WikiMusicUser ->
  UpsertSongOpinionsRequest ->
  Free f (Either SongError UpsertSongOpinionsCommandResponse)
upsertSongOpinionsAction :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env
-> WikiMusicUser
-> UpsertSongOpinionsRequest
-> Free f (Either SongError UpsertSongOpinionsCommandResponse)
upsertSongOpinionsAction Env
env WikiMusicUser
authUser UpsertSongOpinionsRequest
request =
  WikiMusicUser
-> ([UserRole] -> Bool)
-> SongError
-> Free f (Either SongError UpsertSongOpinionsCommandResponse)
-> Free f (Either SongError UpsertSongOpinionsCommandResponse)
forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authUser [UserRole] -> Bool
isAtLeastDemo SongError
AccessUnauthorizedError (Free f (Either SongError UpsertSongOpinionsCommandResponse)
 -> Free f (Either SongError UpsertSongOpinionsCommandResponse))
-> Free f (Either SongError UpsertSongOpinionsCommandResponse)
-> Free f (Either SongError UpsertSongOpinionsCommandResponse)
forall a b. (a -> b) -> a -> b
$ do
    let entityValidation :: SongOpinion -> (UUID, Validation [Text])
entityValidation SongOpinion
x = (SongOpinion
x SongOpinion -> Optic' A_Lens NoIx SongOpinion UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongOpinion UUID
#songIdentifier, SongOpinion -> Validation [Text]
validateSongOpinion SongOpinion
x)

    [SongOpinion]
newOpinions <- (UpsertSongOpinionsRequestItem -> Free f SongOpinion)
-> [UpsertSongOpinionsRequestItem] -> Free f [SongOpinion]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (UUID -> UpsertSongOpinionsRequestItem -> Free f SongOpinion
forall (f :: * -> *).
(SongCommand :<: f) =>
UUID -> UpsertSongOpinionsRequestItem -> Free f SongOpinion
newSongOpinionFromRequest (WikiMusicUser
authUser WikiMusicUser -> Optic' A_Lens NoIx WikiMusicUser UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx WikiMusicUser UUID
#identifier)) (UpsertSongOpinionsRequest
request UpsertSongOpinionsRequest
-> Optic'
     An_Iso
     NoIx
     UpsertSongOpinionsRequest
     [UpsertSongOpinionsRequestItem]
-> [UpsertSongOpinionsRequestItem]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  An_Iso
  NoIx
  UpsertSongOpinionsRequest
  [UpsertSongOpinionsRequestItem]
#songOpinions)
    let validationResults :: Map Text (Validation [Text])
validationResults = [Item (Map Text (Validation [Text]))]
-> Map Text (Validation [Text])
forall l. IsList l => [Item l] -> l
fromList ([Item (Map Text (Validation [Text]))]
 -> Map Text (Validation [Text]))
-> [Item (Map Text (Validation [Text]))]
-> Map Text (Validation [Text])
forall a b. (a -> b) -> a -> b
$ (SongOpinion -> (Text, Validation [Text]))
-> [SongOpinion] -> [(Text, Validation [Text])]
forall a b. (a -> b) -> [a] -> [b]
map ((UUID -> Text)
-> (UUID, Validation [Text]) -> (Text, Validation [Text])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
pack (String -> Text) -> (UUID -> String) -> UUID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
forall b a. (Show a, IsString b) => a -> b
Relude.show) ((UUID, Validation [Text]) -> (Text, Validation [Text]))
-> (SongOpinion -> (UUID, Validation [Text]))
-> SongOpinion
-> (Text, Validation [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SongOpinion -> (UUID, Validation [Text])
entityValidation) [SongOpinion]
newOpinions

    Map Text (Validation [Text])
-> Free f (Either SongError UpsertSongOpinionsCommandResponse)
-> Free f (Either SongError UpsertSongOpinionsCommandResponse)
forall (f :: * -> *) b.
Applicative f =>
Map Text (Validation [Text])
-> f (Either SongError b) -> f (Either SongError b)
ifAllValid Map Text (Validation [Text])
validationResults (Free f (Either SongError UpsertSongOpinionsCommandResponse)
 -> Free f (Either SongError UpsertSongOpinionsCommandResponse))
-> Free f (Either SongError UpsertSongOpinionsCommandResponse)
-> Free f (Either SongError UpsertSongOpinionsCommandResponse)
forall a b. (a -> b) -> a -> b
$ do
      Map UUID SongOpinion
upsertedOpinions <- Env -> [SongOpinion] -> Free f (Map UUID SongOpinion)
forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [SongOpinion] -> Free f (Map UUID SongOpinion)
upsertSongOpinions Env
env [SongOpinion]
newOpinions
      Either SongError UpsertSongOpinionsCommandResponse
-> Free f (Either SongError UpsertSongOpinionsCommandResponse)
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Either SongError UpsertSongOpinionsCommandResponse
 -> Free f (Either SongError UpsertSongOpinionsCommandResponse))
-> (UpsertSongOpinionsCommandResponse
    -> Either SongError UpsertSongOpinionsCommandResponse)
-> UpsertSongOpinionsCommandResponse
-> Free f (Either SongError UpsertSongOpinionsCommandResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UpsertSongOpinionsCommandResponse
-> Either SongError UpsertSongOpinionsCommandResponse
forall a b. b -> Either a b
Right
        (UpsertSongOpinionsCommandResponse
 -> Free f (Either SongError UpsertSongOpinionsCommandResponse))
-> UpsertSongOpinionsCommandResponse
-> Free f (Either SongError UpsertSongOpinionsCommandResponse)
forall a b. (a -> b) -> a -> b
$ UpsertSongOpinionsCommandResponse
          { $sel:songOpinions:UpsertSongOpinionsCommandResponse :: Map UUID SongOpinion
songOpinions = Map UUID SongOpinion
upsertedOpinions,
            $sel:validationResults:UpsertSongOpinionsCommandResponse :: Map Text (Validation [Text])
validationResults = Map Text (Validation [Text])
validationResults
          }

insertSongArtworksAction ::
  (SongCommand :<: f) =>
  Env ->
  WikiMusicUser ->
  InsertSongArtworksRequest ->
  Free f (Either SongError InsertSongArtworksCommandResponse)
insertSongArtworksAction :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env
-> WikiMusicUser
-> InsertSongArtworksRequest
-> Free f (Either SongError InsertSongArtworksCommandResponse)
insertSongArtworksAction Env
env WikiMusicUser
authUser InsertSongArtworksRequest
request =
  WikiMusicUser
-> ([UserRole] -> Bool)
-> SongError
-> Free f (Either SongError InsertSongArtworksCommandResponse)
-> Free f (Either SongError InsertSongArtworksCommandResponse)
forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authUser [UserRole] -> Bool
isAtLeastLowRank SongError
AccessUnauthorizedError (Free f (Either SongError InsertSongArtworksCommandResponse)
 -> Free f (Either SongError InsertSongArtworksCommandResponse))
-> Free f (Either SongError InsertSongArtworksCommandResponse)
-> Free f (Either SongError InsertSongArtworksCommandResponse)
forall a b. (a -> b) -> a -> b
$ do
    let entityValidation :: SongArtwork -> (UUID, Validation [Text])
entityValidation SongArtwork
x = (SongArtwork
x SongArtwork -> Optic' A_Lens NoIx SongArtwork UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongArtwork UUID
#songIdentifier, SongArtwork -> Validation [Text]
validateSongArtwork SongArtwork
x)

    [SongArtwork]
newArtworks <- (InsertSongArtworksRequestItem -> Free f SongArtwork)
-> [InsertSongArtworksRequestItem] -> Free f [SongArtwork]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (UUID -> InsertSongArtworksRequestItem -> Free f SongArtwork
forall (f :: * -> *).
(SongCommand :<: f) =>
UUID -> InsertSongArtworksRequestItem -> Free f SongArtwork
newSongArtworkFromRequest (WikiMusicUser
authUser WikiMusicUser -> Optic' A_Lens NoIx WikiMusicUser UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx WikiMusicUser UUID
#identifier)) (InsertSongArtworksRequest
request InsertSongArtworksRequest
-> Optic'
     An_Iso
     NoIx
     InsertSongArtworksRequest
     [InsertSongArtworksRequestItem]
-> [InsertSongArtworksRequestItem]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  An_Iso
  NoIx
  InsertSongArtworksRequest
  [InsertSongArtworksRequestItem]
#songArtworks)

    let validationResults :: Map Text (Validation [Text])
validationResults = [Item (Map Text (Validation [Text]))]
-> Map Text (Validation [Text])
forall l. IsList l => [Item l] -> l
fromList ([Item (Map Text (Validation [Text]))]
 -> Map Text (Validation [Text]))
-> [Item (Map Text (Validation [Text]))]
-> Map Text (Validation [Text])
forall a b. (a -> b) -> a -> b
$ (SongArtwork -> (Text, Validation [Text]))
-> [SongArtwork] -> [(Text, Validation [Text])]
forall a b. (a -> b) -> [a] -> [b]
map ((UUID -> Text)
-> (UUID, Validation [Text]) -> (Text, Validation [Text])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
pack (String -> Text) -> (UUID -> String) -> UUID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
forall b a. (Show a, IsString b) => a -> b
Relude.show) ((UUID, Validation [Text]) -> (Text, Validation [Text]))
-> (SongArtwork -> (UUID, Validation [Text]))
-> SongArtwork
-> (Text, Validation [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SongArtwork -> (UUID, Validation [Text])
entityValidation) [SongArtwork]
newArtworks

    Map Text (Validation [Text])
-> Free f (Either SongError InsertSongArtworksCommandResponse)
-> Free f (Either SongError InsertSongArtworksCommandResponse)
forall (f :: * -> *) b.
Applicative f =>
Map Text (Validation [Text])
-> f (Either SongError b) -> f (Either SongError b)
ifAllValid Map Text (Validation [Text])
validationResults (Free f (Either SongError InsertSongArtworksCommandResponse)
 -> Free f (Either SongError InsertSongArtworksCommandResponse))
-> Free f (Either SongError InsertSongArtworksCommandResponse)
-> Free f (Either SongError InsertSongArtworksCommandResponse)
forall a b. (a -> b) -> a -> b
$ do
      Map UUID SongArtwork
insertedArtworks <- Env -> [SongArtwork] -> Free f (Map UUID SongArtwork)
forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [SongArtwork] -> Free f (Map UUID SongArtwork)
insertSongArtworks Env
env [SongArtwork]
newArtworks
      Either SongError InsertSongArtworksCommandResponse
-> Free f (Either SongError InsertSongArtworksCommandResponse)
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Either SongError InsertSongArtworksCommandResponse
 -> Free f (Either SongError InsertSongArtworksCommandResponse))
-> (InsertSongArtworksCommandResponse
    -> Either SongError InsertSongArtworksCommandResponse)
-> InsertSongArtworksCommandResponse
-> Free f (Either SongError InsertSongArtworksCommandResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InsertSongArtworksCommandResponse
-> Either SongError InsertSongArtworksCommandResponse
forall a b. b -> Either a b
Right
        (InsertSongArtworksCommandResponse
 -> Free f (Either SongError InsertSongArtworksCommandResponse))
-> InsertSongArtworksCommandResponse
-> Free f (Either SongError InsertSongArtworksCommandResponse)
forall a b. (a -> b) -> a -> b
$ InsertSongArtworksCommandResponse
          { $sel:songArtworks:InsertSongArtworksCommandResponse :: Map UUID SongArtwork
songArtworks = Map UUID SongArtwork
insertedArtworks,
            $sel:validationResults:InsertSongArtworksCommandResponse :: Map Text (Validation [Text])
validationResults = Map Text (Validation [Text])
validationResults
          }

deleteSongsByIdentifierAction ::
  (SongCommand :<: f) =>
  Env ->
  WikiMusicUser ->
  UUID ->
  Free f (Either SongError ())
deleteSongsByIdentifierAction :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> WikiMusicUser -> UUID -> Free f (Either SongError ())
deleteSongsByIdentifierAction Env
env WikiMusicUser
authUser UUID
identifier =
  WikiMusicUser
-> ([UserRole] -> Bool)
-> SongError
-> Free f (Either SongError ())
-> Free f (Either SongError ())
forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authUser [UserRole] -> Bool
isAtLeastMaintainer SongError
AccessUnauthorizedError (Free f (Either SongError ()) -> Free f (Either SongError ()))
-> Free f (Either SongError ()) -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ do
    Either SongCommandError ()
operationResults <- Env -> [UUID] -> Free f (Either SongCommandError ())
forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [UUID] -> Free f (Either SongCommandError ())
deleteSongs Env
env [UUID
identifier]
    Either SongError () -> Free f (Either SongError ())
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SongError () -> Free f (Either SongError ()))
-> (Either SongCommandError () -> Either SongError ())
-> Either SongCommandError ()
-> Free f (Either SongError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SongCommandError -> SongError)
-> Either SongCommandError () -> Either SongError ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> SongError
SomeError (Text -> SongError)
-> (SongCommandError -> Text) -> SongCommandError -> SongError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text)
-> (SongCommandError -> String) -> SongCommandError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SongCommandError -> String
forall b a. (Show a, IsString b) => a -> b
Relude.show) (Either SongCommandError () -> Free f (Either SongError ()))
-> Either SongCommandError () -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ Either SongCommandError ()
operationResults

deleteSongCommentsByIdentifierAction ::
  (SongCommand :<: f) =>
  Env ->
  WikiMusicUser ->
  UUID ->
  Free f (Either SongError ())
deleteSongCommentsByIdentifierAction :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> WikiMusicUser -> UUID -> Free f (Either SongError ())
deleteSongCommentsByIdentifierAction Env
env WikiMusicUser
authUser UUID
identifier =
  WikiMusicUser
-> ([UserRole] -> Bool)
-> SongError
-> Free f (Either SongError ())
-> Free f (Either SongError ())
forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authUser [UserRole] -> Bool
isAtLeastMaintainer SongError
AccessUnauthorizedError (Free f (Either SongError ()) -> Free f (Either SongError ()))
-> Free f (Either SongError ()) -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ do
    Either SongCommandError ()
operationResults <- Env -> [UUID] -> Free f (Either SongCommandError ())
forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [UUID] -> Free f (Either SongCommandError ())
deleteSongComments Env
env [UUID
identifier]
    Either SongError () -> Free f (Either SongError ())
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SongError () -> Free f (Either SongError ()))
-> (Either SongCommandError () -> Either SongError ())
-> Either SongCommandError ()
-> Free f (Either SongError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SongCommandError -> SongError)
-> Either SongCommandError () -> Either SongError ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> SongError
SomeError (Text -> SongError)
-> (SongCommandError -> Text) -> SongCommandError -> SongError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text)
-> (SongCommandError -> String) -> SongCommandError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SongCommandError -> String
forall b a. (Show a, IsString b) => a -> b
Relude.show) (Either SongCommandError () -> Free f (Either SongError ()))
-> Either SongCommandError () -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ Either SongCommandError ()
operationResults

deleteSongOpinionsByIdentifierAction ::
  (SongCommand :<: f) =>
  Env ->
  WikiMusicUser ->
  UUID ->
  Free f (Either SongError ())
deleteSongOpinionsByIdentifierAction :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> WikiMusicUser -> UUID -> Free f (Either SongError ())
deleteSongOpinionsByIdentifierAction Env
env WikiMusicUser
authUser UUID
identifier =
  WikiMusicUser
-> ([UserRole] -> Bool)
-> SongError
-> Free f (Either SongError ())
-> Free f (Either SongError ())
forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authUser [UserRole] -> Bool
isAtLeastMaintainer SongError
AccessUnauthorizedError (Free f (Either SongError ()) -> Free f (Either SongError ()))
-> Free f (Either SongError ()) -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ do
    Either SongCommandError ()
operationResults <- Env -> [UUID] -> Free f (Either SongCommandError ())
forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [UUID] -> Free f (Either SongCommandError ())
deleteSongOpinions Env
env [UUID
identifier]
    Either SongError () -> Free f (Either SongError ())
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SongError () -> Free f (Either SongError ()))
-> (Either SongCommandError () -> Either SongError ())
-> Either SongCommandError ()
-> Free f (Either SongError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SongCommandError -> SongError)
-> Either SongCommandError () -> Either SongError ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> SongError
SomeError (Text -> SongError)
-> (SongCommandError -> Text) -> SongCommandError -> SongError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text)
-> (SongCommandError -> String) -> SongCommandError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SongCommandError -> String
forall b a. (Show a, IsString b) => a -> b
Relude.show) (Either SongCommandError () -> Free f (Either SongError ()))
-> Either SongCommandError () -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ Either SongCommandError ()
operationResults

deleteSongArtworksByIdentifierAction ::
  (SongCommand :<: f) =>
  Env ->
  WikiMusicUser ->
  UUID ->
  Free f (Either SongError ())
deleteSongArtworksByIdentifierAction :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> WikiMusicUser -> UUID -> Free f (Either SongError ())
deleteSongArtworksByIdentifierAction Env
env WikiMusicUser
authUser UUID
identifier =
  WikiMusicUser
-> ([UserRole] -> Bool)
-> SongError
-> Free f (Either SongError ())
-> Free f (Either SongError ())
forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authUser [UserRole] -> Bool
isAtLeastMaintainer SongError
AccessUnauthorizedError (Free f (Either SongError ()) -> Free f (Either SongError ()))
-> Free f (Either SongError ()) -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ do
    Either SongCommandError ()
operationResults <- Env -> [UUID] -> Free f (Either SongCommandError ())
forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [UUID] -> Free f (Either SongCommandError ())
deleteSongArtworks Env
env [UUID
identifier]
    Either SongError () -> Free f (Either SongError ())
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SongError () -> Free f (Either SongError ()))
-> (Either SongCommandError () -> Either SongError ())
-> Either SongCommandError ()
-> Free f (Either SongError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SongCommandError -> SongError)
-> Either SongCommandError () -> Either SongError ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> SongError
SomeError (Text -> SongError)
-> (SongCommandError -> Text) -> SongCommandError -> SongError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text)
-> (SongCommandError -> String) -> SongCommandError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SongCommandError -> String
forall b a. (Show a, IsString b) => a -> b
Relude.show) (Either SongCommandError () -> Free f (Either SongError ()))
-> Either SongCommandError () -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ Either SongCommandError ()
operationResults

updateSongArtworksOrderAction ::
  (SongCommand :<: f) =>
  Env ->
  WikiMusicUser ->
  SongArtworkOrderUpdateRequest ->
  Free f (Either SongError ())
updateSongArtworksOrderAction :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env
-> WikiMusicUser
-> SongArtworkOrderUpdateRequest
-> Free f (Either SongError ())
updateSongArtworksOrderAction Env
env WikiMusicUser
authUser SongArtworkOrderUpdateRequest
request =
  WikiMusicUser
-> ([UserRole] -> Bool)
-> SongError
-> Free f (Either SongError ())
-> Free f (Either SongError ())
forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authUser [UserRole] -> Bool
isAtLeastLowRank SongError
AccessUnauthorizedError (Free f (Either SongError ()) -> Free f (Either SongError ()))
-> Free f (Either SongError ()) -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ do
    let entityValidation :: SongArtworkOrderUpdate -> (UUID, Validation [Text])
entityValidation SongArtworkOrderUpdate
x = (SongArtworkOrderUpdate
x SongArtworkOrderUpdate
-> Optic' A_Lens NoIx SongArtworkOrderUpdate UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongArtworkOrderUpdate UUID
#identifier, SongArtworkOrderUpdate -> Validation [Text]
validateSongArtworkOrderUpdate SongArtworkOrderUpdate
x)
        songArtworkOrderUpdates :: [SongArtworkOrderUpdate]
songArtworkOrderUpdates = SongArtworkOrderUpdateRequest
request SongArtworkOrderUpdateRequest
-> Optic'
     An_Iso NoIx SongArtworkOrderUpdateRequest [SongArtworkOrderUpdate]
-> [SongArtworkOrderUpdate]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  An_Iso NoIx SongArtworkOrderUpdateRequest [SongArtworkOrderUpdate]
#songArtworkOrders
        validationResults :: Map Text (Validation [Text])
validationResults = [Item (Map Text (Validation [Text]))]
-> Map Text (Validation [Text])
forall l. IsList l => [Item l] -> l
fromList ([Item (Map Text (Validation [Text]))]
 -> Map Text (Validation [Text]))
-> [Item (Map Text (Validation [Text]))]
-> Map Text (Validation [Text])
forall a b. (a -> b) -> a -> b
$ (SongArtworkOrderUpdate -> (Text, Validation [Text]))
-> [SongArtworkOrderUpdate] -> [(Text, Validation [Text])]
forall a b. (a -> b) -> [a] -> [b]
map ((UUID -> Text)
-> (UUID, Validation [Text]) -> (Text, Validation [Text])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
pack (String -> Text) -> (UUID -> String) -> UUID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
forall b a. (Show a, IsString b) => a -> b
Relude.show) ((UUID, Validation [Text]) -> (Text, Validation [Text]))
-> (SongArtworkOrderUpdate -> (UUID, Validation [Text]))
-> SongArtworkOrderUpdate
-> (Text, Validation [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SongArtworkOrderUpdate -> (UUID, Validation [Text])
entityValidation) [SongArtworkOrderUpdate]
songArtworkOrderUpdates

    Map Text (Validation [Text])
-> Free f (Either SongError ()) -> Free f (Either SongError ())
forall (f :: * -> *) b.
Applicative f =>
Map Text (Validation [Text])
-> f (Either SongError b) -> f (Either SongError b)
ifAllValid Map Text (Validation [Text])
validationResults (Free f (Either SongError ()) -> Free f (Either SongError ()))
-> Free f (Either SongError ()) -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ do
      Either Text ()
operationResults <- Env -> [SongArtworkOrderUpdate] -> Free f (Either Text ())
forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [SongArtworkOrderUpdate] -> Free f (Either Text ())
updateSongArtworkOrder Env
env [SongArtworkOrderUpdate]
songArtworkOrderUpdates
      Either SongError () -> Free f (Either SongError ())
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SongError () -> Free f (Either SongError ()))
-> (Either Text () -> Either SongError ())
-> Either Text ()
-> Free f (Either SongError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> SongError) -> Either Text () -> Either SongError ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> SongError
SomeError (Either Text () -> Free f (Either SongError ()))
-> Either Text () -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ Either Text ()
operationResults

updateSongAction ::
  (SongQuery :<: f, SongCommand :<: f) =>
  Env ->
  WikiMusicUser ->
  SongDeltaRequest ->
  Free f (Either SongError ())
updateSongAction :: forall (f :: * -> *).
(SongQuery :<: f, SongCommand :<: f) =>
Env
-> WikiMusicUser
-> SongDeltaRequest
-> Free f (Either SongError ())
updateSongAction Env
env WikiMusicUser
authUser SongDeltaRequest
request =
  WikiMusicUser
-> ([UserRole] -> Bool)
-> SongError
-> Free f (Either SongError ())
-> Free f (Either SongError ())
forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authUser [UserRole] -> Bool
isAtLeastLowRank SongError
AccessUnauthorizedError (Free f (Either SongError ()) -> Free f (Either SongError ()))
-> Free f (Either SongError ()) -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ do
    let entityValidation :: SongDelta -> (UUID, Validation [Text])
entityValidation SongDelta
x = (SongDelta
x SongDelta -> Optic' A_Lens NoIx SongDelta UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongDelta UUID
#identifier, SongDelta -> Validation [Text]
validateSongDelta SongDelta
x)
        deltas :: [SongDelta]
deltas = SongDeltaRequest
request SongDeltaRequest
-> Optic' An_Iso NoIx SongDeltaRequest [SongDelta] -> [SongDelta]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx SongDeltaRequest [SongDelta]
#songDeltas
        validationResults :: Map Text (Validation [Text])
validationResults = [Item (Map Text (Validation [Text]))]
-> Map Text (Validation [Text])
forall l. IsList l => [Item l] -> l
fromList ([Item (Map Text (Validation [Text]))]
 -> Map Text (Validation [Text]))
-> [Item (Map Text (Validation [Text]))]
-> Map Text (Validation [Text])
forall a b. (a -> b) -> a -> b
$ (SongDelta -> (Text, Validation [Text]))
-> [SongDelta] -> [(Text, Validation [Text])]
forall a b. (a -> b) -> [a] -> [b]
map ((UUID -> Text)
-> (UUID, Validation [Text]) -> (Text, Validation [Text])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
pack (String -> Text) -> (UUID -> String) -> UUID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
forall b a. (Show a, IsString b) => a -> b
Relude.show) ((UUID, Validation [Text]) -> (Text, Validation [Text]))
-> (SongDelta -> (UUID, Validation [Text]))
-> SongDelta
-> (Text, Validation [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SongDelta -> (UUID, Validation [Text])
entityValidation) [SongDelta]
deltas

    Map Text (Validation [Text])
-> Free f (Either SongError ()) -> Free f (Either SongError ())
forall (f :: * -> *) b.
Applicative f =>
Map Text (Validation [Text])
-> f (Either SongError b) -> f (Either SongError b)
ifAllValid Map Text (Validation [Text])
validationResults (Free f (Either SongError ()) -> Free f (Either SongError ()))
-> Free f (Either SongError ()) -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ do
      let songIds :: [UUID]
songIds = (SongDelta -> UUID) -> [SongDelta] -> [UUID]
forall a b. (a -> b) -> [a] -> [b]
map (SongDelta -> Optic' A_Lens NoIx SongDelta UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongDelta UUID
#identifier) [SongDelta]
deltas
          deltaMap :: Map UUID SongDelta
deltaMap = [Item (Map UUID SongDelta)] -> Map UUID SongDelta
forall l. IsList l => [Item l] -> l
fromList ([Item (Map UUID SongDelta)] -> Map UUID SongDelta)
-> [Item (Map UUID SongDelta)] -> Map UUID SongDelta
forall a b. (a -> b) -> a -> b
$ (SongDelta -> (UUID, SongDelta))
-> [SongDelta] -> [(UUID, SongDelta)]
forall a b. (a -> b) -> [a] -> [b]
map (\SongDelta
x -> (SongDelta
x SongDelta -> Optic' A_Lens NoIx SongDelta UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongDelta UUID
#identifier, SongDelta
x)) [SongDelta]
deltas

      Map UUID Song
songRecords <- (Map UUID Song, [UUID]) -> Map UUID Song
forall a b. (a, b) -> a
fst ((Map UUID Song, [UUID]) -> Map UUID Song)
-> Free f (Map UUID Song, [UUID]) -> Free f (Map UUID Song)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env -> SongSortOrder -> [UUID] -> Free f (Map UUID Song, [UUID])
forall (f :: * -> *).
(SongQuery :<: f) =>
Env -> SongSortOrder -> [UUID] -> Free f (Map UUID Song, [UUID])
fetchSongsByUUID Env
env SongSortOrder
DescCreatedAt [UUID]
songIds

      let songRecordAndDeltaPairMap :: Map UUID (Song, Maybe SongDelta)
songRecordAndDeltaPairMap = (UUID -> Song -> (Song, Maybe SongDelta))
-> Map UUID Song -> Map UUID (Song, Maybe SongDelta)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\UUID
k Song
v -> (Song
v, Map UUID SongDelta
deltaMap Map UUID SongDelta -> UUID -> Maybe SongDelta
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? UUID
k)) Map UUID Song
songRecords

      Either Text ()
operationResults <- Env -> Map UUID (Song, Maybe SongDelta) -> Free f (Either Text ())
forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> Map UUID (Song, Maybe SongDelta) -> Free f (Either Text ())
updateSongs Env
env Map UUID (Song, Maybe SongDelta)
songRecordAndDeltaPairMap
      Either SongError () -> Free f (Either SongError ())
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SongError () -> Free f (Either SongError ()))
-> (Either Text () -> Either SongError ())
-> Either Text ()
-> Free f (Either SongError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> SongError) -> Either Text () -> Either SongError ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> SongError
SomeError (Either Text () -> Free f (Either SongError ()))
-> Either Text () -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ Either Text ()
operationResults

insertArtistsOfSongAction ::
  (SongCommand :<: f) =>
  Env ->
  WikiMusicUser ->
  InsertArtistsOfSongsRequest ->
  Free f (Either SongError InsertArtistsOfSongCommandResponse)
insertArtistsOfSongAction :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env
-> WikiMusicUser
-> InsertArtistsOfSongsRequest
-> Free f (Either SongError InsertArtistsOfSongCommandResponse)
insertArtistsOfSongAction Env
env WikiMusicUser
authUser InsertArtistsOfSongsRequest
request =
  WikiMusicUser
-> ([UserRole] -> Bool)
-> SongError
-> Free f (Either SongError InsertArtistsOfSongCommandResponse)
-> Free f (Either SongError InsertArtistsOfSongCommandResponse)
forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authUser [UserRole] -> Bool
isAtLeastLowRank SongError
AccessUnauthorizedError (Free f (Either SongError InsertArtistsOfSongCommandResponse)
 -> Free f (Either SongError InsertArtistsOfSongCommandResponse))
-> Free f (Either SongError InsertArtistsOfSongCommandResponse)
-> Free f (Either SongError InsertArtistsOfSongCommandResponse)
forall a b. (a -> b) -> a -> b
$ do
    let entityValidation :: ArtistOfSong -> (UUID, Validation [Text])
entityValidation ArtistOfSong
x = (ArtistOfSong
x ArtistOfSong -> Optic' A_Lens NoIx ArtistOfSong UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ArtistOfSong UUID
#artistIdentifier, ArtistOfSong -> Validation [Text]
validateArtistOfSong ArtistOfSong
x)
    [ArtistOfSong]
newArtistsOfSong <- (InsertArtistsOfSongsRequestItem -> Free f ArtistOfSong)
-> [InsertArtistsOfSongsRequestItem] -> Free f [ArtistOfSong]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (UUID -> InsertArtistsOfSongsRequestItem -> Free f ArtistOfSong
forall (f :: * -> *).
(SongCommand :<: f) =>
UUID -> InsertArtistsOfSongsRequestItem -> Free f ArtistOfSong
newArtistOfSongFromRequest (WikiMusicUser
authUser WikiMusicUser -> Optic' A_Lens NoIx WikiMusicUser UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx WikiMusicUser UUID
#identifier)) (InsertArtistsOfSongsRequest
request InsertArtistsOfSongsRequest
-> Optic'
     An_Iso
     NoIx
     InsertArtistsOfSongsRequest
     [InsertArtistsOfSongsRequestItem]
-> [InsertArtistsOfSongsRequestItem]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  An_Iso
  NoIx
  InsertArtistsOfSongsRequest
  [InsertArtistsOfSongsRequestItem]
#songArtists)
    let validationResults :: Map Text (Validation [Text])
validationResults = [Item (Map Text (Validation [Text]))]
-> Map Text (Validation [Text])
forall l. IsList l => [Item l] -> l
fromList ([Item (Map Text (Validation [Text]))]
 -> Map Text (Validation [Text]))
-> [Item (Map Text (Validation [Text]))]
-> Map Text (Validation [Text])
forall a b. (a -> b) -> a -> b
$ (ArtistOfSong -> (Text, Validation [Text]))
-> [ArtistOfSong] -> [(Text, Validation [Text])]
forall a b. (a -> b) -> [a] -> [b]
map ((UUID -> Text)
-> (UUID, Validation [Text]) -> (Text, Validation [Text])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
pack (String -> Text) -> (UUID -> String) -> UUID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
forall b a. (Show a, IsString b) => a -> b
Relude.show) ((UUID, Validation [Text]) -> (Text, Validation [Text]))
-> (ArtistOfSong -> (UUID, Validation [Text]))
-> ArtistOfSong
-> (Text, Validation [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArtistOfSong -> (UUID, Validation [Text])
entityValidation) [ArtistOfSong]
newArtistsOfSong

    Map Text (Validation [Text])
-> Free f (Either SongError InsertArtistsOfSongCommandResponse)
-> Free f (Either SongError InsertArtistsOfSongCommandResponse)
forall (f :: * -> *) b.
Applicative f =>
Map Text (Validation [Text])
-> f (Either SongError b) -> f (Either SongError b)
ifAllValid Map Text (Validation [Text])
validationResults (Free f (Either SongError InsertArtistsOfSongCommandResponse)
 -> Free f (Either SongError InsertArtistsOfSongCommandResponse))
-> Free f (Either SongError InsertArtistsOfSongCommandResponse)
-> Free f (Either SongError InsertArtistsOfSongCommandResponse)
forall a b. (a -> b) -> a -> b
$ do
      Map UUID ArtistOfSong
newArtistsOfSongMap <- Env -> [ArtistOfSong] -> Free f (Map UUID ArtistOfSong)
forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [ArtistOfSong] -> Free f (Map UUID ArtistOfSong)
insertArtistsOfSongs Env
env [ArtistOfSong]
newArtistsOfSong
      Either SongError InsertArtistsOfSongCommandResponse
-> Free f (Either SongError InsertArtistsOfSongCommandResponse)
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Either SongError InsertArtistsOfSongCommandResponse
 -> Free f (Either SongError InsertArtistsOfSongCommandResponse))
-> (InsertArtistsOfSongCommandResponse
    -> Either SongError InsertArtistsOfSongCommandResponse)
-> InsertArtistsOfSongCommandResponse
-> Free f (Either SongError InsertArtistsOfSongCommandResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InsertArtistsOfSongCommandResponse
-> Either SongError InsertArtistsOfSongCommandResponse
forall a b. b -> Either a b
Right
        (InsertArtistsOfSongCommandResponse
 -> Free f (Either SongError InsertArtistsOfSongCommandResponse))
-> InsertArtistsOfSongCommandResponse
-> Free f (Either SongError InsertArtistsOfSongCommandResponse)
forall a b. (a -> b) -> a -> b
$ InsertArtistsOfSongCommandResponse
          { $sel:songArtists:InsertArtistsOfSongCommandResponse :: Map UUID ArtistOfSong
songArtists = Map UUID ArtistOfSong
newArtistsOfSongMap,
            $sel:validationResults:InsertArtistsOfSongCommandResponse :: Map Text (Validation [Text])
validationResults = Map Text (Validation [Text])
validationResults
          }

deleteArtistsOfSongAction ::
  (SongCommand :<: f) =>
  Env ->
  WikiMusicUser ->
  InsertArtistsOfSongsRequest ->
  Free f (Either SongError ())
deleteArtistsOfSongAction :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env
-> WikiMusicUser
-> InsertArtistsOfSongsRequest
-> Free f (Either SongError ())
deleteArtistsOfSongAction Env
env WikiMusicUser
authUser InsertArtistsOfSongsRequest
request =
  WikiMusicUser
-> ([UserRole] -> Bool)
-> SongError
-> Free f (Either SongError ())
-> Free f (Either SongError ())
forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authUser [UserRole] -> Bool
isAtLeastLowRank SongError
AccessUnauthorizedError (Free f (Either SongError ()) -> Free f (Either SongError ()))
-> Free f (Either SongError ()) -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ do
    let isN :: Maybe (NonEmpty InsertArtistsOfSongsRequestItem)
isN = [InsertArtistsOfSongsRequestItem]
-> Maybe (NonEmpty InsertArtistsOfSongsRequestItem)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (InsertArtistsOfSongsRequest
request InsertArtistsOfSongsRequest
-> Optic'
     An_Iso
     NoIx
     InsertArtistsOfSongsRequest
     [InsertArtistsOfSongsRequestItem]
-> [InsertArtistsOfSongsRequestItem]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  An_Iso
  NoIx
  InsertArtistsOfSongsRequest
  [InsertArtistsOfSongsRequestItem]
#songArtists)
    case Maybe (NonEmpty InsertArtistsOfSongsRequestItem)
isN of
      Maybe (NonEmpty InsertArtistsOfSongsRequestItem)
Nothing -> Either SongError () -> Free f (Either SongError ())
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SongError () -> Free f (Either SongError ()))
-> (String -> Either SongError ())
-> String
-> Free f (Either SongError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SongError -> Either SongError ()
forall a b. a -> Either a b
Left (SongError -> Either SongError ())
-> (String -> SongError) -> String -> Either SongError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SongError
SomeError (Text -> SongError) -> (String -> Text) -> String -> SongError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Free f (Either SongError ()))
-> String -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ String
"No valid data provided!"
      Just NonEmpty InsertArtistsOfSongsRequestItem
songArtists -> do
        let r :: InsertArtistsOfSongsRequestItem
r = NonEmpty InsertArtistsOfSongsRequestItem
-> InsertArtistsOfSongsRequestItem
forall (f :: * -> *) a. IsNonEmpty f a a "head" => f a -> a
head NonEmpty InsertArtistsOfSongsRequestItem
songArtists
        Either SongCommandError ()
operationResults <- Env -> (UUID, UUID) -> Free f (Either SongCommandError ())
forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> (UUID, UUID) -> Free f (Either SongCommandError ())
deleteArtistOfSong Env
env (InsertArtistsOfSongsRequestItem
r InsertArtistsOfSongsRequestItem
-> Optic' A_Lens NoIx InsertArtistsOfSongsRequestItem UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx InsertArtistsOfSongsRequestItem UUID
#songIdentifier, InsertArtistsOfSongsRequestItem
r InsertArtistsOfSongsRequestItem
-> Optic' A_Lens NoIx InsertArtistsOfSongsRequestItem UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx InsertArtistsOfSongsRequestItem UUID
#artistIdentifier)
        Either SongError () -> Free f (Either SongError ())
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          (Either SongError () -> Free f (Either SongError ()))
-> (Either SongCommandError () -> Either SongError ())
-> Either SongCommandError ()
-> Free f (Either SongError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SongCommandError -> SongError)
-> Either SongCommandError () -> Either SongError ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> SongError
SomeError (Text -> SongError)
-> (SongCommandError -> Text) -> SongCommandError -> SongError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text)
-> (SongCommandError -> String) -> SongCommandError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SongCommandError -> String
forall b a. (Show a, IsString b) => a -> b
Relude.show)
          (Either SongCommandError () -> Free f (Either SongError ()))
-> Either SongCommandError () -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ Either SongCommandError ()
operationResults

updateSongContentsAction ::
  (SongCommand :<: f) =>
  Env ->
  WikiMusicUser ->
  SongContentDeltaRequest ->
  Free f (Either SongError ())
updateSongContentsAction :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env
-> WikiMusicUser
-> SongContentDeltaRequest
-> Free f (Either SongError ())
updateSongContentsAction Env
env WikiMusicUser
authUser SongContentDeltaRequest
request =
  WikiMusicUser
-> ([UserRole] -> Bool)
-> SongError
-> Free f (Either SongError ())
-> Free f (Either SongError ())
forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authUser [UserRole] -> Bool
isAtLeastLowRank SongError
AccessUnauthorizedError (Free f (Either SongError ()) -> Free f (Either SongError ()))
-> Free f (Either SongError ()) -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ do
    let entityValidation :: SongContentDelta -> (UUID, Validation [Text])
entityValidation SongContentDelta
x = (SongContentDelta
x SongContentDelta
-> Optic' A_Lens NoIx SongContentDelta UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContentDelta UUID
#identifier, SongContentDelta -> Validation [Text]
validateSongContentDelta SongContentDelta
x)
    let deltas :: [SongContentDelta]
deltas = SongContentDeltaRequest
request SongContentDeltaRequest
-> Optic' An_Iso NoIx SongContentDeltaRequest [SongContentDelta]
-> [SongContentDelta]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx SongContentDeltaRequest [SongContentDelta]
#songContentDeltas
    let validationResults :: Map Text (Validation [Text])
validationResults = [Item (Map Text (Validation [Text]))]
-> Map Text (Validation [Text])
forall l. IsList l => [Item l] -> l
fromList ([Item (Map Text (Validation [Text]))]
 -> Map Text (Validation [Text]))
-> [Item (Map Text (Validation [Text]))]
-> Map Text (Validation [Text])
forall a b. (a -> b) -> a -> b
$ (SongContentDelta -> (Text, Validation [Text]))
-> [SongContentDelta] -> [(Text, Validation [Text])]
forall a b. (a -> b) -> [a] -> [b]
map ((UUID -> Text)
-> (UUID, Validation [Text]) -> (Text, Validation [Text])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
pack (String -> Text) -> (UUID -> String) -> UUID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
forall b a. (Show a, IsString b) => a -> b
Relude.show) ((UUID, Validation [Text]) -> (Text, Validation [Text]))
-> (SongContentDelta -> (UUID, Validation [Text]))
-> SongContentDelta
-> (Text, Validation [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SongContentDelta -> (UUID, Validation [Text])
entityValidation) [SongContentDelta]
deltas

    Map Text (Validation [Text])
-> Free f (Either SongError ()) -> Free f (Either SongError ())
forall (f :: * -> *) b.
Applicative f =>
Map Text (Validation [Text])
-> f (Either SongError b) -> f (Either SongError b)
ifAllValid Map Text (Validation [Text])
validationResults (Free f (Either SongError ()) -> Free f (Either SongError ()))
-> Free f (Either SongError ()) -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ do
      Either Text ()
operationResults <- Env -> [SongContentDelta] -> Free f (Either Text ())
forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [SongContentDelta] -> Free f (Either Text ())
updateSongContents Env
env [SongContentDelta]
deltas
      Either SongError () -> Free f (Either SongError ())
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SongError () -> Free f (Either SongError ()))
-> (Either Text () -> Either SongError ())
-> Either Text ()
-> Free f (Either SongError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> SongError) -> Either Text () -> Either SongError ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> SongError
SomeError (Either Text () -> Free f (Either SongError ()))
-> Either Text () -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ Either Text ()
operationResults

deleteSongContentsByIdentifierAction ::
  (SongCommand :<: f) =>
  Env ->
  WikiMusicUser ->
  UUID ->
  Free f (Either SongError ())
deleteSongContentsByIdentifierAction :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> WikiMusicUser -> UUID -> Free f (Either SongError ())
deleteSongContentsByIdentifierAction Env
env WikiMusicUser
authUser UUID
identifier =
  WikiMusicUser
-> ([UserRole] -> Bool)
-> SongError
-> Free f (Either SongError ())
-> Free f (Either SongError ())
forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authUser [UserRole] -> Bool
isAtLeastMaintainer SongError
AccessUnauthorizedError (Free f (Either SongError ()) -> Free f (Either SongError ()))
-> Free f (Either SongError ()) -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ do
    Either SongCommandError ()
operationResults <- Env -> [UUID] -> Free f (Either SongCommandError ())
forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [UUID] -> Free f (Either SongCommandError ())
deleteSongContents Env
env [UUID
identifier]
    Either SongError () -> Free f (Either SongError ())
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Either SongError () -> Free f (Either SongError ()))
-> (Either SongCommandError () -> Either SongError ())
-> Either SongCommandError ()
-> Free f (Either SongError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SongCommandError -> SongError)
-> Either SongCommandError () -> Either SongError ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> SongError
SomeError (Text -> SongError)
-> (SongCommandError -> Text) -> SongCommandError -> SongError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text)
-> (SongCommandError -> String) -> SongCommandError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SongCommandError -> String
forall b a. (Show a, IsString b) => a -> b
Relude.show)
      (Either SongCommandError () -> Free f (Either SongError ()))
-> Either SongCommandError () -> Free f (Either SongError ())
forall a b. (a -> b) -> a -> b
$ Either SongCommandError ()
operationResults

insertSongContentsAction ::
  (SongQuery :<: f, SongCommand :<: f) =>
  Env ->
  WikiMusicUser ->
  InsertSongContentsRequest ->
  Free f (Either SongError InsertSongContentsCommandResponse)
insertSongContentsAction :: forall (f :: * -> *).
(SongQuery :<: f, SongCommand :<: f) =>
Env
-> WikiMusicUser
-> InsertSongContentsRequest
-> Free f (Either SongError InsertSongContentsCommandResponse)
insertSongContentsAction Env
env WikiMusicUser
authUser InsertSongContentsRequest
request =
  WikiMusicUser
-> ([UserRole] -> Bool)
-> SongError
-> Free f (Either SongError InsertSongContentsCommandResponse)
-> Free f (Either SongError InsertSongContentsCommandResponse)
forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authUser [UserRole] -> Bool
isAtLeastLowRank SongError
AccessUnauthorizedError (Free f (Either SongError InsertSongContentsCommandResponse)
 -> Free f (Either SongError InsertSongContentsCommandResponse))
-> Free f (Either SongError InsertSongContentsCommandResponse)
-> Free f (Either SongError InsertSongContentsCommandResponse)
forall a b. (a -> b) -> a -> b
$ do
    let entityValidation :: SongContent -> (Text, Validation [Text])
entityValidation SongContent
x = ((String -> Text
pack (String -> Text) -> (UUID -> String) -> UUID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> String
forall b a. (Show a, IsString b) => a -> b
Relude.show (UUID -> Text) -> UUID -> Text
forall a b. (a -> b) -> a -> b
$ SongContent
x SongContent -> Optic' A_Lens NoIx SongContent UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent UUID
#songIdentifier) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SongContent
x SongContent -> Optic' A_Lens NoIx SongContent Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent Text
#versionName, SongContent -> Validation [Text]
validateSongContent SongContent
x)

    [SongContent]
newSongContents <- (InsertSongContentsRequestItem -> Free f SongContent)
-> [InsertSongContentsRequestItem] -> Free f [SongContent]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (UUID -> InsertSongContentsRequestItem -> Free f SongContent
forall (f :: * -> *).
(SongCommand :<: f) =>
UUID -> InsertSongContentsRequestItem -> Free f SongContent
newSongContentFromRequest (WikiMusicUser
authUser WikiMusicUser -> Optic' A_Lens NoIx WikiMusicUser UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx WikiMusicUser UUID
#identifier)) (InsertSongContentsRequest
request InsertSongContentsRequest
-> Optic'
     An_Iso
     NoIx
     InsertSongContentsRequest
     [InsertSongContentsRequestItem]
-> [InsertSongContentsRequestItem]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  An_Iso
  NoIx
  InsertSongContentsRequest
  [InsertSongContentsRequestItem]
#songContents)

    let validationResults :: Map Text (Validation [Text])
validationResults = [Item (Map Text (Validation [Text]))]
-> Map Text (Validation [Text])
forall l. IsList l => [Item l] -> l
fromList ([Item (Map Text (Validation [Text]))]
 -> Map Text (Validation [Text]))
-> [Item (Map Text (Validation [Text]))]
-> Map Text (Validation [Text])
forall a b. (a -> b) -> a -> b
$ (SongContent -> (Text, Validation [Text]))
-> [SongContent] -> [(Text, Validation [Text])]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text)
-> (Text, Validation [Text]) -> (Text, Validation [Text])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Text
pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall b a. (Show a, IsString b) => a -> b
Relude.show) ((Text, Validation [Text]) -> (Text, Validation [Text]))
-> (SongContent -> (Text, Validation [Text]))
-> SongContent
-> (Text, Validation [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SongContent -> (Text, Validation [Text])
entityValidation) [SongContent]
newSongContents

    Map Text (Validation [Text])
-> Free f (Either SongError InsertSongContentsCommandResponse)
-> Free f (Either SongError InsertSongContentsCommandResponse)
forall (f :: * -> *) b.
Applicative f =>
Map Text (Validation [Text])
-> f (Either SongError b) -> f (Either SongError b)
ifAllValid Map Text (Validation [Text])
validationResults (Free f (Either SongError InsertSongContentsCommandResponse)
 -> Free f (Either SongError InsertSongContentsCommandResponse))
-> Free f (Either SongError InsertSongContentsCommandResponse)
-> Free f (Either SongError InsertSongContentsCommandResponse)
forall a b. (a -> b) -> a -> b
$ do
      Map UUID SongContent
newSongContentsMap <- Env -> [SongContent] -> Free f (Map UUID SongContent)
forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [SongContent] -> Free f (Map UUID SongContent)
insertSongContents Env
env [SongContent]
newSongContents
      Either SongError InsertSongContentsCommandResponse
-> Free f (Either SongError InsertSongContentsCommandResponse)
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Either SongError InsertSongContentsCommandResponse
 -> Free f (Either SongError InsertSongContentsCommandResponse))
-> (InsertSongContentsCommandResponse
    -> Either SongError InsertSongContentsCommandResponse)
-> InsertSongContentsCommandResponse
-> Free f (Either SongError InsertSongContentsCommandResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InsertSongContentsCommandResponse
-> Either SongError InsertSongContentsCommandResponse
forall a b. b -> Either a b
Right
        (InsertSongContentsCommandResponse
 -> Free f (Either SongError InsertSongContentsCommandResponse))
-> InsertSongContentsCommandResponse
-> Free f (Either SongError InsertSongContentsCommandResponse)
forall a b. (a -> b) -> a -> b
$ InsertSongContentsCommandResponse
          { $sel:songContents:InsertSongContentsCommandResponse :: Map UUID SongContent
songContents = Map UUID SongContent
newSongContentsMap,
            $sel:validationResults:InsertSongContentsCommandResponse :: Map Text (Validation [Text])
validationResults = Map Text (Validation [Text])
validationResults
          }