{-# LANGUAGE OverloadedStrings #-}

-- | This module provides utilities for constructing exercise generators.
module Study.Framework.Lojban.ExerciseGenerators
( generateTranslationExercise
, generateTranslationExerciseWithCustomTitle
, generateBlacklistedWordTranslationExercise
, generateRestrictedTranslationExercise
, generateMorphologicalClassExercise
, generateEnglishOrLojbanBridiJufraExercise
, generateLojbanBridiJufraExercise
, generateEnglishBridiJufraExercise
, generateFillingBlanksExerciseByAlternatives
, generateContextualizedFillingBlanksExerciseByAlternatives
, generateFillingBlanksExerciseByExpression
, generateSelbriIdentificationExercise
, generateContextualizedGismuPlacePositionExercise
, generateContextualizedGismuPlaceMeaningExercise
, generateIsolatedBrivlaPlacesExercise
, generateLexiconProvidingExercise
, generateLexiconChoosingExercise
, generateBasicNumberExercise
) where

import Core
import Language.Lojban.Core
import Language.Lojban.Numbers
import Language.Lojban.Canonicalization (normalizeText)
import Util (isSubexpressionOf, replace, replaceFirstSubexpression, replaceSubexpression, chooseItemUniformly, combineGenerators, combineGeneratorsUniformly, generatorWithRetries, isWordOf)
import Text.Read (readMaybe)
import System.Random (StdGen, random)
import Control.Applicative (liftA2)
import Control.Arrow (first)
import Control.Exception (assert)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Map as M

-- | Exercise: translate a given sentence into Lojban.
--
-- Example: https://github.com/jqueiroz/lojban.io/blob/master/docs/exercises/examples/translation.jpg
generateTranslationExercise :: SentenceCanonicalizer -> SentenceComparer -> TranslationGenerator -> ExerciseGenerator
generateTranslationExercise :: SentenceCanonicalizer
-> SentenceComparer -> TranslationGenerator -> ExerciseGenerator
generateTranslationExercise = Text
-> (Text -> Bool)
-> SentenceCanonicalizer
-> SentenceComparer
-> TranslationGenerator
-> ExerciseGenerator
generateRestrictedTranslationExercise Text
"Translate this sentence" (Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | Exercise: translate a given sentence into Lojban (with a custom title).
--
-- Example: https://github.com/jqueiroz/lojban.io/blob/master/docs/exercises/examples/translation.jpg
generateTranslationExerciseWithCustomTitle :: T.Text -> SentenceCanonicalizer -> SentenceComparer -> TranslationGenerator -> ExerciseGenerator
generateTranslationExerciseWithCustomTitle :: Text
-> SentenceCanonicalizer
-> SentenceComparer
-> TranslationGenerator
-> ExerciseGenerator
generateTranslationExerciseWithCustomTitle Text
title = Text
-> (Text -> Bool)
-> SentenceCanonicalizer
-> SentenceComparer
-> TranslationGenerator
-> ExerciseGenerator
generateRestrictedTranslationExercise Text
title (Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | Exercise: translate a given sentence into Lojban, with the restriction that a particular Lojban word cannot be used.
generateBlacklistedWordTranslationExercise :: T.Text -> SentenceCanonicalizer -> SentenceComparer -> TranslationGenerator -> ExerciseGenerator
generateBlacklistedWordTranslationExercise :: Text
-> SentenceCanonicalizer
-> SentenceComparer
-> TranslationGenerator
-> ExerciseGenerator
generateBlacklistedWordTranslationExercise Text
blacklistedWord = Text
-> (Text -> Bool)
-> SentenceCanonicalizer
-> SentenceComparer
-> TranslationGenerator
-> ExerciseGenerator
generateRestrictedTranslationExercise ([Text] -> Text
T.concat [Text
"Translate without using \"", Text
blacklistedWord, Text
"\""]) (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SentenceComparer
isWordOf Text
blacklistedWord)

-- | Exercise: translate a given sentence into Lojban, with some arbitrary (algorithmically specified) restriction concerning the user's solution.
generateRestrictedTranslationExercise :: T.Text -> (T.Text -> Bool) -> SentenceCanonicalizer -> SentenceComparer -> TranslationGenerator -> ExerciseGenerator
generateRestrictedTranslationExercise :: Text
-> (Text -> Bool)
-> SentenceCanonicalizer
-> SentenceComparer
-> TranslationGenerator
-> ExerciseGenerator
generateRestrictedTranslationExercise Text
title Text -> Bool
validator SentenceCanonicalizer
canonicalizer SentenceComparer
sentenceComparer TranslationGenerator
translationGenerator StdGen
r0 = Text -> [ExerciseSentence] -> (Text -> Bool) -> Text -> Exercise
TypingExercise Text
title [Bool -> Text -> ExerciseSentence
ExerciseSentence Bool
False Text
english_sentence] ((Bool -> Bool -> Bool)
-> (Text -> Bool) -> (Text -> Bool) -> Text -> Bool
forall a b c.
(a -> b -> c) -> (Text -> a) -> (Text -> b) -> Text -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&) Text -> Bool
validator Text -> Bool
validateAll) ([Text] -> Text
forall a. HasCallStack => [a] -> a
head [Text]
lojban_sentences) where
    (Translation
translation, StdGen
r1) = TranslationGenerator
translationGenerator StdGen
r0
    ([Text]
lojban_sentences, [Text]
english_sentences) = Translation
translation
    (Text
english_sentence, StdGen
r2) = StdGen -> [Text] -> (Text, StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r1 [Text]
english_sentences
    validateAll :: Text -> Bool
validateAll Text
typed_sentence = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (SentenceComparer
validateSingle Text
typed_sentence) [Text]
lojban_sentences
    validateSingle :: SentenceComparer
validateSingle Text
typed_sentence Text
lojban_sentence =
        let lower_lojban_sentence :: Text
lower_lojban_sentence = Text -> Text
T.toLower Text
lojban_sentence
            lower_typed_sentence :: Text
lower_typed_sentence = Text -> Text
T.toLower Text
typed_sentence
        in (Text
lower_lojban_sentence SentenceComparer
forall a. Eq a => a -> a -> Bool
== Text
lower_typed_sentence) Bool -> Bool -> Bool
||
            case SentenceCanonicalizer
canonicalizer Text
lower_typed_sentence of
                Left String
_ -> Bool
False
                Right Text
canonicalized_typed_sentence -> case SentenceCanonicalizer
canonicalizer Text
lower_lojban_sentence of
                    Left String
_ -> Bool
False
                    Right Text
canonicalized_lojban_sentence -> Text
canonicalized_lojban_sentence SentenceComparer
`sentenceComparer` Text
canonicalized_typed_sentence

-- | Exercise: tell morphological class of a word (brivla, cmavo, or cmevla).
generateMorphologicalClassExercise :: Vocabulary -> ExerciseGenerator
generateMorphologicalClassExercise :: Vocabulary -> ExerciseGenerator
generateMorphologicalClassExercise Vocabulary
vocabulary StdGen
r0 = Text -> [ExerciseSentence] -> Text -> [Text] -> Bool -> Exercise
SingleChoiceExercise Text
title [ExerciseSentence]
forall {a}. [a]
sentences Text
correctAlternative [Text]
incorrectAlternatives Bool
True where
    words :: a -> [Text]
words a
"brivla" = Vocabulary -> [Text]
vocabularyBrivlaList Vocabulary
vocabulary
    words a
"cmavo" = Vocabulary -> [Text]
vocabularyCmavoList Vocabulary
vocabulary
    words a
"cmevla" = Vocabulary -> [Text]
vocabularyCmevlaList Vocabulary
vocabulary
    allAlternatives :: [Text]
allAlternatives = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Text] -> Bool) -> (Text -> [Text]) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
forall {a}. (Eq a, IsString a) => a -> [Text]
words) [Text
"brivla", Text
"cmavo", Text
"cmevla"]
    (Text
correctAlternative, StdGen
r1) = StdGen -> [Text] -> (Text, StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r0 [Text]
allAlternatives
    incorrectAlternatives :: [Text]
incorrectAlternatives = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (SentenceComparer
forall a. Eq a => a -> a -> Bool
/= Text
correctAlternative) [Text]
allAlternatives
    (Text
word, StdGen
_) = StdGen -> [Text] -> (Text, StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r1 ([Text] -> (Text, StdGen)) -> [Text] -> (Text, StdGen)
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
forall {a}. (Eq a, IsString a) => a -> [Text]
words Text
correctAlternative
    title :: Text
title = Text
"Classify <b>" Text -> Text -> Text
`T.append` Text
word Text -> Text -> Text
`T.append` Text
"</b>"
    sentences :: [a]
sentences = []

-- | Exercise: decide whether an utterance (in either English or Lojban) is a bridi or merely a jufra.
generateEnglishOrLojbanBridiJufraExercise :: SimpleBridiGenerator -> TextGenerator -> SimpleBridiDisplayer -> ExerciseGenerator
generateEnglishOrLojbanBridiJufraExercise :: SimpleBridiGenerator
-> TextGenerator -> SimpleBridiDisplayer -> ExerciseGenerator
generateEnglishOrLojbanBridiJufraExercise SimpleBridiGenerator
simpleBridiGenerator TextGenerator
nonbridiGenerator SimpleBridiDisplayer
displayBridi = [ExerciseGenerator] -> ExerciseGenerator
forall a. [StdGen -> a] -> StdGen -> a
combineGeneratorsUniformly [ExerciseGenerator
generateEnglishBridiJufraExercise, SimpleBridiGenerator
-> TextGenerator -> SimpleBridiDisplayer -> ExerciseGenerator
generateLojbanBridiJufraExercise SimpleBridiGenerator
simpleBridiGenerator TextGenerator
nonbridiGenerator SimpleBridiDisplayer
displayBridi]

-- | Exercise: decide whether a Lojban utterance is a bridi or merely a jufra.
generateLojbanBridiJufraExercise :: SimpleBridiGenerator -> TextGenerator -> SimpleBridiDisplayer -> ExerciseGenerator
generateLojbanBridiJufraExercise :: SimpleBridiGenerator
-> TextGenerator -> SimpleBridiDisplayer -> ExerciseGenerator
generateLojbanBridiJufraExercise SimpleBridiGenerator
simpleBridiGenerator TextGenerator
nonbridiGenerator SimpleBridiDisplayer
displayBridi StdGen
r0 = Text -> [ExerciseSentence] -> Text -> [Text] -> Bool -> Exercise
SingleChoiceExercise Text
title [ExerciseSentence]
sentences Text
correctAlternative [Text]
incorrectAlternatives Bool
True where
    chooseLojbanSentence :: T.Text -> StdGen -> (T.Text, StdGen)
    chooseLojbanSentence :: Text -> TextGenerator
chooseLojbanSentence Text
"only jufra" StdGen
r0 = TextGenerator
nonbridiGenerator StdGen
r0
    chooseLojbanSentence Text
"bridi and jufra" StdGen
r0 = SimpleBridiDisplayer
displayBridi StdGen
r1 SimpleBridi
simpleBridi where
        (SimpleBridi
simpleBridi, StdGen
r1) = SimpleBridiGenerator
simpleBridiGenerator StdGen
r0
    allAlternatives :: [Text]
allAlternatives = [Text
"only jufra", Text
"bridi and jufra"]
    (Text
correctAlternative, StdGen
r1) = StdGen -> [Text] -> (Text, StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r0 [Text]
allAlternatives
    incorrectAlternatives :: [Text]
incorrectAlternatives = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (SentenceComparer
forall a. Eq a => a -> a -> Bool
/= Text
correctAlternative) [Text]
allAlternatives
    (Text
sentenceText, StdGen
_) = Text -> TextGenerator
chooseLojbanSentence Text
correctAlternative StdGen
r1
    title :: Text
title = Text
"Bridi or jufra?"
    sentences :: [ExerciseSentence]
sentences = [Bool -> Text -> ExerciseSentence
ExerciseSentence Bool
True Text
sentenceText]

-- | Exercise: decide whether an English utterance is a bridi or merely a jufra.
generateEnglishBridiJufraExercise :: ExerciseGenerator
generateEnglishBridiJufraExercise :: ExerciseGenerator
generateEnglishBridiJufraExercise StdGen
r0 = Text -> [ExerciseSentence] -> Text -> [Text] -> Bool -> Exercise
SingleChoiceExercise Text
title [ExerciseSentence]
sentences Text
correctAlternative [Text]
incorrectAlternatives Bool
True where
        allAlternatives :: [Text]
allAlternatives = [Text
"only jufra", Text
"bridi and jufra"]
        (Text
correctAlternative, StdGen
r1) = StdGen -> [Text] -> (Text, StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r0 [Text]
allAlternatives
        incorrectAlternatives :: [Text]
incorrectAlternatives = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (SentenceComparer
forall a. Eq a => a -> a -> Bool
/= Text
correctAlternative) [Text]
allAlternatives
        (Text
sentenceText, StdGen
_) = StdGen -> [Text] -> (Text, StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r1 ([Text] -> (Text, StdGen)) -> [Text] -> (Text, StdGen)
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
englishSentences Text
correctAlternative
        title :: Text
title = Text
"Bridi or jufra?"
        sentences :: [ExerciseSentence]
sentences = [Bool -> Text -> ExerciseSentence
ExerciseSentence Bool
True Text
sentenceText]

englishSentences :: T.Text -> [T.Text]
englishSentences :: Text -> [Text]
englishSentences Text
"only jufra" =
    [ Text
"Yes."
    , Text
"No."
    , Text
"Ouch!"
    , Text
"Maybe next week."
    , Text
"Again?!"
    , Text
"Door."
    , Text
"Easy come, easy go."
    , Text
"Teapot."
    , Text
"Forty-two."
    , Text
"Almost, but not quite, entirely unlike tea."
    ]
englishSentences Text
"bridi and jufra" =
    [ Text
"I would like to see you."
    , Text
"Most people don't like him."
    , Text
"They don't care about us."
    , Text
"Be happy!"
    , Text
"That's pretty cool."
    , Text
"They would never do that."
    , Text
"I would never have guessed it."
    , Text
"Could you repeat that, please?"
    , Text
"The above proposition is occasionally useful."
    , Text
"Don't panic."
    , Text
"Reality is frequently inaccurate."
    , Text
"Flying is learning how to throw yourself at the ground and miss."
    , Text
"There is another theory which states that this has already happened."
    , Text
"I refuse to answer that question on the grounds that I don't know the answer."
    ]

-- | Exercise: fill in the blanks (by alternatives)
-- Expects a translation generator whose resulting sentences contain precisely one of the alternatives.
generateFillingBlanksExerciseByAlternatives :: [T.Text] -> TranslationGenerator -> ExerciseGenerator
generateFillingBlanksExerciseByAlternatives :: [Text] -> TranslationGenerator -> ExerciseGenerator
generateFillingBlanksExerciseByAlternatives [Text]
alternatives TranslationGenerator
translationGenerator StdGen
r0 = Text -> [ExerciseSentence] -> Text -> [Text] -> Bool -> Exercise
SingleChoiceExercise Text
title [ExerciseSentence]
sentences Text
correctAlternative [Text]
incorrectAlternatives Bool
True where
    (Translation
translation, StdGen
r1) = TranslationGenerator
translationGenerator StdGen
r0
    (Text
sentenceText, StdGen
r2) = StdGen -> [Text] -> (Text, StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r1 (Translation -> [Text]
forall a b. (a, b) -> a
fst Translation
translation)
    correctAlternatives :: [Text]
correctAlternatives = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (SentenceComparer
`isSubexpressionOf` Text
sentenceText) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
alternatives
    correctAlternative :: Text
correctAlternative = case [Text]
correctAlternatives of
        [] -> String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"generateFillingBlanksExerciseByAlternatives: no correct alternative. Sentence: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
sentenceText String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". Alternatives: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Text] -> String
forall a. Show a => a -> String
show [Text]
alternatives
        [Text
x] -> Text
x
        [Text]
_ -> String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"generateFillingBlanksExerciseByAlternatives: more than one correct alternative. Sentence: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
sentenceText
    incorrectAlternatives :: [Text]
incorrectAlternatives = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (SentenceComparer
forall a. Eq a => a -> a -> Bool
/= Text
correctAlternative) [Text]
alternatives
    title :: Text
title = Text
"Fill in the blanks"
    redactedSentenceText :: Text
redactedSentenceText = Text -> Text -> Text -> Text
replaceFirstSubexpression Text
correctAlternative Text
"____" Text
sentenceText
    sentences :: [ExerciseSentence]
sentences = [Bool -> Text -> ExerciseSentence
ExerciseSentence Bool
True Text
redactedSentenceText]

generateContextualizedFillingBlanksExerciseByAlternatives :: [T.Text] -> TranslationGenerator -> ExerciseGenerator
generateContextualizedFillingBlanksExerciseByAlternatives :: [Text] -> TranslationGenerator -> ExerciseGenerator
generateContextualizedFillingBlanksExerciseByAlternatives [Text]
alternatives TranslationGenerator
translationGenerator StdGen
r0 = Text -> [ExerciseSentence] -> Text -> [Text] -> Bool -> Exercise
SingleChoiceExercise Text
title [ExerciseSentence]
sentences Text
correctAlternative [Text]
incorrectAlternatives Bool
True where
    (Translation
translation, StdGen
r1) = TranslationGenerator
translationGenerator StdGen
r0
    (Text
lojbanSentenceText, StdGen
r2) = StdGen -> [Text] -> (Text, StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r1 (Translation -> [Text]
forall a b. (a, b) -> a
fst Translation
translation)
    (Text
englishSentenceText, StdGen
r3) = StdGen -> [Text] -> (Text, StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r2 (Translation -> [Text]
forall a b. (a, b) -> b
snd Translation
translation)
    correctAlternatives :: [Text]
correctAlternatives = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (SentenceComparer
`isSubexpressionOf` Text
lojbanSentenceText) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
alternatives
    correctAlternative :: Text
correctAlternative = case [Text]
correctAlternatives of
        [] -> String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"generateContextualizedFillingBlanksExerciseByAlternatives: no correct alternative. Lojban sentence text: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
lojbanSentenceText String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". Alternatives: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Text] -> String
forall a. Show a => a -> String
show [Text]
alternatives
        [Text
x] -> Text
x
        [Text]
_ -> String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"generateContextualizedFillingBlanksExerciseByAlternatives: more than one correct alternative. Lojban sentence text: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
lojbanSentenceText String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". Alternatives: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Text] -> String
forall a. Show a => a -> String
show [Text]
alternatives
    incorrectAlternatives :: [Text]
incorrectAlternatives = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (SentenceComparer
forall a. Eq a => a -> a -> Bool
/= Text
correctAlternative) [Text]
alternatives
    title :: Text
title = Text
"Complete the translation"
    redactedLojbanSentenceText :: Text
redactedLojbanSentenceText = Text -> Text -> Text -> Text
replaceFirstSubexpression Text
correctAlternative Text
"____" Text
lojbanSentenceText
    sentences :: [ExerciseSentence]
sentences = [Bool -> Text -> ExerciseSentence
ExerciseSentence Bool
False Text
englishSentenceText, Bool -> Text -> ExerciseSentence
ExerciseSentence Bool
True Text
redactedLojbanSentenceText]

-- | Exercise: fill in the blanks (by expression)
generateFillingBlanksExerciseByExpression :: TranslationGeneratorByExpression -> ExerciseGenerator
generateFillingBlanksExerciseByExpression :: TranslationGeneratorByExpression -> ExerciseGenerator
generateFillingBlanksExerciseByExpression TranslationGeneratorByExpression
translationGeneratorByExpression StdGen
r0 = Text -> [ExerciseSentence] -> (Text -> Bool) -> Text -> Exercise
TypingExercise Text
title [ExerciseSentence]
sentences Text -> Bool
validator Text
expression where
    -- TODO: create a proper exercise type instead of using "TypingExercise"
    ((Text
expression, TranslationGenerator
translationGenerator), StdGen
r1) = StdGen
-> TranslationGeneratorByExpression
-> ((Text, TranslationGenerator), StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r0 TranslationGeneratorByExpression
translationGeneratorByExpression
    (Translation
translation, StdGen
r2) = TranslationGenerator
translationGenerator StdGen
r1
    (Text
lojbanSentenceText, StdGen
r3) = StdGen -> [Text] -> (Text, StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r2 (Translation -> [Text]
forall a b. (a, b) -> a
fst Translation
translation)
    (Text
englishSentenceText, StdGen
r4) = StdGen -> [Text] -> (Text, StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r3 (Translation -> [Text]
forall a b. (a, b) -> b
snd Translation
translation)
    title :: Text
title = Text
"Complete the translation"
    redactedLojbanSentenceText :: Text
redactedLojbanSentenceText = Text -> Text -> Text -> Text
replaceSubexpression Text
expression Text
"____" Text
lojbanSentenceText
    sentences :: [ExerciseSentence]
sentences = [Bool -> Text -> ExerciseSentence
ExerciseSentence Bool
False Text
englishSentenceText, Bool -> Text -> ExerciseSentence
ExerciseSentence Bool
True Text
redactedLojbanSentenceText]
    validator :: Text -> Bool
validator Text
attemptedSolution = (Text -> Text
normalizeText (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
attemptedSolution) SentenceComparer
forall a. Eq a => a -> a -> Bool
== (Text -> Text
normalizeText (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
expression)

-- Exercise: identify the selbri
generateSelbriIdentificationExercise :: SimpleBridiGenerator -> SimpleBridiDisplayer -> ExerciseGenerator
generateSelbriIdentificationExercise :: SimpleBridiGenerator -> SimpleBridiDisplayer -> ExerciseGenerator
generateSelbriIdentificationExercise SimpleBridiGenerator
simpleBridiGenerator SimpleBridiDisplayer
displayBridi StdGen
r0 = Text -> [ExerciseSentence] -> Text -> [Text] -> Bool -> Exercise
SingleChoiceExercise Text
title [ExerciseSentence]
sentences Text
correctAlternative [Text]
incorrectAlternatives Bool
False where
    (SimpleBridi
bridi, StdGen
r1) = SimpleBridiGenerator
simpleBridiGenerator StdGen
r0
    correctAlternative :: Text
correctAlternative = SimpleBridi -> Text
simpleBridiSelbri SimpleBridi
bridi
    incorrectAlternatives :: [Text]
incorrectAlternatives = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
4 ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text] -> [Text]
forall a. Eq a => a -> a -> [a] -> [a]
replace Text
"" Text
"zo'e" ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ SimpleBridi -> [Text]
simpleBridiSumti SimpleBridi
bridi
    title :: Text
title = Text
"Identify the <b>selbri</b>"
    (Text
sentenceText, StdGen
_) = SimpleBridiDisplayer
displayBridi StdGen
r1 SimpleBridi
bridi
    sentences :: [ExerciseSentence]
sentences = [Bool -> Text -> ExerciseSentence
ExerciseSentence Bool
True Text
sentenceText]

-- Exercises: tell gismu places of a sentence (TODO: typing exercises?)
generateContextualizedGismuPlaceMeaningExercise :: Dictionary -> SimpleBridiGenerator -> SimpleBridiDisplayer -> ExerciseGenerator
generateContextualizedGismuPlaceMeaningExercise :: Dictionary
-> SimpleBridiGenerator
-> SimpleBridiDisplayer
-> ExerciseGenerator
generateContextualizedGismuPlaceMeaningExercise Dictionary
dictionary SimpleBridiGenerator
simpleBridiGenerator SimpleBridiDisplayer
displayBridi = [(Int, ExerciseGenerator)] -> ExerciseGenerator
forall a. [(Int, StdGen -> a)] -> StdGen -> a
combineGenerators [(Int
1, ExerciseGenerator
f2WithRetries)] where
    f2WithRetries :: ExerciseGenerator
    f2WithRetries :: ExerciseGenerator
f2WithRetries StdGen
r0 = case (Int
-> (StdGen -> (Maybe Exercise, StdGen))
-> StdGen
-> (Maybe Exercise, StdGen)
forall b.
Int -> (StdGen -> (Maybe b, StdGen)) -> StdGen -> (Maybe b, StdGen)
generatorWithRetries Int
10 StdGen -> (Maybe Exercise, StdGen)
f2) StdGen
r0 of
        (Maybe Exercise
Nothing, StdGen
_) -> String -> Exercise
forall a. HasCallStack => String -> a
error String
"generateContextualizedGismuPlaceMeaningExercise: repeatedly failed to pick a sentence with a valid selbri"
        (Just Exercise
x, StdGen
_) -> Exercise
x
    f2 :: MaybeExerciseGenerator
    f2 :: StdGen -> (Maybe Exercise, StdGen)
f2 StdGen
r0 =
        let
            -- Generate bridi
            (SimpleBridi
bridi, StdGen
r1) = SimpleBridiGenerator
simpleBridiGenerator StdGen
r0
            -- Extract brivla places
            selbri :: Text
selbri = SimpleBridi -> Text
simpleBridiSelbri SimpleBridi
bridi
            -- Function for checking whether the selbri is valid
            isInvalidSelbri :: T.Text -> Bool
            isInvalidSelbri :: Text -> Bool
isInvalidSelbri Text
"mo" = Bool
True
            isInvalidSelbri Text
_ = Bool
False
        in
            if Text -> Bool
isInvalidSelbri Text
selbri
                then (Maybe Exercise
forall a. Maybe a
Nothing, StdGen
r1)
            else
                let
                    placesEnglish :: [Text]
placesEnglish = Dictionary -> Text -> [Text]
retrieveBrivlaPlaces Dictionary
dictionary Text
selbri
                    placesLojban :: [Text]
placesLojban = SimpleBridi -> [Text]
simpleBridiSumti SimpleBridi
bridi
                    places :: [(Text, Text)]
places = [Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
placesEnglish (Text -> Text -> [Text] -> [Text]
forall a. Eq a => a -> a -> [a] -> [a]
replace Text
"" Text
"zo'e" [Text]
placesLojban)
                    -- Construct exercise
                    ((Text, Text)
place, StdGen
r2) = StdGen -> [(Text, Text)] -> ((Text, Text), StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r1 [(Text, Text)]
places
                    correctAlternative :: Text
correctAlternative = (Text, Text) -> Text
forall a b. (a, b) -> b
snd (Text, Text)
place
                    incorrectAlternatives :: [Text]
incorrectAlternatives = (SimpleBridi -> Text
simpleBridiSelbri SimpleBridi
bridi) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (SentenceComparer
forall a. Eq a => a -> a -> Bool
/= Text
correctAlternative) ([Text] -> [Text])
-> ([(Text, Text)] -> [Text]) -> [(Text, Text)] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> b
snd ([(Text, Text)] -> [Text]) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
places)
                    title :: Text
title = Text
"Select the " Text -> Text -> Text
`T.append` Text
"<b>" Text -> Text -> Text
`T.append` ((Text, Text) -> Text
forall a b. (a, b) -> a
fst (Text, Text)
place) Text -> Text -> Text
`T.append` Text
"</b>"
                    (Text
sentenceText, StdGen
r3) = SimpleBridiDisplayer
displayBridi StdGen
r2 SimpleBridi
bridi
                    sentences :: [ExerciseSentence]
sentences = [Bool -> Text -> ExerciseSentence
ExerciseSentence Bool
True Text
sentenceText]
                in (Exercise -> Maybe Exercise
forall a. a -> Maybe a
Just (Exercise -> Maybe Exercise) -> Exercise -> Maybe Exercise
forall a b. (a -> b) -> a -> b
$ Text -> [ExerciseSentence] -> Text -> [Text] -> Bool -> Exercise
SingleChoiceExercise Text
title [ExerciseSentence]
sentences Text
correctAlternative [Text]
incorrectAlternatives Bool
False, StdGen
r3)

generateContextualizedGismuPlacePositionExercise :: Dictionary -> SimpleBridiGenerator -> SimpleBridiDisplayer -> ExerciseGenerator
generateContextualizedGismuPlacePositionExercise :: Dictionary
-> SimpleBridiGenerator
-> SimpleBridiDisplayer
-> ExerciseGenerator
generateContextualizedGismuPlacePositionExercise Dictionary
dictionary SimpleBridiGenerator
simpleBridiGenerator SimpleBridiDisplayer
displayBridi = [(Int, ExerciseGenerator)] -> ExerciseGenerator
forall a. [(Int, StdGen -> a)] -> StdGen -> a
combineGenerators [(Int
1, ExerciseGenerator
f2)] where
    f2 :: ExerciseGenerator
f2 StdGen
r0 =
        let
            (SimpleBridi
bridi, StdGen
r1) = SimpleBridiGenerator
simpleBridiGenerator StdGen
r0
            placesNumeric :: [Text]
placesNumeric = (Integer -> Text) -> [Integer] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Char
'x' Char -> Text -> Text
`T.cons`) (Text -> Text) -> (Integer -> Text) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show) ([Integer] -> [Text]) -> [Integer] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Integer
1..]
            placesLojban :: [Text]
placesLojban = SimpleBridi -> [Text]
simpleBridiSumti (SimpleBridi -> [Text]) -> SimpleBridi -> [Text]
forall a b. (a -> b) -> a -> b
$ SimpleBridi
bridi
            places :: [(Text, Text)]
places = [Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
placesNumeric (Text -> Text -> [Text] -> [Text]
forall a. Eq a => a -> a -> [a] -> [a]
replace Text
"" Text
"zo'e" [Text]
placesLojban)
            ((Text, Text)
place, StdGen
r2) = StdGen -> [(Text, Text)] -> ((Text, Text), StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r1 [(Text, Text)]
places
            correctAlternative :: Text
correctAlternative = (Text, Text) -> Text
forall a b. (a, b) -> b
snd (Text, Text)
place
            incorrectAlternatives :: [Text]
incorrectAlternatives = (SimpleBridi -> Text
simpleBridiSelbri SimpleBridi
bridi) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ((Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (SentenceComparer
forall a. Eq a => a -> a -> Bool
/= Text
correctAlternative) ([Text] -> [Text])
-> ([(Text, Text)] -> [Text]) -> [(Text, Text)] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> b
snd ([(Text, Text)] -> [Text]) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
places)
            title :: Text
title = Text
"Select the <b>" Text -> Text -> Text
`T.append` ((Text, Text) -> Text
forall a b. (a, b) -> a
fst (Text, Text)
place) Text -> Text -> Text
`T.append` Text
"</b>"
            (Text
sentenceText, StdGen
_) = SimpleBridiDisplayer
displayBridi StdGen
r2 SimpleBridi
bridi
            sentences :: [ExerciseSentence]
sentences = [Bool -> Text -> ExerciseSentence
ExerciseSentence Bool
True Text
sentenceText]
        in Text -> [ExerciseSentence] -> Text -> [Text] -> Bool -> Exercise
SingleChoiceExercise Text
title [ExerciseSentence]
sentences Text
correctAlternative [Text]
incorrectAlternatives Bool
False

-- Exercise: tell brivla places using se/te/ve/xe
generateIsolatedBrivlaPlacesExercise :: Dictionary -> [T.Text] -> ExerciseGenerator
generateIsolatedBrivlaPlacesExercise :: Dictionary -> [Text] -> ExerciseGenerator
generateIsolatedBrivlaPlacesExercise Dictionary
dictionary [Text]
brivlaList StdGen
r0 =
    let
        brivlaWithAtLeastTwoPlaces :: [Text]
brivlaWithAtLeastTwoPlaces = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2) (Int -> Bool) -> (Text -> Int) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Int) -> (Text -> [Text]) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dictionary -> Text -> [Text]
retrieveBrivlaPlaces Dictionary
dictionary) [Text]
brivlaList
        (Text
brivla, StdGen
r1) =
            if [Text]
brivlaWithAtLeastTwoPlaces [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [] then
                String -> (Text, StdGen)
forall a. HasCallStack => String -> a
error (String -> (Text, StdGen)) -> String -> (Text, StdGen)
forall a b. (a -> b) -> a -> b
$ String
"There are no brivla with at least two places. Brivla list: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Text] -> String
forall a. Show a => a -> String
show [Text]
brivlaList
            else
                StdGen -> [Text] -> (Text, StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r0 [Text]
brivlaWithAtLeastTwoPlaces
        placesLojban :: [Text]
placesLojban = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
x -> Text
x Text -> Text -> Text
`T.append` Text
" " Text -> Text -> Text
`T.append` Text
brivla Text -> Text -> Text
`T.append` Text
" ku") [Text
"lo", Text
"lo se", Text
"lo te", Text
"lo ve", Text
"lo xe"]
        placesEnglish :: [Text]
placesEnglish = Dictionary -> Text -> [Text]
retrieveBrivlaPlaces Dictionary
dictionary Text
brivla
        places :: [(Text, Text)]
places = [Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
placesLojban [Text]
placesEnglish
        ((Text, Text)
place, StdGen
_) =
            if [(Text, Text)]
places [(Text, Text)] -> [(Text, Text)] -> Bool
forall a. Eq a => a -> a -> Bool
== [] then
                String -> ((Text, Text), StdGen)
forall a. HasCallStack => String -> a
error (String -> ((Text, Text), StdGen))
-> String -> ((Text, Text), StdGen)
forall a b. (a -> b) -> a -> b
$ String
"Brivla has no places: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
brivla
            else
                StdGen -> [(Text, Text)] -> ((Text, Text), StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r1 [(Text, Text)]
places
        correctAlternative :: Text
correctAlternative = (Text, Text) -> Text
forall a b. (a, b) -> b
snd (Text, Text)
place
        incorrectAlternatives :: [Text]
incorrectAlternatives = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (SentenceComparer
forall a. Eq a => a -> a -> Bool
/= Text
correctAlternative) ([Text] -> [Text])
-> ([(Text, Text)] -> [Text]) -> [(Text, Text)] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> b
snd ([(Text, Text)] -> [Text]) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> a -> b
$ [(Text, Text)]
places
        title :: Text
title = Text
"Identify <b>" Text -> Text -> Text
`T.append` ((Text, Text) -> Text
forall a b. (a, b) -> a
fst (Text, Text)
place) Text -> Text -> Text
`T.append` Text
"</b>"
        sentences :: [a]
sentences = []
    in Text -> [ExerciseSentence] -> Text -> [Text] -> Bool -> Exercise
SingleChoiceExercise Text
title [ExerciseSentence]
forall {a}. [a]
sentences Text
correctAlternative [Text]
incorrectAlternatives Bool
False

-- Exercise: provide the lexicon
generateLexiconProvidingExercise :: T.Text -> Dictionary -> WordGenerator -> ExerciseGenerator
generateLexiconProvidingExercise :: Text -> Dictionary -> TextGenerator -> ExerciseGenerator
generateLexiconProvidingExercise Text
lexiconCategory Dictionary
dictionary TextGenerator
wordGenerator StdGen
r0 = Text -> [ExerciseSentence] -> (Text -> Bool) -> Text -> Exercise
TypingExercise Text
title [ExerciseSentence]
sentences Text -> Bool
validator Text
canonicalAnswer where
    (Text
word, StdGen
r1) = TextGenerator
wordGenerator StdGen
r0
    wordDefinition :: Text
wordDefinition = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Definition not found in dictionary: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Text -> String
T.unpack Text
word)) (Dictionary -> Map Text Text
dictValsiDefinition Dictionary
dictionary Map Text Text -> Text -> Maybe Text
forall k a. Ord k => Map k a -> k -> Maybe a
M.!? Text
word)
    title :: Text
title = Text
"Provide the " Text -> Text -> Text
`T.append` Text
lexiconCategory
    sentences :: [ExerciseSentence]
sentences = [Bool -> Text -> ExerciseSentence
ExerciseSentence Bool
True Text
wordDefinition]
    validator :: Text -> Bool
validator Text
attemptedSolution = (Text -> Text
normalizeText (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
attemptedSolution) SentenceComparer
forall a. Eq a => a -> a -> Bool
== (Text -> Text
normalizeText (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
word)
    canonicalAnswer :: Text
canonicalAnswer = Text
word

-- Exercise: choose the lexicon
generateLexiconChoosingExercise :: T.Text -> Dictionary -> [T.Text] -> ExerciseGenerator
generateLexiconChoosingExercise :: Text -> Dictionary -> [Text] -> ExerciseGenerator
generateLexiconChoosingExercise Text
lexiconCategory Dictionary
dictionary [Text]
words StdGen
r0 = Text -> [ExerciseSentence] -> Text -> [Text] -> Bool -> Exercise
SingleChoiceExercise Text
title [ExerciseSentence]
sentences Text
correctAlternative [Text]
incorrectAlternatives Bool
True where
    (Text
correctAlternative, StdGen
r1) = StdGen -> [Text] -> (Text, StdGen)
forall a. StdGen -> [a] -> (a, StdGen)
chooseItemUniformly StdGen
r0 [Text]
words
    incorrectAlternatives :: [Text]
incorrectAlternatives = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (SentenceComparer
forall a. Eq a => a -> a -> Bool
/= Text
correctAlternative) [Text]
words
    wordDefinition :: Text
wordDefinition = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Definition not found in dictionary: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Text -> String
T.unpack Text
correctAlternative)) (Dictionary -> Map Text Text
dictValsiDefinition Dictionary
dictionary Map Text Text -> Text -> Maybe Text
forall k a. Ord k => Map k a -> k -> Maybe a
M.!? Text
correctAlternative)
    title :: Text
title = Text
"Provide the " Text -> Text -> Text
`T.append` Text
lexiconCategory
    sentences :: [ExerciseSentence]
sentences = [Bool -> Text -> ExerciseSentence
ExerciseSentence Bool
True Text
wordDefinition]

-- Exercise: convert numbers to and from lojban
generateBasicNumberExercise :: Integer -> ExerciseGenerator
generateBasicNumberExercise :: Integer -> ExerciseGenerator
generateBasicNumberExercise Integer
maximumNumber = [ExerciseGenerator] -> ExerciseGenerator
forall a. [StdGen -> a] -> StdGen -> a
combineGeneratorsUniformly [Integer -> ExerciseGenerator
generateNumberToTextExercise Integer
maximumNumber, Integer -> ExerciseGenerator
generateTextToNumberExercise Integer
maximumNumber]

generateNumberToTextExercise :: Integer -> ExerciseGenerator
generateNumberToTextExercise :: Integer -> ExerciseGenerator
generateNumberToTextExercise Integer
maximumNumber StdGen
r0 =
    let (Integer
x, StdGen
_) = (Integer -> Integer) -> (Integer, StdGen) -> (Integer, StdGen)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` (Integer
maximumNumberInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)) ((Integer, StdGen) -> (Integer, StdGen))
-> (Integer, StdGen) -> (Integer, StdGen)
forall a b. (a -> b) -> a -> b
$ StdGen -> (Integer, StdGen)
forall a g. (Random a, RandomGen g) => g -> (a, g)
forall g. RandomGen g => g -> (Integer, g)
random StdGen
r0 :: (Integer, StdGen)
        v :: Text -> Bool
v = \Text
text -> case Text -> Maybe Integer
lojbanToNumber Text
text of
            Maybe Integer
Nothing -> Bool
False
            Just Integer
x' -> Integer
x' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
x
    in Text -> [ExerciseSentence] -> (Text -> Bool) -> Text -> Exercise
TypingExercise (Text
"Number to text: <b>" Text -> Text -> Text
`T.append` (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
x) Text -> Text -> Text
`T.append` Text
"</b>") [] Text -> Bool
v (Integer -> Text
numberToLojban Integer
x)

generateTextToNumberExercise :: Integer -> ExerciseGenerator
generateTextToNumberExercise :: Integer -> ExerciseGenerator
generateTextToNumberExercise Integer
maximumNumber StdGen
r0 =
    let (Integer
x, StdGen
_) = (Integer -> Integer) -> (Integer, StdGen) -> (Integer, StdGen)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` (Integer
maximumNumberInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)) ((Integer, StdGen) -> (Integer, StdGen))
-> (Integer, StdGen) -> (Integer, StdGen)
forall a b. (a -> b) -> a -> b
$ StdGen -> (Integer, StdGen)
forall a g. (Random a, RandomGen g) => g -> (a, g)
forall g. RandomGen g => g -> (Integer, g)
random StdGen
r0 :: (Integer, StdGen)
        v :: Text -> Bool
v = \Text
text -> case String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
text) of
            Maybe Integer
Nothing -> Bool
False
            Just Integer
x' -> Integer
x' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
x
    in Text -> [ExerciseSentence] -> (Text -> Bool) -> Text -> Exercise
TypingExercise (Text
"Text to number: <b>" Text -> Text -> Text
`T.append` (Integer -> Text
numberToLojban Integer
x) Text -> Text -> Text
`T.append` Text
"</b>") [] Text -> Bool
v (String -> Text
T.pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> Text) -> Integer -> Text
forall a b. (a -> b) -> a -> b
$ Integer
x)