{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

-- | This module defines the deck.
module Study.Decks.English.ContextualizedBrivla
( deck
) where

import Core
import Language.Lojban.Core
import Language.Lojban.Dictionaries (englishDictionary)
import Study.Framework.Lojban.ExerciseGenerators (generateFillingBlanksExerciseByExpression, generateIsolatedBrivlaPlacesExercise, generateLexiconProvidingExercise)
import Study.Courses.English.Vocabulary.Brivla.Translations (translationsByExpression)
import Study.Framework.DocumentBuilders (buildDocumentFromMarkdownCode)
import Data.FileEmbed (embedStringFile)
import Util (combineGenerators, generatorFromList)
import Control.Arrow (second)
import qualified Data.Text as T
import qualified Text.Pandoc as P

-- | Deck description.
longDescription :: P.Pandoc
Right Pandoc
longDescription = Text -> Either PandocError Pandoc
buildDocumentFromMarkdownCode $(embedStringFile "resources/decks/english/brivla/description.md")

-- | Deck credits.
credits :: P.Pandoc
Right Pandoc
credits = Text -> Either PandocError Pandoc
buildDocumentFromMarkdownCode $(embedStringFile "resources/decks/english/brivla/credits.md")

-- | Deck: Contextualized Brivla.
deck :: Deck
deck :: Deck
deck = Text
-> Text
-> Text
-> Maybe Pandoc
-> Maybe Pandoc
-> Dictionary
-> [Card]
-> Deck
Deck Text
id Text
title Text
shortDescription (Pandoc -> Maybe Pandoc
forall a. a -> Maybe a
Just Pandoc
longDescription) (Pandoc -> Maybe Pandoc
forall a. a -> Maybe a
Just Pandoc
credits) Dictionary
dictionary [Card]
cards where
    id :: Text
id = Text
"eng_contextualized-brivla"
    title :: Text
title = Text
"Contextualized brivla"
    shortDescription :: Text
shortDescription = Text
"Learn the most commonly used brivla, while also developing your comprehension skills."

-- | Dictionary for the deck.
dictionary :: Dictionary
dictionary :: Dictionary
dictionary = Dictionary
englishDictionary

-- | Cards for the deck
cards :: [Card]
cards :: [Card]
cards = (Text -> Card) -> [Text] -> [Card]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Card
buildCard [Text]
brivlaList where
    buildCard :: Text -> Card
buildCard Text
brivla = Text -> Text -> ExerciseGenerator -> Card
Card Text
brivla (Dictionary -> Text -> Text
dictLookupValsiDefinition Dictionary
dictionary Text
brivla) (Text -> ExerciseGenerator
buildBrivlaExerciseGenerator Text
brivla)

-- | List of brivla in the deck.
brivlaList :: [T.Text]
brivlaList :: [Text]
brivlaList = ((Text, [Translation]) -> Text)
-> [(Text, [Translation])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, [Translation]) -> Text
forall a b. (a, b) -> a
fst [(Text, [Translation])]
translationsByExpression

-- * Auxiliar functions
buildBrivlaExerciseGenerator :: T.Text -> ExerciseGenerator
buildBrivlaExerciseGenerator :: Text -> ExerciseGenerator
buildBrivlaExerciseGenerator Text
brivla = [(Int, ExerciseGenerator)] -> ExerciseGenerator
forall a. [(Int, StdGen -> a)] -> StdGen -> a
combineGenerators [(Int, ExerciseGenerator)]
chosenGenerators where
    translationExercises :: ExerciseGenerator
translationExercises = TranslationGeneratorByExpression -> ExerciseGenerator
generateFillingBlanksExerciseByExpression (TranslationGeneratorByExpression -> ExerciseGenerator)
-> TranslationGeneratorByExpression -> ExerciseGenerator
forall a b. (a -> b) -> a -> b
$ ((Text, TranslationGenerator) -> Bool)
-> TranslationGeneratorByExpression
-> TranslationGeneratorByExpression
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
brivla) (Text -> Bool)
-> ((Text, TranslationGenerator) -> Text)
-> (Text, TranslationGenerator)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, TranslationGenerator) -> Text
forall a b. (a, b) -> a
fst) TranslationGeneratorByExpression
translationGeneratorByExpression
    translationGeneratorByExpression :: TranslationGeneratorByExpression
translationGeneratorByExpression = ((Text, [Translation]) -> (Text, TranslationGenerator))
-> [(Text, [Translation])] -> TranslationGeneratorByExpression
forall a b. (a -> b) -> [a] -> [b]
map (([Translation] -> TranslationGenerator)
-> (Text, [Translation]) -> (Text, TranslationGenerator)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second [Translation] -> TranslationGenerator
forall a. [a] -> StdGen -> (a, StdGen)
generatorFromList) [(Text, [Translation])]
translationsByExpression
    brivlaPlacesExercises :: ExerciseGenerator
brivlaPlacesExercises = Dictionary -> [Text] -> ExerciseGenerator
generateIsolatedBrivlaPlacesExercise Dictionary
dictionary [Text
brivla]
    brivlaProvidingExercises :: ExerciseGenerator
brivlaProvidingExercises = Text -> Dictionary -> WordGenerator -> ExerciseGenerator
generateLexiconProvidingExercise Text
"brivla" Dictionary
dictionary (WordGenerator -> ExerciseGenerator)
-> WordGenerator -> ExerciseGenerator
forall a b. (a -> b) -> a -> b
$ [Text] -> WordGenerator
forall a. [a] -> StdGen -> (a, StdGen)
generatorFromList [Text
brivla]
    brivlaHasAtLeastTwoPlaces :: Bool
brivlaHasAtLeastTwoPlaces = ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Int) -> [Text] -> Int
forall a b. (a -> b) -> a -> b
$ Dictionary -> Text -> [Text]
retrieveBrivlaPlaces Dictionary
dictionary Text
brivla) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
    chosenGenerators :: [(Int, ExerciseGenerator)]
chosenGenerators =
        if Bool
brivlaHasAtLeastTwoPlaces then
            [(Int
12, ExerciseGenerator
translationExercises), (Int
2, ExerciseGenerator
brivlaPlacesExercises), (Int
3, ExerciseGenerator
brivlaProvidingExercises)]
        else
            [(Int
12, ExerciseGenerator
translationExercises), (Int
4, ExerciseGenerator
brivlaProvidingExercises)]