{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoFieldSelectors #-}

module WikiMusic.Free.SongCommand
  ( SongCommand (..),
    insertSongs,
    insertSongComments,
    insertSongArtworks,
    upsertSongOpinions,
    insertSongExternalSources,
    deleteSongs,
    deleteSongComments,
    deleteSongArtworks,
    deleteSongOpinions,
    deleteCommentsOfSongs,
    deleteSongExternalSources,
    deleteArtworksOfSongs,
    deleteOpinionsOfSongs,
    insertArtistsOfSongs,
    deleteArtistsOfSongs,
    deleteArtistOfSong,
    updateSongArtworkOrder,
    updateSongs,
    updateSongExternalSources,
    newSongFromRequest,
    newSongCommentFromRequest,
    newSongOpinionFromRequest,
    newSongArtworkFromRequest,
    newArtistOfSongFromRequest,
    SongCommandError (..),
    insertSongContents,
    updateSongContents,
    deleteSongContents,
    deleteContentsOfSongs,
    newSongContentFromRequest,
    incrementViewsByOne,
  )
where

import Data.UUID
import Free.AlaCarte
import Relude
import WikiMusic.Interaction.Model.Song
import WikiMusic.Model.Env
import WikiMusic.Model.Song

data SongCommandError = PersistenceError Text | LogicError Text
  deriving (SongCommandError -> SongCommandError -> Bool
(SongCommandError -> SongCommandError -> Bool)
-> (SongCommandError -> SongCommandError -> Bool)
-> Eq SongCommandError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SongCommandError -> SongCommandError -> Bool
== :: SongCommandError -> SongCommandError -> Bool
$c/= :: SongCommandError -> SongCommandError -> Bool
/= :: SongCommandError -> SongCommandError -> Bool
Eq, Int -> SongCommandError -> ShowS
[SongCommandError] -> ShowS
SongCommandError -> String
(Int -> SongCommandError -> ShowS)
-> (SongCommandError -> String)
-> ([SongCommandError] -> ShowS)
-> Show SongCommandError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SongCommandError -> ShowS
showsPrec :: Int -> SongCommandError -> ShowS
$cshow :: SongCommandError -> String
show :: SongCommandError -> String
$cshowList :: [SongCommandError] -> ShowS
showList :: [SongCommandError] -> ShowS
Show)

type SongCommand :: Type -> Type
data SongCommand a
  = InsertSongs Env [Song] (Map UUID Song -> a)
  | InsertSongComments Env [SongComment] (Either SongCommandError () -> a)
  | InsertSongArtworks Env [SongArtwork] (Map UUID SongArtwork -> a)
  | InsertArtistsOfSongs Env [ArtistOfSong] (Map UUID ArtistOfSong -> a)
  | InsertSongExternalSources Env [SongExternalSources] (Map UUID SongExternalSources -> a)
  | InsertSongContents Env [SongContent] (Map UUID SongContent -> a)
  | DeleteSongs Env [UUID] (Either SongCommandError () -> a)
  | DeleteSongComments Env [UUID] (Either SongCommandError () -> a)
  | DeleteSongArtworks Env [UUID] (Either SongCommandError () -> a)
  | DeleteSongOpinions Env [UUID] (Either SongCommandError () -> a)
  | DeleteCommentsOfSongs Env [UUID] (Either SongCommandError () -> a)
  | DeleteSongExternalSources Env [UUID] (Either SongCommandError () -> a)
  | DeleteArtworksOfSongs Env [UUID] (Either SongCommandError () -> a)
  | DeleteOpinionsOfSongs Env [UUID] (Either SongCommandError () -> a)
  | DeleteArtistsOfSongs Env [UUID] (Either SongCommandError () -> a)
  | DeleteArtistOfSong Env (UUID, UUID) (Either SongCommandError () -> a)
  | DeleteSongContents Env [UUID] (Either SongCommandError () -> a)
  | DeleteContentsOfSongs Env [UUID] (Either SongCommandError () -> a)
  | UpsertSongOpinions Env [SongOpinion] (Map UUID SongOpinion -> a)
  | UpdateSongArtworkOrder Env [SongArtworkOrderUpdate] (Either Text () -> a)
  | UpdateSongs Env (Map UUID (Song, Maybe SongDelta)) (Either Text () -> a)
  | UpdateSongExternalSources Env (Map UUID (Song, Maybe SongDelta)) (Either Text () -> a)
  | UpdateSongContents Env [SongContentDelta] (Either Text () -> a)
  | NewSongFromRequest UUID InsertSongsRequestItem (Song -> a)
  | -- TODO: separate model generators to their own monad
    NewSongCommentFromRequest UUID InsertSongCommentsRequestItem (SongComment -> a)
  | NewSongOpinionFromRequest UUID UpsertSongOpinionsRequestItem (SongOpinion -> a)
  | NewSongArtworkFromRequest UUID InsertSongArtworksRequestItem (SongArtwork -> a)
  | NewArtistOfSongFromRequest UUID InsertArtistsOfSongsRequestItem (ArtistOfSong -> a)
  | NewSongContentFromRequest UUID InsertSongContentsRequestItem (SongContent -> a)
  | IncrementViewsByOne Env [UUID] (Either SongCommandError () -> a)
  deriving ((forall a b. (a -> b) -> SongCommand a -> SongCommand b)
-> (forall a b. a -> SongCommand b -> SongCommand a)
-> Functor SongCommand
forall a b. a -> SongCommand b -> SongCommand a
forall a b. (a -> b) -> SongCommand a -> SongCommand b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> SongCommand a -> SongCommand b
fmap :: forall a b. (a -> b) -> SongCommand a -> SongCommand b
$c<$ :: forall a b. a -> SongCommand b -> SongCommand a
<$ :: forall a b. a -> SongCommand b -> SongCommand a
Functor)

insertSongs :: (SongCommand :<: f) => Env -> [Song] -> Free f (Map UUID Song)
insertSongs :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [Song] -> Free f (Map UUID Song)
insertSongs Env
env [Song]
songs = SongCommand (Free f (Map UUID Song)) -> Free f (Map UUID Song)
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [Song]
-> (Map UUID Song -> Free f (Map UUID Song))
-> SongCommand (Free f (Map UUID Song))
forall a. Env -> [Song] -> (Map UUID Song -> a) -> SongCommand a
InsertSongs Env
env [Song]
songs Map UUID Song -> Free f (Map UUID Song)
forall (f :: * -> *) a. a -> Free f a
Pure)

