{-# LANGUAGE OverloadedStrings #-}

module Server.Website.Views.Core
( includeUniversalStylesheets
, includeInternalStylesheet
, includeExternalStylesheet
, includeInlineStylesheet
, includeCourseStylesheet
, includeUniversalScripts
, includeInternalScript
, includeExternalScript
, includeInlineScript
, includeDictionaryScript
, includeDeckScript
, includeCourseScript
, includeLessonScript
, TopbarCategory (..)
, displayTopbar
, displayFooter
) where

import Core
import Server.Core
import Language.Lojban.Core
import Control.Monad (unless, forM_)
import qualified Data.Text as T
import qualified Text.Blaze as B
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A

-- * Stylesheets
includeViewportTag :: H.Html
includeViewportTag :: Html
includeViewportTag = do
    Html
H.meta
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.name (String -> AttributeValue
H.stringValue String
"viewport")
      --TODO: B.! A.content "width=device-width, initial-scale=1"
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.content AttributeValue
""

includeThemeColorTag :: H.Html
includeThemeColorTag :: Html
includeThemeColorTag = do
    Html
H.meta
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.name (String -> AttributeValue
H.stringValue String
"theme-color")
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.content AttributeValue
"#9054FF"

includeOpenGraphImageTag :: H.Html
includeOpenGraphImageTag :: Html
includeOpenGraphImageTag = do
    let imageUrl :: Text
imageUrl = Text
"https://live.staticflickr.com/65535/50395936413_e56cf07308_o.png"
    Html
H.meta
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! Tag -> AttributeValue -> Attribute
H.customAttribute Tag
"property" (Text -> AttributeValue
H.textValue Text
"og:image")
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.content (Text -> AttributeValue
H.textValue Text
imageUrl)
    Html
H.meta
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! Tag -> AttributeValue -> Attribute
H.customAttribute Tag
"property" (Text -> AttributeValue
H.textValue Text
"og:image:secure_url")
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.content (Text -> AttributeValue
H.textValue Text
imageUrl)
    Html
H.meta
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! Tag -> AttributeValue -> Attribute
H.customAttribute Tag
"property" (Text -> AttributeValue
H.textValue Text
"og:image:type")
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.content AttributeValue
"image/png"
    Html
H.meta
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! Tag -> AttributeValue -> Attribute
H.customAttribute Tag
"property" (Text -> AttributeValue
H.textValue Text
"og:image:width")
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.content AttributeValue
"1200"
    Html
H.meta
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! Tag -> AttributeValue -> Attribute
H.customAttribute Tag
"property" (Text -> AttributeValue
H.textValue Text
"og:image:height")
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.content AttributeValue
"627"

includeWebManifest :: H.Html
includeWebManifest :: Html
includeWebManifest = do
    Html
H.link
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.href (String -> AttributeValue
H.stringValue String
"/manifest.webmanifest")
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.rel AttributeValue
"manifest"

includeUniversalStylesheets :: H.Html
includeUniversalStylesheets :: Html
includeUniversalStylesheets = do
    Html
includeViewportTag
    Html
includeThemeColorTag
    Html
includeOpenGraphImageTag
    Html
includeWebManifest
    -- TODO: consider removing bootstrap
    String -> Html
includeInternalStylesheet String
"bootstrap.min.css"
    --includeInternalStylesheet "normalize.css"
    --includeExternalStylesheet "https://maxcdn.bootstrapcdn.com/font-awesome/4.5.0/css/font-awesome.min.css"
    --includeExternalStylesheet "https://fonts.googleapis.com/icon?family=Material+Icons"

includeInternalStylesheet :: String -> H.Html
includeInternalStylesheet :: String -> Html
includeInternalStylesheet = String -> Html
includeExternalStylesheet (String -> Html) -> (String -> String) -> String -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"/static/style/"String -> String -> String
forall a. [a] -> [a] -> [a]
++)

includeExternalStylesheet :: String -> H.Html
includeExternalStylesheet :: String -> Html
includeExternalStylesheet String
src =
    Html
