{-# 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' :: forall (m :: * -> *).
MonadIO m =>
Env
-> UiMode
-> Language
-> Palette
-> SortOrder
-> GetSongsQueryResponse
-> m (MarkupM ())
songListPage' Env
env UiMode
mode Language
language Palette
palette SortOrder
sortOrder GetSongsQueryResponse
xs = do
  MarkupM ()
sharedHead <- Env -> UiMode -> Palette -> Text -> m (MarkupM ())
forall (m :: * -> *).
MonadIO m =>
Env -> UiMode -> Palette -> Text -> m (MarkupM ())
mkSharedHead Env
env UiMode
mode Palette
palette (LanguageDict
dictionary LanguageDict
-> Optic' A_Lens NoIx LanguageDict DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx LanguageDict LanguageDict Titles Titles
#titles Optic A_Lens NoIx LanguageDict LanguageDict Titles Titles
-> Optic A_Lens NoIx Titles Titles DictTerm DictTerm
-> Optic' A_Lens NoIx LanguageDict DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Titles Titles DictTerm DictTerm
#songsPage DictTerm -> Language -> Text
|##| Language
language)
  MarkupM () -> m (MarkupM ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MarkupM () -> m (MarkupM ())) -> MarkupM () -> m (MarkupM ())
forall a b. (a -> b) -> a -> b
$ MarkupM () -> MarkupM ()
H.html (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ do
    MarkupM ()
sharedHead
    MarkupM () -> MarkupM ()
body (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ MarkupM () -> MarkupM ()
section (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ do
      Maybe Text -> UiMode -> Language -> Palette -> MarkupM ()
sharedPageTop (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ LanguageDict
dictionary LanguageDict
-> Optic' A_Lens NoIx LanguageDict DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx LanguageDict LanguageDict Titles Titles
#titles Optic A_Lens NoIx LanguageDict LanguageDict Titles Titles
-> Optic A_Lens NoIx Titles Titles DictTerm DictTerm
-> Optic' A_Lens NoIx LanguageDict DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Titles Titles DictTerm DictTerm
#songsPage DictTerm -> Language -> Text
|##| Language
language) UiMode
mode Language
language Palette
palette
      MarkupM () -> MarkupM ()
section (MarkupM () -> MarkupM ()) -> Attribute -> MarkupM () -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"flex direction-row justify-content-center gap-small align-items-baseline" (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ do
        MarkupM () -> MarkupM ()
H.a (MarkupM () -> MarkupM ()) -> Attribute -> MarkupM () -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href AttributeValue
"/songs/create" (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ MarkupM () -> MarkupM ()
button (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ MarkupM () -> MarkupM ()
H.small MarkupM ()
"+ new song"
        Language -> SortOrder -> Text -> Text -> MarkupM ()
mkSortingForm Language
language SortOrder
sortOrder Text
"/user-preferences/song-sorting" Text
"song-sorting"
      MarkupM () -> MarkupM ()
section (MarkupM () -> MarkupM ()) -> Attribute -> MarkupM () -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"entity-card-section" (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ (Song -> MarkupM ()) -> [Song] -> MarkupM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Language -> Text -> Song -> MarkupM ()
forall k1 k3 k4 k5 k6 k7 k8 k9 a k10 l1 l2 s1 u v k11 s2 k12 s3.
(Is k1 A_Getter, Is k3 A_Getter, Is k4 A_Getter, Is k5 A_Getter,
 Is k6 A_Getter, Is k7 A_Getter, Is k8 A_Getter, Is k9 A_Getter,
 Show a, JoinKinds k10 l1 k4, JoinKinds k10 l2 k3,
 LabelOptic "displayName" k8 s1 s1 Text Text,
 LabelOptic "isLike" l1 u v Bool Bool,
 LabelOptic "artworks" k5 s1 s1 (Map k11 s2) (Map k11 s2),
 LabelOptic "identifier" k7 s1 s1 UUID UUID,
 LabelOptic "opinions" k9 s1 s1 (Map k12 s3) (Map k12 s3),
 LabelOptic "viewCount" k1 s1 s1 a a,
 LabelOptic "artwork" k6 s2 s2 Artwork Artwork,
 LabelOptic "opinion" k10 s3 s3 u v,
 LabelOptic "isDislike" l2 u v Bool Bool) =>
Language -> Text -> s1 -> MarkupM ()
simpleEntityCard Language
language Text
"songs") [Song]
sortedXs
  where
    sortedXs :: [Song]
sortedXs =
      (UUID -> Maybe Song) -> [UUID] -> [Song]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
        (\UUID
identifier -> (GetSongsQueryResponse
xs GetSongsQueryResponse
-> Optic' A_Lens NoIx GetSongsQueryResponse (Map UUID Song)
-> Map UUID Song
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx GetSongsQueryResponse (Map UUID Song)
#songs) Map UUID Song -> UUID -> Maybe Song
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? UUID
identifier)
        (GetSongsQueryResponse
xs GetSongsQueryResponse
-> Optic' A_Lens NoIx GetSongsQueryResponse [UUID] -> [UUID]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx GetSongsQueryResponse [UUID]
#sortOrder)

songDetailPage' :: (MonadIO m) => Env -> UiMode -> Language -> Palette -> SongAsciiSize -> Song -> m Html
songDetailPage' :: forall (m :: * -> *).
MonadIO m =>
Env
-> UiMode
-> Language
-> Palette
-> SongAsciiSize
-> Song
-> m (MarkupM ())
songDetailPage' Env
env UiMode
mode Language
language Palette
palette SongAsciiSize
songAsciiSize Song
x = do
  MarkupM ()
sharedHead <- Env -> UiMode -> Palette -> Text -> m (MarkupM ())
forall (m :: * -> *).
MonadIO m =>
Env -> UiMode -> Palette -> Text -> m (MarkupM ())
mkSharedHead Env
env UiMode
mode Palette
palette (LanguageDict
dictionary LanguageDict
-> Optic' A_Lens NoIx LanguageDict DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx LanguageDict LanguageDict Titles Titles
#titles Optic A_Lens NoIx LanguageDict LanguageDict Titles Titles
-> Optic A_Lens NoIx Titles Titles DictTerm DictTerm
-> Optic' A_Lens NoIx LanguageDict DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Titles Titles DictTerm DictTerm
#songsPage DictTerm -> Language -> Text
|##| Language
language)
  MarkupM () -> m (MarkupM ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MarkupM () -> m (MarkupM ())) -> MarkupM () -> m (MarkupM ())
forall a b. (a -> b) -> a -> b
$ MarkupM () -> MarkupM ()
H.html (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ do
    MarkupM ()
sharedHead
    MarkupM () -> MarkupM ()
body (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ MarkupM () -> MarkupM ()
section (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ do
      Maybe Text -> UiMode -> Language -> Palette -> MarkupM ()
sharedPageTop Maybe Text
forall a. Maybe a
Nothing UiMode
mode Language
language Palette
palette
      Language -> Text -> Song -> MarkupM ()
forall k1 k2 k3 k4 k5 k6 k7 k8 k9 k10 k11 k12 k13 (t1 :: * -> *)
       (t2 :: * -> *) (t3 :: * -> *) (t4 :: * -> *) (t5 :: * -> *)
       (t6 :: * -> *) a1 a2 a3 a4 a5 s k14 a6.
(Is k1 A_Getter, Is k2 A_Getter, Is k3 A_Getter, Is k4 A_Getter,
 Is k5 A_Getter, Is k6 A_Getter, Is k7 A_Getter, Is k8 A_Getter,
 Is k9 A_Getter, Is k10 A_Getter, Is k11 A_Getter, Is k12 A_Getter,
 Is k13 A_Getter, Foldable t1, Foldable t2, Foldable t3,
 Foldable t4, Foldable t5, Foldable t6, Show a1, Show a2, Show a3,
 Show a4, Show a5, Functor t4, LabelOptic "createdAt" k4 s s a2 a2,
 LabelOptic "createdBy" k3 s s a1 a1,
 LabelOptic "lastEditedAt" k11 s s (t4 a5) (t4 a5),
 LabelOptic "displayName" k5 s s Text Text,
 LabelOptic "artworks" k6 s s (Map k14 a6) (Map k14 a6),
 LabelOptic "identifier" k9 s s a3 a3,
 LabelOptic "viewCount" k10 s s a4 a4,
 LabelOptic "artwork" k7 a6 a6 Artwork Artwork,
 LabelOptic "description" k8 s s (t3 Text) (t3 Text),
 LabelOptic "soundcloudUrl" k1 s s (t1 Text) (t1 Text),
 LabelOptic "spotifyUrl" k12 s s (t5 Text) (t5 Text),
 LabelOptic "wikipediaUrl" k2 s s (t2 Text) (t2 Text),
 LabelOptic "youtubeUrl" k13 s s (t6 Text) (t6 Text)) =>
Language -> Text -> s -> MarkupM ()
entityDetails Language
language Text
"songs" Song
x
      Language -> Song -> MarkupM ()
songDetails Language
language Song
x
      MarkupM () -> MarkupM ()
H.div (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ MarkupM () -> MarkupM ()
H.form (MarkupM () -> MarkupM ()) -> Attribute -> MarkupM () -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
action AttributeValue
"/user-preferences/song-ascii-size" (MarkupM () -> MarkupM ()) -> Attribute -> MarkupM () -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
method AttributeValue
"POST" (MarkupM () -> MarkupM ()) -> Attribute -> MarkupM () -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
enctype AttributeValue
"multipart/form-data" (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ do
        MarkupM () -> MarkupM ()
select (MarkupM () -> MarkupM ()) -> Attribute -> MarkupM () -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
onchange AttributeValue
"this.form.submit()" (MarkupM () -> MarkupM ()) -> Attribute -> MarkupM () -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"checkbox" (MarkupM () -> MarkupM ()) -> Attribute -> MarkupM () -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name AttributeValue
"song-ascii-size" (MarkupM () -> MarkupM ()) -> Attribute -> MarkupM () -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"song-ascii-size" (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ do
          (Text -> MarkupM ()) -> [Text] -> MarkupM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
            ( \Text
size' ->
                let mkOption :: MarkupM () -> MarkupM ()
mkOption = MarkupM () -> MarkupM ()
option (MarkupM () -> MarkupM ())
-> (Bool, Attribute) -> MarkupM () -> MarkupM ()
forall h. Attributable h => h -> (Bool, Attribute) -> h
!? ((SongAsciiSize
songAsciiSize SongAsciiSize -> Optic' An_Iso NoIx SongAsciiSize Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx SongAsciiSize Text
#value) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
size', AttributeValue -> Attribute
selected AttributeValue
"true") (MarkupM () -> MarkupM ()) -> Attribute -> MarkupM () -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue)
-> (Text -> String) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
size')
                 in MarkupM () -> MarkupM ()
mkOption (MarkupM () -> MarkupM ())
-> (Text -> MarkupM ()) -> Text -> MarkupM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MarkupM ()
text (Text -> MarkupM ()) -> Text -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ Text
size'
            )
            [Text]
fontSizes
        MarkupM () -> MarkupM ()
noscript (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ MarkupM () -> MarkupM ()
button (MarkupM () -> MarkupM ()) -> Attribute -> MarkupM () -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"submit" (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ MarkupM ()
"submit"
      MarkupM () -> MarkupM ()
section (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ do
        (SongContent -> MarkupM ()) -> Map UUID SongContent -> MarkupM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Language -> SongAsciiSize -> SongContent -> MarkupM ()
mkVersion Language
language SongAsciiSize
songAsciiSize) (Song
x Song
-> Optic' A_Lens NoIx Song (Map UUID SongContent)
-> Map UUID SongContent
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song (Map UUID SongContent)
#contents)
  where
    fontSizes :: [Text]
    fontSizes :: [Text]
fontSizes = [Text
"xx-small", Text
"x-small", Text
"small", Text
"medium", Text
"large", Text
"larger", Text
"x-large", Text
"xx-large"]

songDetails :: Language -> Song -> Html
songDetails :: Language -> Song -> MarkupM ()
songDetails Language
language Song
x = do
  MarkupM () -> MarkupM ()
section (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ MarkupM () -> MarkupM ()
detailList (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ do
    (Text -> MarkupM ()) -> Maybe Text -> MarkupM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
      (Text -> MarkupM () -> MarkupM ()
detailListEntry (LanguageDict
dictionary LanguageDict
-> Optic' A_Lens NoIx LanguageDict DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx LanguageDict LanguageDict More More
#more Optic A_Lens NoIx LanguageDict LanguageDict More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx LanguageDict DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx More More DictTerm DictTerm
#musicTuning DictTerm -> Language -> Text
|##| Language
language) (MarkupM () -> MarkupM ())
-> (Text -> MarkupM ()) -> Text -> MarkupM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MarkupM ()
text)
      (Song
x Song -> Optic' A_Lens NoIx Song (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song (Maybe Text)
#musicTuning)
    (Text -> MarkupM ()) -> Maybe Text -> MarkupM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
      (Text -> MarkupM () -> MarkupM ()
detailListEntry (LanguageDict
dictionary LanguageDict
-> Optic' A_Lens NoIx LanguageDict DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx LanguageDict LanguageDict More More
#more Optic A_Lens NoIx LanguageDict LanguageDict More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx LanguageDict DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx More More DictTerm DictTerm
#musicKey DictTerm -> Language -> Text
|##| Language
language) (MarkupM () -> MarkupM ())
-> (Text -> MarkupM ()) -> Text -> MarkupM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MarkupM ()
text)
      (Song
x Song -> Optic' A_Lens NoIx Song (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song (Maybe Text)
#musicKey)
    (Text -> MarkupM ()) -> Maybe Text -> MarkupM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
      (Text -> MarkupM () -> MarkupM ()
detailListEntry (LanguageDict
dictionary LanguageDict
-> Optic' A_Lens NoIx LanguageDict DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx LanguageDict LanguageDict More More
#more Optic A_Lens NoIx LanguageDict LanguageDict More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx LanguageDict DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx More More DictTerm DictTerm
#musicCreationDate DictTerm -> Language -> Text
|##| Language
language) (MarkupM () -> MarkupM ())
-> (Text -> MarkupM ()) -> Text -> MarkupM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MarkupM ()
text)
      (Song
x Song -> Optic' A_Lens NoIx Song (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song (Maybe Text)
#musicCreationDate)
    (Text -> MarkupM ()) -> Maybe Text -> MarkupM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
      (Text -> MarkupM () -> MarkupM ()
detailListEntry (LanguageDict
dictionary LanguageDict
-> Optic' A_Lens NoIx LanguageDict DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx LanguageDict LanguageDict More More
#more Optic A_Lens NoIx LanguageDict LanguageDict More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx LanguageDict DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx More More DictTerm DictTerm
#albumName DictTerm -> Language -> Text
|##| Language
language) (MarkupM () -> MarkupM ())
-> (Text -> MarkupM ()) -> Text -> MarkupM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MarkupM ()
text)
      (Song
x Song -> Optic' A_Lens NoIx Song (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song (Maybe Text)
#albumName)
    (Text -> MarkupM ()) -> Maybe Text -> MarkupM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
      (Text -> MarkupM () -> MarkupM ()
detailListEntry (LanguageDict
dictionary LanguageDict
-> Optic' A_Lens NoIx LanguageDict DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx LanguageDict LanguageDict More More
#more Optic A_Lens NoIx LanguageDict LanguageDict More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx LanguageDict DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx More More DictTerm DictTerm
#albumInfoLink DictTerm -> Language -> Text
|##| Language
language) (MarkupM () -> MarkupM ())
-> (Text -> MarkupM ()) -> Text -> MarkupM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MarkupM ()
text)
      (Song
x Song -> Optic' A_Lens NoIx Song (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Song (Maybe Text)
#albumInfoLink)

mkVersion :: Language -> SongAsciiSize -> SongContent -> Html
mkVersion :: Language -> SongAsciiSize -> SongContent -> MarkupM ()
mkVersion Language
language SongAsciiSize
songAsciiSize SongContent
v = MarkupM () -> MarkupM ()
H.article (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ do
  MarkupM ()
hr MarkupM () -> Attribute -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"margin-top-medium"
  MarkupM () -> MarkupM ()
h3 (MarkupM () -> MarkupM ())
-> (Text -> MarkupM ()) -> Text -> MarkupM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MarkupM ()
text (Text -> MarkupM ()) -> Text -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ (SongContent
v SongContent -> Optic' A_Lens NoIx SongContent Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent Text
#versionName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (SongContent
v SongContent -> Optic' A_Lens NoIx SongContent Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent Text
#instrumentType)

  MarkupM () -> MarkupM ()
detailList (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ do
    (MarkupM () -> MarkupM ()) -> Maybe (MarkupM ()) -> MarkupM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
      (Text -> MarkupM () -> MarkupM ()
detailListEntry (LanguageDict
dictionary LanguageDict
-> Optic' A_Lens NoIx LanguageDict DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx LanguageDict LanguageDict More More
#more Optic A_Lens NoIx LanguageDict LanguageDict More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx LanguageDict DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx More More DictTerm DictTerm
#lastEditedAt DictTerm -> Language -> Text
|##| Language
language))
      (UTCTime -> MarkupM ()
forall b a. (Show a, IsString b) => a -> b
Relude.show (UTCTime -> MarkupM ()) -> Maybe UTCTime -> Maybe (MarkupM ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SongContent
v SongContent
-> Optic' A_Lens NoIx SongContent (Maybe UTCTime) -> Maybe UTCTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent (Maybe UTCTime)
#lastEditedAt)
    Text -> MarkupM () -> MarkupM ()
detailListEntry (LanguageDict
dictionary LanguageDict
-> Optic' A_Lens NoIx LanguageDict DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx LanguageDict LanguageDict More More
#more Optic A_Lens NoIx LanguageDict LanguageDict More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx LanguageDict DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx More More DictTerm DictTerm
#createdAt DictTerm -> Language -> Text
|##| Language
language) (UTCTime -> MarkupM ()
forall b a. (Show a, IsString b) => a -> b
Relude.show (UTCTime -> MarkupM ()) -> UTCTime -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ SongContent
v SongContent -> Optic' A_Lens NoIx SongContent UTCTime -> UTCTime
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent UTCTime
#createdAt)
    Text -> MarkupM () -> MarkupM ()
detailListEntry (LanguageDict
dictionary LanguageDict
-> Optic' A_Lens NoIx LanguageDict DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx LanguageDict LanguageDict More More
#more Optic A_Lens NoIx LanguageDict LanguageDict More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx LanguageDict DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx More More DictTerm DictTerm
#createdBy DictTerm -> Language -> Text
|##| Language
language) (UUID -> MarkupM ()
forall b a. (Show a, IsString b) => a -> b
Relude.show (UUID -> MarkupM ()) -> UUID -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ SongContent
v SongContent -> Optic' A_Lens NoIx SongContent UUID -> UUID
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent UUID
#createdBy)

  (Text -> MarkupM ()) -> Maybe Text -> MarkupM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    ( \Text
asciiLegend -> MarkupM () -> MarkupM ()
details (MarkupM () -> MarkupM ()) -> Attribute -> MarkupM () -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
open AttributeValue
"" (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ do
        MarkupM () -> MarkupM ()
H.summary MarkupM ()
"ASCII Legend"
        (MarkupM () -> MarkupM ()
H.pre (MarkupM () -> MarkupM ()) -> Attribute -> MarkupM () -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue)
-> (Text -> String) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
"font-size-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (SongAsciiSize
songAsciiSize SongAsciiSize -> Optic' An_Iso NoIx SongAsciiSize Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx SongAsciiSize Text
#value))) (MarkupM () -> MarkupM ())
-> (Text -> MarkupM ()) -> Text -> MarkupM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MarkupM ()
text (Text -> MarkupM ()) -> Text -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ Text
asciiLegend
    )
    (SongContent
v SongContent
-> Optic' A_Lens NoIx SongContent (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent (Maybe Text)
#asciiLegend)
  (Text -> MarkupM ()) -> Maybe Text -> MarkupM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    ( \Text
asciiContents -> MarkupM () -> MarkupM ()
details (MarkupM () -> MarkupM ()) -> Attribute -> MarkupM () -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
open AttributeValue
"" (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ do
        MarkupM () -> MarkupM ()
H.summary MarkupM ()
"ASCII Content"
        (MarkupM () -> MarkupM ()
H.pre (MarkupM () -> MarkupM ()) -> Attribute -> MarkupM () -> MarkupM ()
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue)
-> (Text -> String) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
"font-size-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (SongAsciiSize
songAsciiSize SongAsciiSize -> Optic' An_Iso NoIx SongAsciiSize Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx SongAsciiSize Text
#value))) (MarkupM () -> MarkupM ())
-> (Text -> MarkupM ()) -> Text -> MarkupM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MarkupM ()
text (Text -> MarkupM ()) -> Text -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ Text
asciiContents
    )
    (SongContent
v SongContent
-> Optic' A_Lens NoIx SongContent (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx SongContent (Maybe Text)
#asciiContents)

songCreatePage' :: (MonadIO m) => Env -> UiMode -> Language -> Palette -> m Html
songCreatePage' :: forall (m :: * -> *).
MonadIO m =>
Env -> UiMode -> Language -> Palette -> m (MarkupM ())
songCreatePage' Env
env UiMode
mode Language
language Palette
palette = do
  MarkupM ()
sharedHead <- Env -> UiMode -> Palette -> Text -> m (MarkupM ())
forall (m :: * -> *).
MonadIO m =>
Env -> UiMode -> Palette -> Text -> m (MarkupM ())
mkSharedHead Env
env UiMode
mode Palette
palette (LanguageDict
dictionary LanguageDict
-> Optic' A_Lens NoIx LanguageDict DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx LanguageDict LanguageDict Titles Titles
#titles Optic A_Lens NoIx LanguageDict LanguageDict Titles Titles
-> Optic A_Lens NoIx Titles Titles DictTerm DictTerm
-> Optic' A_Lens NoIx LanguageDict DictTerm
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Titles Titles DictTerm DictTerm
#songsPage DictTerm -> Language -> Text
|##| Language
language)
  MarkupM () -> m (MarkupM ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MarkupM () -> m (MarkupM ())) -> MarkupM () -> m (MarkupM ())
forall a b. (a -> b) -> a -> b
$ MarkupM () -> MarkupM ()
H.html (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ do
    MarkupM ()
sharedHead
    MarkupM () -> MarkupM ()
body (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ MarkupM () -> MarkupM ()
section (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ do
      Maybe Text -> UiMode -> Language -> Palette -> MarkupM ()
sharedPageTop Maybe Text
forall a. Maybe a
Nothing UiMode
mode Language
language Palette
palette
      MarkupM () -> MarkupM ()
section (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ do
        MarkupM () -> MarkupM ()
H.h2 MarkupM ()
"Create song"
        Text -> MarkupM () -> MarkupM ()
postForm Text
"/songs/create" (MarkupM () -> MarkupM ()) -> MarkupM () -> MarkupM ()
forall a b. (a -> b) -> a -> b
$ do
          Text -> Text -> MarkupM ()
requiredTextInput Text
"displayName" Text
"song name"
          Text -> Text -> MarkupM ()
optionalTextArea Text
"description" Text
"description"
          Text -> Text -> MarkupM ()
optionalTextInput Text
"spotifyUrl" Text
"spotify URL"
          Text -> Text -> MarkupM ()
optionalTextInput Text
"youtubeUrl" Text
"youtube URL"
          Text -> Text -> MarkupM ()
optionalTextInput Text
"wikipediaUrl" Text
"wikipedia URL"
          Text -> Text -> MarkupM ()
optionalTextInput Text
"soundcloudUrl" Text
"soundcloud URL"
          Text -> Text -> MarkupM ()
optionalTextInput Text
"musicKey" Text
"music key"
          Text -> Text -> MarkupM ()
optionalTextInput Text
"musicTuning" Text
"tuning"
          Text -> Text -> MarkupM ()
optionalTextInput Text
"musicCreationDate" Text
"date composed"
          Text -> Text -> MarkupM ()
optionalTextInput Text
"albumName" Text
"album name"
          Text -> Text -> MarkupM ()
optionalTextInput Text
"albumInfoLink" Text
"about the album"
          Language -> MarkupM ()
submitButton Language
language