{-# LANGUAGE OverloadedLabels #-}

module WikiMusic.SSR.View.Components.PageTop where

import Principium
import Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A
import WikiMusic.SSR.View.Components.Icons

sharedPageTop :: Maybe Text -> ViewVars -> Html
sharedPageTop :: Maybe Text -> ViewVars -> Html
sharedPageTop Maybe Text
title' ViewVars
vv = do
  ViewVars -> Html
topTitle ViewVars
vv
  ViewVars -> Html
myNav ViewVars
vv

  Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"flex", Text
"flex-wrap", Text
"flex-row", Text
"gap-6", Text
"justify-center"] (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    ViewVars -> Html
userPrefs ViewVars
vv
    -- warningBanner language
    Maybe Text -> Html
maybeTitle Maybe Text
title'

maybeTitle :: Maybe Text -> Html
maybeTitle :: Maybe Text -> Html
maybeTitle =
  (Text -> Html) -> Maybe Text -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
    ( (Html -> Html
h2 (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"text-2xl", Text
"text-grey-600", Text
"font-mono"])
        (Html -> Html) -> (Text -> Html) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html
text
    )

languageMenu :: ViewVars -> Html
languageMenu :: ViewVars -> Html
languageMenu ViewVars
vv = do
  Html -> Html
H.form
  (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
action AttributeValue
"/user-preferences/locale"
  (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
method AttributeValue
"POST"
  (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
enctype AttributeValue
"multipart/form-data"
  (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
select (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! Set Text -> Attribute
css (ViewVars -> Set Text
cssSelect ViewVars
vv) (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
onchange AttributeValue
"this.form.submit()" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name AttributeValue
"locale" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      ((Text, Text) -> Html) -> [(Text, Text)] -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ViewVars -> (Text, Text) -> Html
mkLanguageOption ViewVars
vv) [(Text
"en", Text
"🇬🇧 English"), (Text
"nl", Text
"🇳🇱 Nederlands")]
    Html -> Html
noscript (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
button (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"submit" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"submit"

mkLanguageOption :: ViewVars -> (Text, Text) -> Html
mkLanguageOption :: ViewVars -> (Text, Text) -> Html
mkLanguageOption ViewVars
vv (Text
locale, Text
viewLabel) =
  ( Html -> Html
option
      (Html -> Html) -> (Bool, Attribute) -> Html -> Html
forall h. Attributable h => h -> (Bool, Attribute) -> h
H.!? ((ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language Optic' A_Lens NoIx ViewVars Language
-> Optic An_Iso NoIx Language Language Text Text
-> Optic' A_Lens NoIx ViewVars Text
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 An_Iso NoIx Language Language Text Text
#value) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpackText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
locale), AttributeValue -> Attribute
selected (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
unpackText (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
""))
      (Html -> Html) -> Attribute -> Html -> Html
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
unpackText (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
locale)
  )
    (Html -> Html) -> (Text -> Html) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html
text
    (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text
viewLabel

myNav :: ViewVars -> Html
myNav :: ViewVars -> Html
myNav ViewVars
vv = do
  Html
hr
  Html -> Html
nav (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"flex", Text
"flex-row", Text
"flex-wrap", Text
"gap-8", Text
"py-4", Text
"justify-center"] (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"flex", Text
"flex-wrap", Text
"flex-row", Text
"justify-center", Text
"gap-8", Text
"items-center", Text
"font-mono"] (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Html -> Html
a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text]
navLinkClass (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href AttributeValue
"/songs" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
text ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
#more Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary 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
#songsNav) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language))
      Html -> Html
a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text]
navLinkClass (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href AttributeValue
"/artists" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
text ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
#more Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary 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
#artistsNav) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language))
      Html -> Html
a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text]
navLinkClass (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href AttributeValue
"/genres" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
text ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
#more Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary 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
#genresNav) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language))
      Html -> Html
a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text]
navLinkClass (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href AttributeValue
"/login" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
text ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
#more Optic
  A_Lens NoIx ApplicationDictionary ApplicationDictionary More More
-> Optic A_Lens NoIx More More DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary 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
#loginNav) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language))
    Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"flex", Text
"flex-wrap", Text
"flex-row", Text
"justify-center", Text
"gap-8", Text
"items-center"] (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      ViewVars -> Html
languageMenu ViewVars
vv
  Html
hr
  where
    navLinkClass :: [Text]
navLinkClass = [Text
"text-lg", Text
"font-bold", if ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx ViewVars ViewVars UiMode UiMode
#uiMode Optic A_Lens NoIx ViewVars ViewVars UiMode UiMode
-> Optic An_Iso NoIx UiMode UiMode Text Text
-> Optic' A_Lens NoIx ViewVars Text
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 An_Iso NoIx UiMode UiMode Text Text
#value Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dark" then Text
"text-stone-200" else Text
"text-stone-700"]

userPrefs :: ViewVars -> Html
userPrefs :: ViewVars -> Html
userPrefs ViewVars
vv = do
  Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css' [Text
"mt-6", Text
"flex", Text
"flex-wrap", Text
"flex-row", Text
"gap-6", Text
"justify-center", Text
"align-center"] (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> Html
H.form (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
action AttributeValue
"/user-preferences/dark-mode" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
method AttributeValue
"POST" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
enctype AttributeValue
"multipart/form-data" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Html -> Html
select (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! Set Text -> Attribute
css (ViewVars -> Set Text
cssSelect ViewVars
vv) (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
onchange AttributeValue
"this.form.submit()" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"checkbox" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name AttributeValue
"dark-mode" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"dark-mode" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
option (Html -> Html) -> (Bool, Attribute) -> Html -> Html
forall h. Attributable h => h -> (Bool, Attribute) -> h
H.!? ((ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx ViewVars ViewVars UiMode UiMode
#uiMode Optic A_Lens NoIx ViewVars ViewVars UiMode UiMode
-> Optic An_Iso NoIx UiMode UiMode Text Text
-> Optic' A_Lens NoIx ViewVars Text
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 An_Iso NoIx UiMode UiMode Text Text
#value) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dark", AttributeValue -> Attribute
selected AttributeValue
"true") (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value AttributeValue
"dark" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Html
simpleIcon Text
"🌙" Text
"dark mode"
        Html -> Html
option (Html -> Html) -> (Bool, Attribute) -> Html -> Html
forall h. Attributable h => h -> (Bool, Attribute) -> h
H.!? ((ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx ViewVars ViewVars UiMode UiMode
#uiMode Optic A_Lens NoIx ViewVars ViewVars UiMode UiMode
-> Optic An_Iso NoIx UiMode UiMode Text Text
-> Optic' A_Lens NoIx ViewVars Text
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 An_Iso NoIx UiMode UiMode Text Text
#value) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"light", AttributeValue -> Attribute
selected AttributeValue
"true") (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value AttributeValue
"light" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Html
simpleIcon Text
"☀️" Text
"light mode"
      Html -> Html
noscript (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
button (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"submit" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"submit"

    Html -> Html
H.form (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
action AttributeValue
"/user-preferences/palette" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
method AttributeValue
"POST" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
enctype AttributeValue
"multipart/form-data" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Html -> Html
select (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! Set Text -> Attribute
css (ViewVars -> Set Text
cssSelect ViewVars
vv) (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
onchange AttributeValue
"this.form.submit()" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"checkbox" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name AttributeValue
"palette" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id AttributeValue
"palette" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        (Text -> Html) -> [Text] -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
          (ViewVars -> Text -> Html
mkPaletteOption ViewVars
vv)
          ( [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort
              [ Text
"purple",
                Text
"green",
                Text
"amber",
                Text
"stone",
                Text
"white",
                Text
"red",
                Text
"pink",
                Text
"orange",
                Text
"slate",
                Text
"gray",
                Text
"yellow",
                Text
"lime",
                Text
"emerald",
                Text
"teal",
                Text
"cyan",
                Text
"sky",
                Text
"blue",
                Text
"indigo",
                Text
"violet",
                Text
"rose"
              ]
          )
      Html -> Html
noscript (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
button (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"submit" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
"submit"

mkPaletteOption :: ViewVars -> Text -> Html
mkPaletteOption :: ViewVars -> Text -> Html
mkPaletteOption ViewVars
vv Text
choice = do
  (Html -> Html
option (Html -> Html) -> (Bool, Attribute) -> Html -> Html
forall h. Attributable h => h -> (Bool, Attribute) -> h
H.!? ((ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx ViewVars ViewVars Palette Palette
#palette Optic A_Lens NoIx ViewVars ViewVars Palette Palette
-> Optic An_Iso NoIx Palette Palette Text Text
-> Optic' A_Lens NoIx ViewVars Text
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 An_Iso NoIx Palette Palette Text Text
#value) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
choice, AttributeValue -> Attribute
selected AttributeValue
"true") (Html -> Html) -> Attribute -> Html -> Html
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
unpackText (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
choice)) (Html -> Html) -> (Text -> Html) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Html
text (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text
choice

topTitle :: ViewVars -> Html
topTitle :: ViewVars -> Html
topTitle ViewVars
vv = do
  Html -> Html
section
    (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css'
      [ Text
"flex",
        Text
"flex-wrap",
        Text
"flex-row",
        Text
"justify-center",
        Text
"align-center",
        Text
"gap-8",
        Text
"px-3",
        Text
"py-3"
      ]
    (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Html -> Html
a
        (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
href AttributeValue
"/songs"
        (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
h1
        (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css'
          [ Text
"text-xl",
            Text
"font-bold",
            Text
"font-mono",
            Text
"italic",
            if ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx ViewVars ViewVars UiMode UiMode
#uiMode Optic A_Lens NoIx ViewVars ViewVars UiMode UiMode
-> Optic An_Iso NoIx UiMode UiMode Text Text
-> Optic' A_Lens NoIx ViewVars Text
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 An_Iso NoIx UiMode UiMode Text Text
#value Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dark" then Text
"text-stone-200" else Text
"text-stone-800"
          ]
        (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
text ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  ApplicationDictionary
  ApplicationDictionary
  Titles
  Titles
#titles Optic
  A_Lens
  NoIx
  ApplicationDictionary
  ApplicationDictionary
  Titles
  Titles
-> Optic A_Lens NoIx Titles Titles DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary 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
#wikimusicSSR) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language))
      Html -> Html
em
        (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! [Text] -> Attribute
css'
          [ Text
"text-xl",
            Text
"font-light",
            Text
"font-mono",
            Text
"italic",
            if ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx ViewVars ViewVars UiMode UiMode
#uiMode Optic A_Lens NoIx ViewVars ViewVars UiMode UiMode
-> Optic An_Iso NoIx UiMode UiMode Text Text
-> Optic' A_Lens NoIx ViewVars Text
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 An_Iso NoIx UiMode UiMode Text Text
#value Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dark" then Text
"text-stone-200" else Text
"text-stone-800"
          ]
        (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
text ((ApplicationDictionary
-> Optic' A_Lens NoIx ApplicationDictionary DictTerm -> DictTerm
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  ApplicationDictionary
  ApplicationDictionary
  Slogans
  Slogans
#slogans Optic
  A_Lens
  NoIx
  ApplicationDictionary
  ApplicationDictionary
  Slogans
  Slogans
-> Optic An_Iso NoIx Slogans Slogans DictTerm DictTerm
-> Optic' A_Lens NoIx ApplicationDictionary 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 An_Iso NoIx Slogans Slogans DictTerm DictTerm
#pageTop) (ApplicationDictionary -> DictTerm) -> Language -> Text
|##| (ViewVars
vv ViewVars -> Optic' A_Lens NoIx ViewVars Language -> Language
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx ViewVars Language
#language))