insertSongComments :: (SongCommand :<: f) => Env -> [SongComment] -> Free f (Either SongCommandError ())
insertSongComments :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [SongComment] -> Free f (Either SongCommandError ())
insertSongComments Env
env [SongComment]
songComments = SongCommand (Free f (Either SongCommandError ()))
-> Free f (Either SongCommandError ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [SongComment]
-> (Either SongCommandError ()
    -> Free f (Either SongCommandError ()))
-> SongCommand (Free f (Either SongCommandError ()))
forall a.
Env
-> [SongComment]
-> (Either SongCommandError () -> a)
-> SongCommand a
InsertSongComments Env
env [SongComment]
songComments Either SongCommandError () -> Free f (Either SongCommandError ())
forall (f :: * -> *) a. a -> Free f a
Pure)

insertSongArtworks :: (SongCommand :<: f) => Env -> [SongArtwork] -> Free f (Map UUID SongArtwork)
insertSongArtworks :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [SongArtwork] -> Free f (Map UUID SongArtwork)
insertSongArtworks Env
env [SongArtwork]
songArtworks = SongCommand (Free f (Map UUID SongArtwork))
-> Free f (Map UUID SongArtwork)
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [SongArtwork]
-> (Map UUID SongArtwork -> Free f (Map UUID SongArtwork))
-> SongCommand (Free f (Map UUID SongArtwork))
forall a.
Env
-> [SongArtwork] -> (Map UUID SongArtwork -> a) -> SongCommand a
InsertSongArtworks Env
env [SongArtwork]
songArtworks Map UUID SongArtwork -> Free f (Map UUID SongArtwork)
forall (f :: * -> *) a. a -> Free f a
Pure)

