{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module WikiMusic.SSR.View.OtherHtml where 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.Components.Forms import WikiMusic.SSR.View.HtmlUtil errorPage' :: (MonadIO m) => Env -> ViewVars -> Maybe Int -> Maybe Text -> m Html errorPage' :: forall (m :: * -> *). MonadIO m => Env -> ViewVars -> Maybe Int -> Maybe Text -> m Html errorPage' Env env ViewVars vv Maybe Int _ Maybe Text maybeMessage = do 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 let maybeDecoded :: Maybe (Either String ByteString) maybeDecoded = (Text -> Either String ByteString) -> Maybe Text -> Maybe (Either String ByteString) forall a b. (a -> b) -> Maybe a -> Maybe b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Text -> Either String ByteString maybeDecodeBase16 Maybe Text maybeMessage Html -> Html H.pre (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do case Maybe (Either String ByteString) maybeDecoded of Maybe (Either String ByteString) Nothing -> Text -> Html text Text "Unexpected Error!" Just Either String ByteString maybeDecodedError -> (String -> Html) -> (ByteString -> Html) -> Either String ByteString -> Html forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either (Html -> String -> Html forall a. a -> String -> a forall (f :: * -> *) a. Applicative f => a -> f a pure (Html -> String -> Html) -> Html -> String -> Html forall a b. (a -> b) -> a -> b $ Text -> Html text Text "Unexpected Error!") (Text -> Html text (Text -> Html) -> (ByteString -> Text) -> ByteString -> Html forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Text T.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> String forall a b. ConvertUtf8 a b => b -> a decodeUtf8) Either String ByteString maybeDecodedError where 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 -> Maybe Text -> Text forall a. a -> Maybe a -> a fromMaybe Text "Error ocurred!" Maybe Text maybeMessage) 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 -> ViewVars -> m Html loginPage' :: forall (m :: * -> *). MonadIO m => Env -> ViewVars -> m Html loginPage' Env env ViewVars vv = do 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 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 -> m Html) -> Html -> m Html forall a b. (a -> b) -> a -> b $ do Html -> Html section (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! [Text] -> Attribute css' [Text "flex", Text "justify-center"] (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Text -> [Text] -> Html -> Html postForm' Text "/login" [Text "flex", Text "flex-col", Text "gap-4"] (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-row", Text "flex-wrap", Text "gap-8"] (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do Text -> Text -> Html requiredEmailInput Text "email" ((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 Forms Forms #forms Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary Forms Forms -> Optic A_Lens NoIx Forms Forms 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 Forms Forms DictTerm DictTerm #email) (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)) Text -> Text -> Html requiredPasswordInput Text "password" ((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 Forms Forms #forms Optic A_Lens NoIx ApplicationDictionary ApplicationDictionary Forms Forms -> Optic A_Lens NoIx Forms Forms 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 Forms Forms DictTerm DictTerm #password) (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)) ViewVars -> Html submitButton ViewVars vv Html -> Html a (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! Set Text -> Attribute css (ViewVars -> Set Text cssLink ViewVars vv) (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute href AttributeValue "/passwords/request-reset" (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Html "forgot password ?" doPasswordResetPage' :: (MonadIO m) => Env -> ViewVars -> Maybe Text -> m Html doPasswordResetPage' :: forall (m :: * -> *). MonadIO m => Env -> ViewVars -> Maybe Text -> m Html doPasswordResetPage' Env env ViewVars vv Maybe Text t = do 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 "Reset password") (Html -> m Html) -> Html -> m Html forall a b. (a -> b) -> a -> b $ do Html -> Html section (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Text -> Html -> Html postForm Text "/passwords/do-reset" (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do Text -> Text -> Html requiredEmailInput Text "email" Text "email" Text -> Text -> Html requiredPasswordInput Text "password" Text "password" Text -> Text -> Html requiredPasswordInput Text "passwordConfirm" Text "password again" Text -> Text -> Maybe Text -> Html requiredTextInput' Text "token" Text "token" Maybe Text t ViewVars -> Html submitButton ViewVars vv requestPasswordResetPage' :: (MonadIO m) => Env -> ViewVars -> m Html requestPasswordResetPage' :: forall (m :: * -> *). MonadIO m => Env -> ViewVars -> m Html requestPasswordResetPage' Env env ViewVars vv = do 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 "Request password reset ?") (Html -> m Html) -> Html -> m Html forall a b. (a -> b) -> a -> b $ do Html -> Html section (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Text -> Html -> Html postForm Text "/passwords/request-reset" (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do Text -> Text -> Html requiredEmailInput Text "email" Text "email" ViewVars -> Html submitButton ViewVars vv inviteUserPage' :: (MonadIO m) => Env -> ViewVars -> m Html inviteUserPage' :: forall (m :: * -> *). MonadIO m => Env -> ViewVars -> m Html inviteUserPage' Env env ViewVars vv = do 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 "Invite user") (Html -> m Html) -> Html -> m Html forall a b. (a -> b) -> a -> b $ do Html -> Html section (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Text -> Html -> Html postForm Text "/users/invite" (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do Text -> Text -> Html requiredEmailInput Text "email" Text "email" Text -> Text -> Html requiredTextInput Text "displayName" Text "name" Html -> Html H.label (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute for AttributeValue "role" (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Html "role" 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 required AttributeValue "" (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute name AttributeValue "role" (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute A.id AttributeValue "role" (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ do Html -> Html option (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute value AttributeValue "wm::demo" (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Html "demo user" Html -> Html option (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute value AttributeValue "wm::lowrank" (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Html "average user" Html -> Html option (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute value AttributeValue "wm::maintainer" (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Html "wiki maintainer" Html -> Html option (Html -> Html) -> Attribute -> Html -> Html forall h. Attributable h => h -> Attribute -> h ! AttributeValue -> Attribute value AttributeValue "wm::superuser" (Html -> Html) -> Html -> Html forall a b. (a -> b) -> a -> b $ Html "super user" Text -> Text -> Html optionalTextArea Text "description" Text "description" ViewVars -> Html submitButton ViewVars vv