H.link
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.href (String -> AttributeValue
H.stringValue String
src)
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.rel AttributeValue
"stylesheet"

includeInlineStylesheet :: String -> H.Html
includeInlineStylesheet :: String -> Html
includeInlineStylesheet String
code =
    Html -> Html
H.style (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.type_ (String -> AttributeValue
H.stringValue String
"text/css") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
        String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml String
code

includeCourseStylesheet :: Course -> H.Html
includeCourseStylesheet :: Course -> Html
includeCourseStylesheet Course
course = String -> Html
includeInlineStylesheet String
code where
    style :: CourseStyle
style = Course -> CourseStyle
courseStyle Course
course
    courseColor1 :: String
courseColor1 = case (CourseStyle -> Maybe String
courseStyleColor1 CourseStyle
style) of
        Just String
color ->String
"--course-color1: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
color String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
        Maybe String
Nothing -> String
""
    courseIcon :: String
courseIcon = case (CourseStyle -> Maybe String
courseStyleIconUrl CourseStyle
style) of
        Just String
url -> String
"--course-icon: url(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
url String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");"
        Maybe String
Nothing -> String
""
    code :: String
code = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
":root {"
        , String
courseColor1
        , String
courseIcon
        , String
"}"
        ]

-- * Scripts
includeGoogleAnalyticsScript :: H.Html
includeGoogleAnalyticsScript :: Html
includeGoogleAnalyticsScript = do
    let embeddedCode :: Text
embeddedCode = [Text] -> Text
T.concat
            [ Text
"window.dataLayer = window.dataLayer || [];"
            , Text
"function gtag(){dataLayer.push(arguments);};"
            , Text
"gtag('js', new Date());"
            , Text
"gtag('config', 'UA-175660110-1', { 'anonymize_ip': true });"
            ]
    Html -> Html
H.script Html
""
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.type_ AttributeValue
"text/javascript"
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.src (String -> AttributeValue
H.stringValue String
"https://www.googletagmanager.com/gtag/js?id=UA-175660110-1")
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.async (String -> AttributeValue
H.stringValue String
"true")
    Html -> Html
H.script (Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml Text
embeddedCode)
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.type_ AttributeValue
"text/javascript"

includePwaBuilderScript :: H.Html
includePwaBuilderScript :: Html
includePwaBuilderScript = do
    let embeddedCode :: Text
embeddedCode = [Text] -> Text
T.concat
            [ Text
"import 'https://cdn.jsdelivr.net/npm/@pwabuilder/pwaupdate';"
            , Text
"const el = document.createElement('pwa-update');"
            , Text
"document.body.appendChild(el);"
            ]
    Html -> Html
H.script (Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml Text
embeddedCode)
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.type_ AttributeValue
"module"

includeUniversalScripts :: H.Html
includeUniversalScripts :: Html
includeUniversalScripts = do
    Html
includePwaBuilderScript
    String -> Html
includeExternalScript String
"https://kit.fontawesome.com/ae6f2dc037.js"
    Html
includeGoogleAnalyticsScript
    --includeInternalScript "vendors.js"

includeInternalScript :: String -> H.Html
includeInternalScript :: String -> Html
includeInternalScript = String -> Html
includeExternalScript (String -> Html) -> (String -> String) -> String -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"/static/scripts/"String -> String -> String
forall a. [a] -> [a] -> [a]
++)

includeExternalScript :: String -> H.Html
includeExternalScript :: String -> Html
includeExternalScript String
src =
    Html -> Html
H.script Html
""
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.type_ AttributeValue
"text/javascript"
      Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.src (String -> AttributeValue
H.stringValue String
src)
      --TODO: B.! A.crossorigin (H.stringValue "anonymous")

includeInlineScript :: T.Text -> H.Html
includeInlineScript :: Text -> Html
includeInlineScript Text
code =
    Html -> Html