upsertSongOpinions :: (SongCommand :<: f) => Env -> [SongOpinion] -> Free f (Map UUID SongOpinion)
upsertSongOpinions :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [SongOpinion] -> Free f (Map UUID SongOpinion)
upsertSongOpinions Env
env [SongOpinion]
songOpinions = SongCommand (Free f (Map UUID SongOpinion))
-> Free f (Map UUID SongOpinion)
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [SongOpinion]
-> (Map UUID SongOpinion -> Free f (Map UUID SongOpinion))
-> SongCommand (Free f (Map UUID SongOpinion))
forall a.
Env
-> [SongOpinion] -> (Map UUID SongOpinion -> a) -> SongCommand a
UpsertSongOpinions Env
env [SongOpinion]
songOpinions Map UUID SongOpinion -> Free f (Map UUID SongOpinion)
forall (f :: * -> *) a. a -> Free f a
Pure)

insertSongExternalSources :: (SongCommand :<: f) => Env -> [SongExternalSources] -> Free f (Map UUID SongExternalSources)
insertSongExternalSources :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env
-> [SongExternalSources] -> Free f (Map UUID SongExternalSources)
insertSongExternalSources Env
env [SongExternalSources]
songExternalSources = SongCommand (Free f (Map UUID SongExternalSources))
-> Free f (Map UUID SongExternalSources)
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [SongExternalSources]
-> (Map UUID SongExternalSources
    -> Free f (Map UUID SongExternalSources))
-> SongCommand (Free f (Map UUID SongExternalSources))
forall a.
Env
-> [SongExternalSources]
-> (Map UUID SongExternalSources -> a)
-> SongCommand a
InsertSongExternalSources Env
env [SongExternalSources]
songExternalSources Map UUID SongExternalSources
-> Free f (Map UUID SongExternalSources)
forall (f :: * -> *) a. a -> Free f a
Pure)

deleteSongs :: (SongCommand :<: f) => Env -> [UUID] -> Free f (Either SongCommandError ())
deleteSongs :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [UUID] -> Free f (Either SongCommandError ())
deleteSongs Env
env [UUID]
uuids = SongCommand (Free f (Either SongCommandError ()))
-> Free f (Either SongCommandError ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [UUID]
-> (Either SongCommandError ()
    -> Free f (Either SongCommandError ()))
-> SongCommand (Free f (Either SongCommandError ()))
forall a.
Env -> [UUID] -> (Either SongCommandError () -> a) -> SongCommand a
DeleteSongs Env
env [UUID]
uuids Either SongCommandError () -> Free f (Either SongCommandError ())
forall (f :: * -> *) a. a -> Free f a
Pure)

deleteSongComments :: (SongCommand :<: f) => Env -> [UUID] -> Free f (Either SongCommandError ())
deleteSongComments :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [UUID] -> Free f (Either SongCommandError ())
deleteSongComments Env
env [UUID]
uuids = SongCommand (Free f (Either SongCommandError ()))
-> Free f (Either SongCommandError ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [UUID]
-> (Either SongCommandError ()
    -> Free f (Either SongCommandError ()))
-> SongCommand (Free f (Either SongCommandError ()))
forall a.
Env -> [UUID] -> (Either SongCommandError () -> a) -> SongCommand a
DeleteSongComments Env
env [UUID]
uuids Either SongCommandError () -> Free f (Either SongCommandError ())
forall (f :: * -> *) a. a -> Free f a
Pure)

