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

module WikiMusic.SSR.View.Html () where

import Data.Map qualified as Map
import Data.Text qualified as T
import Free.AlaCarte
import Optics
import Relude
import Text.Blaze.Html
import Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A
import WikiMusic.SSR.Free.View
import WikiMusic.SSR.Language
import WikiMusic.SSR.Model.Api
import WikiMusic.SSR.Model.Env
import WikiMusic.SSR.View.ArtistHtml
import WikiMusic.SSR.View.Components.Forms
import WikiMusic.SSR.View.Components.Meta
import WikiMusic.SSR.View.Components.PageTop
import WikiMusic.SSR.View.GenreHtml
import WikiMusic.SSR.View.SongHtml
import Prelude qualified

instance Exec View where
  execAlgebra :: forall a. View (IO a) -> IO a
execAlgebra (ArtistListPage Env
env UiMode
mode Language
sortOrder Palette
l SortOrder
palette GetArtistsQueryResponse
r Html -> IO a
next) =
    Html -> IO a
next (Html -> IO a) -> IO Html -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env
-> UiMode
-> Language
-> Palette
-> SortOrder
-> GetArtistsQueryResponse
-> IO Html
forall (m :: * -> *).
MonadIO m =>
Env
-> UiMode
-> Language
-> Palette
-> SortOrder
-> GetArtistsQueryResponse
-> m Html
artistListPage' Env
env UiMode
mode Language
sortOrder Palette
l SortOrder
palette GetArtistsQueryResponse
r
  execAlgebra (ArtistDetailPage Env
env UiMode
mode Language
language Palette
palette GetArtistsQueryResponse
r Html -> IO a
next) =
    Html -> IO a
