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

module WikiMusic.Free.GenreQuery
  ( GenreQuery (..),
    fetchGenres,
    fetchGenresByUUID,
    enrichedGenreResponse,
    fetchGenreComments,
    fetchGenreOpinions,
    fetchGenreArtworks,
    GenreQueryError (..),
    searchGenres,
  )
where

import Free.AlaCarte
import WikiMusic.Interaction.Model.Genre
import WikiMusic.Model.Genre
import WikiMusic.Model.Other
import WikiMusic.Protolude

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

type GenreQuery :: Type -> Type
data GenreQuery a
  = FetchGenres Env GenreSortOrder Limit Offset ((Map UUID Genre, [UUID]) -> a)
  | FetchGenresByUUID Env GenreSortOrder [UUID] ((Map UUID Genre, [UUID]) -> a)
  | EnrichedGenreResponse Env (Map UUID Genre) EnrichGenreParams (Map UUID Genre -> a)
  | FetchGenreComments Env [UUID] (Map UUID GenreComment -> a)
  | FetchGenreOpinions Env [UUID] (Map UUID GenreOpinion -> a)
  | FetchGenreArtworks Env [UUID] (Map UUID GenreArtwork -> a)
  | SearchGenres Env SearchInput GenreSortOrder Limit Offset ((Map UUID Genre, [UUID]) -> a)
  deriving ((forall a b. (a -> b) -> GenreQuery a -> GenreQuery b)
-> (forall a b. a -> GenreQuery b -> GenreQuery a)
-> Functor GenreQuery
forall a b. a -> GenreQuery b -> GenreQuery a
forall a b. (a -> b) -> GenreQuery a -> GenreQuery 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) -> GenreQuery a -> GenreQuery b
fmap :: forall a b. (a -> b) -> GenreQuery a -> GenreQuery b
$c<$ :: forall a b. a -> GenreQuery b -> GenreQuery a
<$ :: forall a b. a -> GenreQuery b -> GenreQuery a
Functor)

fetchGenres :: (GenreQuery :<: f) => Env -> GenreSortOrder -> Limit -> Offset -> Free f (Map UUID Genre, [UUID])
fetchGenres :: forall (f :: * -> *).
(GenreQuery :<: f) =>
Env
-> GenreSortOrder
-> Limit
-> Offset
-> Free f (Map UUID Genre, [UUID])
fetchGenres Env
env GenreSortOrder
sortOrder Limit
limit Offset
offset = GenreQuery (Free f (Map UUID Genre, [UUID]))
-> Free f (Map UUID Genre, [UUID])
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> GenreSortOrder
-> Limit
-> Offset
-> ((Map UUID Genre, [UUID]) -> Free f (Map UUID Genre, [UUID]))
-> GenreQuery (Free f (Map UUID Genre, [UUID]))
forall a.
Env
-> GenreSortOrder
-> Limit
-> Offset
-> ((Map UUID Genre, [UUID]) -> a)
-> GenreQuery a
FetchGenres Env
env GenreSortOrder
sortOrder Limit
limit Offset
offset (Map UUID Genre, [UUID]) -> Free f (Map UUID Genre, [UUID])
forall (f :: * -> *) a. a -> Free f a
Pure)

fetchGenresByUUID :: (GenreQuery :<: f) => Env -> GenreSortOrder -> [UUID] -> Free f (Map UUID Genre, [UUID])
fetchGenresByUUID :: forall (f :: * -> *).
(GenreQuery :<: f) =>
Env -> GenreSortOrder -> [UUID] -> Free f (Map UUID Genre, [UUID])
fetchGenresByUUID Env
env GenreSortOrder
sortOrder [UUID]
uuids = GenreQuery (Free f (Map UUID Genre, [UUID]))
-> Free f (Map UUID Genre, [UUID])
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> GenreSortOrder
-> [UUID]
-> ((Map UUID Genre, [UUID]) -> Free f (Map UUID Genre, [UUID]))
-> GenreQuery (Free f (Map UUID Genre, [UUID]))
forall a.
Env
-> GenreSortOrder
-> [UUID]
-> ((Map UUID Genre, [UUID]) -> a)
-> GenreQuery a
FetchGenresByUUID Env
env GenreSortOrder
sortOrder [UUID]
uuids (Map UUID Genre, [UUID]) -> Free f (Map UUID Genre, [UUID])
forall (f :: * -> *) a. a -> Free f a
Pure)

