{-# LANGUAGE OverloadedStrings #-}

module Server.Website.Views.Lesson
( displayLessonHome
, displayLessonExercise
) where

import Core
import Server.Core
import Server.Website.Views.Core
import Control.Monad (when)
import Data.Maybe (isJust, fromJust)
import Data.Either.Unwrap (fromRight)
import Study.Framework.DocumentBuilders (buildGlossaryDocument)
import qualified Data.Text as T
import qualified Text.Pandoc as P
import qualified Text.Pandoc.Writers.HTML as PWH
import qualified Text.Blaze as B
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A

data LessonSubpage = LessonHome | LessonVocabulary | LessonExercises deriving (Int -> LessonSubpage
LessonSubpage -> Int
LessonSubpage -> [LessonSubpage]
LessonSubpage -> LessonSubpage
LessonSubpage -> LessonSubpage -> [LessonSubpage]
LessonSubpage -> LessonSubpage -> LessonSubpage -> [LessonSubpage]
(LessonSubpage -> LessonSubpage)
-> (LessonSubpage -> LessonSubpage)
-> (Int -> LessonSubpage)
-> (LessonSubpage -> Int)
-> (LessonSubpage -> [LessonSubpage])
-> (LessonSubpage -> LessonSubpage -> [LessonSubpage])
-> (LessonSubpage -> LessonSubpage -> [LessonSubpage])
-> (LessonSubpage
    -> LessonSubpage -> LessonSubpage -> [LessonSubpage])
-> Enum LessonSubpage
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 :: LessonSubpage -> LessonSubpage
succ :: LessonSubpage -> LessonSubpage
$cpred :: LessonSubpage -> LessonSubpage
pred :: LessonSubpage -> LessonSubpage
$ctoEnum :: Int -> LessonSubpage
toEnum :: Int -> LessonSubpage
$cfromEnum :: LessonSubpage -> Int
fromEnum :: LessonSubpage -> Int
$cenumFrom :: LessonSubpage -> [LessonSubpage]
enumFrom :: LessonSubpage -> [LessonSubpage]
$cenumFromThen :: LessonSubpage -> LessonSubpage -> [LessonSubpage]
enumFromThen :: LessonSubpage -> LessonSubpage -> [LessonSubpage]
$cenumFromTo :: LessonSubpage -> LessonSubpage -> [LessonSubpage]
enumFromTo :: LessonSubpage -> LessonSubpage -> [LessonSubpage]
$cenumFromThenTo :: LessonSubpage -> LessonSubpage -> LessonSubpage -> [LessonSubpage]
enumFromThenTo :: LessonSubpage -> LessonSubpage -> LessonSubpage -> [LessonSubpage]
Enum, LessonSubpage -> LessonSubpage -> Bool
(LessonSubpage -> LessonSubpage -> Bool)
-> (LessonSubpage -> LessonSubpage -> Bool) -> Eq LessonSubpage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LessonSubpage -> LessonSubpage -> Bool
== :: LessonSubpage -> LessonSubpage -> Bool
$c/= :: LessonSubpage -> LessonSubpage -> Bool
/= :: LessonSubpage -> LessonSubpage -> Bool
Eq)

displayLessonHome :: ServerConfiguration -> Maybe UserIdentity -> TopbarCategory -> Course -> Int -> H.Html
displayLessonHome :: ServerConfiguration
-> Maybe UserIdentity -> TopbarCategory -> Course -> Int -> Html
displayLessonHome ServerConfiguration
serverConfiguration Maybe UserIdentity
userIdentityMaybe TopbarCategory
topbarCategory Course
course Int
lessonNumber = do
    let dictionary :: Dictionary
dictionary = Course -> Dictionary
courseDictionary Course
course
    let baseLessonUrl :: String
baseLessonUrl = String
""
    let lesson :: Lesson
lesson = (Course -> [Lesson]
courseLessons Course
course) [Lesson] -> Int -> Lesson
forall a. HasCallStack => [a] -> Int -> a
!! (Int
lessonNumber Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    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 ((Lesson -> Text
lessonTitle Lesson
lesson) Text -> Text -> Text
`T.append` Text
" :: lojban.io")
            Html
includeUniversalStylesheets
            Html
includeUniversalScripts
            String -> Html
includeInternalStylesheet String
"lesson.css"
            Course -> Html
includeCourseStylesheet Course
course
            String -> Html
includeInternalScript String
"lesson-min.js"
            Course -> Html
includeCourseScript Course
course
            Int -> Html
includeLessonScript Int
lessonNumber
        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
topbarCategory
            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
"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)
                    String -> LessonSubpage -> Course -> Int -> Html
displayLessonHeader String
baseLessonUrl LessonSubpage
LessonHome Course
course Int
lessonNumber
                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_ (String -> AttributeValue
H.stringValue String
"lesson") (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_ (String -> AttributeValue
H.stringValue String
"lesson-body") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                            Lesson -> Html
displayLessonTabs Lesson
lesson
                            Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Pandoc -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Pandoc -> Bool) -> Maybe Pandoc -> Bool
forall a b. (a -> b) -> a -> b
$ Lesson -> Maybe Pandoc
lessonLecture Lesson
lesson) (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_ (String -> AttributeValue
H.stringValue String
"lesson-lecture") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                                    Html -> Html
H.div (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                                        Either PandocError Html -> Html
forall a b. Either a b -> b
fromRight (Either PandocError Html -> Html)
-> (Pandoc -> Either PandocError Html) -> Pandoc -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocPure Html -> Either PandocError Html
forall a. PandocPure a -> Either PandocError a
P.runPure (PandocPure Html -> Either PandocError Html)
-> (Pandoc -> PandocPure Html) -> Pandoc -> Either PandocError Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> Pandoc -> PandocPure Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Html
PWH.writeHtml5 WriterOptions
forall a. Default a => a
P.def (Pandoc -> Html) -> Pandoc -> Html
forall a b. (a -> b) -> a -> b
$ Maybe Pandoc -> Pandoc
forall a. HasCallStack => Maybe a -> a
fromJust (Lesson -> Maybe Pandoc
lessonLecture Lesson
lesson)
                                    Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ AttributeValue
"lesson-footer-buttons" (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.class_ (String -> AttributeValue
H.stringValue String
"button") (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.href (String -> AttributeValue
H.stringValue (String -> AttributeValue) -> String -> AttributeValue
forall a b. (a -> b) -> a -> b
$ String
baseLessonUrl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"exercises") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ (String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (String
"Practice" :: String))
                            Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Pandoc -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Pandoc -> Bool) -> Maybe Pandoc -> Bool
forall a b. (a -> b) -> a -> b
$ Lesson -> Maybe Pandoc
lessonPlan Lesson
lesson) (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_ (String -> AttributeValue
H.stringValue String
"lesson-plan") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                                    Html -> Html
H.div (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                                        Either PandocError Html -> Html
forall a b. Either a b -> b
fromRight (Either PandocError Html -> Html)
-> (Pandoc -> Either PandocError Html) -> Pandoc -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocPure Html -> Either PandocError Html
forall a. PandocPure a -> Either PandocError a
P.runPure (PandocPure Html -> Either PandocError Html)
-> (Pandoc -> PandocPure Html) -> Pandoc -> Either PandocError Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> Pandoc -> PandocPure Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Html
PWH.writeHtml5 WriterOptions
forall a. Default a => a
P.def (Pandoc -> Html) -> Pandoc -> Html
forall a b. (a -> b) -> a -> b
$ Maybe Pandoc -> Pandoc
forall a. HasCallStack => Maybe a -> a
fromJust (Lesson -> Maybe Pandoc
lessonPlan Lesson
lesson)
                            Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Vocabulary -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Vocabulary -> Bool) -> Maybe Vocabulary -> Bool
forall a b. (a -> b) -> a -> b
$ Lesson -> Maybe Vocabulary
lessonVocabulary Lesson
lesson) (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_ (String -> AttributeValue
H.stringValue String
"lesson-vocabulary") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                                    Html -> Html
H.div (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                                        Either PandocError Html -> Html
forall a b. Either a b -> b
fromRight (Either PandocError Html -> Html)
-> (Vocabulary -> Either PandocError Html) -> Vocabulary -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocPure Html -> Either PandocError Html
forall a. PandocPure a -> Either PandocError a
P.runPure (PandocPure Html -> Either PandocError Html)
-> (Vocabulary -> PandocPure Html)
-> Vocabulary
-> Either PandocError Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> Pandoc -> PandocPure Html
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Html
PWH.writeHtml5 WriterOptions
forall a. Default a => a
P.def (Pandoc -> PandocPure Html)
-> (Vocabulary -> Pandoc) -> Vocabulary -> PandocPure Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dictionary -> Vocabulary -> Pandoc
buildGlossaryDocument Dictionary
dictionary (Vocabulary -> Html) -> Vocabulary -> Html
forall a b. (a -> b) -> a -> b
$ Maybe Vocabulary -> Vocabulary
forall a. HasCallStack => Maybe a -> a
fromJust (Lesson -> Maybe Vocabulary
lessonVocabulary Lesson
lesson)
                            Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Pandoc -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Pandoc -> Bool) -> Maybe Pandoc -> Bool
forall a b. (a -> b) -> a -> b
$ Lesson -> Maybe Pandoc
lessonLecture Lesson
lesson) (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_ (String -> AttributeValue
H.stringValue String
"lesson-feedback") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                                    Html -> Html
H.div (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                                        Html -> Html
H.h3 (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Text
"Feedback" :: T.Text)
                                        Html -> Html
H.p (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                                            Html -> Html
H.span Html
"Any feedback about this lesson would be deeply appreciated. "
                                        Html -> Html
H.p (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                                            Html -> Html
H.span Html
"If you believe you discovered an error, or if you have any criticism or suggestions, please consider "
                                            Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.href (String -> AttributeValue
H.stringValue (String -> AttributeValue) -> String -> AttributeValue
forall a b. (a -> b) -> a -> b
$ String
baseLessonUrl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"report") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Text
"opening an issue" :: T.Text)
                                            Html -> Html
H.span Html
" in our GitHub repository."
                                        Html -> Html
H.p (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                                            Html -> Html
H.span Html
"If you are interested, you may also edit this lesson directly. For more details, please refer to "
                                            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 -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Text
"https://github.com/jqueiroz/lojban.io#improving-existing-lessons") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Text
"Improving existing lessons" :: T.Text)
                                            Html -> Html
H.span Html
"."
                    Html
displayFooter

displayLessonTabs :: Lesson -> H.Html
displayLessonTabs :: Lesson -> Html
displayLessonTabs Lesson
lesson = do
    let hasLecture :: Bool
hasLecture = Maybe Pandoc -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Pandoc -> Bool) -> Maybe Pandoc -> Bool
forall a b. (a -> b) -> a -> b
$ Lesson -> Maybe Pandoc
lessonLecture Lesson
lesson
    let hasPlan :: Bool
hasPlan = Maybe Pandoc -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Pandoc -> Bool) -> Maybe Pandoc -> Bool
forall a b. (a -> b) -> a -> b
$ Lesson -> Maybe Pandoc
lessonPlan Lesson
lesson
    let hasVocabulary :: Bool
hasVocabulary = Maybe Vocabulary -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Vocabulary -> Bool) -> Maybe Vocabulary -> Bool
forall a b. (a -> b) -> a -> b
$ Lesson -> Maybe Vocabulary
lessonVocabulary Lesson
lesson
    Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasLecture (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        String -> String -> Bool -> Html
displayLessonTab String
"lesson-tab-lecture" String
"Lecture" Bool
True
    Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasVocabulary (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        String -> String -> Bool -> Html
displayLessonTab String
"lesson-tab-vocabulary" String
"Vocabulary" (Bool -> Html) -> Bool -> Html
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool
not Bool
hasLecture)
    Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasPlan (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        String -> String -> Bool -> Html
displayLessonTab String
"lesson-tab-plan" String
"Plan" (Bool -> Html) -> Bool -> Html
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool
not Bool
hasLecture) Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
hasVocabulary)
    Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasLecture (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        String -> String -> Bool -> Html
displayLessonTab String
"lesson-tab-feedback" String
"Feedback" Bool
False

displayLessonTab :: String -> String -> Bool -> H.Html
displayLessonTab :: String -> String -> Bool -> Html
displayLessonTab String
id String
title Bool
checked = do
    Html
H.input Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.type_ (String -> AttributeValue
H.stringValue String
"radio") Html -> (Bool, Attribute) -> Html
forall h. Attributable h => h -> (Bool, Attribute) -> h
B.!? (Bool
checked, AttributeValue -> Attribute
A.checked AttributeValue
"checked") Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.name (String -> AttributeValue
H.stringValue String
"lesson-tabgroup") Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.id (String -> AttributeValue
H.stringValue String
id) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ (String -> AttributeValue
H.stringValue String
"lesson-tab-input")
    Html -> Html
H.label (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.for (String -> AttributeValue
H.stringValue String
id) (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ (AttributeValue
"lesson-tab-label") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml String
title

-- Embedded dictionary: consider using tooltips (https://getbootstrap.com/docs/4.0/components/tooltips/)
displayLessonExercise :: ServerConfiguration -> Maybe UserIdentity -> TopbarCategory -> Course -> Int -> H.Html
displayLessonExercise :: ServerConfiguration
-> Maybe UserIdentity -> TopbarCategory -> Course -> Int -> Html
displayLessonExercise ServerConfiguration
serverConfiguration Maybe UserIdentity
userIdentityMaybe TopbarCategory
topbarCategory Course
course Int
lessonNumber = do
    let dictionary :: Dictionary
dictionary = Course -> Dictionary
courseDictionary Course
course
    let baseLessonUrl :: String
baseLessonUrl = String
"../"
    Html
H.docType
    Html -> Html
H.html (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 (Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Text -> Html) -> Text -> Html
forall a b. (a -> b) -> a -> b
$ (Lesson -> Text
lessonTitle Lesson
lesson) Text -> Text -> Text
`T.append` Text
" :: Practice :: lojban.io")
            Html
includeUniversalStylesheets
            String -> Html
includeInternalStylesheet String
"funkyradio.css"
            String -> Html
includeInternalStylesheet String
"list-group-horizontal.css"
            String -> Html
includeInternalStylesheet String
"exercise.css"
            Html
includeUniversalScripts
            Course -> Html
includeCourseScript Course
course
            Int -> Html
includeLessonScript Int
lessonNumber
            Dictionary -> Html
includeDictionaryScript Dictionary
dictionary
            String -> Html
includeInternalScript String
"exercise-min.js"
            Course -> Html
includeCourseStylesheet Course
course
        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
topbarCategory
            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
"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
"body") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                    String -> LessonSubpage -> Course -> Int -> Html
displayLessonHeader String
baseLessonUrl LessonSubpage
LessonExercises Course
course Int
lessonNumber
                    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
"lesson") (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.id (String -> AttributeValue
H.stringValue String
"exercise-holder") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (String
"" :: String)
    where
        lesson :: Lesson
lesson = (Course -> [Lesson]
courseLessons Course
course) [Lesson] -> Int -> Lesson
forall a. HasCallStack => [a] -> Int -> a
!! (Int
lessonNumber Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

displayLessonHeader :: String -> LessonSubpage -> Course -> Int -> H.Html
displayLessonHeader :: String -> LessonSubpage -> Course -> Int -> Html
displayLessonHeader String
baseLessonUrl LessonSubpage
lessonSubpage Course
course Int
lessonNumber = do
    let baseCourseUrl :: String
baseCourseUrl = String
baseLessonUrl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"../"
    let lessons :: [Lesson]
lessons = Course -> [Lesson]
courseLessons Course
course
    let lessonsCount :: Int
lessonsCount = [Lesson] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Lesson]
lessons
    let lesson :: Lesson
lesson = [Lesson]
lessons [Lesson] -> Int -> Lesson
forall a. HasCallStack => [a] -> Int -> a
!! (Int
lessonNumber Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    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
"lesson-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_ (String -> AttributeValue
H.stringValue String
"lesson-info") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            Html -> Html
H.h1 (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ AttributeValue
"course-title" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
                Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.href (String -> AttributeValue
H.stringValue String
baseCourseUrl) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Course -> Text
courseTitle Course
course)
            Html -> Html
H.h2 (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ AttributeValue
"lesson-title" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                -- Previous lesson
                Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
lessonNumber Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
                    let
                        url :: String
url = (String
"../" String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
baseLessonUrl String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
lessonNumber Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                        title :: Text
title = (Text
"Previous lesson: " Text -> Text -> Text
`T.append`) (Text -> Text) -> (Lesson -> Text) -> Lesson -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lesson -> Text
lessonTitle (Lesson -> Text) -> Lesson -> Text
forall a b. (a -> b) -> a -> b
$ [Lesson]
lessons [Lesson] -> Int -> Lesson
forall a. HasCallStack => [a] -> Int -> a
!! (Int
lessonNumber Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
                    in
                        Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.href (String -> AttributeValue
H.stringValue String
url) (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.title (Text -> AttributeValue
H.textValue Text
title) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (String
"<" :: String)
                -- Lesson title
                Html -> Html
H.span (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml ((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
". " Text -> Text -> Text
`T.append` Lesson -> Text
lessonTitle Lesson
lesson)
                -- Next lesson
                Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
lessonNumber Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lessonsCount) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
                    let
                        url :: String
url = (String
"../"String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
baseLessonUrlString -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int
lessonNumber Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                        title :: Text
title = (Text
"Next lesson: " Text -> Text -> Text
`T.append`) (Text -> Text) -> (Lesson -> Text) -> Lesson -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lesson -> Text
lessonTitle (Lesson -> Text) -> Lesson -> Text
forall a b. (a -> b) -> a -> b
$ [Lesson]
lessons [Lesson] -> Int -> Lesson
forall a. HasCallStack => [a] -> Int -> a
!! Int
lessonNumber
                    in
                        Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.href (String -> AttributeValue
H.stringValue String
url) (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.title (Text -> AttributeValue
H.textValue Text
title) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (String
">" :: String)
        Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ AttributeValue
"lesson-buttons" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
            Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LessonSubpage
lessonSubpage LessonSubpage -> LessonSubpage -> Bool
forall a. Eq a => a -> a -> Bool
/= LessonSubpage
LessonHome) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ (String -> AttributeValue
H.stringValue String
"button") (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.href (String -> AttributeValue
H.stringValue String
"../") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ (String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (String
"Review Theory" :: String))
            Bool -> Html -> Html
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LessonSubpage
lessonSubpage LessonSubpage -> LessonSubpage -> Bool
forall a. Eq a => a -> a -> Bool
/= LessonSubpage
LessonExercises) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ (String -> AttributeValue
H.stringValue String
"button") (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.href (String -> AttributeValue
H.stringValue (String -> AttributeValue) -> String -> AttributeValue
forall a b. (a -> b) -> a -> b
$ String
baseLessonUrl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"exercises") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ (String -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (String
"Practice" :: String))
            --when (lessonSubpage /= LessonVocabulary) $ H.a B.! A.class_ (H.stringValue "button") B.! A.href (H.stringValue $ baseLessonUrl ++ "vocabulary")$ (H.toHtml ("Vocabulary" :: String))
            --TODO: consider alternative layout: inside theory, there are two tabs: one for the actual theory and another for vocabulary
            -- also consider including the lesson plan in a third tab

-- displayLessonVocabulary: consider using cards (https://getbootstrap.com/docs/4.0/components/card/)
-- probably better: table similar to https://www.memrise.com/course/37344/simplified-gismu/1/