{-# LANGUAGE OverloadedStrings #-}

module Server.Website.Views.Courses
( displayCoursesHome
) where

import Core
import Server.Core
import Server.Website.Views.Core
import qualified Study.Courses.English.Grammar.Introduction.Course
import qualified Study.Courses.English.Grammar.Crash.Course
import qualified Study.Courses.English.Vocabulary.Attitudinals.Course
import qualified Study.Courses.English.Vocabulary.Brivla.Course
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

displayCoursesHome :: ServerConfiguration -> Maybe UserIdentity -> H.Html
displayCoursesHome :: ServerConfiguration -> Maybe UserIdentity -> Html
displayCoursesHome ServerConfiguration
serverConfiguration Maybe UserIdentity
userIdentityMaybe = do
    let descriptionPart1 :: Text
descriptionPart1 = (Text
"Learn lojban with carefully designed courses, and practice with entertaining interactive exercises." :: T.Text)
    let descriptionPart2 :: Text
descriptionPart2 = (Text
"Learn from the beginning if you are a newcomer, or learn by subject if you are already familiar with the core aspects of the language." :: T.Text)
    let descriptionComplete :: Text
descriptionComplete = Text
descriptionPart1 Text -> Text -> Text
`T.append` Text
" " Text -> Text -> Text
`T.append` Text
descriptionPart2
    Html
H.docType
    Html -> Html
H.html (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.lang (String -> AttributeValue
H.stringValue String
"en-us") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        Html -> Html
H.head (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            Html -> Html
H.title (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Text
"Courses :: lojban.io" :: T.Text)
            Html
H.meta Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.name (Text -> AttributeValue
H.textValue Text
"description") Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.content (Text -> AttributeValue
H.textValue Text
descriptionComplete)
            Html
includeUniversalStylesheets
            Html
includeUniversalScripts
            String -> Html
includeInternalStylesheet String
"courses.css"
        Html -> Html
H.body (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            ServerConfiguration -> Maybe UserIdentity -> TopbarCategory -> Html
displayTopbar ServerConfiguration
serverConfiguration Maybe UserIdentity
userIdentityMaybe TopbarCategory
TopbarCourses
            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
"main") (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
"header") (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
"header-bg") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Text
"" :: T.Text)
                    Html -> Html
H.h1 (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Text
"Courses" :: T.Text)
                    Html -> Html
H.p (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml Text
descriptionPart1
                    Html -> Html
H.p (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml Text
descriptionPart2
                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
"body") (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
"grammar") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                        Html -> Html
H.h2 (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Text
"Learn from the beginning" :: T.Text)
                        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
"grid") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                            (Text, Course) -> Html
displayCourse (Text
"/courses/introduction", Course
Study.Courses.English.Grammar.Introduction.Course.course)
                            --displayCourse ("/courses/crash", Study.Courses.English.Grammar.Crash.Course.course)
                    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
"vocabulary") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                        Html -> Html
H.h2 (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Text
"Learn by subject" :: T.Text)
                        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
"grid") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                            (Text, Course) -> Html
displayCourse (Text
"/courses/attitudinals", Course
Study.Courses.English.Vocabulary.Attitudinals.Course.course)
                            --displayCourse ("/courses/brivla", Study.Courses.English.Vocabulary.Brivla.Course.course)
                            --displayCourse ("/courses/attitudinals", Study.Courses.English.Vocabulary.Attitudinals.Course.course)
                            --displayCourse ("/courses/attitudinals", Study.Courses.English.Vocabulary.Attitudinals.Course.course)
                            --displayCourse ("/courses/brivla", Study.Courses.English.Vocabulary.Brivla.Course.course)
                            --displayCourse ("/courses/brivla", Study.Courses.English.Vocabulary.Brivla.Course.course)
                            --displayCourse ("/courses/brivla", Study.Courses.English.Vocabulary.Brivla.Course.course)
                            --displayCourse ("/courses/brivla", Study.Courses.English.Vocabulary.Brivla.Course.course)
                            --displayCourse ("/courses/brivla", Study.Courses.English.Vocabulary.Brivla.Course.course)
                            --displayCourse ("/courses/brivla", Study.Courses.English.Vocabulary.Brivla.Course.course)
                    Html
displayFooter

displayCourse :: (T.Text, Course) -> H.Html
displayCourse :: (Text, Course) -> Html
displayCourse (Text
url, Course
course) = do
    let title :: Text
title = Course -> Text
courseTitle Course
course
    let shortDescription :: Text
shortDescription = Course -> Text
courseShortDescription Course
course
    let linkText :: Text
linkText = Text
"Learn more" :: T.Text
    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
"course") (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
"course-title") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml Text
title
        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
"course-description") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml Text
shortDescription
        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
"course-link") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            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
url) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml Text
linkText