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

module WikiMusic.SSR.View.Components.Meta
  ( mkSharedHead,
  )
where

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.SSR.Model.Api
import WikiMusic.SSR.Model.Env

mkSharedHead :: (MonadIO m) => Env -> UiMode -> Palette -> Text -> m Html
mkSharedHead :: forall (m :: * -> *).
MonadIO m =>
Env -> UiMode -> Palette -> Text -> m Html
mkSharedHead Env
env UiMode
mode Palette
palette Text
pageTitle = do
  let style' :: Html
style' = String -> Html
forall a. IsString a => String -> a
fromString (String -> Html) -> (Text -> String) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ (Env
env Env -> Optic' A_Lens NoIx Env Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Env Text
#mainCss)
  let modeStyle :: Text
modeStyle =
        if (UiMode
mode UiMode -> Optic' An_Iso NoIx UiMode Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx UiMode Text
#value) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dark"
          then Env
env Env -> Optic' A_Lens NoIx Env Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Env Text
#darkCss
          else Env
env Env -> Optic' A_Lens NoIx Env Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Env Text
#lightCss
  let paletteStyle :: Text
paletteStyle = case Palette
palette Palette -> Optic' An_Iso NoIx Palette Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx Palette Text
#value of
        Text
"green" -> Env
env Env -> Optic' A_Lens NoIx Env Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx Env Env PalettesCss PalettesCss
#palettes Optic A_Lens NoIx Env Env PalettesCss PalettesCss
-> Optic A_Lens NoIx PalettesCss PalettesCss Text Text
-> Optic' A_Lens NoIx Env 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 A_Lens NoIx PalettesCss PalettesCss Text Text
#green
        Text
_ -> Env
env Env -> Optic' A_Lens NoIx Env Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx Env Env PalettesCss PalettesCss
#palettes Optic A_Lens NoIx Env Env PalettesCss PalettesCss
-> Optic A_Lens NoIx PalettesCss PalettesCss Text Text
-> Optic' A_Lens NoIx Env 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 A_Lens NoIx PalettesCss PalettesCss Text Text
#mauve

  Html -> m Html
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Html -> m Html) -> Html -> m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.head (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html
H.meta Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
charset AttributeValue
"utf-8"
    Html
H.meta Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
lang AttributeValue
"en"
    Html -> Html
H.title (Html -> Html) -> (Text -> Html) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Html
forall a. IsString a => String -> a
fromString (String -> Html) -> (Text -> String) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text
pageTitle
    Html
meta Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name AttributeValue
"viewport" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
content AttributeValue
"width=device-width, initial-scale=1"
    Html -> Html
H.style (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. IsString a => String -> a
fromString (String -> Html) -> (Text -> String) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text
modeStyle
    Html -> Html
H.style (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. IsString a => String -> a
fromString (String -> Html) -> (Text -> String) -> Text -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text
paletteStyle
    Html -> Html
H.style Html
style'