next (Html -> IO a) -> IO Html -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env -> UiMode -> Language -> Palette -> Artist -> IO Html
forall (m :: * -> *).
MonadIO m =>
Env -> UiMode -> Language -> Palette -> Artist -> m Html
artistDetailPage' Env
env UiMode
mode Language
language Palette
palette ([Artist] -> Artist
forall a. HasCallStack => [a] -> a
Prelude.head ([Artist] -> Artist)
-> (Map UUID Artist -> [Artist]) -> Map UUID Artist -> Artist
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map UUID Artist -> [Artist]
forall k a. Map k a -> [a]
Map.elems (Map UUID Artist -> Artist) -> Map UUID Artist -> Artist
forall a b. (a -> b) -> a -> b
$ GetArtistsQueryResponse
r GetArtistsQueryResponse
-> Optic' A_Lens NoIx GetArtistsQueryResponse (Map UUID Artist)
-> Map UUID Artist
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx GetArtistsQueryResponse (Map UUID Artist)
#artists)
  execAlgebra (ArtistCreatePage Env
env UiMode
mode Language
language Palette
palette Html -> IO a
next) =
    Html -> IO a
next (Html -> IO a) -> IO Html -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env -> UiMode -> Language -> Palette -> IO Html
forall (m :: * -> *).
MonadIO m =>
Env -> UiMode -> Language -> Palette -> m Html
artistCreatePage' Env
env UiMode
mode Language
language Palette
palette
  execAlgebra (GenreListPage Env
env UiMode
mode Language
sortOrder Palette
l SortOrder
palette GetGenresQueryResponse
r Html -> IO a
next) =
    Html -> IO a
next (Html -> IO a) -> IO Html -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env
-> UiMode
-> Language
-> Palette
-> SortOrder
-> GetGenresQueryResponse
-> IO Html
forall (m :: * -> *).
MonadIO m =>
Env
-> UiMode
-> Language
-> Palette
-> SortOrder
-> GetGenresQueryResponse
-> m Html
genreListPage' Env
env UiMode
mode Language
sortOrder Palette
l SortOrder
palette GetGenresQueryResponse
r
  execAlgebra (GenreDetailPage Env
env UiMode
mode Language
language Palette
palette GetGenresQueryResponse
r Html -> IO a
next) =
    Html -> IO a
next (Html -> IO a) -> IO Html -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env -> UiMode -> Language -> Palette -> Genre -> IO Html
forall (m :: * -> *).
MonadIO m =>
Env -> UiMode -> Language -> Palette -> Genre -> m Html
genreDetailPage' Env
env UiMode
mode Language
language Palette
palette ([Genre] -> Genre
forall a. HasCallStack => [a] -> a
Prelude.head ([Genre] -> Genre)
-> (Map UUID Genre -> [Genre]) -> Map UUID Genre -> Genre
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map UUID Genre -> [Genre]
forall k a. Map k a -> [a]
Map.elems (Map UUID Genre -> Genre) -> Map UUID Genre -> Genre
forall a b. (a -> b) -> a -> b
$ GetGenresQueryResponse
r GetGenresQueryResponse
-> Optic' A_Lens NoIx GetGenresQueryResponse (Map UUID Genre)
-> Map UUID Genre
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx GetGenresQueryResponse (Map UUID Genre)
#genres)
  execAlgebra (GenreCreatePage Env
env UiMode
mode Language
language Palette
palette Html -> IO a
next) =
    Html -> IO a
next (Html -> IO a) -> IO Html -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env -> UiMode -> Language -> Palette -> IO Html
forall (m :: * -> *).
MonadIO m =>
Env -> UiMode -> Language -> Palette -> m Html
genreCreatePage' Env
env UiMode
mode Language
language Palette
palette
  execAlgebra (SongListPage Env
env UiMode
mode Language
sortOrder Palette
language SortOrder
palette GetSongsQueryResponse
r Html -> IO a
next) =
    Html -> IO a
next (Html -> IO a) -> IO Html -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env
-> UiMode
-> Language
-> Palette
-> SortOrder
-> GetSongsQueryResponse
-> IO Html
forall (m :: * -> *).
MonadIO m =>
Env
-> UiMode
-> Language
-> Palette
-> SortOrder
-> GetSongsQueryResponse
-> m Html
songListPage' Env
env UiMode
mode Language
sortOrder Palette
language SortOrder
palette GetSongsQueryResponse
r
  execAlgebra (SongDetailPage Env
env UiMode
mode Language
language Palette
palette SongAsciiSize
songAsciiSize GetSongsQueryResponse
r Html -> IO a
next) =
    Html -> IO a
next (Html -> IO a) -> IO Html -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env
-> UiMode
-> Language
-> Palette
-> SongAsciiSize
-> Song
-> IO Html
forall (m :: * -> *).
MonadIO m =>
Env
-> UiMode -> Language -> Palette -> SongAsciiSize -> Song -> m Html
songDetailPage' Env
env UiMode
mode Language
language Palette
palette SongAsciiSize
songAsciiSize ([Song] -> Song
forall a. HasCallStack => [a] -> a
Prelude.head ([Song] -> Song)
-> (Map UUID Song -> [Song]) -> Map UUID Song -> Song
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map UUID Song -> [Song]
forall k a. Map k a -> [a]
Map.elems (Map UUID Song -> Song) -> Map UUID Song -> Song
forall a b. (a -> b) -> a -> b
$ GetSongsQueryResponse
r 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)
  execAlgebra (SongCreatePage Env
env UiMode
mode Language
language Palette
palette Html -> IO a
next) =
    Html -> IO a
next (Html -> IO a) -> IO Html -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env -> UiMode -> Language -> Palette -> IO Html
forall (m :: * -> *).
MonadIO m =>
Env -> UiMode -> Language -> Palette -> m Html
songCreatePage' Env
env UiMode
mode Language
language Palette
palette
  execAlgebra (ErrorPage Env
env UiMode
mode Language
language Palette
palette Text
message Html -> IO a
next) =
    Html -> IO a
next (Html -> IO a) -> IO Html -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env -> UiMode -> Language -> Palette -> Text -> IO Html
forall (m :: * -> *).
MonadIO m =>
Env -> UiMode -> Language -> Palette -> Text -> m Html
errorPage' Env
env UiMode
mode Language
language Palette
palette Text
message
  execAlgebra (LoginPage Env
env UiMode
mode Language
language Palette
palette Html -> IO a
next) =
    Html -> IO a
next (Html -> IO a) -> IO Html -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env -> UiMode -> Language -> Palette -> IO Html
forall (m :: * -> *).
MonadIO m =>
Env -> UiMode -> Language -> Palette -> m Html
loginPage' Env
env UiMode
mode Language
language Palette
palette

errorPage' :: (MonadIO m) => Env -> UiMode -> Language -> Palette -> Text -> m Html
errorPage' :: forall (m :: * -> *).
MonadIO m =>
Env -> UiMode -> Language -> Palette -> Text -> m Html
errorPage' Env
env UiMode
mode Language
language Palette
palette Text
message = do
  Html
sharedHead <- Env -> UiMode -> Palette -> Text -> m Html
forall (m :: * -> *).
MonadIO m =>
Env -> UiMode -> Palette -> Text -> m Html
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
#errorOccurred DictTerm -> Language -> Text
|##| Language
language)
  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.html (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html
sharedHead
    Html -> Html
body (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
section (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Maybe Text -> UiMode -> Language -> Palette -> Html
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
#errorOccurred DictTerm -> Language -> Text
|##| Language
language) UiMode
mode Language
language Palette
palette
      Html -> Html
h3 (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
messageCauses
      Html -> Html
H.pre (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
class_ AttributeValue
"font-size-small" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
text Text
message
  where
    messageCauses :: Text
    messageCauses :: Text
messageCauses = Text -> [Text] -> Text
T.intercalate Text
" - " [Text]
causeStrings
    causeStrings :: [Text]
causeStrings = [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Error", if Text -> Text -> Bool
T.isInfixOf Text
"504" Text
message then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Gateway Timeout" else Maybe Text
forall a. Maybe a
Nothing]

loginPage' :: (MonadIO m) => Env -> UiMode -> Language -> Palette -> m Html
loginPage' :: forall (m :: * -> *).
MonadIO m =>
Env -> UiMode -> Language -> Palette -> m Html
loginPage' Env
env UiMode
mode Language
language Palette
palette = do
  Html
sharedHead <- Env -> UiMode -> Palette -> Text -> m Html
forall (m :: * -> *).
MonadIO m =>
Env -> UiMode -> Palette -> Text -> m Html
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
#login DictTerm -> Language -> Text
|##| Language
language)
  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.html (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    Html
sharedHead
    Html -> Html
body (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
section (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Maybe Text -> UiMode -> Language -> Palette -> Html
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
#login DictTerm -> Language -> Text
|##| Language
language) UiMode
mode Language
language Palette
palette
      Html -> Html
section (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html -> Html
postForm Text
"/login" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Text -> Text -> Html
requiredEmailInput Text
"email" (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 Forms Forms
#forms Optic A_Lens NoIx LanguageDict LanguageDict Forms Forms
-> Optic A_Lens NoIx Forms Forms 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 Forms Forms DictTerm DictTerm
#email DictTerm -> Language -> Text
|##| Language
language)
        Text -> Text -> Html
requiredPasswordInput Text
"password" (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 Forms Forms
#forms Optic A_Lens NoIx LanguageDict LanguageDict Forms Forms
-> Optic A_Lens NoIx Forms Forms 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 Forms Forms DictTerm DictTerm
#password DictTerm -> Language -> Text
|##| Language
language)
        Language -> Html
submitButton Language
language