deleteSongArtworks :: (SongCommand :<: f) => Env -> [UUID] -> Free f (Either SongCommandError ())
deleteSongArtworks :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [UUID] -> Free f (Either SongCommandError ())
deleteSongArtworks Env
env [UUID]
uuids = SongCommand (Free f (Either SongCommandError ()))
-> Free f (Either SongCommandError ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [UUID]
-> (Either SongCommandError ()
    -> Free f (Either SongCommandError ()))
-> SongCommand (Free f (Either SongCommandError ()))
forall a.
Env -> [UUID] -> (Either SongCommandError () -> a) -> SongCommand a
DeleteSongArtworks Env
env [UUID]
uuids Either SongCommandError () -> Free f (Either SongCommandError ())
forall (f :: * -> *) a. a -> Free f a
Pure)

deleteArtistsOfSongs :: (SongCommand :<: f) => Env -> [UUID] -> Free f (Either SongCommandError ())
deleteArtistsOfSongs :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [UUID] -> Free f (Either SongCommandError ())
deleteArtistsOfSongs Env
env [UUID]
uuids = SongCommand (Free f (Either SongCommandError ()))
-> Free f (Either SongCommandError ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [UUID]
-> (Either SongCommandError ()
    -> Free f (Either SongCommandError ()))
-> SongCommand (Free f (Either SongCommandError ()))
forall a.
Env -> [UUID] -> (Either SongCommandError () -> a) -> SongCommand a
DeleteArtistsOfSongs Env
env [UUID]
uuids Either SongCommandError () -> Free f (Either SongCommandError ())
forall (f :: * -> *) a. a -> Free f a
Pure)

deleteArtistOfSong :: (SongCommand :<: f) => Env -> (UUID, UUID) -> Free f (Either SongCommandError ())
deleteArtistOfSong :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> (UUID, UUID) -> Free f (Either SongCommandError ())
deleteArtistOfSong Env
env (UUID, UUID)
uuids = SongCommand (Free f (Either SongCommandError ()))
-> Free f (Either SongCommandError ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> (UUID, UUID)
-> (Either SongCommandError ()
    -> Free f (Either SongCommandError ()))
-> SongCommand (Free f (Either SongCommandError ()))
forall a.
Env
-> (UUID, UUID)
-> (Either SongCommandError () -> a)
-> SongCommand a
DeleteArtistOfSong Env
env (UUID, UUID)
uuids Either SongCommandError () -> Free f (Either SongCommandError ())
forall (f :: * -> *) a. a -> Free f a
Pure)

deleteSongContents :: (SongCommand :<: f) => Env -> [UUID] -> Free f (Either SongCommandError ())
deleteSongContents :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [UUID] -> Free f (Either SongCommandError ())
deleteSongContents Env
env [UUID]
uuids = SongCommand (Free f (Either SongCommandError ()))
-> Free f (Either SongCommandError ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [UUID]
-> (Either SongCommandError ()
    -> Free f (Either SongCommandError ()))
-> SongCommand (Free f (Either SongCommandError ()))
forall a.
Env -> [UUID] -> (Either SongCommandError () -> a) -> SongCommand a
DeleteSongContents Env
env [UUID]
uuids Either SongCommandError () -> Free f (Either SongCommandError ())
forall (f :: * -> *) a. a -> Free f a
Pure)

deleteContentsOfSongs :: (SongCommand :<: f) => Env -> [UUID] -> Free f (Either SongCommandError ())
deleteContentsOfSongs :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [UUID] -> Free f (Either SongCommandError ())
deleteContentsOfSongs Env
env [UUID]
uuids = SongCommand (Free f (Either SongCommandError ()))
-> Free f (Either SongCommandError ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [UUID]
-> (Either SongCommandError ()
    -> Free f (Either SongCommandError ()))
-> SongCommand (Free f (Either SongCommandError ()))
forall a.
Env -> [UUID] -> (Either SongCommandError () -> a) -> SongCommand a
DeleteContentsOfSongs Env
env [UUID]
uuids Either SongCommandError () -> Free f (Either SongCommandError ())
forall (f :: * -> *) a. a -> Free f a
Pure)

