GenreRoutes.hs

{-# LANGUAGE OverloadedLabels #-}

module WikiMusic.SSR.Servant.GenreRoutes
  ( genresRoute,
    genreRoute,
    genreCreateRoute,
    genreCreateFormRoute,
    genreLikeRoute,
    genreDislikeRoute,
    genreEditRoute
  )
where

import Data.Map qualified as Map
import Data.Maybe qualified 
import Control.Monad.Error.Class
import Data.ByteString.Lazy qualified as BL
import Data.Text qualified as T
import Data.UUID (UUID)
import Free.AlaCarte
import Optics
import Relude
import Servant
import Servant.Multipart
import Text.Blaze.Html as Html
import WikiMusic.Interaction.Model.Genre
import WikiMusic.Model.Other
import WikiMusic.SSR.Backend.Rest ()
import WikiMusic.SSR.Free.Backend
import WikiMusic.SSR.Free.View
import WikiMusic.SSR.Model.Api
import WikiMusic.SSR.Model.Env
import WikiMusic.SSR.Servant.Utilities
import WikiMusic.SSR.View.Html ()

genresRoute :: (MonadIO m) => Env -> Maybe Text -> Maybe Text -> Maybe Int -> Maybe Int -> m Html
genresRoute env cookie givenSortOrder limit offset = do
  maybeGenres <-
    liftIO
      $ exec @Backend
        ( getGenres
            env
            (viewVars ^. #authToken)
            (maybe (Limit 50) Limit limit)
            (maybe (Offset 0) Offset offset)
            sortOrder
            (Include {value = "artworks,comments,opinions"})
        )
  eitherView
    env
    (viewVars ^. #uiMode)
    (viewVars ^. #locale)
    (viewVars ^. #palette)
    maybeGenres
    (exec @View . genreListPage env (viewVars ^. #uiMode) (viewVars ^. #locale) (viewVars ^. #palette) sortOrder)
  where
    viewVars = viewVarsFromCookies cookie
    sortOrder = maybe (viewVars ^. #genreSorting) SortOrder givenSortOrder

genreRoute :: (MonadIO m) => Env -> Maybe Text -> UUID -> m Html
genreRoute env cookie identifier = do
  maybeGenres <-
    liftIO
      $ exec @Backend
        ( getGenre
            env
            (viewVars ^. #authToken)
            identifier
            (Include {value = "artworks,comments,opinions"})
        )
  eitherView
    env
    (viewVars ^. #uiMode)
    (viewVars ^. #locale)
    (viewVars ^. #palette)
    maybeGenres
    (exec @View . genreDetailPage env (viewVars ^. #uiMode) (viewVars ^. #locale) (viewVars ^. #palette))
  where
    viewVars = viewVarsFromCookies cookie

genreCreateRoute :: (MonadIO m) => Env -> Maybe Text -> m Html
genreCreateRoute env cookie = do
  liftIO $ exec @View (genreCreatePage env (viewVars ^. #uiMode) (viewVars ^. #locale) (viewVars ^. #palette))
  where
    viewVars = viewVarsFromCookies cookie

genreCreateFormRoute :: (MonadIO m, MonadError ServerError m) => Env -> Maybe Text -> MultipartData tag -> m a
genreCreateFormRoute env cookie multipartData = do
  createResult <- liftIO $ exec @Backend (createGenre env (viewVars ^. #authToken) r)
  _ <- liftIO $ BL.putStr (fromString . show $ createResult)
  throwError
    $ ServerError
      { errHTTPCode = 302,
        errReasonPhrase = "Found",
        errBody = "",
        errHeaders =
          [("Location", "/genres")]
      }
  where
    viewVars = viewVarsFromCookies cookie
    r =
      InsertGenresRequest
        { genres =
            [ InsertGenresRequestItem
                { displayName = fromForm multipartData "" "displayName",
                  spotifyUrl = maybeFromForm multipartData "spotifyUrl",
                  youtubeUrl = maybeFromForm multipartData "youtubeUrl",
                  soundcloudUrl = maybeFromForm multipartData "soundcloudUrl",
                  wikipediaUrl = maybeFromForm multipartData "wikipediaUrl",
                  description = maybeFromForm multipartData "description"
                }
            ]
        }

genreLikeRoute :: (MonadIO m, MonadError ServerError m) => Env -> Maybe Text -> Maybe Text -> UUID -> m a
genreLikeRoute env cookie maybeReferer identifier = do
  res <- liftIO $ exec @Backend (upsertGenreOpinion env (viewVars ^. #authToken) r)
  _ <- liftIO $ BL.putStr (fromString . show $ res)
  throwError
    $ ServerError
      { errHTTPCode = 302,
        errReasonPhrase = "Found",
        errBody = "",
        errHeaders =
          [("Location", fromString . T.unpack $ fromMaybe "/genres" maybeReferer)]
      }
  where
    viewVars = viewVarsFromCookies cookie
    r =
      UpsertGenreOpinionsRequest
        { genreOpinions =
            [ UpsertGenreOpinionsRequestItem
                { genreIdentifier = identifier,
                  isLike = True
                }
            ]
        }

genreDislikeRoute :: (MonadIO m, MonadError ServerError m) => Env -> Maybe Text -> Maybe Text -> UUID -> m a
genreDislikeRoute env cookie maybeReferer identifier = do
  res <- liftIO $ exec @Backend (upsertGenreOpinion env (viewVars ^. #authToken) r)
  _ <- liftIO $ BL.putStr (fromString . show $ res)
  throwError
    $ ServerError
      { errHTTPCode = 302,
        errReasonPhrase = "Found",
        errBody = "",
        errHeaders =
          [("Location", fromString . T.unpack $ fromMaybe "/genres" maybeReferer)]
      }
  where
    viewVars = viewVarsFromCookies cookie
    r =
      UpsertGenreOpinionsRequest
        { genreOpinions =
            [ UpsertGenreOpinionsRequestItem
                { genreIdentifier = identifier,
                  isLike = False
                }
            ]
        }

genreEditRoute :: (MonadIO m) => Env -> Maybe Text -> UUID -> m Html
genreEditRoute env cookie identifier = do
  maybeGenres <-
    liftIO
      $ exec @Backend
        ( getGenre
            env
            (viewVars ^. #authToken)
            identifier
            (Include {value = "artworks,comments,opinions"})
        )
  let a = second (\x -> (head . Data.Maybe.fromJust . nonEmpty) $ Map.elems $ x ^. #genres) maybeGenres
  eitherView
    env
    (viewVars ^. #uiMode)
    (viewVars ^. #locale)
    (viewVars ^. #palette)
    a
    (exec @View . genreEditPage env (viewVars ^. #uiMode) (viewVars ^. #locale) (viewVars ^. #palette))
  where
    viewVars = viewVarsFromCookies cookie