H.script (Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml Text
code) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.type_ AttributeValue
"text/javascript"

includeDictionaryScript :: Dictionary -> H.Html
includeDictionaryScript :: Dictionary -> Html
includeDictionaryScript Dictionary
dictionary = String -> Html
includeInternalScript (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"dictionaries/" Text -> Text -> Text
`T.append` (Dictionary -> Text
dictIdentifier Dictionary
dictionary) Text -> Text -> Text
`T.append` Text
".js"

includeDeckScript :: Deck -> H.Html
includeDeckScript :: Deck -> Html
includeDeckScript Deck
deck = Text -> Html
includeInlineScript (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text
"deckId = \"" Text -> Text -> Text
`T.append` (Deck -> Text
deckId Deck
deck) Text -> Text -> Text
`T.append` Text
"\";"

includeCourseScript :: Course -> H.Html
includeCourseScript :: Course -> Html
includeCourseScript Course
course = Text -> Html
includeInlineScript (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text
"courseId = \"" Text -> Text -> Text
`T.append` (Course -> Text
courseId Course
course) Text -> Text -> Text
`T.append` Text
"\";"

includeLessonScript :: Int -> H.Html
includeLessonScript :: Int -> Html
includeLessonScript Int
lessonNumber = Text -> Html
includeInlineScript (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ Text
"lessonNumber = \"" Text -> Text -> Text
`T.append` (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
lessonNumber) Text -> Text -> Text
`T.append` Text
"\";"

-- * Topbar
data TopbarCategory = TopbarHome | TopbarCourses | TopbarDecks | TopbarResources | TopbarFAQ | TopbarNone deriving (Int -> TopbarCategory
TopbarCategory -> Int
TopbarCategory -> [TopbarCategory]
TopbarCategory -> TopbarCategory
TopbarCategory -> TopbarCategory -> [TopbarCategory]
TopbarCategory
-> TopbarCategory -> TopbarCategory -> [TopbarCategory]
(TopbarCategory -> TopbarCategory)
-> (TopbarCategory -> TopbarCategory)
-> (Int -> TopbarCategory)
-> (TopbarCategory -> Int)
-> (TopbarCategory -> [TopbarCategory])
-> (TopbarCategory -> TopbarCategory -> [TopbarCategory])
-> (TopbarCategory -> TopbarCategory -> [TopbarCategory])
-> (TopbarCategory
    -> TopbarCategory -> TopbarCategory -> [TopbarCategory])
-> Enum TopbarCategory
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TopbarCategory -> TopbarCategory
succ :: TopbarCategory -> TopbarCategory
$cpred :: TopbarCategory -> TopbarCategory
pred :: TopbarCategory -> TopbarCategory
$ctoEnum :: Int -> TopbarCategory
toEnum :: Int -> TopbarCategory
$cfromEnum :: TopbarCategory -> Int
fromEnum :: TopbarCategory -> Int
$cenumFrom :: TopbarCategory -> [TopbarCategory]
enumFrom :: TopbarCategory -> [TopbarCategory]
$cenumFromThen :: TopbarCategory -> TopbarCategory -> [TopbarCategory]
enumFromThen :: TopbarCategory -> TopbarCategory -> [TopbarCategory]
$cenumFromTo :: TopbarCategory -> TopbarCategory -> [TopbarCategory]
enumFromTo :: TopbarCategory -> TopbarCategory -> [TopbarCategory]
$cenumFromThenTo :: TopbarCategory
-> TopbarCategory -> TopbarCategory -> [TopbarCategory]
enumFromThenTo :: TopbarCategory
-> TopbarCategory -> TopbarCategory -> [TopbarCategory]
Enum, TopbarCategory -> TopbarCategory -> Bool
(TopbarCategory -> TopbarCategory -> Bool)
-> (TopbarCategory -> TopbarCategory -> Bool) -> Eq TopbarCategory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TopbarCategory -> TopbarCategory -> Bool
== :: TopbarCategory -> TopbarCategory -> Bool
$c/= :: TopbarCategory -> TopbarCategory -> Bool
/= :: TopbarCategory -> TopbarCategory -> Bool
Eq)

displayTopbar :: ServerConfiguration -> Maybe UserIdentity -> TopbarCategory -> H.Html
displayTopbar :: ServerConfiguration -> Maybe UserIdentity -> TopbarCategory -> Html
displayTopbar ServerConfiguration
serverConfiguration Maybe UserIdentity
userIdentityMaybe TopbarCategory
topbarCategory = do
    Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ (String -> AttributeValue
H.stringValue String
"topbar") (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
B.! AttributeValue -> Attribute
A.class_ AttributeValue
"logo" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            Html -> Html
H.a (String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (String
"lojban.io" :: String))
                Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.href (String -> AttributeValue
H.stringValue String
"/")
        TopbarCategory -> Html
displayTopbarMenu TopbarCategory
topbarCategory
        ServerConfiguration -> Maybe UserIdentity -> Html
displayUserProfile ServerConfiguration
serverConfiguration Maybe UserIdentity
userIdentityMaybe

displayUserProfile :: ServerConfiguration -> Maybe UserIdentity -> H.Html
displayUserProfile :: ServerConfiguration -> Maybe UserIdentity -> Html
displayUserProfile ServerConfiguration
serverConfiguration Maybe UserIdentity
userIdentityMaybe = do
    case Maybe UserIdentity
userIdentityMaybe of
        Maybe UserIdentity
Nothing ->
            case (ServerConfiguration -> [IdentityProvider]
serverConfigurationIdentityProviders ServerConfiguration
serverConfiguration) of
                [] -> Html
forall a. Monoid a => a
mempty
                (IdentityProvider
identityProvidersHead : [IdentityProvider]
identityProvidersTail) -> do
                    Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ AttributeValue
"user-signin" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                        IdentityProvider -> Html
displayIdentityProviderSignInLink IdentityProvider
identityProvidersHead
                        Html
H.input
                            Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.id AttributeValue
"signin-menu-input"
                            Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.type_ AttributeValue
"checkbox"
                        Html -> Html
H.label
                            (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.for AttributeValue
"signin-menu-input"
                            (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.tabindex AttributeValue
"0"
                            (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.alt AttributeValue
"Toggle sign-in menu"
                            (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.style (if [IdentityProvider] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IdentityProvider]
identityProvidersTail then AttributeValue
"visibility: hidden;" else AttributeValue
"") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
forall a. Monoid a => a
mempty
                        Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([IdentityProvider] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IdentityProvider]
identityProvidersTail) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                            Html -> Html
H.ul (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ AttributeValue
"signin-menu" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                                [IdentityProvider] -> (IdentityProvider -> Html) -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [IdentityProvider]
identityProvidersTail ((IdentityProvider -> Html) -> Html)
-> (IdentityProvider -> Html) -> Html
forall a b. (a -> b) -> a -> b
$ \IdentityProvider
identityProvider -> do
                                    Html -> Html
H.li (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                                        IdentityProvider -> Html
displayIdentityProviderSignInLink IdentityProvider
identityProvider
        Just UserIdentity
userIdentity -> do
            let pictureUrl :: Text
pictureUrl = UserIdentity -> Text
userPictureUrl UserIdentity
userIdentity
            Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ AttributeValue
"user-profile" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                Html
H.input
                    Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.id AttributeValue
"user-menu-input"
                    Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.type_ AttributeValue
"checkbox"
                Html -> Html
H.label
                    (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.for AttributeValue
"user-menu-input"
                    (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.tabindex AttributeValue
"0"
                    (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.alt AttributeValue
"Toggle user menu" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                        let finalPictureUrl :: Text
finalPictureUrl = if (Text -> Bool
T.null Text
pictureUrl) then Text
"https://www.gravatar.com/avatar/00000000000000000000000000000000?d=mp&f=y" else Text
pictureUrl
                        Html
H.img Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ AttributeValue
"picture" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.src (Text -> AttributeValue
H.textValue Text
finalPictureUrl)
                Html -> Html
H.ul (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ AttributeValue
"user-menu" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                    Html -> Html
H.li (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                        -- TODO: fontawesome icon for sign out
                        Html -> Html
H.a (Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Text
"Sign out" :: T.Text))
                            Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.href (Text -> AttributeValue
H.textValue (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
"/authentication/logout/")

displayIdentityProviderSignInLink :: IdentityProvider -> H.Html
displayIdentityProviderSignInLink :: IdentityProvider -> Html
displayIdentityProviderSignInLink IdentityProvider
identityProvider = do
    Html -> Html
H.a (Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Text
"sign in" :: T.Text)) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ (Text -> AttributeValue
H.textValue (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
"provider-" Text -> Text -> Text
`T.append` (IdentityProvider -> Text
identityProviderIdentifier IdentityProvider
identityProvider))
        Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.href (Text -> AttributeValue
H.textValue (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ IdentityProvider -> Text
identityProviderLoginUrl IdentityProvider
identityProvider)
        Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.title (Text -> AttributeValue
H.textValue (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
"Sign in with " Text -> Text -> Text
`T.append` (IdentityProvider -> Text
identityProviderName IdentityProvider
identityProvider))

displayTopbarMenu :: TopbarCategory -> H.Html
displayTopbarMenu :: TopbarCategory -> Html
displayTopbarMenu TopbarCategory
topbarCategory = do
    Html -> Html
H.ul (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Bool -> String -> String -> Html
displayTopbarMenuItem (TopbarCategory
topbarCategory TopbarCategory -> TopbarCategory -> Bool
forall a. Eq a => a -> a -> Bool
== TopbarCategory
TopbarFAQ) String
"About" String
"/FAQ/"
        Bool -> String -> String -> Html
displayTopbarMenuItem (TopbarCategory
topbarCategory TopbarCategory -> TopbarCategory -> Bool
forall a. Eq a => a -> a -> Bool
== TopbarCategory
TopbarResources) String
"Resources" String
"/resources/"
        Bool -> String -> String -> Html
displayTopbarMenuItem (TopbarCategory
topbarCategory TopbarCategory -> TopbarCategory -> Bool
forall a. Eq a => a -> a -> Bool
== TopbarCategory
TopbarCourses) String
"Courses" String
"/courses/"
        Bool -> String -> String -> Html
displayTopbarMenuItem (TopbarCategory
topbarCategory TopbarCategory -> TopbarCategory -> Bool
forall a. Eq a => a -> a -> Bool
== TopbarCategory
TopbarDecks) String
"Decks" String
"/decks/"

displayTopbarMenuItem :: Bool -> String -> String -> H.Html
displayTopbarMenuItem :: Bool -> String -> String -> Html
displayTopbarMenuItem Bool
selected String
text String
url = do
    let selectedClass :: AttributeValue
selectedClass = if Bool
selected then AttributeValue
"selected" else AttributeValue
""
    Html -> Html
H.li (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
H.a (String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml String
text)
            Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.href (String -> AttributeValue
H.stringValue String
url)
            Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ AttributeValue
selectedClass

displayFooter :: H.Html
displayFooter :: Html
displayFooter = do
    Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ (Text -> AttributeValue
H.textValue Text
"footer") (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
B.! AttributeValue -> Attribute
A.class_ (Text -> AttributeValue
H.textValue Text
"links") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            --H.a B.! A.href (H.textValue "/about") $ H.toHtml ("About" :: T.Text)
            --H.a B.! A.href (H.textValue "https://github.com/jqueiroz/lojban.io") $ H.toHtml ("About" :: T.Text)
            Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.href (Text -> AttributeValue
H.textValue Text
"mailto:contact@lojban.io") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Text
"Contact" :: T.Text)
            Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.href (Text -> AttributeValue
H.textValue Text
"https://github.com/jqueiroz/lojban.io") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Text
"Contribute" :: T.Text)