deleteSongOpinions :: (SongCommand :<: f) => Env -> [UUID] -> Free f (Either SongCommandError ())
deleteSongOpinions :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [UUID] -> Free f (Either SongCommandError ())
deleteSongOpinions Env
env [UUID]
uuids = SongCommand (Free f (Either SongCommandError ()))
-> Free f (Either SongCommandError ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [UUID]
-> (Either SongCommandError ()
    -> Free f (Either SongCommandError ()))
-> SongCommand (Free f (Either SongCommandError ()))
forall a.
Env -> [UUID] -> (Either SongCommandError () -> a) -> SongCommand a
DeleteSongOpinions Env
env [UUID]
uuids Either SongCommandError () -> Free f (Either SongCommandError ())
forall (f :: * -> *) a. a -> Free f a
Pure)

deleteCommentsOfSongs :: (SongCommand :<: f) => Env -> [UUID] -> Free f (Either SongCommandError ())
deleteCommentsOfSongs :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [UUID] -> Free f (Either SongCommandError ())
deleteCommentsOfSongs Env
env [UUID]
uuids = SongCommand (Free f (Either SongCommandError ()))
-> Free f (Either SongCommandError ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [UUID]
-> (Either SongCommandError ()
    -> Free f (Either SongCommandError ()))
-> SongCommand (Free f (Either SongCommandError ()))
forall a.
Env -> [UUID] -> (Either SongCommandError () -> a) -> SongCommand a
DeleteCommentsOfSongs Env
env [UUID]
uuids Either SongCommandError () -> Free f (Either SongCommandError ())
forall (f :: * -> *) a. a -> Free f a
Pure)

deleteSongExternalSources :: (SongCommand :<: f) => Env -> [UUID] -> Free f (Either SongCommandError ())
deleteSongExternalSources :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [UUID] -> Free f (Either SongCommandError ())
deleteSongExternalSources Env
env [UUID]
uuids = SongCommand (Free f (Either SongCommandError ()))
-> Free f (Either SongCommandError ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [UUID]
-> (Either SongCommandError ()
    -> Free f (Either SongCommandError ()))
-> SongCommand (Free f (Either SongCommandError ()))
forall a.
Env -> [UUID] -> (Either SongCommandError () -> a) -> SongCommand a
DeleteSongExternalSources Env
env [UUID]
uuids Either SongCommandError () -> Free f (Either SongCommandError ())
forall (f :: * -> *) a. a -> Free f a
Pure)

deleteArtworksOfSongs :: (SongCommand :<: f) => Env -> [UUID] -> Free f (Either SongCommandError ())
deleteArtworksOfSongs :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [UUID] -> Free f (Either SongCommandError ())
deleteArtworksOfSongs Env
env [UUID]
uuids = SongCommand (Free f (Either SongCommandError ()))
-> Free f (Either SongCommandError ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [UUID]
-> (Either SongCommandError ()
    -> Free f (Either SongCommandError ()))
-> SongCommand (Free f (Either SongCommandError ()))
forall a.
Env -> [UUID] -> (Either SongCommandError () -> a) -> SongCommand a
DeleteArtworksOfSongs Env
env [UUID]
uuids Either SongCommandError () -> Free f (Either SongCommandError ())
forall (f :: * -> *) a. a -> Free f a
Pure)

deleteOpinionsOfSongs :: (SongCommand :<: f) => Env -> [UUID] -> Free f (Either SongCommandError ())
deleteOpinionsOfSongs :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [UUID] -> Free f (Either SongCommandError ())
deleteOpinionsOfSongs Env
env [UUID]
uuids = SongCommand (Free f (Either SongCommandError ()))
-> Free f (Either SongCommandError ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [UUID]
-> (Either SongCommandError ()
    -> Free f (Either SongCommandError ()))
-> SongCommand (Free f (Either SongCommandError ()))
forall a.
Env -> [UUID] -> (Either SongCommandError () -> a) -> SongCommand a
DeleteOpinionsOfSongs Env
env [UUID]
uuids Either SongCommandError () -> Free f (Either SongCommandError ())
forall (f :: * -> *) a. a -> Free f a
Pure)

