SongHtml.hs

{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module WikiMusic.SSR.View.SongHtml
  ( songListPage',
    songDetailPage',
    songCreatePage',
  )
where

import Data.Map qualified as Map
import Data.Text qualified as T
import Optics
import Relude
import Text.Blaze.Html
import Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A
import WikiMusic.Interaction.Model.Song
import WikiMusic.Model.Song
import WikiMusic.SSR.Language
import WikiMusic.SSR.Model.Api
import WikiMusic.SSR.Model.Env
import WikiMusic.SSR.View.Components.DetailList
import WikiMusic.SSR.View.Components.Forms
import WikiMusic.SSR.View.Components.Meta
import WikiMusic.SSR.View.Components.Other
import WikiMusic.SSR.View.Components.PageTop

songListPage' :: (MonadIO m) => Env -> UiMode -> Language -> Palette -> SortOrder -> GetSongsQueryResponse -> m Html
songListPage' env mode language palette sortOrder xs = do
  sharedHead <- mkSharedHead env mode palette (dictionary ^. #titles % #songsPage |##| language)
  pure $ H.html $ do
    sharedHead
    body $ section $ do
      sharedPageTop (Just $ dictionary ^. #titles % #songsPage |##| language) mode language palette
      section ! class_ "flex direction-row justify-content-center gap-small align-items-baseline" $ do
        H.a ! href "/songs/create" $ button $ H.small "+ new song"
        mkSortingForm language sortOrder "/user-preferences/song-sorting" "song-sorting"
      section ! class_ "entity-card-section" $ mapM_ (simpleEntityCard language "songs") sortedXs
  where
    sortedXs =
      mapMaybe
        (\identifier -> (xs ^. #songs) Map.!? identifier)
        (xs ^. #sortOrder)

songDetailPage' :: (MonadIO m) => Env -> UiMode -> Language -> Palette -> SongAsciiSize -> Song -> m Html
songDetailPage' env mode language palette songAsciiSize x = do
  sharedHead <- mkSharedHead env mode palette (dictionary ^. #titles % #songsPage |##| language)
  pure $ H.html $ do
    sharedHead
    body $ section $ do
      sharedPageTop Nothing mode language palette
      entityDetails language "songs" x
      songDetails language x
      H.div $ H.form ! action "/user-preferences/song-ascii-size" ! method "POST" ! enctype "multipart/form-data" $ do
        select ! onchange "this.form.submit()" ! type_ "checkbox" ! name "song-ascii-size" ! A.id "song-ascii-size" $ do
          mapM_
            ( \size' ->
                let mkOption = option !? ((songAsciiSize ^. #value) == size', selected "true") ! value (fromString . T.unpack $ size')
                 in mkOption . text $ size'
            )
            fontSizes
        noscript $ button ! type_ "submit" $ "submit"
      section $ do
        mapM_ (mkVersion language songAsciiSize) (x ^. #contents)
  where
    fontSizes :: [Text]
    fontSizes = ["xx-small", "x-small", "small", "medium", "large", "larger", "x-large", "xx-large"]

songDetails :: Language -> Song -> Html
songDetails language x = do
  section $ detailList $ do
    mapM_
      (detailListEntry (dictionary ^. #more % #musicTuning |##| language) . text)
      (x ^. #musicTuning)
    mapM_
      (detailListEntry (dictionary ^. #more % #musicKey |##| language) . text)
      (x ^. #musicKey)
    mapM_
      (detailListEntry (dictionary ^. #more % #musicCreationDate |##| language) . text)
      (x ^. #musicCreationDate)
    mapM_
      (detailListEntry (dictionary ^. #more % #albumName |##| language) . text)
      (x ^. #albumName)
    mapM_
      (detailListEntry (dictionary ^. #more % #albumInfoLink |##| language) . text)
      (x ^. #albumInfoLink)

mkVersion :: Language -> SongAsciiSize -> SongContent -> Html
mkVersion language songAsciiSize v = H.article $ do
  hr ! class_ "margin-top-medium"
  h3 . text $ (v ^. #versionName) <> " " <> (v ^. #instrumentType)

  detailList $ do
    mapM_
      (detailListEntry (dictionary ^. #more % #lastEditedAt |##| language))
      (Relude.show <$> v ^. #lastEditedAt)
    detailListEntry (dictionary ^. #more % #createdAt |##| language) (Relude.show $ v ^. #createdAt)
    detailListEntry (dictionary ^. #more % #createdBy |##| language) (Relude.show $ v ^. #createdBy)

  mapM_
    ( \asciiLegend -> details ! open "" $ do
        H.summary "ASCII Legend"
        (H.pre ! class_ (fromString . T.unpack $ "font-size-" <> (songAsciiSize ^. #value))) . text $ asciiLegend
    )
    (v ^. #asciiLegend)
  mapM_
    ( \asciiContents -> details ! open "" $ do
        H.summary "ASCII Content"
        (H.pre ! class_ (fromString . T.unpack $ "font-size-" <> (songAsciiSize ^. #value))) . text $ asciiContents
    )
    (v ^. #asciiContents)

songCreatePage' :: (MonadIO m) => Env -> UiMode -> Language -> Palette -> m Html
songCreatePage' env mode language palette = do
  sharedHead <- mkSharedHead env mode palette (dictionary ^. #titles % #songsPage |##| language)
  pure $ H.html $ do
    sharedHead
    body $ section $ do
      sharedPageTop Nothing mode language palette
      section $ do
        H.h2 "Create song"
        postForm "/songs/create" $ do
          requiredTextInput "displayName" "song name"
          optionalTextArea "description" "description"
          optionalTextInput "spotifyUrl" "spotify URL"
          optionalTextInput "youtubeUrl" "youtube URL"
          optionalTextInput "wikipediaUrl" "wikipedia URL"
          optionalTextInput "soundcloudUrl" "soundcloud URL"
          optionalTextInput "musicKey" "music key"
          optionalTextInput "musicTuning" "tuning"
          optionalTextInput "musicCreationDate" "date composed"
          optionalTextInput "albumName" "album name"
          optionalTextInput "albumInfoLink" "about the album"
          submitButton language