{-# LANGUAGE OverloadedStrings #-}

module Server.Website.Views.Course
( displayCourseHome
) where

import Core
import Server.Core
import Server.Website.Views.Core
import Control.Monad (when, forM_)
import Data.Maybe (isJust, fromJust)
import Data.Either.Unwrap (fromRight)
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

-- TODO: consider using list groups (https://getbootstrap.com/docs/4.0/components/list-group/)
displayCourseHome :: ServerConfiguration -> Maybe UserIdentity -> TopbarCategory -> Course -> H.Html
displayCourseHome :: ServerConfiguration
-> Maybe UserIdentity -> TopbarCategory -> Course -> Html
displayCourseHome ServerConfiguration
serverConfiguration Maybe UserIdentity
userIdentityMaybe TopbarCategory
topbarCategory Course
course = do
    let baseCourseUrl :: [Char]
baseCourseUrl = [Char]
""
    let title :: Text
title = Course -> Text
courseTitle Course
course
    let shortDescription :: Text
shortDescription = Course -> Text
courseShortDescription Course
course
    Html
H.docType
    Html -> Html
H.html (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.lang ([Char] -> AttributeValue
H.stringValue [Char]
"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
title Text -> Text -> Text
`T.append` Text
" :: lojban.io")
            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
shortDescription)
            Html
includeUniversalStylesheets
            Html
includeUniversalScripts
            [Char] -> Html
includeInternalStylesheet [Char]
"course.css"
            Course -> Html
includeCourseStylesheet Course
course
            Course -> Html
includeCourseScript 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_ ([Char] -> AttributeValue
H.stringValue [Char]
"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)
                    [Char] -> Course -> Html
displayCourseMenu [Char]
baseCourseUrl 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
"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_ ([Char] -> AttributeValue
H.stringValue [Char]
"course") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                        [Char] -> Course -> Html
displayCourseContents [Char]
baseCourseUrl Course
course
                    Html
displayFooter

displayCourseMenu :: String -> Course -> H.Html
displayCourseMenu :: [Char] -> Course -> Html
displayCourseMenu [Char]
baseCourseUrl Course
course = do
    Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ ([Char] -> AttributeValue
H.stringValue [Char]
"course-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_ ([Char] -> AttributeValue
H.stringValue [Char]
"course-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
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Course -> Text
courseTitle Course
course)
            Html -> Html
H.h1 (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ AttributeValue
"course-lessons-count" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [Char] -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Int -> [Char]
showNumberOfLessons (Int -> [Char]) -> (Course -> Int) -> Course -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Lesson] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Lesson] -> Int) -> (Course -> [Lesson]) -> Course -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Course -> [Lesson]
courseLessons (Course -> [Char]) -> Course -> [Char]
forall a b. (a -> b) -> a -> b
$ Course
course)
            Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ AttributeValue
"course-description" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [Char] -> Html
forall a. ToMarkup a => a -> Html
H.toHtml ([Char]
"" :: String)

displayCourseContents :: String -> Course -> H.Html
displayCourseContents :: [Char] -> Course -> Html
displayCourseContents [Char]
baseCourseUrl Course
course = do
    let lessons :: [Lesson]
lessons = Course -> [Lesson]
courseLessons Course
course
    Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ ([Char] -> AttributeValue
H.stringValue [Char]
"course-contents") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        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
$ Course -> Maybe Pandoc
courseLongDescription Course
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_ ([Char] -> AttributeValue
H.stringValue [Char]
"course-about") (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
$ [Char] -> Html
forall a. ToMarkup a => a -> Html
H.toHtml ([Char]
"About this course" :: String)
                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 (Course -> Maybe Pandoc
courseLongDescription Course
course)
        Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ ([Char] -> AttributeValue
H.stringValue [Char]
"course-lessons") (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
$ [Char] -> Html
forall a. ToMarkup a => a -> Html
H.toHtml ([Char]
"Lessons" :: String)
            Html -> Html
H.ol (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [(Int, Lesson)] -> ((Int, Lesson) -> Html) -> Html
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [Lesson] -> [(Int, Lesson)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Lesson]
lessons) (Int, Lesson) -> Html
displayCourseLessonItem
        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
$ Course -> Maybe Pandoc
courseCredits Course
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_ ([Char] -> AttributeValue
H.stringValue [Char]
"course-credits") (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
$ [Char] -> Html
forall a. ToMarkup a => a -> Html
H.toHtml ([Char]
"Credits" :: String)
                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 (Course -> Maybe Pandoc
courseCredits Course
course)

displayCourseLessonItem :: (Int, Lesson) -> H.Html
displayCourseLessonItem :: (Int, Lesson) -> Html
displayCourseLessonItem (Int
lessonNumber, Lesson
lesson) = do
    Html -> Html
H.li (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
"lesson-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.a (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)
            Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.href ([Char] -> AttributeValue
H.stringValue ([Char] -> AttributeValue)
-> (Int -> [Char]) -> Int -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"/") ([Char] -> [Char]) -> (Int -> [Char]) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> AttributeValue) -> Int -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Int
lessonNumber)

showNumberOfLessons :: Int -> String
showNumberOfLessons :: Int -> [Char]
showNumberOfLessons Int
0 = [Char]
"No lessons yet..."
showNumberOfLessons Int
1 = [Char]
"1 lesson"
showNumberOfLessons Int
x = (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
x) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" lessons"