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

module WikiMusic.SSR.View.ErrorHtml where

import Data.ByteString.Base16.Lazy qualified as B16
import Data.Text qualified as T
import Principium
import Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes as A
import WikiMusic.SSR.View.HtmlUtil

errorPage' :: (MonadIO m) => Env -> ViewVars -> Text -> m Html
errorPage' :: forall (m :: * -> *).
MonadIO m =>
Env -> ViewVars -> Text -> m Html
errorPage' Env
env ViewVars
vv Text
message' =
  Env -> ViewVars -> SimplePageTitle -> Html -> m Html
forall (m :: * -> *).
MonadIO m =>
Env -> ViewVars -> SimplePageTitle -> Html -> m Html
simplePage Env
env ViewVars
vv (Text -> SimplePageTitle
SimplePageTitle (Text -> SimplePageTitle) -> Text -> SimplePageTitle
forall a b. (a -> b) -> a -> b
$ (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
#songsPage) (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 -> m Html) -> Html -> m Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
section (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
    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) -> 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
    message :: Text
message = ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text) -> (Text -> ByteString) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B16.decodeLenient (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
message'
    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]