insertSongContents :: (SongCommand :<: f) => Env -> [SongContent] -> Free f (Map UUID SongContent)
insertSongContents :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [SongContent] -> Free f (Map UUID SongContent)
insertSongContents Env
env [SongContent]
contents = SongCommand (Free f (Map UUID SongContent))
-> Free f (Map UUID SongContent)
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [SongContent]
-> (Map UUID SongContent -> Free f (Map UUID SongContent))
-> SongCommand (Free f (Map UUID SongContent))
forall a.
Env
-> [SongContent] -> (Map UUID SongContent -> a) -> SongCommand a
InsertSongContents Env
env [SongContent]
contents Map UUID SongContent -> Free f (Map UUID SongContent)
forall (f :: * -> *) a. a -> Free f a
Pure)

updateSongArtworkOrder :: (SongCommand :<: f) => Env -> [SongArtworkOrderUpdate] -> Free f (Either Text ())
updateSongArtworkOrder :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [SongArtworkOrderUpdate] -> Free f (Either Text ())
updateSongArtworkOrder Env
env [SongArtworkOrderUpdate]
uuids = SongCommand (Free f (Either Text ())) -> Free f (Either Text ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [SongArtworkOrderUpdate]
-> (Either Text () -> Free f (Either Text ()))
-> SongCommand (Free f (Either Text ()))
forall a.
Env
-> [SongArtworkOrderUpdate]
-> (Either Text () -> a)
-> SongCommand a
UpdateSongArtworkOrder Env
env [SongArtworkOrderUpdate]
uuids Either Text () -> Free f (Either Text ())
forall (f :: * -> *) a. a -> Free f a
Pure)

updateSongs :: (SongCommand :<: f) => Env -> Map UUID (Song, Maybe SongDelta) -> Free f (Either Text ())
updateSongs :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> Map UUID (Song, Maybe SongDelta) -> Free f (Either Text ())
updateSongs Env
env Map UUID (Song, Maybe SongDelta)
deltas = SongCommand (Free f (Either Text ())) -> Free f (Either Text ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> Map UUID (Song, Maybe SongDelta)
-> (Either Text () -> Free f (Either Text ()))
-> SongCommand (Free f (Either Text ()))
forall a.
Env
-> Map UUID (Song, Maybe SongDelta)
-> (Either Text () -> a)
-> SongCommand a
UpdateSongs Env
env Map UUID (Song, Maybe SongDelta)
deltas Either Text () -> Free f (Either Text ())
forall (f :: * -> *) a. a -> Free f a
Pure)

updateSongExternalSources :: (SongCommand :<: f) => Env -> Map UUID (Song, Maybe SongDelta) -> Free f (Either Text ())
updateSongExternalSources :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> Map UUID (Song, Maybe SongDelta) -> Free f (Either Text ())
updateSongExternalSources Env
env Map UUID (Song, Maybe SongDelta)
deltas = SongCommand (Free f (Either Text ())) -> Free f (Either Text ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> Map UUID (Song, Maybe SongDelta)
-> (Either Text () -> Free f (Either Text ()))
-> SongCommand (Free f (Either Text ()))
forall a.
Env
-> Map UUID (Song, Maybe SongDelta)
-> (Either Text () -> a)
-> SongCommand a
UpdateSongExternalSources Env
env Map UUID (Song, Maybe SongDelta)
deltas Either Text () -> Free f (Either Text ())
forall (f :: * -> *) a. a -> Free f a
Pure)