enrichedGenreResponse :: (GenreQuery :<: f) => Env -> Map UUID Genre -> EnrichGenreParams -> Free f (Map UUID Genre)
enrichedGenreResponse :: forall (f :: * -> *).
(GenreQuery :<: f) =>
Env
-> Map UUID Genre -> EnrichGenreParams -> Free f (Map UUID Genre)
enrichedGenreResponse Env
env Map UUID Genre
genres EnrichGenreParams
enrichParams = GenreQuery (Free f (Map UUID Genre)) -> Free f (Map UUID Genre)
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> Map UUID Genre
-> EnrichGenreParams
-> (Map UUID Genre -> Free f (Map UUID Genre))
-> GenreQuery (Free f (Map UUID Genre))
forall a.
Env
-> Map UUID Genre
-> EnrichGenreParams
-> (Map UUID Genre -> a)
-> GenreQuery a
EnrichedGenreResponse Env
env Map UUID Genre
genres EnrichGenreParams
enrichParams Map UUID Genre -> Free f (Map UUID Genre)
forall (f :: * -> *) a. a -> Free f a
Pure)

fetchGenreComments :: (GenreQuery :<: f) => Env -> [UUID] -> Free f (Map UUID GenreComment)
fetchGenreComments :: forall (f :: * -> *).
(GenreQuery :<: f) =>
Env -> [UUID] -> Free f (Map UUID GenreComment)
fetchGenreComments Env
env [UUID]
uuids = GenreQuery (Free f (Map UUID GenreComment))
-> Free f (Map UUID GenreComment)
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [UUID]
-> (Map UUID GenreComment -> Free f (Map UUID GenreComment))
-> GenreQuery (Free f (Map UUID GenreComment))
forall a.
Env -> [UUID] -> (Map UUID GenreComment -> a) -> GenreQuery a
FetchGenreComments Env
env [UUID]
uuids Map UUID GenreComment -> Free f (Map UUID GenreComment)
forall (f :: * -> *) a. a -> Free f a
Pure)

fetchGenreOpinions :: (GenreQuery :<: f) => Env -> [UUID] -> Free f (Map UUID GenreOpinion)
fetchGenreOpinions :: forall (f :: * -> *).
(GenreQuery :<: f) =>
Env -> [UUID] -> Free f (Map UUID GenreOpinion)
fetchGenreOpinions Env
env [UUID]
uuids = GenreQuery (Free f (Map UUID GenreOpinion))
-> Free f (Map UUID GenreOpinion)
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [UUID]
-> (Map UUID GenreOpinion -> Free f (Map UUID GenreOpinion))
-> GenreQuery (Free f (Map UUID GenreOpinion))
forall a.
Env -> [UUID] -> (Map UUID GenreOpinion -> a) -> GenreQuery a
FetchGenreOpinions Env
env [UUID]
uuids Map UUID GenreOpinion -> Free f (Map UUID GenreOpinion)
forall (f :: * -> *) a. a -> Free f a
Pure)

fetchGenreArtworks :: (GenreQuery :<: f) => Env -> [UUID] -> Free f (Map UUID GenreArtwork)
fetchGenreArtworks :: forall (f :: * -> *).
(GenreQuery :<: f) =>
Env -> [UUID] -> Free f (Map UUID GenreArtwork)
fetchGenreArtworks Env
env [UUID]
uuids = GenreQuery (Free f (Map UUID GenreArtwork))
-> Free f (Map UUID GenreArtwork)
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> [UUID]
-> (Map UUID GenreArtwork -> Free f (Map UUID GenreArtwork))
-> GenreQuery (Free f (Map UUID GenreArtwork))
forall a.
Env -> [UUID] -> (Map UUID GenreArtwork -> a) -> GenreQuery a
FetchGenreArtworks Env
env [UUID]
uuids Map UUID GenreArtwork -> Free f (Map UUID GenreArtwork)
forall (f :: * -> *) a. a -> Free f a
Pure)

searchGenres :: (GenreQuery :<: f) => Env -> SearchInput -> GenreSortOrder -> Limit -> Offset -> Free f (Map UUID Genre, [UUID])
searchGenres :: forall (f :: * -> *).
(GenreQuery :<: f) =>
Env
-> SearchInput
-> GenreSortOrder
-> Limit
-> Offset
-> Free f (Map UUID Genre, [UUID])
searchGenres Env
env SearchInput
searchInput GenreSortOrder
sortOrder Limit
limit Offset
offset = GenreQuery (Free f (Map UUID Genre, [UUID]))
-> Free f (Map UUID Genre, [UUID])
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> SearchInput
-> GenreSortOrder
-> Limit
-> Offset
-> ((Map UUID Genre, [UUID]) -> Free f (Map UUID Genre, [UUID]))
-> GenreQuery (Free f (Map UUID Genre, [UUID]))
forall a.
Env
-> SearchInput
-> GenreSortOrder
-> Limit
-> Offset
-> ((Map UUID Genre, [UUID]) -> a)
-> GenreQuery a
SearchGenres Env
env SearchInput
searchInput GenreSortOrder
sortOrder Limit
limit Offset
offset (Map UUID Genre, [UUID]) -> Free f (Map UUID Genre, [UUID])
forall (f :: * -> *) a. a -> Free f a
Pure)