ArtistRoutes.hs

{-# LANGUAGE OverloadedLabels #-}

module WikiMusic.SSR.Servant.ArtistRoutes
  ( artistsRoute,
    artistRoute,
    artistCreateRoute,
    artistCreateFormRoute,
    artistLikeRoute,
    artistEditRoute,
    artistDislikeRoute,
  )
where

import Data.Maybe qualified
import Control.Monad.Error.Class
import Data.ByteString.Lazy qualified as BL
import Data.Map qualified as Map
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.Artist
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 ()

artistsRoute :: (MonadIO m) => Env -> Maybe Text -> Maybe Text -> Maybe Int -> Maybe Int -> m Html
artistsRoute env cookie givenSortOrder limit offset = do
  maybeArtists <-
    liftIO
      $ exec @Backend
        ( getArtists
            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)
    maybeArtists
    (exec @View . artistListPage env (viewVars ^. #uiMode) (viewVars ^. #locale) (viewVars ^. #palette) sortOrder)
  where
    viewVars = viewVarsFromCookies cookie
    sortOrder = maybe (viewVars ^. #artistSorting) SortOrder givenSortOrder

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

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

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

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

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

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