updateSongContents :: (SongCommand :<: f) => Env -> [SongContentDelta] -> Free f (Either Text ())
updateSongContents :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [SongContentDelta] -> Free f (Either Text ())
updateSongContents Env
env [SongContentDelta]
deltas = SongCommand (Free f (Either Text ())) -> Free f (Either Text ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [SongContentDelta]
-> (Either Text () -> Free f (Either Text ()))
-> SongCommand (Free f (Either Text ()))
forall a.
Env -> [SongContentDelta] -> (Either Text () -> a) -> SongCommand a
UpdateSongContents Env
env [SongContentDelta]
deltas Either Text () -> Free f (Either Text ())
forall (f :: * -> *) a. a -> Free f a
Pure)

newSongFromRequest :: (SongCommand :<: f) => UUID -> InsertSongsRequestItem -> Free f Song
newSongFromRequest :: forall (f :: * -> *).
(SongCommand :<: f) =>
UUID -> InsertSongsRequestItem -> Free f Song
newSongFromRequest UUID
uuid InsertSongsRequestItem
req = SongCommand (Free f Song) -> Free f Song
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (UUID
-> InsertSongsRequestItem
-> (Song -> Free f Song)
-> SongCommand (Free f Song)
forall a.
UUID -> InsertSongsRequestItem -> (Song -> a) -> SongCommand a
NewSongFromRequest UUID
uuid InsertSongsRequestItem
req Song -> Free f Song
forall (f :: * -> *) a. a -> Free f a
Pure)

newSongCommentFromRequest :: (SongCommand :<: f) => UUID -> InsertSongCommentsRequestItem -> Free f SongComment
newSongCommentFromRequest :: forall (f :: * -> *).
(SongCommand :<: f) =>
UUID -> InsertSongCommentsRequestItem -> Free f SongComment
newSongCommentFromRequest UUID
uuid InsertSongCommentsRequestItem
req = SongCommand (Free f SongComment) -> Free f SongComment
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (UUID
-> InsertSongCommentsRequestItem
-> (SongComment -> Free f SongComment)
-> SongCommand (Free f SongComment)
forall a.
UUID
-> InsertSongCommentsRequestItem
-> (SongComment -> a)
-> SongCommand a
NewSongCommentFromRequest UUID
uuid InsertSongCommentsRequestItem
req SongComment -> Free f SongComment
forall (f :: * -> *) a. a -> Free f a
Pure)

newSongOpinionFromRequest :: (SongCommand :<: f) => UUID -> UpsertSongOpinionsRequestItem -> Free f SongOpinion
newSongOpinionFromRequest :: forall (f :: * -> *).
(SongCommand :<: f) =>
UUID -> UpsertSongOpinionsRequestItem -> Free f SongOpinion
newSongOpinionFromRequest UUID
uuid UpsertSongOpinionsRequestItem
req = SongCommand (Free f SongOpinion) -> Free f SongOpinion
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (UUID
-> UpsertSongOpinionsRequestItem
-> (SongOpinion -> Free f SongOpinion)
-> SongCommand (Free f SongOpinion)
forall a.
UUID
-> UpsertSongOpinionsRequestItem
-> (SongOpinion -> a)
-> SongCommand a
NewSongOpinionFromRequest UUID
uuid UpsertSongOpinionsRequestItem
req SongOpinion -> Free f SongOpinion
forall (f :: * -> *) a. a -> Free f a
Pure)

newSongContentFromRequest :: (SongCommand :<: f) => UUID -> InsertSongContentsRequestItem -> Free f SongContent
newSongContentFromRequest :: forall (f :: * -> *).
(SongCommand :<: f) =>
UUID -> InsertSongContentsRequestItem -> Free f SongContent
newSongContentFromRequest UUID
uuid InsertSongContentsRequestItem
req = SongCommand (Free f SongContent) -> Free f SongContent
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (UUID
-> InsertSongContentsRequestItem
-> (SongContent -> Free f SongContent)
-> SongCommand (Free f SongContent)
forall a.
UUID
-> InsertSongContentsRequestItem
-> (SongContent -> a)
-> SongCommand a
NewSongContentFromRequest UUID
uuid InsertSongContentsRequestItem
req SongContent -> Free f SongContent
forall (f :: * -> *) a. a -> Free f a
Pure)

