{-# LANGUAGE OverloadedStrings #-}

module Server.Website.Views.Deck
( displayDeckHome
, displayDeckExercise
) 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 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/)
displayDeckHome :: ServerConfiguration -> Maybe UserIdentity -> Deck -> H.Html
displayDeckHome :: ServerConfiguration -> Maybe UserIdentity -> Deck -> Html
displayDeckHome ServerConfiguration
serverConfiguration Maybe UserIdentity
userIdentityMaybe Deck
deck = do
    let baseDeckUrl :: Text
baseDeckUrl = Text
""
    let title :: Text
title = Deck -> Text
deckTitle Deck
deck
    let shortDescription :: Text
shortDescription = Deck -> Text
deckShortDescription Deck
deck
    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]
"deck.css"
            Deck -> Html
includeDeckScript Deck
deck
            [Char] -> Html
includeInternalScript [Char]
"deck-min.js"
        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
TopbarDecks
            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)
                    Text -> Deck -> Html
displayDeckHomeHeader Text
baseDeckUrl Deck
deck
                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
"deck-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
$ Deck -> Maybe Pandoc
deckLongDescription Deck
deck) (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]
"deck-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 deck" :: 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 (Deck -> Maybe Pandoc
deckLongDescription Deck
deck)
                        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]
"deck-manage") (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
"Manage your cards" :: 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
"Tap on cards to alternate between \"not started\" (or \"inactive\"), \"currently learning\" and \"already mastered\"." Text -> Text -> Text
`T.append`
                                            Text
" Stars represent how familiar you are with each card, based on past performance." Text -> Text -> Text
`T.append`
                                            Text
" Only cards tagged as \"currently learning\" will appear in exercises." Text -> Text -> Text
`T.append`
                                            Text
" Consequently, once you have mastered a card, you may optionally tag it as \"already mastered\" to ignore it." :: 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
"For the optimal learning experience, we suggest having between 10 and 200 active cards at any given moment." Text -> Text -> Text
`T.append`
                                            Text
" Cards for exercises are selected algorithmically, in such a way that lesser-known cards are featured more frequently." :: T.Text)
                            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]
"deck-cards") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Text
"" :: T.Text)
                        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
$ Deck -> Maybe Pandoc
deckCredits Deck
deck) (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]
"deck-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 (Deck -> Maybe Pandoc
deckCredits Deck
deck)
                    Html
displayFooter

displayDeckExercise :: ServerConfiguration -> Maybe UserIdentity -> Deck -> H.Html
displayDeckExercise :: ServerConfiguration -> Maybe UserIdentity -> Deck -> Html
displayDeckExercise ServerConfiguration
serverConfiguration Maybe UserIdentity
userIdentityMaybe Deck
deck = do
    let dictionary :: Dictionary
dictionary = Deck -> Dictionary
deckDictionary Deck
deck
    let baseDeckUrl :: Text
baseDeckUrl = Text
"./"
    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
$ (Deck -> Text
deckTitle Deck
deck) Text -> Text -> Text
`T.append` Text
" :: Practice :: lojban.io")
            Html
includeUniversalStylesheets
            [Char] -> Html
includeInternalStylesheet [Char]
"funkyradio.css"
            [Char] -> Html
includeInternalStylesheet [Char]
"list-group-horizontal.css"
            [Char] -> Html
includeInternalStylesheet [Char]
"exercise.css"
            Html
includeUniversalScripts
            Dictionary -> Html
includeDictionaryScript Dictionary
dictionary
            Deck -> Html
includeDeckScript Deck
deck
            [Char] -> Html
includeInternalScript [Char]
"exercise-min.js"
        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
TopbarDecks
            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
"body") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
                    Text -> Deck -> Html
displayDeckExerciseHeader Text
baseDeckUrl Deck
deck
                    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]
"deck") (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 ([Char] -> AttributeValue
H.stringValue [Char]
"exercise-holder") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Text
"" :: T.Text)

displayDeckHomeHeader :: T.Text -> Deck -> H.Html
displayDeckHomeHeader :: Text -> Deck -> Html
displayDeckHomeHeader Text
baseDeckUrl Deck
deck = do
    let title :: Text
title = Deck -> Text
deckTitle Deck
deck
    let shortDescription :: Text
shortDescription = Deck -> Text
deckShortDescription Deck
deck
    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]
"deck-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]
"deck-info") (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]
"deck-info-short") (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
"deck-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.h1 (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ AttributeValue
"deck-cards-count" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ [Char] -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Int -> [Char]
showNumberOfCards (Int -> [Char]) -> (Deck -> Int) -> Deck -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Card] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Card] -> Int) -> (Deck -> [Card]) -> Deck -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Deck -> [Card]
deckCards (Deck -> [Char]) -> Deck -> [Char]
forall a b. (a -> b) -> a -> b
$ Deck
deck)
            Html -> Html
H.p (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ AttributeValue
"deck-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_ AttributeValue
"deck-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_ (Text -> AttributeValue
H.textValue Text
"button") (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
baseDeckUrl Text -> Text -> Text
`T.append` Text
"./exercises") (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ (Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Text
"Practice" :: T.Text))

displayDeckExerciseHeader :: T.Text -> Deck -> H.Html
displayDeckExerciseHeader :: Text -> Deck -> Html
displayDeckExerciseHeader Text
baseDeckUrl Deck
deck = do
    -- TODO: consider displaying: "x active cards out of y"
    let cardsCount :: Int
cardsCount = [Card] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Deck -> [Card]
deckCards Deck
deck)
    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]
"deck-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]
"deck-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
"deck-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 (Text -> AttributeValue
H.textValue Text
baseDeckUrl) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Deck -> Text
deckTitle Deck
deck)
        Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.class_ AttributeValue
"deck-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_ (Text -> AttributeValue
H.textValue Text
"button") (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
B.! AttributeValue -> Attribute
A.href (Text -> AttributeValue
H.textValue Text
baseDeckUrl) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ (Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Text
"Review Deck" :: T.Text))

showNumberOfCards :: Int -> String
showNumberOfCards :: Int -> [Char]
showNumberOfCards Int
0 = [Char]
"No cards yet..."
showNumberOfCards Int
1 = [Char]
"1 card"
showNumberOfCards Int
x = (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
x) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" cards"