SongRoutes.hs

{-# LANGUAGE OverloadedLabels #-}

module WikiMusic.SSR.Servant.SongRoutes
  ( songsRoute,
    songRoute,
    songCreateRoute,
    songCreateFormRoute,
    songLikeRoute,
    songDislikeRoute,
    songEditRoute,
  )
where

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.Song
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 ()
import Data.Map qualified as Map
import Data.Maybe qualified 

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

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

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

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

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

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

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