newSongArtworkFromRequest :: (SongCommand :<: f) => UUID -> InsertSongArtworksRequestItem -> Free f SongArtwork
newSongArtworkFromRequest :: forall (f :: * -> *).
(SongCommand :<: f) =>
UUID -> InsertSongArtworksRequestItem -> Free f SongArtwork
newSongArtworkFromRequest UUID
uuid InsertSongArtworksRequestItem
req = SongCommand (Free f SongArtwork) -> Free f SongArtwork
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (UUID
-> InsertSongArtworksRequestItem
-> (SongArtwork -> Free f SongArtwork)
-> SongCommand (Free f SongArtwork)
forall a.
UUID
-> InsertSongArtworksRequestItem
-> (SongArtwork -> a)
-> SongCommand a
NewSongArtworkFromRequest UUID
uuid InsertSongArtworksRequestItem
req SongArtwork -> Free f SongArtwork
forall (f :: * -> *) a. a -> Free f a
Pure)

insertArtistsOfSongs :: (SongCommand :<: f) => Env -> [ArtistOfSong] -> Free f (Map UUID ArtistOfSong)
insertArtistsOfSongs :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [ArtistOfSong] -> Free f (Map UUID ArtistOfSong)
insertArtistsOfSongs Env
env [ArtistOfSong]
art = SongCommand (Free f (Map UUID ArtistOfSong))
-> Free f (Map UUID ArtistOfSong)
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [ArtistOfSong]
-> (Map UUID ArtistOfSong -> Free f (Map UUID ArtistOfSong))
-> SongCommand (Free f (Map UUID ArtistOfSong))
forall a.
Env
-> [ArtistOfSong] -> (Map UUID ArtistOfSong -> a) -> SongCommand a
InsertArtistsOfSongs Env
env [ArtistOfSong]
art Map UUID ArtistOfSong -> Free f (Map UUID ArtistOfSong)
forall (f :: * -> *) a. a -> Free f a
Pure)

newArtistOfSongFromRequest :: (SongCommand :<: f) => UUID -> InsertArtistsOfSongsRequestItem -> Free f ArtistOfSong
newArtistOfSongFromRequest :: forall (f :: * -> *).
(SongCommand :<: f) =>
UUID -> InsertArtistsOfSongsRequestItem -> Free f ArtistOfSong
newArtistOfSongFromRequest UUID
uuid InsertArtistsOfSongsRequestItem
req = SongCommand (Free f ArtistOfSong) -> Free f ArtistOfSong
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (UUID
-> InsertArtistsOfSongsRequestItem
-> (ArtistOfSong -> Free f ArtistOfSong)
-> SongCommand (Free f ArtistOfSong)
forall a.
UUID
-> InsertArtistsOfSongsRequestItem
-> (ArtistOfSong -> a)
-> SongCommand a
NewArtistOfSongFromRequest UUID
uuid InsertArtistsOfSongsRequestItem
req ArtistOfSong -> Free f ArtistOfSong
forall (f :: * -> *) a. a -> Free f a
Pure)

incrementViewsByOne :: (SongCommand :<: f) => Env -> [UUID] -> Free f (Either SongCommandError ())
incrementViewsByOne :: forall (f :: * -> *).
(SongCommand :<: f) =>
Env -> [UUID] -> Free f (Either SongCommandError ())
incrementViewsByOne Env
env [UUID]
uuids = SongCommand (Free f (Either SongCommandError ()))
-> Free f (Either SongCommandError ())
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [UUID]
-> (Either SongCommandError ()
    -> Free f (Either SongCommandError ()))
-> SongCommand (Free f (Either SongCommandError ()))
forall a.
Env -> [UUID] -> (Either SongCommandError () -> a) -> SongCommand a
IncrementViewsByOne Env
env [UUID]
uuids Either SongCommandError () -> Free f (Either SongCommandError ())
forall (f :: * -> *) a. a -> Free f a
Pure)