Initial commit: standalone quiz-testing system
Full-stack F# (Domain/Server/Client via Fable+Elmish+Feliz), PostgreSQL persistence via Dapper, Docker Compose deployment. Student quiz-taking flow with time-limit enforcement and focus-loss tracking, Teacher question bank and quiz builder with results analytics, Admin user management.
This commit is contained in:
danamir
13
.config/dotnet-tools.json
Normal file
13
.config/dotnet-tools.json
Normal file
@@ -0,0 +1,13 @@
|
||||
{
|
||||
"version": 1,
|
||||
"isRoot": true,
|
||||
"tools": {
|
||||
"fable": {
|
||||
"version": "5.13.0",
|
||||
"commands": [
|
||||
"fable"
|
||||
],
|
||||
"rollForward": false
|
||||
}
|
||||
}
|
||||
}
|
||||
14
.dockerignore
Normal file
14
.dockerignore
Normal file
@@ -0,0 +1,14 @@
|
||||
bin/
|
||||
obj/
|
||||
**/bin/
|
||||
**/obj/
|
||||
node_modules/
|
||||
fable_modules/
|
||||
src/Client/**/*.js
|
||||
src/Client/**/*.js.map
|
||||
src/Client/dist/
|
||||
.vs/
|
||||
*.user
|
||||
.env
|
||||
.git/
|
||||
docs/
|
||||
8
.env.example
Normal file
8
.env.example
Normal file
@@ -0,0 +1,8 @@
|
||||
# Copy to .env (gitignored) and fill in before running `docker-compose up`.
|
||||
|
||||
# Any string works for local dev; use a long random value for anything
|
||||
# beyond that.
|
||||
JWT_SECRET=dev-secret-change-me-please-32-chars-min
|
||||
|
||||
# Optional — defaults to "devpassword" if unset.
|
||||
POSTGRES_PASSWORD=devpassword
|
||||
9
.gitignore
vendored
Normal file
9
.gitignore
vendored
Normal file
@@ -0,0 +1,9 @@
|
||||
bin/
|
||||
obj/
|
||||
node_modules/
|
||||
fable_modules/
|
||||
src/Client/**/*.js
|
||||
src/Client/**/*.js.map
|
||||
.vs/
|
||||
*.user
|
||||
.env
|
||||
86
RuVdsTests.sln
Normal file
86
RuVdsTests.sln
Normal file
@@ -0,0 +1,86 @@
|
||||
|
||||
Microsoft Visual Studio Solution File, Format Version 12.00
|
||||
# Visual Studio Version 17
|
||||
VisualStudioVersion = 17.0.31903.59
|
||||
MinimumVisualStudioVersion = 10.0.40219.1
|
||||
Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "src", "src", "{827E0CD3-B72D-47B6-A68D-7590B98EB39B}"
|
||||
EndProject
|
||||
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Domain", "src\Domain\Domain.fsproj", "{3F7A3C04-B488-478D-8B1A-36EFA1532AAC}"
|
||||
EndProject
|
||||
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Server", "src\Server\Server.fsproj", "{F7816033-6699-4C1B-AD25-08CABD9A5950}"
|
||||
EndProject
|
||||
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Client", "src\Client\Client.fsproj", "{C7CDAB67-4C65-4782-97E9-41C27CF7F163}"
|
||||
EndProject
|
||||
Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "tests", "tests", "{0AB3BF05-4346-4AA6-1389-037BE0695223}"
|
||||
EndProject
|
||||
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Domain.Tests", "tests\Domain.Tests\Domain.Tests.fsproj", "{6662C4B5-5AB7-49E5-85B7-23BA59B2433A}"
|
||||
EndProject
|
||||
Global
|
||||
GlobalSection(SolutionConfigurationPlatforms) = preSolution
|
||||
Debug|Any CPU = Debug|Any CPU
|
||||
Debug|x64 = Debug|x64
|
||||
Debug|x86 = Debug|x86
|
||||
Release|Any CPU = Release|Any CPU
|
||||
Release|x64 = Release|x64
|
||||
Release|x86 = Release|x86
|
||||
EndGlobalSection
|
||||
GlobalSection(ProjectConfigurationPlatforms) = postSolution
|
||||
{3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
|
||||
{3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Debug|Any CPU.Build.0 = Debug|Any CPU
|
||||
{3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Debug|x64.ActiveCfg = Debug|Any CPU
|
||||
{3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Debug|x64.Build.0 = Debug|Any CPU
|
||||
{3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Debug|x86.ActiveCfg = Debug|Any CPU
|
||||
{3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Debug|x86.Build.0 = Debug|Any CPU
|
||||
{3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Release|Any CPU.ActiveCfg = Release|Any CPU
|
||||
{3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Release|Any CPU.Build.0 = Release|Any CPU
|
||||
{3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Release|x64.ActiveCfg = Release|Any CPU
|
||||
{3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Release|x64.Build.0 = Release|Any CPU
|
||||
{3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Release|x86.ActiveCfg = Release|Any CPU
|
||||
{3F7A3C04-B488-478D-8B1A-36EFA1532AAC}.Release|x86.Build.0 = Release|Any CPU
|
||||
{F7816033-6699-4C1B-AD25-08CABD9A5950}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
|
||||
{F7816033-6699-4C1B-AD25-08CABD9A5950}.Debug|Any CPU.Build.0 = Debug|Any CPU
|
||||
{F7816033-6699-4C1B-AD25-08CABD9A5950}.Debug|x64.ActiveCfg = Debug|Any CPU
|
||||
{F7816033-6699-4C1B-AD25-08CABD9A5950}.Debug|x64.Build.0 = Debug|Any CPU
|
||||
{F7816033-6699-4C1B-AD25-08CABD9A5950}.Debug|x86.ActiveCfg = Debug|Any CPU
|
||||
{F7816033-6699-4C1B-AD25-08CABD9A5950}.Debug|x86.Build.0 = Debug|Any CPU
|
||||
{F7816033-6699-4C1B-AD25-08CABD9A5950}.Release|Any CPU.ActiveCfg = Release|Any CPU
|
||||
{F7816033-6699-4C1B-AD25-08CABD9A5950}.Release|Any CPU.Build.0 = Release|Any CPU
|
||||
{F7816033-6699-4C1B-AD25-08CABD9A5950}.Release|x64.ActiveCfg = Release|Any CPU
|
||||
{F7816033-6699-4C1B-AD25-08CABD9A5950}.Release|x64.Build.0 = Release|Any CPU
|
||||
{F7816033-6699-4C1B-AD25-08CABD9A5950}.Release|x86.ActiveCfg = Release|Any CPU
|
||||
{F7816033-6699-4C1B-AD25-08CABD9A5950}.Release|x86.Build.0 = Release|Any CPU
|
||||
{C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
|
||||
{C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Debug|Any CPU.Build.0 = Debug|Any CPU
|
||||
{C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Debug|x64.ActiveCfg = Debug|Any CPU
|
||||
{C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Debug|x64.Build.0 = Debug|Any CPU
|
||||
{C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Debug|x86.ActiveCfg = Debug|Any CPU
|
||||
{C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Debug|x86.Build.0 = Debug|Any CPU
|
||||
{C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Release|Any CPU.ActiveCfg = Release|Any CPU
|
||||
{C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Release|Any CPU.Build.0 = Release|Any CPU
|
||||
{C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Release|x64.ActiveCfg = Release|Any CPU
|
||||
{C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Release|x64.Build.0 = Release|Any CPU
|
||||
{C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Release|x86.ActiveCfg = Release|Any CPU
|
||||
{C7CDAB67-4C65-4782-97E9-41C27CF7F163}.Release|x86.Build.0 = Release|Any CPU
|
||||
{6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
|
||||
{6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Debug|Any CPU.Build.0 = Debug|Any CPU
|
||||
{6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Debug|x64.ActiveCfg = Debug|Any CPU
|
||||
{6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Debug|x64.Build.0 = Debug|Any CPU
|
||||
{6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Debug|x86.ActiveCfg = Debug|Any CPU
|
||||
{6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Debug|x86.Build.0 = Debug|Any CPU
|
||||
{6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Release|Any CPU.ActiveCfg = Release|Any CPU
|
||||
{6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Release|Any CPU.Build.0 = Release|Any CPU
|
||||
{6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Release|x64.ActiveCfg = Release|Any CPU
|
||||
{6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Release|x64.Build.0 = Release|Any CPU
|
||||
{6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Release|x86.ActiveCfg = Release|Any CPU
|
||||
{6662C4B5-5AB7-49E5-85B7-23BA59B2433A}.Release|x86.Build.0 = Release|Any CPU
|
||||
EndGlobalSection
|
||||
GlobalSection(SolutionProperties) = preSolution
|
||||
HideSolutionNode = FALSE
|
||||
EndGlobalSection
|
||||
GlobalSection(NestedProjects) = preSolution
|
||||
{3F7A3C04-B488-478D-8B1A-36EFA1532AAC} = {827E0CD3-B72D-47B6-A68D-7590B98EB39B}
|
||||
{F7816033-6699-4C1B-AD25-08CABD9A5950} = {827E0CD3-B72D-47B6-A68D-7590B98EB39B}
|
||||
{C7CDAB67-4C65-4782-97E9-41C27CF7F163} = {827E0CD3-B72D-47B6-A68D-7590B98EB39B}
|
||||
{6662C4B5-5AB7-49E5-85B7-23BA59B2433A} = {0AB3BF05-4346-4AA6-1389-037BE0695223}
|
||||
EndGlobalSection
|
||||
EndGlobal
|
||||
47
docker-compose.yml
Normal file
47
docker-compose.yml
Normal file
@@ -0,0 +1,47 @@
|
||||
services:
|
||||
postgres:
|
||||
image: postgres:16-alpine
|
||||
environment:
|
||||
POSTGRES_DB: quizsystem
|
||||
POSTGRES_USER: quizsystem
|
||||
POSTGRES_PASSWORD: ${POSTGRES_PASSWORD:-devpassword}
|
||||
volumes:
|
||||
- pgdata:/var/lib/postgresql/data
|
||||
healthcheck:
|
||||
test: ["CMD-SHELL", "pg_isready -U quizsystem -d quizsystem"]
|
||||
interval: 5s
|
||||
timeout: 5s
|
||||
retries: 10
|
||||
networks: [quizsystem]
|
||||
|
||||
server:
|
||||
build:
|
||||
context: .
|
||||
dockerfile: src/Server/Dockerfile
|
||||
environment:
|
||||
ConnectionStrings__Postgres: "Host=postgres;Port=5432;Database=quizsystem;Username=quizsystem;Password=${POSTGRES_PASSWORD:-devpassword}"
|
||||
Jwt__Secret: ${JWT_SECRET:?Set JWT_SECRET in .env — see .env.example}
|
||||
Client__Origin: "http://localhost:8081"
|
||||
ASPNETCORE_ENVIRONMENT: Production
|
||||
depends_on:
|
||||
postgres:
|
||||
condition: service_healthy
|
||||
# Mapped to the same host port the client's hardcoded
|
||||
# Client/Shared/JsonWire.fs `serverUrl` already expects — the browser
|
||||
# (not any container) is what resolves "localhost:5144", so this keeps
|
||||
# that working unmodified for local/dev use of the compose stack.
|
||||
ports: ["5144:8080"]
|
||||
networks: [quizsystem]
|
||||
|
||||
client:
|
||||
build:
|
||||
context: .
|
||||
dockerfile: src/Client/Dockerfile
|
||||
ports: ["8081:80"]
|
||||
networks: [quizsystem]
|
||||
|
||||
volumes:
|
||||
pgdata:
|
||||
|
||||
networks:
|
||||
quizsystem:
|
||||
501
docs/DESIGN.md
Normal file
501
docs/DESIGN.md
Normal file
@@ -0,0 +1,501 @@
|
||||
# Дизайн системы
|
||||
|
||||
Дата: 2026-08-03. Статус: проектирование, реализация не начата (кроме уже существующего студенческого MVP).
|
||||
|
||||
## 1. Идея и границы системы
|
||||
|
||||
Standalone-система проверки знаний — аналог модуля «Тест» в Moodle, без остальной части LMS
|
||||
(без курсов как оргединицы, без контента/форумов). Три роли: **Admin**, **Teacher**, **Student**.
|
||||
|
||||
Ключевые решения, зафиксированные в разговоре с пользователем:
|
||||
|
||||
| Вопрос | Решение |
|
||||
|---|---|
|
||||
| Курсы | Не нужны. Убираем `Course`/`Enrollment` из домена. |
|
||||
| Банк вопросов | Приватный у каждого преподавателя (темы = топики, без общего пространства). |
|
||||
| «Итоговый» тест со случайными вопросами | Случайный набор вопросов формируется **заново при каждой попытке** (как в Moodle). |
|
||||
| Кому виден тест | Преподаватель явно назначает тест конкретным студентам (нет курсов/групп). |
|
||||
| Регистрация | Открытой регистрации нет — все аккаунты создаёт Admin вручную. |
|
||||
| Роль Admin | Admin = Teacher + управление пользователями (создание/удаление учителей и студентов). |
|
||||
| Персистентность | PostgreSQL (уже предусмотрено комментарием в `Store.fs`), доступ через Dapper. |
|
||||
| Аналитика | Нужна сразу: % правильных ответов и сложность по каждому вопросу, не только список попыток. |
|
||||
| Анти-списывание | В аналитике попытки нужно видеть число потерь фокуса окна теста. |
|
||||
| Лимит времени | Настраивается преподавателем (уже есть `TimeLimit`), но должен реально принуждаться, а не только отображаться. |
|
||||
| Что происходит по истечении времени | Авто-сдача текущих ответов на сервере, как в Moodle. |
|
||||
| Публикация теста | Отдельный флаг `IsPublished` — преподаватель готовит тест и назначения заранее, студенты не видят его, пока он явно не опубликован. |
|
||||
| Ручная коррекция автооценки | Не нужна для v1 — полагаемся только на автопроверку (`Grading.gradeResponse`). |
|
||||
|
||||
## 2. Роли и права
|
||||
|
||||
- **Student** — видит только тесты, на которые его явно назначили; проходит попытки; видит свои результаты.
|
||||
- **Teacher** — управляет **своими** темами, вопросами и тестами; назначает на тест студентов из общего
|
||||
справочника пользователей (справочник read-only для Teacher — юзеров создаёт только Admin);
|
||||
видит попытки и аналитику только по **своим** тестам.
|
||||
- **Admin** — всё, что может Teacher (свой банк вопросов и свои тесты — то есть Admin тоже может быть
|
||||
автором тестов), плюс CRUD пользователей (создание/деактивация/сброс пароля, назначение ролей).
|
||||
|
||||
Авторизация как сейчас: JWT с claim роли, выдаётся при `login`. Каждый серверный хендлер
|
||||
проверяет роль/владельца сам (единообразный `Result`-based шаблон ошибок, без ASP.NET `[Authorize(Roles=...)]`,
|
||||
чтобы не расходиться со стилем существующего `QuizApi.fs`).
|
||||
|
||||
## 3. Доменная модель (изменения к текущей)
|
||||
|
||||
Убираем: `Course`, `Enrollment`, `CourseId`, `EnrollmentRole` (полностью, не используются без курсов).
|
||||
|
||||
### 3.1 Пользователь
|
||||
|
||||
Текущий `User` (`Domain/Users.fs`) не несёт признака активности, хотя возможность деактивации
|
||||
уже решена (§2, Admin) и уже присутствует в схеме БД (§5) — это пробел, закрываем явно.
|
||||
`CreatedAt` — практическая необходимость для сортировки списков в UI (Admin увидит, когда
|
||||
заведён аккаунт; Teacher — когда создана тема/вопрос/тест).
|
||||
|
||||
```fsharp
|
||||
type User =
|
||||
{ Id: UserId
|
||||
Name: string
|
||||
Email: string
|
||||
PasswordHash: string
|
||||
Role: Role
|
||||
IsActive: bool // NEW — деактивированный пользователь не может login'иться
|
||||
CreatedAt: DateTimeOffset } // NEW
|
||||
```
|
||||
|
||||
`login` дополнительно проверяет `IsActive`; при `false` — тот же `Error "Неверный email или пароль"`,
|
||||
что и при неверном пароле (не раскрываем факт существования/деактивации аккаунта в тексте ошибки).
|
||||
|
||||
### 3.2 Темы и вопросы
|
||||
|
||||
`QuestionCategory` переименовывается в `Topic` и переподвешивается на преподавателя вместо курса:
|
||||
|
||||
```fsharp
|
||||
[<Struct>] type TopicId = TopicId of Guid
|
||||
|
||||
type Topic =
|
||||
{ Id: TopicId
|
||||
OwnerId: UserId // преподаватель-владелец
|
||||
Name: string
|
||||
CreatedAt: DateTimeOffset } // NEW
|
||||
|
||||
type Question =
|
||||
{ Id: QuestionId
|
||||
TopicId: TopicId
|
||||
Text: string
|
||||
Points: float // дефолтные баллы вопроса в банке
|
||||
Type: QuestionType // без изменений: SingleChoice/MultipleChoice/TrueFalse/ShortAnswer/Numeric
|
||||
IsArchived: bool // NEW — см. врезку про удаление ниже
|
||||
CreatedAt: DateTimeOffset } // NEW
|
||||
```
|
||||
|
||||
**Удаление при наличии истории.** Вопрос может быть частью `Quiz.Composition` (`FixedQuestions`)
|
||||
и/или уже фигурировать в чьих-то `Attempt.ResolvedQuestions`/`attempt_grades` — жёсткое удаление
|
||||
сломало бы ссылочную целостность и обнулило бы прошлые результаты. Поэтому `deleteQuestion`:
|
||||
если вопрос нигде не используется — удаляет по-настоящему; если используется хоть где-то —
|
||||
выставляет `IsArchived = true` вместо удаления. Архивные вопросы не показываются в списке для
|
||||
добавления в новый тест и не участвуют в пуле `RandomFromTopics` (§3.4), но остаются видны в
|
||||
уже прошедших попытках и в `getQuestionStats` (§3.5) — история не должна исчезать.
|
||||
Тема (`deleteTopic`) удаляется только если в ней **нет вопросов** (архивных в том числе — сначала
|
||||
перенести/удалить вопросы); отдельного `IsArchived` для темы не вводим, это не то, на что
|
||||
что-либо ссылается напрямую после удаления вопросов.
|
||||
|
||||
### 3.3 Состав теста: fixed vs random-from-topics
|
||||
|
||||
Главное новое понятие — тест может либо содержать явный список вопросов, либо описывать правило
|
||||
случайного набора по темам:
|
||||
|
||||
```fsharp
|
||||
type QuizQuestionRef =
|
||||
{ QuestionId: QuestionId
|
||||
Points: float // баллы именно в этом тесте, может отличаться от дефолта вопроса
|
||||
Order: int }
|
||||
|
||||
/// Правило "N случайных вопросов из темы X, каждый на Y баллов"
|
||||
type RandomTopicRule =
|
||||
{ TopicId: TopicId
|
||||
Count: int
|
||||
PointsPerQuestion: float }
|
||||
|
||||
type QuizComposition =
|
||||
| FixedQuestions of QuizQuestionRef list
|
||||
| RandomFromTopics of RandomTopicRule list
|
||||
|
||||
type Quiz =
|
||||
{ Id: QuizId
|
||||
OwnerId: UserId
|
||||
Title: string
|
||||
Description: string
|
||||
Composition: QuizComposition
|
||||
TimeLimit: TimeSpan option
|
||||
MaxAttempts: int option
|
||||
GradingMethod: GradingMethod
|
||||
ShuffleQuestions: bool
|
||||
ShuffleAnswers: bool
|
||||
OpenFrom: DateTimeOffset option
|
||||
OpenTo: DateTimeOffset option
|
||||
PassingScore: float option
|
||||
AssignedStudentIds: Set<UserId>
|
||||
IsPublished: bool // NEW — по умолчанию false, см. таблицу решений в §1
|
||||
IsArchived: bool // NEW — аналогично Question.IsArchived: мягкое удаление, если есть попытки
|
||||
CreatedAt: DateTimeOffset } // NEW
|
||||
```
|
||||
|
||||
`IsPublished` отделяет подготовку теста от его показа студентам: пока флаг не выставлен явно
|
||||
(`publishQuiz`, см. §4.2), тест не появляется в `getAvailableQuizzes` даже у уже назначенных
|
||||
студентов — независимо от `OpenFrom`/`OpenTo`. `deleteQuiz` — то же правило мягкого удаления,
|
||||
что и для `Question` (§3.2): если по тесту уже есть хоть одна попытка, `deleteQuiz` архивирует
|
||||
(`IsArchived = true`) вместо удаления, чтобы не потерять историю в `getQuizResults`/`getQuestionStats`.
|
||||
|
||||
`Quiz.totalPoints` считается без резолва вопросов (важно, чтобы студент видел максимум баллов
|
||||
ещё до начала попытки):
|
||||
- `FixedQuestions refs` → `sum refs.Points`
|
||||
- `RandomFromTopics rules` → `sum (rule.Count * rule.PointsPerQuestion)`
|
||||
|
||||
"Тест по теме" из требования пользователя — это `RandomFromTopics` с одним правилом
|
||||
(например, все/N вопросов из одной темы), а "итоговый" тест — `RandomFromTopics` с несколькими
|
||||
правилами (по одному на каждую выбранную тему). Отдельный домена не нужен — это два случая одного
|
||||
и того же режима.
|
||||
|
||||
### 3.4 Резолв случайного набора и попытка
|
||||
|
||||
Ключевая проблема: раз набор вопросов случаен, конкретная попытка должна **зафиксировать**, какие
|
||||
именно вопросы были показаны студенту — иначе нечего будет ни оценивать, ни показывать в ревью.
|
||||
Резолв случается **один раз при `startAttempt`** и сохраняется на самой попытке:
|
||||
|
||||
```fsharp
|
||||
type AttemptFinishReason =
|
||||
| ManualSubmit
|
||||
| TimedOut
|
||||
|
||||
type Attempt =
|
||||
{ Id: AttemptId
|
||||
QuizId: QuizId
|
||||
UserId: UserId
|
||||
AttemptNumber: int // NEW — 1, 2, 3... в рамках (QuizId, UserId), для UI и MaxAttempts
|
||||
StartedAt: DateTimeOffset
|
||||
SubmittedAt: DateTimeOffset option
|
||||
State: AttemptState
|
||||
FinishReason: AttemptFinishReason option // NEW — None пока InProgress; см. §3.6
|
||||
ResolvedQuestions: QuizQuestionRef list // NEW — конкретные вопросы именно этой попытки
|
||||
Responses: Map<QuestionId, StudentResponse>
|
||||
Grades: Map<QuestionId, QuestionGrade>
|
||||
Score: float option
|
||||
FocusLossCount: int } // NEW — см. §3.6
|
||||
```
|
||||
|
||||
`AttemptNumber` считается при `startAttempt` как `(существующие попытки этого студента по этому
|
||||
тесту).Length + 1` — избавляет UI/аналитику от пересчёта каждый раз. `Attempt.submit` принимает
|
||||
`AttemptFinishReason` параметром (`ManualSubmit` из ручного `finishAttempt`, `TimedOut` из
|
||||
принудительного завершения по лимиту времени, см. §3.6) — сигнатура меняется с
|
||||
`submit (now: DateTimeOffset) (attempt: Attempt)` на
|
||||
`submit (reason: AttemptFinishReason) (now: DateTimeOffset) (attempt: Attempt)`.
|
||||
|
||||
Чистая (без I/O) функция резолва в `Domain`, рандом и доступ к вопросам передаются снаружи:
|
||||
|
||||
```fsharp
|
||||
module Quiz =
|
||||
/// shuffle — инжектируемая функция перемешивания (использует ShuffleQuestions квиза сам вызывающий код).
|
||||
/// topicQuestions — вопросы каждой темы, уже загруженные вызывающим кодом из Store.
|
||||
let resolveComposition
|
||||
(shuffle: 'a list -> 'a list)
|
||||
(topicQuestions: Map<TopicId, Question list>)
|
||||
(quiz: Quiz)
|
||||
: Result<QuizQuestionRef list, string> =
|
||||
match quiz.Composition with
|
||||
| FixedQuestions refs -> Ok(if quiz.ShuffleQuestions then shuffle refs else refs)
|
||||
| RandomFromTopics rules ->
|
||||
rules
|
||||
|> List.fold (fun acc rule ->
|
||||
acc |> Result.bind (fun picked ->
|
||||
match Map.tryFind rule.TopicId topicQuestions with
|
||||
| Some pool when pool.Length >= rule.Count ->
|
||||
let chosen = pool |> shuffle |> List.truncate rule.Count
|
||||
let refs = chosen |> List.map (fun q -> { QuestionId = q.Id; Points = rule.PointsPerQuestion; Order = 0 })
|
||||
Ok(picked @ refs)
|
||||
| _ -> Error "В одной из тем недостаточно вопросов для случайного набора"))
|
||||
(Ok [])
|
||||
|> Result.map (fun refs ->
|
||||
let ordered = if quiz.ShuffleQuestions then shuffle refs else refs
|
||||
ordered |> List.mapi (fun i r -> { r with Order = i }))
|
||||
```
|
||||
|
||||
`Grading.gradeAttempt` переключается на `attempt.ResolvedQuestions` вместо `quiz.Questions` как
|
||||
единый источник правды для обоих режимов — это же упрощает `startAttempt`/`finishAttempt`, им больше
|
||||
не нужно различать fixed/random после резолва.
|
||||
|
||||
### 3.5 Аналитика по вопросам
|
||||
|
||||
Отдельная нормализованная таблица (см. §5) `attempt_grades` (attempt_id, question_id, points_awarded,
|
||||
max_points, is_correct) пишется при `finishAttempt` вместе с `Grades`. По ней считается:
|
||||
|
||||
```fsharp
|
||||
type QuestionStat =
|
||||
{ QuestionId: QuestionId
|
||||
QuestionText: string
|
||||
TimesAsked: int
|
||||
TimesCorrect: int
|
||||
PercentCorrect: float
|
||||
AvgPointsAwarded: float }
|
||||
```
|
||||
|
||||
Агрегация — обычный SQL `GROUP BY question_id`, без DU-хитростей.
|
||||
|
||||
### 3.6 Анти-списывание: потери фокуса окна и жёсткий лимит времени
|
||||
|
||||
**Потери фокуса.** Клиент слушает `document.visibilitychange` (переключение вкладки, сворачивание)
|
||||
и `window.blur` (переключение на другое окно/приложение поверх той же вкладки) с момента получения
|
||||
ответа от `startAttempt` — то есть с самого начала попытки, а не с первого отвеченного вопроса
|
||||
(студент может уйти листать шпаргалку ещё до того, как ответит хоть на один вопрос, и это тоже
|
||||
должно засчитаться). При переходе в состояние "не в фокусе" клиент дёргает новый метод API, который **инкрементит**
|
||||
счётчик на сервере (не принимает готовое число от клиента — так его нельзя подделать в свою пользу,
|
||||
разве что заспамить в меньшую сторону невозможно, а накрутить больше нет смысла жулику):
|
||||
|
||||
```fsharp
|
||||
// добавляется в IQuizApi (§4.1)
|
||||
reportFocusLoss: AttemptId -> Async<Result<unit, string>>
|
||||
```
|
||||
|
||||
Дребезг (несколько событий подряд при одном уходе) гасится на клиенте — считаем один "уход",
|
||||
пока пользователь не вернулся (`visibilitychange` обратно в `visible` сбрасывает флаг "уже считали").
|
||||
`FocusLossCount` попадает в `AttemptSummary`/`AttemptDetail` (§3.7), преподаватель видит число
|
||||
рядом с баллом и сам решает, похоже это на списывание или нет — автоматических санкций система
|
||||
не применяет.
|
||||
|
||||
**Жёсткий лимит времени.** Два уровня принуждения:
|
||||
|
||||
1. **Активная сессия.** `submitAnswer` и `finishAttempt` перед выполнением проверяют
|
||||
`Attempt.isExpired quiz now attempt` (функция уже есть в `Attempts.fs`, просто не вызывается).
|
||||
Если время вышло — сервер сам переводит попытку в `Graded` (те же шаги, что и ручной
|
||||
`finishAttempt`: `Attempt.submit TimedOut` → `Grading.gradeAttempt`, `FinishReason = Some TimedOut`)
|
||||
и возвращает `Error "Время вышло, тест завершён автоматически"`,
|
||||
а не проваливает исходное действие молча. Клиент по такому ответу показывает экран результата.
|
||||
2. **Заброшенная сессия.** Если студент закрыл вкладку и больше не прислал ни одного запроса,
|
||||
пункт 1 не сработает — некому вызвать `submitAnswer`. Поэтому на сервере нужен фоновый
|
||||
`IHostedService` ("expiry sweeper"), который каждые ~30 сек находит `InProgress`-попытки с
|
||||
`started_at + time_limit < now` в Postgres и точно так же принудительно завершает и оценивает их
|
||||
(`Attempt.submit TimedOut` → `Grading.gradeAttempt`).
|
||||
Это и есть источник истины по лимиту — клиентский таймер в UI (обратный отсчёт) только для
|
||||
удобства студента, не для принуждения.
|
||||
|
||||
Обычное ручное завершение (`finishAttempt` без истечения лимита) ставит `FinishReason = Some ManualSubmit`.
|
||||
Вопросы, на которые студент не успел ответить к моменту авто-сдачи, никак специально не
|
||||
обрабатываются — они и так остаются без записи в `attempt.Responses`, а `Grading.gradeAttempt`
|
||||
уже сегодня трактует отсутствующий ответ через `emptyResponseFor` как нулевой/неверный
|
||||
(см. `Grading.fs:59-64`). Отдельной логики "пропущенный вопрос" вводить не нужно.
|
||||
|
||||
### 3.7 Финальная оценка по нескольким попыткам и история
|
||||
|
||||
Пробел в более ранней версии этого документа: типы `AttemptSummary`/`AttemptDetail`/`StudentQuizResult`
|
||||
упоминались в §4 по имени, но нигде не были определены. Плюс — в домене уже есть
|
||||
`Grading.applyGradingMethod`, который сводит несколько попыток студента в одну итоговую оценку по
|
||||
`Quiz.GradingMethod` (`HighestAttempt`/`AverageAttempt`/`FirstAttempt`/`LastAttempt`), но раньше
|
||||
эта функция никуда не была подключена: ни в одном API-методе результат её работы не отдавался ни
|
||||
преподавателю, ни самому студенту. Закрываем оба пробела одним набором типов:
|
||||
|
||||
```fsharp
|
||||
type AttemptSummary =
|
||||
{ AttemptId: AttemptId
|
||||
StudentId: UserId
|
||||
StudentName: string
|
||||
AttemptNumber: int
|
||||
State: AttemptState
|
||||
StartedAt: DateTimeOffset
|
||||
SubmittedAt: DateTimeOffset option
|
||||
FinishReason: AttemptFinishReason option
|
||||
Score: float option
|
||||
MaxScore: float
|
||||
FocusLossCount: int }
|
||||
|
||||
type AttemptDetail =
|
||||
{ Summary: AttemptSummary
|
||||
Questions: QuestionView list // как показывались студенту, из ResolvedQuestions
|
||||
Responses: Map<QuestionId, StudentResponse>
|
||||
Grades: Map<QuestionId, QuestionGrade> }
|
||||
|
||||
/// Итог по тесту для одного студента, с учётом Quiz.GradingMethod.
|
||||
type StudentQuizResult =
|
||||
{ StudentId: UserId
|
||||
StudentName: string
|
||||
Attempts: AttemptSummary list
|
||||
FinalScore: float option // Grading.applyGradingMethod по всем Attempts
|
||||
MaxScore: float
|
||||
Passed: bool option }
|
||||
```
|
||||
|
||||
Два инварианта, которые эти типы предполагают:
|
||||
- **Оценка — снимок на момент `finishAttempt`/sweeper'а.** Если преподаватель потом отредактирует
|
||||
`Question` (текст, правильный ответ) или состав теста, уже выставленные `Grades`/`Score` задним
|
||||
числом не пересчитываются — иначе история результатов "плыла" бы вместе с правками банка вопросов.
|
||||
Это и есть причина, почему `Question`/`Quiz` архивируются, а не пересчитываются на лету (§3.2, §3.3).
|
||||
- **`ShuffleAnswers`** (порядок вариантов ответа внутри вопроса) не требует отдельного состояния —
|
||||
в отличие от `ShuffleQuestions`/`ResolvedQuestions`, порядок вариантов не влияет на то, что именно
|
||||
засчитывается (ответ кодируется через стабильный `OptionId`), поэтому просто перемешивается на
|
||||
сервере при формировании `QuestionView` в `startAttempt`, без сохранения куда-либо.
|
||||
|
||||
## 4. API (Fable.Remoting-style, вручную через fetch — см. комментарий в `Api.fs`)
|
||||
|
||||
Три интерфейса вместо одного, каждый — отдельный роут-неймспейс (`/api/<TypeName>/<Method>`),
|
||||
роль проверяется на сервере в каждом хендлере.
|
||||
|
||||
### 4.1 `IQuizApi` (Student) — правки существующего
|
||||
|
||||
- `login` — дополнительно проверяет `User.IsActive` (§3.1).
|
||||
- `getAvailableQuizzes` — теперь фильтрует по `IsPublished = true`, `AssignedStudentIds` (только
|
||||
тесты, куда назначен текущий студент), `not IsArchived` и по окну `OpenFrom`/`OpenTo`, как сейчас.
|
||||
- `startAttempt`, `submitAnswer`, `finishAttempt` — логика резолва встраивается в `startAttempt`
|
||||
(см. §3.4), наружу для клиента ничего не меняется; `submitAnswer`/`finishAttempt` дополнительно
|
||||
проверяют истечение времени (см. §3.6).
|
||||
- `reportFocusLoss: AttemptId -> Async<Result<unit, string>>` — новый метод, см. §3.6.
|
||||
- `getMyResults: QuizId -> Async<Result<StudentQuizResult, string>>` — новый метод: студент видит
|
||||
свою историю попыток по тесту и итоговую оценку по `Quiz.GradingMethod` (§3.7) — без него у
|
||||
студента с `MaxAttempts > 1` нет способа посмотреть, как считался финальный балл.
|
||||
|
||||
### 4.2 `ITeacherApi` (Teacher и Admin)
|
||||
|
||||
```fsharp
|
||||
type ITeacherApi =
|
||||
{ listTopics: unit -> Async<Topic list>
|
||||
createTopic: string -> Async<Result<Topic, string>>
|
||||
renameTopic: TopicId * string -> Async<Result<unit, string>>
|
||||
deleteTopic: TopicId -> Async<Result<unit, string>>
|
||||
|
||||
listQuestions: TopicId -> Async<Question list>
|
||||
createQuestion: CreateQuestionRequest -> Async<Result<Question, string>>
|
||||
updateQuestion: UpdateQuestionRequest -> Async<Result<unit, string>>
|
||||
deleteQuestion: QuestionId -> Async<Result<unit, string>>
|
||||
|
||||
listMyQuizzes: unit -> Async<QuizAdminSummary list>
|
||||
getQuiz: QuizId -> Async<Result<QuizDetail, string>>
|
||||
createQuiz: CreateQuizRequest -> Async<Result<QuizId, string>>
|
||||
updateQuiz: UpdateQuizRequest -> Async<Result<unit, string>>
|
||||
publishQuiz: QuizId -> Async<Result<unit, string>> // NEW — см. §3.3
|
||||
unpublishQuiz: QuizId -> Async<Result<unit, string>> // NEW — снять с публикации (уже стартовавших попыток не отменяет)
|
||||
deleteQuiz: QuizId -> Async<Result<unit, string>> // архивирует, если есть попытки — см. §3.3
|
||||
|
||||
listStudents: unit -> Async<StudentSummary list> // справочник для назначения, read-only
|
||||
assignStudents: QuizId * UserId list -> Async<Result<unit, string>>
|
||||
unassignStudent: QuizId * UserId -> Async<Result<unit, string>>
|
||||
|
||||
getQuizAttempts: QuizId -> Async<AttemptSummary list> // сырой список попыток, см. §3.7
|
||||
getAttemptDetail: AttemptId -> Async<Result<AttemptDetail, string>>
|
||||
getQuizResults: QuizId -> Async<StudentQuizResult list> // NEW — сводка по студентам, см. §3.7
|
||||
getQuestionStats: QuizId -> Async<QuestionStat list> }
|
||||
```
|
||||
|
||||
`getQuizAttempts` и `getQuizResults` отвечают на разные вопросы: первый — "кто, когда и как проходил
|
||||
тест" (нужен для анти-читерского ревью каждой отдельной попытки — `FocusLossCount`, `FinishReason`,
|
||||
длительность), второй — "какая у студента итоговая оценка по тесту с учётом `GradingMethod`"
|
||||
(журнал-ведомость). Оба используют типы из §3.7.
|
||||
|
||||
Владение проверяется всюду: Teacher видит/меняет только темы/вопросы/тесты со своим `OwnerId`
|
||||
(Admin — тоже, но плюс видит вообще всех через `IAdminApi`, не через `ITeacherApi`).
|
||||
|
||||
### 4.3 `IAdminApi` (только Admin)
|
||||
|
||||
```fsharp
|
||||
type IAdminApi =
|
||||
{ listUsers: unit -> Async<UserSummary list>
|
||||
createUser: CreateUserRequest -> Async<Result<UserSummary, string>> // задаёт Role: Teacher | Student | Admin
|
||||
updateUser: UpdateUserRequest -> Async<Result<unit, string>>
|
||||
deactivateUser: UserId -> Async<Result<unit, string>>
|
||||
resetPassword: UserId * string -> Async<Result<unit, string>> }
|
||||
```
|
||||
|
||||
## 5. Персистентность (PostgreSQL + Dapper)
|
||||
|
||||
DU-тяжёлые части (`QuestionType`, `QuizComposition`, `Responses`) храним как `jsonb` — реляционных
|
||||
join-таблиц под каждый вариант DU не оправдано на этом масштабе, а Dapper + `System.Text.Json` (с тем же
|
||||
подходом к конвертерам, что уже применён для Fable.Remoting.Json на сервере) сериализует их напрямую.
|
||||
|
||||
```sql
|
||||
users (
|
||||
id uuid pk, name text, email text unique, password_hash text, role text,
|
||||
is_active bool not null default true, created_at timestamptz not null default now()
|
||||
)
|
||||
|
||||
topics (id uuid pk, owner_id uuid references users, name text, created_at timestamptz not null default now())
|
||||
|
||||
questions (
|
||||
id uuid pk, topic_id uuid references topics, text text, points double precision, type_json jsonb,
|
||||
is_archived bool not null default false, created_at timestamptz not null default now()
|
||||
)
|
||||
|
||||
quizzes (
|
||||
id uuid pk, owner_id uuid references users, title text, description text,
|
||||
composition_json jsonb, time_limit_minutes int null, max_attempts int null,
|
||||
grading_method text, shuffle_questions bool, shuffle_answers bool,
|
||||
open_from timestamptz null, open_to timestamptz null, passing_score double precision null,
|
||||
is_published bool not null default false, is_archived bool not null default false,
|
||||
created_at timestamptz not null default now()
|
||||
)
|
||||
|
||||
quiz_assignments (quiz_id uuid references quizzes, student_id uuid references users, primary key (quiz_id, student_id))
|
||||
|
||||
attempts (
|
||||
id uuid pk, quiz_id uuid references quizzes, user_id uuid references users,
|
||||
attempt_number int not null, started_at timestamptz, submitted_at timestamptz null, state text,
|
||||
finish_reason text null, resolved_questions_json jsonb, responses_json jsonb, score double precision null,
|
||||
focus_loss_count int not null default 0
|
||||
)
|
||||
|
||||
attempt_grades (
|
||||
attempt_id uuid references attempts, question_id uuid references questions,
|
||||
points_awarded double precision, max_points double precision, is_correct bool,
|
||||
primary key (attempt_id, question_id)
|
||||
)
|
||||
```
|
||||
|
||||
`Store.fs` заменяется на модуль с Dapper-запросами за тем же member-интерфейсом (там уже есть
|
||||
комментарий это предвосхищающий) — сигнатуры методов остаются похожими, чтобы `QuizApi.fs` и новые
|
||||
`TeacherApi.fs`/`AdminApi.fs` менялись минимально.
|
||||
|
||||
Миграции — лёгкий инструмент поверх Dapper (например DbUp: пронумерованные `.sql`-файлы, применяются
|
||||
при старте сервера), без EF Core, чтобы не тащить лишний ORM-слой.
|
||||
|
||||
## 6. UX прохождения теста
|
||||
|
||||
Список вопросов остаётся одним непрерывно прокручиваемым блоком, как сейчас (`View.fs:226`) —
|
||||
без пагинации/пошагового визарда «один вопрос за раз». Студент должен иметь возможность свободно
|
||||
скроллить вверх-вниз по всем вопросам в любом порядке и с любой скоростью, без ограничений.
|
||||
|
||||
Кнопка «Завершить тест» физически выносится из области прокрутки. Сейчас (`View.fs:227-231`) она
|
||||
рендерится прямо под последним вопросом внутри того же `taking-quiz-page`-контейнера — при быстрой
|
||||
прокрутке длинного списка случайный клик в момент остановки скролла может преждевременно завершить
|
||||
попытку. Нужен отдельный зафиксированный блок (sticky-хедер сверху или боковая панель), где живут
|
||||
общие элементы управления попыткой — обратный отсчёт времени (§3.6) и кнопка «Завершить тест», — и
|
||||
который не участвует в скролле списка вопросов, чтобы моторика "долистать до конца" и "нажать
|
||||
завершить" были физически разными жестами.
|
||||
|
||||
## 7. Фазы реализации
|
||||
|
||||
1. **Домен**: `User.IsActive`/`CreatedAt`, переименование Category→Topic + `Topic.CreatedAt`,
|
||||
`Question.IsArchived`/`CreatedAt`, `QuizComposition`, `Quiz.IsPublished`/`IsArchived`/`CreatedAt`,
|
||||
`Attempt.ResolvedQuestions`/`AttemptNumber`/`FinishReason`/`FocusLossCount`, включение проверки
|
||||
`Attempt.isExpired` в поток завершения попытки, удаление Course/Enrollment, обновление
|
||||
`Grading`/`Attempt`/`Quiz` модулей + юнит-тесты (`tests/Domain.Tests`) на резолв случайного
|
||||
набора, на `totalPoints` для обоих режимов и на сведение попыток через `applyGradingMethod`.
|
||||
2. **PostgreSQL**: схема (§5), Dapper-репозиторий взамен `Store.fs`, миграции, конфиг строки подключения,
|
||||
фоновый `IHostedService`-sweeper для заброшенных просроченных попыток (§3.6).
|
||||
3. **Admin API + мини-UI**: CRUD пользователей (с учётом `IsActive`).
|
||||
4. **Teacher API + UI**: темы → вопросы (с архивированием вместо жёсткого удаления, §3.2) → тесты
|
||||
(fixed/random, включая настройку `TimeLimit`, `publishQuiz`/`unpublishQuiz`) → назначение студентов.
|
||||
5. **Результаты и аналитика**: список попыток по тесту (`getQuizAttempts`, с `FocusLossCount`,
|
||||
`FinishReason` и длительностью), сводка по студентам с учётом `GradingMethod` (`getQuizResults`),
|
||||
детальный просмотр попытки, `QuestionStat`.
|
||||
6. **Student UI**: уже работает end-to-end, донастройка — reflect only assigned+open quizzes,
|
||||
обратный отсчёт времени в UI, слушатели `visibilitychange`/`blur` → `reportFocusLoss`,
|
||||
вынос кнопки «Завершить тест» в отдельный зафиксированный блок (§6).
|
||||
7. **Деплой на RuVDS**: systemd-юнит для Kestrel, nginx как reverse proxy + TLS, прод-конфиг
|
||||
`Jwt:Secret`/`Client:Origin`/строка подключения к Postgres (сейчас в `appsettings.Development.json`
|
||||
захардкожен dev-секрет и dev-порт клиента — см. память проекта про CORS-баг 2026-08-03).
|
||||
|
||||
## 8. Открытые вопросы (не решены, всплывут по ходу реализации)
|
||||
|
||||
- Нужен ли предпросмотр/тестовый прогон теста преподавателем без сохранения попытки в статистику?
|
||||
- Что показывать студенту при просмотре своего результата — только баллы, или также его ответы
|
||||
с правильными (риск слива вопросов в банк для будущих попыток при `MaxAttempts > 1`)?
|
||||
- Лимит на минимальное число вопросов в теме, чтобы `RandomFromTopics` не падал в самый ответственный
|
||||
момент («недостаточно вопросов») — валидировать при создании теста или только при старте попытки?
|
||||
- Нужен ли визуальный порог/бейдж «подозрительно» при большом `FocusLossCount`, или преподаватель
|
||||
просто смотрит на число сам без автоматической оценки?
|
||||
- ~~С какого момента считать потери фокуса~~ — решено: с ответа `startAttempt`, см. §3.6.
|
||||
- Показывать ли преподавателю архивные (`IsArchived`) вопросы/тесты в общих списках приглушённым
|
||||
цветом с фильтром, или полностью прятать и доставать только через карточку конкретной попытки?
|
||||
187
docs/PLAN.md
Normal file
187
docs/PLAN.md
Normal file
@@ -0,0 +1,187 @@
|
||||
# План реализации
|
||||
|
||||
Живой чек-лист по `docs/DESIGN.md`. Отмечайте пункты по мере реализации (`[ ]` → `[x]`); статусы
|
||||
ниже соответствуют фактическому состоянию кода на 2026-08-03. Фазы и нумерация разделов совпадают
|
||||
с `docs/DESIGN.md` §7 — там же обоснование каждого пункта, здесь только чек-лист.
|
||||
|
||||
## Базовое состояние на сегодня
|
||||
|
||||
- [x] Студенческий флоу целиком на **старой** доменной модели (`Course`/`CategoryId`/без
|
||||
`Composition`) работает end-to-end через in-memory `Store`: `login` → `getAvailableQuizzes` →
|
||||
`startAttempt` → `submitAnswer` → `finishAttempt` — проверено в браузере.
|
||||
- [x] CORS для dev настроен верно (`Client:Origin = http://localhost:5173`), баг с портом 5174 исправлен.
|
||||
- [x] `Grading.applyGradingMethod` уже реализован и покрыт тестами (`HighestAttempt`, пустой список) —
|
||||
но никуда не подключён (нет API-метода, который бы его вызывал).
|
||||
- [x] `Attempt.isExpired` уже реализован — но нигде не вызывается, лимит времени сейчас не принуждается.
|
||||
|
||||
Все пункты ниже — то, чего в коде пока нет.
|
||||
|
||||
## Архитектурный рефакторинг: организация кода по вертикальным срезам
|
||||
|
||||
Отдельный от фаз 1–7 вопрос — не про функциональность, а про то, как раскладывать код по файлам
|
||||
по мере роста Server/Client. Возник из обсуждения 2026-08-03: сейчас архитектура классическая
|
||||
слоистая (3 проекта = 3 слоя), а не по фиче.
|
||||
|
||||
**Текущее состояние.** `Domain` (чистые типы и бизнес-логика) → `Server` (`Store.fs` + `Auth.fs` +
|
||||
один `QuizApi.fs` на все хендлеры, роутинг через Fable.Remoting.Giraffe по единому интерфейсу
|
||||
`IQuizApi`) → `Client` (Elmish MVU: один общий `Model` в `Types.fs`, один общий `Msg`-DU, один
|
||||
`update` в `State.fs`, один `View.fs`). Срез идёт по техническому слою (типы / состояние /
|
||||
отображение / API), а не по фиче — ровно то, что архитектура вертикальных срезов (VSA) устраняет.
|
||||
|
||||
**Почему не полный переход на VSA.** Два места будут этому сопротивляться:
|
||||
1. Контракт `IQuizApi`/`ITeacherApi`/`IAdminApi` в `Domain.Contracts` (DESIGN.md §4) — это по сути
|
||||
RPC-интерфейс "один record на роль", а не роутинг по фиче. Fable.Remoting-style клиент
|
||||
(`Api.fs`) уже завязан на паттерн `/api/<TypeName>/<Method>` по этим record'ам.
|
||||
2. Elmish с одним `Model`/`Msg` на всё приложение — тоже принципиально центральный паттерн;
|
||||
срез по фиче потребовал бы отдельного рефакторинга на суб-модели (паттерн "Elmish page"),
|
||||
не связанного с серверным вопросом.
|
||||
|
||||
**Компромиссное решение.** Не ломать контракт и Elmish целиком, а **реализацию** каждого метода
|
||||
интерфейса выносить в свой файл/папку по фиче, а не копить всё в одном `TeacherApi.fs`/`View.fs`.
|
||||
Даёт большую часть пользы VSA (не лазить по всему файлу ради одной фичи, фича = один файл со всем
|
||||
необходимым) без переписывания транспорта и стейт-менеджмента.
|
||||
|
||||
**Почему сейчас удобный момент.** Из нового дизайна пока не реализовано практически ничего (см.
|
||||
«Базовое состояние» выше) — так что переход дешевле всего до того, как `TeacherApi.fs`/`View.fs`
|
||||
разрастутся под Teacher/Admin функциональность.
|
||||
|
||||
### Server: организация по фиче
|
||||
- [ ] Вместо одного `TeacherApi.fs`/`AdminApi.fs` — папка `Server/Features/<Role>/<UseCase>.fs`
|
||||
(например `Server/Features/Teacher/CreateQuiz.fs`, `.../PublishQuiz.fs`), каждый файл содержит
|
||||
маппинг запроса/ответа и логику ровно одного метода интерфейса.
|
||||
- [ ] Сборка `ITeacherApi`/`IAdminApi` в одном месте (аналог текущего `QuizApi.build`) остаётся
|
||||
тонкой композицией — record просто ссылается на функции из `Features/*`, сам не содержит логики.
|
||||
- [ ] Тот же принцип для уже существующего `QuizApi.fs` — постепенно разнести на
|
||||
`Server/Features/Student/*.fs`, но не отдельным рывком, а по мере следующих правок этого файла.
|
||||
|
||||
### Client: частичная декомпозиция Elmish
|
||||
- [ ] Общий `Model`/`Msg`/`update` в `Types.fs`/`State.fs` остаётся корнем (сессия, роутинг между
|
||||
страницами), но крупные разделы (кабинет Teacher, кабинет Admin) выносятся в под-модели по
|
||||
паттерну "Elmish page" — свои Model/Msg/update/view на страницу — вместо бесконечного
|
||||
расширения единых `Types.fs`/`State.fs`/`View.fs`.
|
||||
- [ ] Не переписывать существующий студенческий флоу (`Types.fs`/`State.fs`/`View.fs`) ради этого —
|
||||
он маленький и рабочий; применять паттерн к новым разделам (Teacher/Admin UI, фазы 3–4).
|
||||
|
||||
### Когда применять
|
||||
- [ ] Не блокирует фазы 1–2 (домен/БД) — там организация по типу файла (`Users.fs`/`Quizzes.fs`/...,
|
||||
`Store.fs`) уже естественна и менять её не нужно.
|
||||
- [ ] Применяется как соглашение **начиная с фазы 3** (Admin API) — новый код сразу пишется в
|
||||
`Features/`-структуре; уже написанный `QuizApi.fs` не рефакторится превентивно, только когда
|
||||
до него дойдёт очередная правка (рефакторинг не ради рефакторинга).
|
||||
|
||||
## Фаза 1 — Домен (DESIGN.md §3)
|
||||
|
||||
### 1.1 Пользователь (§3.1)
|
||||
- [ ] `User.IsActive`
|
||||
- [ ] `User.CreatedAt`
|
||||
- [ ] `login` проверяет `IsActive`, отказывает тем же текстом ошибки, что и неверный пароль
|
||||
|
||||
### 1.2 Темы и вопросы (§3.2)
|
||||
- [ ] `QuestionCategory` → `Topic`, `CategoryId` → `TopicId`
|
||||
- [ ] `Topic.OwnerId` (вместо `CourseId`), `Topic.CreatedAt`
|
||||
- [ ] `Question.TopicId` (вместо `CategoryId`)
|
||||
- [ ] `Question.IsArchived`, `Question.CreatedAt`
|
||||
- [ ] Правило мягкого удаления вопроса (архивировать вместо удаления, если используется) — сама
|
||||
флаг-логика в домене; серверная проверка "используется ли где-то" — фаза 4
|
||||
|
||||
### 1.3 Состав теста (§3.3)
|
||||
- [ ] `RandomTopicRule`
|
||||
- [ ] `QuizComposition` (`FixedQuestions` / `RandomFromTopics`)
|
||||
- [ ] `Quiz.OwnerId` (вместо `CourseId`)
|
||||
- [ ] `Quiz.AssignedStudentIds`
|
||||
- [ ] `Quiz.IsPublished`, `Quiz.IsArchived`, `Quiz.CreatedAt`
|
||||
- [ ] `Quiz.totalPoints` пересчитан под `Composition` (сумма по `FixedQuestions` или
|
||||
`Count * PointsPerQuestion` по `RandomFromTopics`)
|
||||
- [ ] Удалены `Course`, `Enrollment`, `CourseId`, `EnrollmentRole`
|
||||
|
||||
### 1.4 Резолв и попытка (§3.4, §3.6)
|
||||
- [ ] `AttemptFinishReason` (`ManualSubmit` / `TimedOut`)
|
||||
- [ ] `Attempt.AttemptNumber`
|
||||
- [ ] `Attempt.FinishReason`
|
||||
- [ ] `Attempt.ResolvedQuestions`
|
||||
- [ ] `Attempt.FocusLossCount`
|
||||
- [ ] `Quiz.resolveComposition` (чистая функция, shuffle и вопросы темы — параметрами)
|
||||
- [ ] `Attempt.submit` принимает `AttemptFinishReason`
|
||||
- [ ] `Grading.gradeAttempt` переключён на `attempt.ResolvedQuestions` вместо `quiz.Questions`
|
||||
- [ ] Проверка `Attempt.isExpired` встроена в поток `submitAnswer`/`finishAttempt` (авто-завершение
|
||||
с `FinishReason = TimedOut`)
|
||||
|
||||
### 1.5 Типы аналитики и валидация (§3.5, §3.7)
|
||||
- [ ] `QuestionStat`
|
||||
- [ ] `AttemptSummary`, `AttemptDetail`, `StudentQuizResult`
|
||||
- [ ] `Validation.fs`: `QuizValidation` переработан под `QuizComposition` (сейчас требует
|
||||
непустой `quiz.Questions`, нужно — непустой `FixedQuestions` **или** хотя бы одно правило
|
||||
с `Count > 0` в `RandomFromTopics`)
|
||||
|
||||
### 1.6 Юнит-тесты (`tests/Domain.Tests`)
|
||||
- [ ] `resolveComposition`: `FixedQuestions` (с шаффлом и без), `RandomFromTopics` (успешный набор,
|
||||
ошибка при нехватке вопросов в теме)
|
||||
- [ ] `totalPoints` для обоих режимов `Composition`
|
||||
- [ ] `applyGradingMethod`: добавить `AverageAttempt`/`FirstAttempt`/`LastAttempt` (сейчас покрыт
|
||||
только `HighestAttempt`)
|
||||
- [ ] Существующие `GradingTests.fs`/`ValidationTests.fs` обновлены под новую форму
|
||||
`Question`/`Quiz` (`TopicId` вместо `CategoryId`, `Composition` вместо `Questions`)
|
||||
|
||||
## Фаза 2 — PostgreSQL (§5)
|
||||
|
||||
- [ ] SQL-схема: `users`, `topics`, `questions`, `quizzes`, `quiz_assignments`, `attempts`, `attempt_grades`
|
||||
- [ ] Миграции (DbUp, пронумерованные `.sql`, применяются при старте сервера)
|
||||
- [ ] Dapper-репозиторий взамен `Store.fs` (тот же member-интерфейс)
|
||||
- [ ] Строка подключения к Postgres в конфиге (`appsettings.*.json`)
|
||||
- [ ] `IHostedService` — "expiry sweeper" для заброшенных просроченных попыток (§3.6)
|
||||
|
||||
## Фаза 3 — Admin API + UI (§2, §4.3)
|
||||
|
||||
- [ ] `IAdminApi.listUsers`
|
||||
- [ ] `IAdminApi.createUser` (с выбором `Role`)
|
||||
- [ ] `IAdminApi.updateUser`
|
||||
- [ ] `IAdminApi.deactivateUser`
|
||||
- [ ] `IAdminApi.resetPassword`
|
||||
- [ ] Проверка роли `Admin` на сервере для всех методов `IAdminApi`
|
||||
- [ ] UI: список пользователей, создание/деактивация/сброс пароля
|
||||
|
||||
## Фаза 4 — Teacher API + UI (§4.2)
|
||||
|
||||
- [ ] `ITeacherApi`: `listTopics`/`createTopic`/`renameTopic`/`deleteTopic`
|
||||
- [ ] `ITeacherApi`: `listQuestions`/`createQuestion`/`updateQuestion`/`deleteQuestion`
|
||||
(с архивированием вместо удаления, если вопрос используется — §3.2)
|
||||
- [ ] `ITeacherApi`: `listMyQuizzes`/`getQuiz`/`createQuiz`/`updateQuiz`
|
||||
- [ ] `ITeacherApi`: `publishQuiz`/`unpublishQuiz`
|
||||
- [ ] `ITeacherApi`: `deleteQuiz` (архивирование, если есть попытки — §3.3)
|
||||
- [ ] `ITeacherApi`: `listStudents`/`assignStudents`/`unassignStudent`
|
||||
- [ ] Проверка владения (`OwnerId`) на каждом хендлере, кроме `listStudents`
|
||||
- [ ] UI: темы → вопросы → конструктор теста (fixed-список / random-по-темам) → назначение студентов
|
||||
|
||||
## Фаза 5 — Результаты и аналитика (§3.5, §3.7, §4.2)
|
||||
|
||||
- [ ] Запись в `attempt_grades` при `finishAttempt`/авто-завершении
|
||||
- [ ] `ITeacherApi.getQuizAttempts`
|
||||
- [ ] `ITeacherApi.getAttemptDetail`
|
||||
- [ ] `ITeacherApi.getQuizResults` (сводка по студентам с учётом `GradingMethod`)
|
||||
- [ ] `ITeacherApi.getQuestionStats`
|
||||
- [ ] UI: список попыток (с `FocusLossCount`/`FinishReason`/длительностью), карточка попытки,
|
||||
сводная ведомость по студентам, аналитика по вопросам
|
||||
|
||||
## Фаза 6 — Student UI (§4.1, §6)
|
||||
|
||||
- [ ] `getAvailableQuizzes`: фильтр по `IsPublished`, `AssignedStudentIds`, `not IsArchived`, окну дат
|
||||
- [ ] `IQuizApi.getMyResults` + экран истории попыток студента
|
||||
- [ ] `IQuizApi.reportFocusLoss` + клиентские слушатели `visibilitychange`/`blur`
|
||||
- [ ] Обратный отсчёт времени в UI прохождения теста
|
||||
- [ ] Кнопка «Завершить тест» вынесена в отдельный зафиксированный блок, не участвующий в
|
||||
скролле списка вопросов (§6)
|
||||
|
||||
## Фаза 7 — Деплой на RuVDS (§1, §7)
|
||||
|
||||
- [ ] systemd-юнит для Kestrel
|
||||
- [ ] nginx как reverse proxy + TLS
|
||||
- [ ] Прод-конфиг: `Jwt:Secret`, `Client:Origin`, строка подключения к Postgres
|
||||
(сейчас в `appsettings.Development.json` — dev-значения, включая исправленный порт 5173)
|
||||
|
||||
## Открытые вопросы (DESIGN.md §8) — решить по ходу соответствующей фазы
|
||||
|
||||
- [ ] Нужен ли предпросмотр/тестовый прогон теста преподавателем без сохранения попытки в статистику? (фаза 4)
|
||||
- [ ] Показывать ли студенту его ответы с правильными при просмотре результата, или только баллы? (фаза 5/6)
|
||||
- [ ] Валидировать нехватку вопросов в теме для `RandomFromTopics` при создании теста или только при старте попытки? (фаза 1/4)
|
||||
- [ ] Нужен ли визуальный порог/бейдж «подозрительно» при большом `FocusLossCount`? (фаза 5)
|
||||
- [ ] Показывать ли преподавателю архивные вопросы/тесты в общих списках (приглушённо+фильтр) или полностью прятать? (фаза 4)
|
||||
118
docs/SETUP.md
Normal file
118
docs/SETUP.md
Normal file
@@ -0,0 +1,118 @@
|
||||
# Развёртывание проекта для разработки (Windows 11)
|
||||
|
||||
Два варианта: **нативная разработка** (быстрый цикл правки-проверки, рекомендуется для повседневной
|
||||
работы) и **Docker Compose** (весь стек одной командой, полезно для быстрой проверки/демо). Для
|
||||
обоих нужен Postgres — с этой сессии сервер больше не хранит данные в памяти.
|
||||
|
||||
## Предварительные требования
|
||||
|
||||
| Инструмент | Версия | Зачем |
|
||||
|---|---|---|
|
||||
| [Git](https://git-scm.com/) | любая современная | клонировать репозиторий |
|
||||
| [.NET SDK](https://dotnet.microsoft.com/download) | 9.0 или новее | сборка Domain/Server/Client (Fable компилирует F# в JS поверх .NET SDK) |
|
||||
| [Node.js](https://nodejs.org/) | 20 LTS или новее | Vite (сборка/дев-сервер клиента) |
|
||||
| [Docker Desktop](https://www.docker.com/products/docker-desktop/) | любая современная | Postgres (в обоих вариантах) и опционально весь стек |
|
||||
|
||||
Проверить, что всё установлено:
|
||||
|
||||
```powershell
|
||||
git --version
|
||||
dotnet --version
|
||||
node --version
|
||||
docker --version
|
||||
```
|
||||
|
||||
## 1. Клонировать репозиторий
|
||||
|
||||
```powershell
|
||||
git clone <URL репозитория>
|
||||
cd RuVdsTests
|
||||
```
|
||||
|
||||
## 2. Поставить зависимости
|
||||
|
||||
```powershell
|
||||
# Fable (F# → JS компилятор) — версия закреплена в .config/dotnet-tools.json
|
||||
dotnet tool restore
|
||||
|
||||
# npm-пакеты клиента (react, vite и т.д.)
|
||||
npm install
|
||||
```
|
||||
|
||||
## 3. Поднять Postgres
|
||||
|
||||
Серверу нужна база `quizsystem` с пользователем `quizsystem`/паролем `devpassword` на порту `5432`
|
||||
localhost — это то, что уже прописано по умолчанию в
|
||||
`src/Server/appsettings.Development.json`, менять ничего не нужно, если использовать эти же значения.
|
||||
|
||||
Самый быстрый способ — разовый контейнер:
|
||||
|
||||
```powershell
|
||||
docker run -d --name quizsystem-postgres -p 5432:5432 `
|
||||
-e POSTGRES_DB=quizsystem -e POSTGRES_USER=quizsystem -e POSTGRES_PASSWORD=devpassword `
|
||||
postgres:16-alpine
|
||||
```
|
||||
|
||||
Схема и демо-данные создаются автоматически при первом запуске сервера (миграции — через DbUp,
|
||||
сид — через `Seed.fs`, оба идемпотентны, безопасно перезапускать).
|
||||
|
||||
Если 5432 на хосте уже занят другим Postgres — либо остановите его, либо смените порт в команде выше
|
||||
и в `ConnectionStrings:Postgres` в `appsettings.Development.json` соответственно.
|
||||
|
||||
## 4. Запустить сервер и клиент
|
||||
|
||||
Два процесса, в двух отдельных терминалах:
|
||||
|
||||
```powershell
|
||||
# Терминал 1 — сервер (ASP.NET/Giraffe, порт 5144)
|
||||
dotnet run --project src/Server/Server.fsproj
|
||||
```
|
||||
|
||||
```powershell
|
||||
# Терминал 2 — клиент (Fable watch + Vite dev-сервер, порт 5173)
|
||||
npm run dev
|
||||
```
|
||||
|
||||
Открыть **http://localhost:5173**. Демо-доступы (создаются сидом при первом запуске сервера):
|
||||
|
||||
| Роль | Email | Пароль |
|
||||
|---|---|---|
|
||||
| Преподаватель | `teacher@example.com` | `teacher123` |
|
||||
| Студент | `student@example.com` | `student123` |
|
||||
| Администратор | `admin@example.com` | `admin123` |
|
||||
|
||||
## Альтернатива: всё через Docker Compose
|
||||
|
||||
Вместо шагов 3–4 можно поднять весь стек (Postgres + Server + Client) одной командой — не нужен ни
|
||||
локальный .NET SDK, ни Node, только Docker.
|
||||
|
||||
```powershell
|
||||
cp .env.example .env
|
||||
# при желании отредактировать .env (JWT_SECRET/POSTGRES_PASSWORD)
|
||||
|
||||
docker compose up --build
|
||||
```
|
||||
|
||||
Клиент — **http://localhost:8081**, сервер — **http://localhost:5144** (тот же порт, что и при
|
||||
нативном запуске: клиент обращается к серверу по захардкоженному `http://localhost:5144`, поэтому
|
||||
адрес совпадает независимо от способа запуска).
|
||||
|
||||
```powershell
|
||||
docker compose down # остановить, данные в volume сохраняются
|
||||
docker compose down -v # остановить и стереть все данные Postgres
|
||||
```
|
||||
|
||||
## Типичные проблемы
|
||||
|
||||
- **"Domain.dll используется другим процессом" при пересборке.** Где-то в фоне остался запущенный
|
||||
`dotnet run`/`dotnet watch` от прошлой сессии — найти и завершить процесс
|
||||
(`Get-Process dotnet | Stop-Process`, либо точечно по PID из текста ошибки) и пересобрать заново.
|
||||
- **Логин не проходит / CORS-ошибка в консоли браузера.** Обычно значит, что сервер или клиент не
|
||||
запущены, либо запущены не на портах 5144/5173 — `Client:Origin` в `appsettings.Development.json`
|
||||
жёстко указывает на `http://localhost:5173`.
|
||||
- **Сервер падает при старте с ошибкой подключения к Postgres.** Убедиться, что контейнер/сервис
|
||||
Postgres реально поднят и слушает порт 5432 (`docker ps`), и что `ConnectionStrings:Postgres`
|
||||
в `appsettings.Development.json` соответствует реальным логину/паролю/порту.
|
||||
- **`docker compose build` падает с сетевой ошибкой (не может достучаться до nuget.org/registry).**
|
||||
Обычно временная проблема DNS/VPN на хосте — попробовать пересобрать ещё раз
|
||||
(`docker compose build --no-cache`).
|
||||
1059
package-lock.json
generated
Normal file
1059
package-lock.json
generated
Normal file
File diff suppressed because it is too large
Load Diff
16
package.json
Normal file
16
package.json
Normal file
@@ -0,0 +1,16 @@
|
||||
{
|
||||
"name": "ruvdstests-client",
|
||||
"private": true,
|
||||
"type": "module",
|
||||
"scripts": {
|
||||
"dev": "dotnet fable watch src/Client -o src/Client --run node node_modules/vite/bin/vite.js",
|
||||
"build": "dotnet fable src/Client -o src/Client && node node_modules/vite/bin/vite.js build"
|
||||
},
|
||||
"dependencies": {
|
||||
"react": "^18.3.1",
|
||||
"react-dom": "^18.3.1"
|
||||
},
|
||||
"devDependencies": {
|
||||
"vite": "^5.4.10"
|
||||
}
|
||||
}
|
||||
66
src/Client/App/State.fs
Normal file
66
src/Client/App/State.fs
Normal file
@@ -0,0 +1,66 @@
|
||||
module Client.App.State
|
||||
|
||||
open Elmish
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
open Client.Features
|
||||
open Client.Shared.SessionStorage
|
||||
open Client.App.Types
|
||||
|
||||
/// Shared by `init` (restoring a persisted session) and the login-success
|
||||
/// transition below, so a page refresh lands on the same role-appropriate
|
||||
/// home page a fresh login would.
|
||||
let private pageForSession (session: LoginResponse) : Page * Cmd<Msg> =
|
||||
match session.Role with
|
||||
| Student ->
|
||||
let browseModel, browseCmd = Quizzes.Browse.State.init ()
|
||||
Browse browseModel, Cmd.map BrowseMsg browseCmd
|
||||
| Teacher
|
||||
| Admin ->
|
||||
let teacherModel, teacherCmd = Teacher.Home.State.init session.Role
|
||||
TeacherHome teacherModel, Cmd.map TeacherMsg teacherCmd
|
||||
|
||||
let init () : Model * Cmd<Msg> =
|
||||
match tryLoad () with
|
||||
| Some session ->
|
||||
let page, cmd = pageForSession session
|
||||
{ Session = Some session; Page = page }, cmd
|
||||
| None -> { Session = None; Page = Login(Auth.Login.State.init ()) }, Cmd.none
|
||||
|
||||
let private token (model: Model) = model.Session |> Option.map (fun s -> s.Token)
|
||||
|
||||
/// Parent inspects specific child messages to handle page transitions (login
|
||||
/// success, quiz started, quiz finished) and otherwise delegates to the
|
||||
/// active page's own `update`, per the standard Elm "component" composition
|
||||
/// pattern — no separate ExternalMsg type needed for an app this size.
|
||||
let update (msg: Msg) (model: Model) : Model * Cmd<Msg> =
|
||||
match msg, model.Page with
|
||||
| LoginMsg(Auth.Login.Types.Succeeded session), _ ->
|
||||
save session
|
||||
let page, cmd = pageForSession session
|
||||
{ Session = Some session; Page = page }, cmd
|
||||
| LoginMsg subMsg, Login loginModel ->
|
||||
let m, cmd = Auth.Login.State.update subMsg loginModel
|
||||
{ model with Page = Login m }, Cmd.map LoginMsg cmd
|
||||
| BrowseMsg(Quizzes.Browse.Types.Started data), _ ->
|
||||
{ model with Page = TakeQuiz(Quizzes.TakeQuiz.Types.init data) },
|
||||
Cmd.map
|
||||
TakeQuizMsg
|
||||
(Cmd.batch [ Quizzes.TakeQuiz.State.startTicking (); Quizzes.TakeQuiz.State.attachFocusTracking () ])
|
||||
| BrowseMsg subMsg, Browse browseModel ->
|
||||
let m, cmd = Quizzes.Browse.State.update (token model) subMsg browseModel
|
||||
{ model with Page = Browse m }, Cmd.map BrowseMsg cmd
|
||||
| TakeQuizMsg(Quizzes.TakeQuiz.Types.Finished result), _ -> { model with Page = ViewResult result }, Cmd.none
|
||||
| TakeQuizMsg subMsg, TakeQuiz takeQuizModel ->
|
||||
let m, cmd = Quizzes.TakeQuiz.State.update (token model) subMsg takeQuizModel
|
||||
{ model with Page = TakeQuiz m }, Cmd.map TakeQuizMsg cmd
|
||||
| TeacherMsg subMsg, TeacherHome teacherModel ->
|
||||
let m, cmd = Teacher.Home.State.update (token model) subMsg teacherModel
|
||||
{ model with Page = TeacherHome m }, Cmd.map TeacherMsg cmd
|
||||
| Logout, _ ->
|
||||
clear ()
|
||||
{ Session = None; Page = Login(Auth.Login.State.init ()) }, Cmd.none
|
||||
| BackToQuizList, _ ->
|
||||
let browseModel, browseCmd = Quizzes.Browse.State.init ()
|
||||
{ model with Page = Browse browseModel }, Cmd.map BrowseMsg browseCmd
|
||||
| _ -> model, Cmd.none
|
||||
21
src/Client/App/Types.fs
Normal file
21
src/Client/App/Types.fs
Normal file
@@ -0,0 +1,21 @@
|
||||
module Client.App.Types
|
||||
|
||||
open Domain.Contracts
|
||||
open Client.Features
|
||||
|
||||
type Page =
|
||||
| Login of Auth.Login.Types.Model
|
||||
| Browse of Quizzes.Browse.Types.Model
|
||||
| TakeQuiz of Quizzes.TakeQuiz.Types.Model
|
||||
| ViewResult of AttemptResult
|
||||
| TeacherHome of Teacher.Home.Types.Model
|
||||
|
||||
type Model = { Session: LoginResponse option; Page: Page }
|
||||
|
||||
type Msg =
|
||||
| LoginMsg of Auth.Login.Types.Msg
|
||||
| BrowseMsg of Quizzes.Browse.Types.Msg
|
||||
| TakeQuizMsg of Quizzes.TakeQuiz.Types.Msg
|
||||
| TeacherMsg of Teacher.Home.Types.Msg
|
||||
| Logout
|
||||
| BackToQuizList
|
||||
47
src/Client/App/View.fs
Normal file
47
src/Client/App/View.fs
Normal file
@@ -0,0 +1,47 @@
|
||||
module Client.App.View
|
||||
|
||||
open Feliz
|
||||
open Domain
|
||||
open Client.Features
|
||||
open Client.App.Types
|
||||
|
||||
let private roleLabel (role: Role) =
|
||||
match role with
|
||||
| Admin -> "Администратор"
|
||||
| Teacher -> "Преподаватель"
|
||||
| Student -> "Студент"
|
||||
|
||||
let private withTopbar (model: Model) (dispatch: Msg -> unit) (page: ReactElement) =
|
||||
Html.div [
|
||||
Html.div [
|
||||
prop.className "topbar"
|
||||
prop.children [
|
||||
Html.span [ prop.className "wordmark"; prop.text "Экзамен" ]
|
||||
Html.div [
|
||||
prop.className "topbar-identity"
|
||||
prop.children [
|
||||
yield!
|
||||
match model.Session with
|
||||
| Some s ->
|
||||
[ Html.span [ prop.className "topbar-name"; prop.text s.Name ]
|
||||
Html.span [ prop.className "role-badge"; prop.text (roleLabel s.Role) ] ]
|
||||
| None -> []
|
||||
Html.button [ prop.onClick (fun _ -> dispatch Logout); prop.text "Выйти" ]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
page
|
||||
]
|
||||
|
||||
let view (model: Model) (dispatch: Msg -> unit) =
|
||||
match model.Page with
|
||||
| Login loginModel -> Auth.Login.View.view loginModel (LoginMsg >> dispatch)
|
||||
| Browse browseModel ->
|
||||
withTopbar model dispatch (Quizzes.Browse.View.view browseModel (BrowseMsg >> dispatch))
|
||||
| TakeQuiz takeQuizModel ->
|
||||
withTopbar model dispatch (Quizzes.TakeQuiz.View.view takeQuizModel (TakeQuizMsg >> dispatch))
|
||||
| ViewResult result ->
|
||||
withTopbar model dispatch (Quizzes.ViewResult.View.view result (fun () -> dispatch BackToQuizList))
|
||||
| TeacherHome teacherModel ->
|
||||
withTopbar model dispatch (Teacher.Home.View.view teacherModel (TeacherMsg >> dispatch))
|
||||
60
src/Client/Client.fsproj
Normal file
60
src/Client/Client.fsproj
Normal file
@@ -0,0 +1,60 @@
|
||||
<Project Sdk="Microsoft.NET.Sdk">
|
||||
|
||||
<PropertyGroup>
|
||||
<OutputType>Exe</OutputType>
|
||||
<TargetFramework>net9.0</TargetFramework>
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<Compile Include="Shared/JsonWire.fs" />
|
||||
<Compile Include="Shared/Format.fs" />
|
||||
<Compile Include="Shared/SessionStorage.fs" />
|
||||
<Compile Include="Features/Auth/Login/Types.fs" />
|
||||
<Compile Include="Features/Auth/Login/Api.fs" />
|
||||
<Compile Include="Features/Auth/Login/State.fs" />
|
||||
<Compile Include="Features/Auth/Login/View.fs" />
|
||||
<Compile Include="Features/Quizzes/Browse/Types.fs" />
|
||||
<Compile Include="Features/Quizzes/Browse/Api.fs" />
|
||||
<Compile Include="Features/Quizzes/Browse/State.fs" />
|
||||
<Compile Include="Features/Quizzes/Browse/View.fs" />
|
||||
<Compile Include="Features/Quizzes/TakeQuiz/Types.fs" />
|
||||
<Compile Include="Features/Quizzes/TakeQuiz/Api.fs" />
|
||||
<Compile Include="Features/Quizzes/TakeQuiz/State.fs" />
|
||||
<Compile Include="Features/Quizzes/TakeQuiz/View.fs" />
|
||||
<Compile Include="Features/Quizzes/ViewResult/View.fs" />
|
||||
<Compile Include="Features/Teacher/Questions/Types.fs" />
|
||||
<Compile Include="Features/Teacher/Questions/Api.fs" />
|
||||
<Compile Include="Features/Teacher/Questions/State.fs" />
|
||||
<Compile Include="Features/Teacher/Questions/View.fs" />
|
||||
<Compile Include="Features/Teacher/Tests/Types.fs" />
|
||||
<Compile Include="Features/Teacher/Tests/Api.fs" />
|
||||
<Compile Include="Features/Teacher/Tests/State.fs" />
|
||||
<Compile Include="Features/Teacher/Tests/View.fs" />
|
||||
<Compile Include="Features/Admin/Users/Types.fs" />
|
||||
<Compile Include="Features/Admin/Users/Api.fs" />
|
||||
<Compile Include="Features/Admin/Users/State.fs" />
|
||||
<Compile Include="Features/Admin/Users/View.fs" />
|
||||
<Compile Include="Features/Teacher/Home/Types.fs" />
|
||||
<Compile Include="Features/Teacher/Home/State.fs" />
|
||||
<Compile Include="Features/Teacher/Home/View.fs" />
|
||||
<Compile Include="App/Types.fs" />
|
||||
<Compile Include="App/State.fs" />
|
||||
<Compile Include="App/View.fs" />
|
||||
<Compile Include="Program.fs" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<ProjectReference Include="..\Domain\Domain.fsproj" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="Fable.Browser.Dom" Version="2.20.0" />
|
||||
<PackageReference Include="Fable.Browser.WebStorage" Version="1.3.0" />
|
||||
<PackageReference Include="Fable.Core" Version="5.2.0" />
|
||||
<PackageReference Include="Fable.Elmish" Version="5.0.2" />
|
||||
<PackageReference Include="Fable.Elmish.React" Version="5.6.0" />
|
||||
<PackageReference Include="Fable.Promise" Version="3.2.0" />
|
||||
<PackageReference Include="Feliz" Version="3.3.3" />
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
||||
25
src/Client/Dockerfile
Normal file
25
src/Client/Dockerfile
Normal file
@@ -0,0 +1,25 @@
|
||||
# `npm run build` shells out to `dotnet fable` before `vite build`, so this
|
||||
# stage needs both Node and the .NET SDK — simplest to install Node into the
|
||||
# SDK image and run the existing script unmodified, rather than hand-split it.
|
||||
# Build context is the repo root (see docker-compose.yml).
|
||||
# Uses the SDK 10 image (not 9, even though the project targets net9.0):
|
||||
# the NuGet client in SDK 9.0.x fails to restore the `fable` dotnet-tool
|
||||
# package ("Settings file 'DotnetToolSettings.xml' was not found in the
|
||||
# package", right after signature verification succeeds) — SDK 10's newer
|
||||
# NuGet client reads the same package fine, and building a net9.0 project
|
||||
# with a newer SDK is otherwise unaffected.
|
||||
FROM mcr.microsoft.com/dotnet/sdk:10.0 AS build
|
||||
WORKDIR /src
|
||||
RUN apt-get update && apt-get install -y --no-install-recommends nodejs npm && rm -rf /var/lib/apt/lists/*
|
||||
COPY package.json package-lock.json ./
|
||||
COPY .config/ .config/
|
||||
RUN npm ci && dotnet tool restore
|
||||
COPY src/Domain/ src/Domain/
|
||||
COPY src/Client/ src/Client/
|
||||
COPY vite.config.js ./
|
||||
RUN npm run build
|
||||
|
||||
FROM nginx:1.27-alpine AS runtime
|
||||
COPY --from=build /src/src/Client/dist /usr/share/nginx/html
|
||||
COPY src/Client/nginx.conf /etc/nginx/conf.d/default.conf
|
||||
EXPOSE 80
|
||||
63
src/Client/Features/Admin/Users/Api.fs
Normal file
63
src/Client/Features/Admin/Users/Api.fs
Normal file
@@ -0,0 +1,63 @@
|
||||
module Client.Features.Admin.Users.Api
|
||||
|
||||
open Fable.Core.JsInterop
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
open Client.Shared.JsonWire
|
||||
|
||||
let private encRole (role: Role) : obj = box (string role)
|
||||
|
||||
let private decodeUserSummary (raw: obj) : UserSummary =
|
||||
{ Id = decUserId raw?Id
|
||||
Name = raw?Name
|
||||
Email = raw?Email
|
||||
Role = decodeRole raw?Role
|
||||
IsActive = unbox<bool> raw?IsActive }
|
||||
|
||||
let listUsers (token: string option) : Async<Result<UserSummary list, string>> =
|
||||
async {
|
||||
let! raw = callApi token "GET" "/api/admin/users" None
|
||||
return decodeResult (fun r -> (unbox<obj[]> r) |> Array.toList |> List.map decodeUserSummary) raw
|
||||
}
|
||||
|
||||
let createUser (token: string option) (req: CreateUserRequest) : Async<Result<UserSummary, string>> =
|
||||
async {
|
||||
let body =
|
||||
createObj [
|
||||
"Name" ==> box req.Name
|
||||
"Email" ==> box req.Email
|
||||
"Password" ==> box req.Password
|
||||
"Role" ==> encRole req.Role
|
||||
]
|
||||
|
||||
let! raw = callApi token "POST" "/api/admin/users/create" (Some body)
|
||||
return decodeResult decodeUserSummary raw
|
||||
}
|
||||
|
||||
let updateUser (token: string option) (req: UpdateUserRequest) : Async<Result<UserSummary, string>> =
|
||||
async {
|
||||
let body =
|
||||
createObj [
|
||||
"Id" ==> encUserId req.Id
|
||||
"Name" ==> box req.Name
|
||||
"Email" ==> box req.Email
|
||||
"Role" ==> encRole req.Role
|
||||
]
|
||||
|
||||
let! raw = callApi token "POST" "/api/admin/users/update" (Some body)
|
||||
return decodeResult decodeUserSummary raw
|
||||
}
|
||||
|
||||
let setUserActive (token: string option) ((userId, isActive): UserId * bool) : Async<Result<UserSummary, string>> =
|
||||
async {
|
||||
let body = createObj [ "Id" ==> encUserId userId; "IsActive" ==> box isActive ]
|
||||
let! raw = callApi token "POST" "/api/admin/users/set-active" (Some body)
|
||||
return decodeResult decodeUserSummary raw
|
||||
}
|
||||
|
||||
let resetPassword (token: string option) ((userId, newPassword): UserId * string) : Async<Result<unit, string>> =
|
||||
async {
|
||||
let body = createObj [ "Id" ==> encUserId userId; "NewPassword" ==> box newPassword ]
|
||||
let! raw = callApi token "POST" "/api/admin/users/reset-password" (Some body)
|
||||
return decodeResult (fun _ -> ()) raw
|
||||
}
|
||||
121
src/Client/Features/Admin/Users/State.fs
Normal file
121
src/Client/Features/Admin/Users/State.fs
Normal file
@@ -0,0 +1,121 @@
|
||||
module Client.Features.Admin.Users.State
|
||||
|
||||
open Elmish
|
||||
open Domain.Contracts
|
||||
open Client.Features.Admin.Users.Types
|
||||
|
||||
let init () : Model * Cmd<Msg> = empty, Cmd.ofMsg LoadUsers
|
||||
|
||||
let update (token: string option) (msg: Msg) (model: Model) : Model * Cmd<Msg> =
|
||||
match msg with
|
||||
| LoadUsers ->
|
||||
let cmd =
|
||||
Cmd.OfAsync.either
|
||||
Api.listUsers
|
||||
token
|
||||
(function
|
||||
| Ok users -> UsersLoaded users
|
||||
| Error err -> UsersLoadFailed err)
|
||||
(fun ex -> UsersLoadFailed ex.Message)
|
||||
|
||||
{ model with Loading = true; Error = None }, cmd
|
||||
| UsersLoaded users -> { model with Users = users; Loading = false }, Cmd.none
|
||||
| UsersLoadFailed err -> { model with Loading = false; Error = Some err }, Cmd.none
|
||||
| StartNewUser ->
|
||||
{ model with ShowUserForm = true; EditingUserId = None; UserForm = emptyUserForm }, Cmd.none
|
||||
| StartEditUser userId ->
|
||||
match model.Users |> List.tryFind (fun u -> u.Id = userId) with
|
||||
| None -> model, Cmd.none
|
||||
| Some u ->
|
||||
let form = { emptyUserForm with Name = u.Name; Email = u.Email; Role = u.Role }
|
||||
{ model with ShowUserForm = true; EditingUserId = Some userId; UserForm = form }, Cmd.none
|
||||
| CancelUserForm -> { model with ShowUserForm = false; EditingUserId = None }, Cmd.none
|
||||
| SetUserName text -> { model with UserForm = { model.UserForm with Name = text } }, Cmd.none
|
||||
| SetUserEmail text -> { model with UserForm = { model.UserForm with Email = text } }, Cmd.none
|
||||
| SetUserPassword text -> { model with UserForm = { model.UserForm with Password = text } }, Cmd.none
|
||||
| SetUserRole role -> { model with UserForm = { model.UserForm with Role = role } }, Cmd.none
|
||||
| SubmitUserForm ->
|
||||
let form = model.UserForm
|
||||
|
||||
if System.String.IsNullOrWhiteSpace form.Name || System.String.IsNullOrWhiteSpace form.Email then
|
||||
{ model with UserForm = { form with Error = Some "Имя и email обязательны" } }, Cmd.none
|
||||
elif model.EditingUserId.IsNone && form.Password.Length < 6 then
|
||||
{ model with UserForm = { form with Error = Some "Пароль должен быть не короче 6 символов" } }, Cmd.none
|
||||
else
|
||||
let submitting = { form with IsSubmitting = true; Error = None }
|
||||
|
||||
let cmd =
|
||||
match model.EditingUserId with
|
||||
| None ->
|
||||
let req: CreateUserRequest =
|
||||
{ Name = form.Name; Email = form.Email; Password = form.Password; Role = form.Role }
|
||||
|
||||
Cmd.OfAsync.either
|
||||
(Api.createUser token)
|
||||
req
|
||||
(function
|
||||
| Ok u -> UserSaved u
|
||||
| Error err -> UserSaveFailed err)
|
||||
(fun ex -> UserSaveFailed ex.Message)
|
||||
| Some userId ->
|
||||
let req: UpdateUserRequest =
|
||||
{ Id = userId; Name = form.Name; Email = form.Email; Role = form.Role }
|
||||
|
||||
Cmd.OfAsync.either
|
||||
(Api.updateUser token)
|
||||
req
|
||||
(function
|
||||
| Ok u -> UserSaved u
|
||||
| Error err -> UserSaveFailed err)
|
||||
(fun ex -> UserSaveFailed ex.Message)
|
||||
|
||||
{ model with UserForm = submitting }, cmd
|
||||
| UserSaved u ->
|
||||
let exists = model.Users |> List.exists (fun x -> x.Id = u.Id)
|
||||
|
||||
{ model with
|
||||
Users = if exists then model.Users |> List.map (fun x -> if x.Id = u.Id then u else x) else model.Users @ [ u ]
|
||||
ShowUserForm = false
|
||||
EditingUserId = None },
|
||||
Cmd.none
|
||||
| UserSaveFailed err -> { model with UserForm = { model.UserForm with IsSubmitting = false; Error = Some err } }, Cmd.none
|
||||
| ToggleActive(userId, isActive) ->
|
||||
let cmd =
|
||||
Cmd.OfAsync.either
|
||||
(Api.setUserActive token)
|
||||
(userId, isActive)
|
||||
(function
|
||||
| Ok u -> ActiveToggled u
|
||||
| Error err -> ActiveToggleFailed err)
|
||||
(fun ex -> ActiveToggleFailed ex.Message)
|
||||
|
||||
{ model with Error = None }, cmd
|
||||
| ActiveToggled u ->
|
||||
{ model with Users = model.Users |> List.map (fun x -> if x.Id = u.Id then u else x) }, Cmd.none
|
||||
| ActiveToggleFailed err -> { model with Error = Some err }, Cmd.none
|
||||
| StartResetPassword userId ->
|
||||
{ model with ResetPasswordUserId = Some userId; PasswordForm = emptyPasswordForm }, Cmd.none
|
||||
| CancelResetPassword -> { model with ResetPasswordUserId = None }, Cmd.none
|
||||
| SetNewPassword text -> { model with PasswordForm = { model.PasswordForm with NewPassword = text } }, Cmd.none
|
||||
| SubmitResetPassword ->
|
||||
match model.ResetPasswordUserId with
|
||||
| None -> model, Cmd.none
|
||||
| Some userId ->
|
||||
if model.PasswordForm.NewPassword.Length < 6 then
|
||||
{ model with
|
||||
PasswordForm = { model.PasswordForm with Error = Some "Пароль должен быть не короче 6 символов" } },
|
||||
Cmd.none
|
||||
else
|
||||
let cmd =
|
||||
Cmd.OfAsync.either
|
||||
(Api.resetPassword token)
|
||||
(userId, model.PasswordForm.NewPassword)
|
||||
(function
|
||||
| Ok() -> PasswordReset
|
||||
| Error err -> PasswordResetFailed err)
|
||||
(fun ex -> PasswordResetFailed ex.Message)
|
||||
|
||||
{ model with PasswordForm = { model.PasswordForm with IsSubmitting = true; Error = None } }, cmd
|
||||
| PasswordReset -> { model with ResetPasswordUserId = None }, Cmd.none
|
||||
| PasswordResetFailed err ->
|
||||
{ model with PasswordForm = { model.PasswordForm with IsSubmitting = false; Error = Some err } }, Cmd.none
|
||||
74
src/Client/Features/Admin/Users/Types.fs
Normal file
74
src/Client/Features/Admin/Users/Types.fs
Normal file
@@ -0,0 +1,74 @@
|
||||
module Client.Features.Admin.Users.Types
|
||||
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
|
||||
type UserForm =
|
||||
{ Name: string
|
||||
Email: string
|
||||
Password: string
|
||||
Role: Role
|
||||
Error: string option
|
||||
IsSubmitting: bool }
|
||||
|
||||
let emptyUserForm =
|
||||
{ Name = ""
|
||||
Email = ""
|
||||
Password = ""
|
||||
Role = Student
|
||||
Error = None
|
||||
IsSubmitting = false }
|
||||
|
||||
type PasswordForm =
|
||||
{ NewPassword: string
|
||||
Error: string option
|
||||
IsSubmitting: bool }
|
||||
|
||||
let emptyPasswordForm = { NewPassword = ""; Error = None; IsSubmitting = false }
|
||||
|
||||
type Model =
|
||||
{ Users: UserSummary list
|
||||
Loading: bool
|
||||
Error: string option
|
||||
/// `None` = the form creates a new user; `Some id` = it edits that
|
||||
/// existing user instead (in which case the password field is hidden —
|
||||
/// password changes go through the separate reset-password form).
|
||||
EditingUserId: UserId option
|
||||
ShowUserForm: bool
|
||||
UserForm: UserForm
|
||||
ResetPasswordUserId: UserId option
|
||||
PasswordForm: PasswordForm }
|
||||
|
||||
let empty =
|
||||
{ Users = []
|
||||
Loading = false
|
||||
Error = None
|
||||
EditingUserId = None
|
||||
ShowUserForm = false
|
||||
UserForm = emptyUserForm
|
||||
ResetPasswordUserId = None
|
||||
PasswordForm = emptyPasswordForm }
|
||||
|
||||
type Msg =
|
||||
| LoadUsers
|
||||
| UsersLoaded of UserSummary list
|
||||
| UsersLoadFailed of string
|
||||
| StartNewUser
|
||||
| StartEditUser of UserId
|
||||
| CancelUserForm
|
||||
| SetUserName of string
|
||||
| SetUserEmail of string
|
||||
| SetUserPassword of string
|
||||
| SetUserRole of Role
|
||||
| SubmitUserForm
|
||||
| UserSaved of UserSummary
|
||||
| UserSaveFailed of string
|
||||
| ToggleActive of UserId * bool
|
||||
| ActiveToggled of UserSummary
|
||||
| ActiveToggleFailed of string
|
||||
| StartResetPassword of UserId
|
||||
| CancelResetPassword
|
||||
| SetNewPassword of string
|
||||
| SubmitResetPassword
|
||||
| PasswordReset
|
||||
| PasswordResetFailed of string
|
||||
199
src/Client/Features/Admin/Users/View.fs
Normal file
199
src/Client/Features/Admin/Users/View.fs
Normal file
@@ -0,0 +1,199 @@
|
||||
module Client.Features.Admin.Users.View
|
||||
|
||||
open Feliz
|
||||
open Domain
|
||||
open Client.Features.Admin.Users.Types
|
||||
|
||||
let private roleLabel (role: Role) =
|
||||
match role with
|
||||
| Admin -> "Администратор"
|
||||
| Teacher -> "Преподаватель"
|
||||
| Student -> "Студент"
|
||||
|
||||
let private roleOptions = [ Student; Teacher; Admin ]
|
||||
|
||||
let private userFormView (isEditing: bool) (model: Model) dispatch =
|
||||
let form = model.UserForm
|
||||
|
||||
Html.form [
|
||||
prop.className "new-question-form"
|
||||
prop.onSubmit (fun e ->
|
||||
e.preventDefault ()
|
||||
dispatch SubmitUserForm)
|
||||
prop.children [
|
||||
Html.h3 (if isEditing then "Редактирование пользователя" else "Новый пользователь")
|
||||
Html.label [ prop.text "Имя" ]
|
||||
Html.input [ prop.type'.text; prop.value form.Name; prop.onChange (SetUserName >> dispatch) ]
|
||||
Html.label [ prop.text "Email" ]
|
||||
Html.input [ prop.type'.email; prop.value form.Email; prop.onChange (SetUserEmail >> dispatch) ]
|
||||
if not isEditing then
|
||||
Html.label [ prop.text "Пароль" ]
|
||||
Html.input [
|
||||
prop.type'.password
|
||||
prop.value form.Password
|
||||
prop.onChange (SetUserPassword >> dispatch)
|
||||
]
|
||||
Html.label [ prop.text "Роль" ]
|
||||
Html.select [
|
||||
prop.value (string form.Role)
|
||||
prop.onChange (fun (v: string) ->
|
||||
roleOptions |> List.tryFind (fun r -> string r = v) |> Option.iter (SetUserRole >> dispatch))
|
||||
prop.children [
|
||||
for r in roleOptions ->
|
||||
Html.option [ prop.key (string r); prop.value (string r); prop.text (roleLabel r) ]
|
||||
]
|
||||
]
|
||||
match form.Error with
|
||||
| Some err -> Html.p [ prop.className "error"; prop.text err ]
|
||||
| None -> Html.none
|
||||
Html.button [
|
||||
prop.type'.submit
|
||||
prop.disabled form.IsSubmitting
|
||||
prop.text (
|
||||
if form.IsSubmitting then "Сохранение…"
|
||||
elif isEditing then "Сохранить изменения"
|
||||
else "Создать пользователя"
|
||||
)
|
||||
]
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun _ -> dispatch CancelUserForm)
|
||||
prop.text "Отмена"
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
let private passwordFormView (model: Model) dispatch =
|
||||
let form = model.PasswordForm
|
||||
|
||||
Html.form [
|
||||
prop.className "new-question-form"
|
||||
prop.onSubmit (fun e ->
|
||||
e.preventDefault ()
|
||||
dispatch SubmitResetPassword)
|
||||
prop.children [
|
||||
Html.h3 "Сброс пароля"
|
||||
Html.label [ prop.text "Новый пароль" ]
|
||||
Html.input [
|
||||
prop.type'.password
|
||||
prop.value form.NewPassword
|
||||
prop.onChange (SetNewPassword >> dispatch)
|
||||
]
|
||||
match form.Error with
|
||||
| Some err -> Html.p [ prop.className "error"; prop.text err ]
|
||||
| None -> Html.none
|
||||
Html.button [
|
||||
prop.type'.submit
|
||||
prop.disabled form.IsSubmitting
|
||||
prop.text (if form.IsSubmitting then "Сохранение…" else "Сбросить пароль")
|
||||
]
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun _ -> dispatch CancelResetPassword)
|
||||
prop.text "Отмена"
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
let view (model: Model) (dispatch: Msg -> unit) =
|
||||
Html.div [
|
||||
prop.className "users-page"
|
||||
prop.children [
|
||||
Html.div [
|
||||
prop.className "page-header"
|
||||
prop.children [
|
||||
Html.h1 "Пользователи"
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun _ -> dispatch StartNewUser)
|
||||
prop.text "Добавить пользователя"
|
||||
]
|
||||
]
|
||||
]
|
||||
match model.Error with
|
||||
| Some err -> Html.p [ prop.className "error"; prop.text err ]
|
||||
| None -> Html.none
|
||||
if model.Loading then
|
||||
Html.p "Загрузка…"
|
||||
elif model.Users.IsEmpty then
|
||||
Html.p "Пользователей пока нет"
|
||||
else
|
||||
Html.ul [
|
||||
prop.className "users-list"
|
||||
prop.children [
|
||||
for u in model.Users ->
|
||||
Html.li [
|
||||
prop.key (string u.Id)
|
||||
prop.className "user-row"
|
||||
prop.children [
|
||||
Html.div [
|
||||
prop.className "user-row-info"
|
||||
prop.children [
|
||||
Html.span [ prop.className "user-row-name"; prop.text u.Name ]
|
||||
Html.span [ prop.className "tag-mono"; prop.text u.Email ]
|
||||
Html.div [
|
||||
prop.className "user-row-badges"
|
||||
prop.children [
|
||||
Html.span [ prop.className "role-badge"; prop.text (roleLabel u.Role) ]
|
||||
Html.span [
|
||||
prop.className (
|
||||
if u.IsActive then "status-badge active" else "status-badge inactive"
|
||||
)
|
||||
prop.text (if u.IsActive then "Активен" else "Отключён")
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
Html.div [
|
||||
prop.className "user-row-actions"
|
||||
prop.children [
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun _ -> dispatch (StartEditUser u.Id))
|
||||
prop.text "Изменить"
|
||||
]
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun _ -> dispatch (StartResetPassword u.Id))
|
||||
prop.text "Сбросить пароль"
|
||||
]
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun _ -> dispatch (ToggleActive(u.Id, not u.IsActive)))
|
||||
prop.text (if u.IsActive then "Деактивировать" else "Активировать")
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
if model.ShowUserForm then
|
||||
Html.div [
|
||||
prop.className "modal-backdrop"
|
||||
prop.onClick (fun _ -> dispatch CancelUserForm)
|
||||
prop.children [
|
||||
Html.div [
|
||||
prop.className "modal-dialog"
|
||||
prop.onClick (fun e -> e.stopPropagation ())
|
||||
prop.children [ userFormView model.EditingUserId.IsSome model dispatch ]
|
||||
]
|
||||
]
|
||||
]
|
||||
match model.ResetPasswordUserId with
|
||||
| Some _ ->
|
||||
Html.div [
|
||||
prop.className "modal-backdrop"
|
||||
prop.onClick (fun _ -> dispatch CancelResetPassword)
|
||||
prop.children [
|
||||
Html.div [
|
||||
prop.className "modal-dialog"
|
||||
prop.onClick (fun e -> e.stopPropagation ())
|
||||
prop.children [ passwordFormView model dispatch ]
|
||||
]
|
||||
]
|
||||
]
|
||||
| None -> Html.none
|
||||
]
|
||||
]
|
||||
18
src/Client/Features/Auth/Login/Api.fs
Normal file
18
src/Client/Features/Auth/Login/Api.fs
Normal file
@@ -0,0 +1,18 @@
|
||||
module Client.Features.Auth.Login.Api
|
||||
|
||||
open Fable.Core.JsInterop
|
||||
open Domain.Contracts
|
||||
open Client.Shared.JsonWire
|
||||
|
||||
let private decodeLoginResponse (raw: obj) : LoginResponse =
|
||||
{ Token = raw?Token
|
||||
UserId = decUserId raw?UserId
|
||||
Name = raw?Name
|
||||
Role = decodeRole raw?Role }
|
||||
|
||||
let login (req: LoginRequest) : Async<Result<LoginResponse, string>> =
|
||||
async {
|
||||
let body = createObj [ "Email" ==> req.Email; "Password" ==> req.Password ]
|
||||
let! raw = callApi None "POST" "/api/login" (Some body)
|
||||
return decodeResult decodeLoginResponse raw
|
||||
}
|
||||
28
src/Client/Features/Auth/Login/State.fs
Normal file
28
src/Client/Features/Auth/Login/State.fs
Normal file
@@ -0,0 +1,28 @@
|
||||
module Client.Features.Auth.Login.State
|
||||
|
||||
open Elmish
|
||||
open Domain.Contracts
|
||||
open Client.Features.Auth.Login.Types
|
||||
|
||||
let init () : Model = empty
|
||||
|
||||
let update (msg: Msg) (model: Model) : Model * Cmd<Msg> =
|
||||
match msg with
|
||||
| SetEmail email -> { model with Email = email }, Cmd.none
|
||||
| SetPassword password -> { model with Password = password }, Cmd.none
|
||||
| Submit ->
|
||||
let model = { model with IsSubmitting = true; Error = None }
|
||||
let request: LoginRequest = { Email = model.Email; Password = model.Password }
|
||||
|
||||
let cmd =
|
||||
Cmd.OfAsync.either
|
||||
Api.login
|
||||
request
|
||||
(function
|
||||
| Ok response -> Succeeded response
|
||||
| Error err -> Failed err)
|
||||
(fun ex -> Failed ex.Message)
|
||||
|
||||
model, cmd
|
||||
| Succeeded _ -> model, Cmd.none // handled by the parent, which switches pages
|
||||
| Failed err -> { model with IsSubmitting = false; Error = Some err }, Cmd.none
|
||||
22
src/Client/Features/Auth/Login/Types.fs
Normal file
22
src/Client/Features/Auth/Login/Types.fs
Normal file
@@ -0,0 +1,22 @@
|
||||
module Client.Features.Auth.Login.Types
|
||||
|
||||
open Domain.Contracts
|
||||
|
||||
type Model =
|
||||
{ Email: string
|
||||
Password: string
|
||||
Error: string option
|
||||
IsSubmitting: bool }
|
||||
|
||||
let empty =
|
||||
{ Email = ""
|
||||
Password = ""
|
||||
Error = None
|
||||
IsSubmitting = false }
|
||||
|
||||
type Msg =
|
||||
| SetEmail of string
|
||||
| SetPassword of string
|
||||
| Submit
|
||||
| Succeeded of LoginResponse
|
||||
| Failed of string
|
||||
49
src/Client/Features/Auth/Login/View.fs
Normal file
49
src/Client/Features/Auth/Login/View.fs
Normal file
@@ -0,0 +1,49 @@
|
||||
module Client.Features.Auth.Login.View
|
||||
|
||||
open Feliz
|
||||
open Client.Features.Auth.Login.Types
|
||||
|
||||
let view (model: Model) (dispatch: Msg -> unit) =
|
||||
Html.div [
|
||||
prop.className "login-page"
|
||||
prop.children [
|
||||
Html.h1 [ prop.className "wordmark"; prop.text "Экзамен" ]
|
||||
Html.p [ prop.className "hint"; prop.text "Система тестирования" ]
|
||||
Html.div [
|
||||
prop.className "login-card"
|
||||
prop.children [
|
||||
Html.form [
|
||||
prop.onSubmit (fun e ->
|
||||
e.preventDefault ()
|
||||
dispatch Submit)
|
||||
prop.children [
|
||||
Html.label [ prop.text "Email" ]
|
||||
Html.input [
|
||||
prop.type'.email
|
||||
prop.value model.Email
|
||||
prop.onChange (SetEmail >> dispatch)
|
||||
]
|
||||
Html.label [ prop.text "Пароль" ]
|
||||
Html.input [
|
||||
prop.type'.password
|
||||
prop.value model.Password
|
||||
prop.onChange (SetPassword >> dispatch)
|
||||
]
|
||||
match model.Error with
|
||||
| Some err -> Html.p [ prop.className "error"; prop.text err ]
|
||||
| None -> Html.none
|
||||
Html.button [
|
||||
prop.type'.submit
|
||||
prop.disabled model.IsSubmitting
|
||||
prop.text (if model.IsSubmitting then "Вход…" else "Войти")
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
Html.p [
|
||||
prop.className "hint"
|
||||
prop.text "Демо: teacher@example.com / teacher123 или student@example.com / student123"
|
||||
]
|
||||
]
|
||||
]
|
||||
73
src/Client/Features/Quizzes/Browse/Api.fs
Normal file
73
src/Client/Features/Quizzes/Browse/Api.fs
Normal file
@@ -0,0 +1,73 @@
|
||||
module Client.Features.Quizzes.Browse.Api
|
||||
|
||||
open Fable.Core.JsInterop
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
open Client.Shared.JsonWire
|
||||
|
||||
let private decodeQuizSummary (raw: obj) : QuizSummary =
|
||||
{ Id = decQuizId raw?Id
|
||||
Title = raw?Title
|
||||
Description = raw?Description
|
||||
TotalPoints = raw?TotalPoints
|
||||
TimeLimitMinutes = raw?TimeLimitMinutes |> optDec unbox<int>
|
||||
MaxAttempts = raw?MaxAttempts |> optDec unbox<int>
|
||||
AttemptsCount = raw?AttemptsCount
|
||||
AlreadyPassed = raw?AlreadyPassed }
|
||||
|
||||
let private decodeMyAttemptSummary (raw: obj) : MyAttemptSummary =
|
||||
{ AttemptId = decAttemptId raw?AttemptId
|
||||
StartedAt = System.DateTimeOffset.Parse(raw?StartedAt: string)
|
||||
Score = raw?Score
|
||||
MaxScore = raw?MaxScore
|
||||
Passed = raw?Passed |> optDec unbox<bool> }
|
||||
|
||||
let private decodeQuestionViewKind (raw: obj) : QuestionViewKind =
|
||||
match box raw with
|
||||
| :? string as caseName ->
|
||||
match caseName with
|
||||
| "TrueFalseView" -> TrueFalseView
|
||||
| "ShortAnswerView" -> ShortAnswerView
|
||||
| "NumericView" -> NumericView
|
||||
| other -> failwithf "Неизвестный тип вопроса: %s" other
|
||||
| _ ->
|
||||
if not (isNullOrUndefined raw?SingleChoiceView) then
|
||||
let options: (obj * string)[] = raw?SingleChoiceView
|
||||
SingleChoiceView(options |> Array.toList |> List.map (fun (idRaw, text) -> decOptionId idRaw, text))
|
||||
elif not (isNullOrUndefined raw?MultipleChoiceView) then
|
||||
let options: (obj * string)[] = raw?MultipleChoiceView
|
||||
MultipleChoiceView(options |> Array.toList |> List.map (fun (idRaw, text) -> decOptionId idRaw, text))
|
||||
else
|
||||
failwith "Неизвестный тип вопроса"
|
||||
|
||||
let private decodeQuestionView (raw: obj) : QuestionView =
|
||||
{ Id = decQuestionId raw?Id
|
||||
Text = raw?Text
|
||||
Points = raw?Points
|
||||
Kind = decodeQuestionViewKind raw?Kind }
|
||||
|
||||
let private decodeQuizForAttempt (raw: obj) : QuizForAttempt =
|
||||
{ AttemptId = decAttemptId raw?AttemptId
|
||||
Quiz = decodeQuizSummary raw?Quiz
|
||||
StartedAt = System.DateTimeOffset.Parse(raw?StartedAt: string)
|
||||
Questions = (unbox<obj[]> raw?Questions) |> Array.toList |> List.map decodeQuestionView }
|
||||
|
||||
let getAvailableQuizzes (token: string option) : Async<QuizSummary list> =
|
||||
async {
|
||||
let! raw = callApi token "GET" "/api/quizzes" None
|
||||
return (unbox<obj[]> raw) |> Array.toList |> List.map decodeQuizSummary
|
||||
}
|
||||
|
||||
let startAttempt (token: string option) (quizId: QuizId) : Async<Result<QuizForAttempt, string>> =
|
||||
async {
|
||||
let body = createObj [ "QuizId" ==> encQuizId quizId ]
|
||||
let! raw = callApi token "POST" "/api/quizzes/start" (Some body)
|
||||
return decodeResult decodeQuizForAttempt raw
|
||||
}
|
||||
|
||||
let getMyAttempts (token: string option) (quizId: QuizId) : Async<Result<MyAttemptSummary list, string>> =
|
||||
async {
|
||||
let body = createObj [ "QuizId" ==> encQuizId quizId ]
|
||||
let! raw = callApi token "POST" "/api/quizzes/my-attempts" (Some body)
|
||||
return decodeResult (fun r -> (unbox<obj[]> r) |> Array.toList |> List.map decodeMyAttemptSummary) raw
|
||||
}
|
||||
49
src/Client/Features/Quizzes/Browse/State.fs
Normal file
49
src/Client/Features/Quizzes/Browse/State.fs
Normal file
@@ -0,0 +1,49 @@
|
||||
module Client.Features.Quizzes.Browse.State
|
||||
|
||||
open Elmish
|
||||
open Client.Features.Quizzes.Browse.Types
|
||||
|
||||
let init () : Model * Cmd<Msg> = empty, Cmd.ofMsg Load
|
||||
|
||||
let private loadCmd (token: string option) =
|
||||
Cmd.OfAsync.either Api.getAvailableQuizzes token Loaded (fun ex -> LoadFailed ex.Message)
|
||||
|
||||
let update (token: string option) (msg: Msg) (model: Model) : Model * Cmd<Msg> =
|
||||
match msg with
|
||||
| Load -> { model with Loading = true; Error = None }, loadCmd token
|
||||
| Loaded quizzes -> { model with Quizzes = quizzes; Loading = false }, Cmd.none
|
||||
| LoadFailed err -> { model with Loading = false; Error = Some err }, Cmd.none
|
||||
| Start quizId ->
|
||||
let cmd =
|
||||
Cmd.OfAsync.either
|
||||
(Api.startAttempt token)
|
||||
quizId
|
||||
(function
|
||||
| Ok data -> Started data
|
||||
| Error err -> StartFailed err)
|
||||
(fun ex -> StartFailed ex.Message)
|
||||
|
||||
{ model with StartingQuizId = Some quizId; Error = None }, cmd
|
||||
| Started _ -> { model with StartingQuizId = None }, Cmd.none // handled by the parent, which switches pages
|
||||
| StartFailed err -> { model with StartingQuizId = None; Error = Some err }, Cmd.none
|
||||
| ToggleResults quizId ->
|
||||
if model.ExpandedResultsFor = Some quizId then
|
||||
{ model with ExpandedResultsFor = None }, Cmd.none
|
||||
else
|
||||
let cmd =
|
||||
Cmd.OfAsync.either
|
||||
(Api.getMyAttempts token)
|
||||
quizId
|
||||
(function
|
||||
| Ok results -> ResultsLoaded results
|
||||
| Error err -> ResultsLoadFailed err)
|
||||
(fun ex -> ResultsLoadFailed ex.Message)
|
||||
|
||||
{ model with
|
||||
ExpandedResultsFor = Some quizId
|
||||
ResultsLoading = true
|
||||
ResultsError = None
|
||||
Results = [] },
|
||||
cmd
|
||||
| ResultsLoaded results -> { model with Results = results; ResultsLoading = false }, Cmd.none
|
||||
| ResultsLoadFailed err -> { model with ResultsLoading = false; ResultsError = Some err }, Cmd.none
|
||||
37
src/Client/Features/Quizzes/Browse/Types.fs
Normal file
37
src/Client/Features/Quizzes/Browse/Types.fs
Normal file
@@ -0,0 +1,37 @@
|
||||
module Client.Features.Quizzes.Browse.Types
|
||||
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
|
||||
type Model =
|
||||
{ Quizzes: QuizSummary list
|
||||
Loading: bool
|
||||
Error: string option
|
||||
StartingQuizId: QuizId option
|
||||
/// Which quiz's past-attempts panel is currently expanded, if any —
|
||||
/// only one at a time, closing on a second click of the same button.
|
||||
ExpandedResultsFor: QuizId option
|
||||
ResultsLoading: bool
|
||||
ResultsError: string option
|
||||
Results: MyAttemptSummary list }
|
||||
|
||||
let empty =
|
||||
{ Quizzes = []
|
||||
Loading = false
|
||||
Error = None
|
||||
StartingQuizId = None
|
||||
ExpandedResultsFor = None
|
||||
ResultsLoading = false
|
||||
ResultsError = None
|
||||
Results = [] }
|
||||
|
||||
type Msg =
|
||||
| Load
|
||||
| Loaded of QuizSummary list
|
||||
| LoadFailed of string
|
||||
| Start of QuizId
|
||||
| Started of QuizForAttempt
|
||||
| StartFailed of string
|
||||
| ToggleResults of QuizId
|
||||
| ResultsLoaded of MyAttemptSummary list
|
||||
| ResultsLoadFailed of string
|
||||
143
src/Client/Features/Quizzes/Browse/View.fs
Normal file
143
src/Client/Features/Quizzes/Browse/View.fs
Normal file
@@ -0,0 +1,143 @@
|
||||
module Client.Features.Quizzes.Browse.View
|
||||
|
||||
open Feliz
|
||||
open Domain.Contracts
|
||||
open Client.Shared
|
||||
open Client.Features.Quizzes.Browse.Types
|
||||
|
||||
let private attemptRow (a: MyAttemptSummary) =
|
||||
Html.li [
|
||||
prop.key (string a.AttemptId)
|
||||
prop.className "attempt-row"
|
||||
prop.children [
|
||||
Html.span [
|
||||
prop.className "tag-mono"
|
||||
prop.text (a.StartedAt.ToLocalTime().ToString("dd.MM.yyyy HH:mm"))
|
||||
]
|
||||
Html.span [
|
||||
prop.className "score-value"
|
||||
prop.text (sprintf "%s / %s" (Format.points a.Score) (Format.points a.MaxScore))
|
||||
]
|
||||
match a.Passed with
|
||||
| Some true -> Html.span [ prop.className "grade-stamp passed"; prop.text "Пройден" ]
|
||||
| Some false -> Html.span [ prop.className "grade-stamp failed"; prop.text "Не пройден" ]
|
||||
| None -> Html.none
|
||||
]
|
||||
]
|
||||
|
||||
let private resultsPanel (model: Model) =
|
||||
Html.div [
|
||||
prop.className "results-panel"
|
||||
prop.children [
|
||||
match model.ResultsError with
|
||||
| Some err -> Html.p [ prop.className "error"; prop.text err ]
|
||||
| None -> Html.none
|
||||
if model.ResultsLoading then
|
||||
Html.p "Загрузка…"
|
||||
elif model.Results.IsEmpty then
|
||||
Html.p "Нет завершённых попыток"
|
||||
else
|
||||
Html.ul [ prop.children [ for a in model.Results -> attemptRow a ] ]
|
||||
]
|
||||
]
|
||||
|
||||
let view (model: Model) (dispatch: Msg -> unit) =
|
||||
Html.div [
|
||||
prop.className "quiz-list-page"
|
||||
prop.children [
|
||||
Html.h2 "Доступные тесты"
|
||||
match model.Error with
|
||||
| Some err -> Html.p [ prop.className "error"; prop.text err ]
|
||||
| None -> Html.none
|
||||
if model.Loading then
|
||||
Html.p "Загрузка…"
|
||||
elif model.Quizzes.IsEmpty then
|
||||
Html.p "Тесты недоступны"
|
||||
else
|
||||
Html.ul [
|
||||
prop.children [
|
||||
for quiz in model.Quizzes ->
|
||||
let remainingAttempts =
|
||||
quiz.MaxAttempts |> Option.map (fun m -> System.Math.Max(0, m - quiz.AttemptsCount))
|
||||
|
||||
Html.li [
|
||||
prop.key (string quiz.Id)
|
||||
prop.className "quiz-card"
|
||||
prop.children [
|
||||
Html.h3 quiz.Title
|
||||
Html.p quiz.Description
|
||||
Html.div [
|
||||
prop.className "meta-row"
|
||||
prop.children [
|
||||
Html.div [
|
||||
prop.className "meta-item"
|
||||
prop.children [
|
||||
Html.span [ prop.className "meta-label"; prop.text "Баллов" ]
|
||||
Html.span [
|
||||
prop.className "meta-value"
|
||||
prop.text (Format.points quiz.TotalPoints)
|
||||
]
|
||||
]
|
||||
]
|
||||
match quiz.TimeLimitMinutes with
|
||||
| Some minutes ->
|
||||
Html.div [
|
||||
prop.className "meta-item"
|
||||
prop.children [
|
||||
Html.span [ prop.className "meta-label"; prop.text "Лимит времени" ]
|
||||
Html.span [
|
||||
prop.className "meta-value"
|
||||
prop.text (sprintf "%d мин" minutes)
|
||||
]
|
||||
]
|
||||
]
|
||||
| None -> Html.none
|
||||
match quiz.MaxAttempts, remainingAttempts with
|
||||
| Some maxAttempts, Some remaining ->
|
||||
Html.div [
|
||||
prop.className "meta-item"
|
||||
prop.children [
|
||||
Html.span [ prop.className "meta-label"; prop.text "Осталось попыток" ]
|
||||
Html.span [
|
||||
prop.className "meta-value"
|
||||
prop.text (sprintf "%d из %d" remaining maxAttempts)
|
||||
]
|
||||
]
|
||||
]
|
||||
| _ -> Html.none
|
||||
]
|
||||
]
|
||||
if quiz.AlreadyPassed then
|
||||
Html.span [ prop.className "status-badge active"; prop.text "Тест пройден успешно" ]
|
||||
elif remainingAttempts = Some 0 then
|
||||
Html.p [ prop.className "hint"; prop.text "Попытки исчерпаны" ]
|
||||
else
|
||||
Html.button [
|
||||
prop.disabled (model.StartingQuizId = Some quiz.Id)
|
||||
prop.onClick (fun _ -> dispatch (Start quiz.Id))
|
||||
prop.text (
|
||||
if model.StartingQuizId = Some quiz.Id then
|
||||
"Запуск…"
|
||||
else
|
||||
"Начать тест"
|
||||
)
|
||||
]
|
||||
if quiz.AttemptsCount > 0 then
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun _ -> dispatch (ToggleResults quiz.Id))
|
||||
prop.text (
|
||||
if model.ExpandedResultsFor = Some quiz.Id then
|
||||
"Скрыть результаты"
|
||||
else
|
||||
sprintf "Посмотреть результаты (%d)" quiz.AttemptsCount
|
||||
)
|
||||
]
|
||||
if model.ExpandedResultsFor = Some quiz.Id then
|
||||
resultsPanel model
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
47
src/Client/Features/Quizzes/TakeQuiz/Api.fs
Normal file
47
src/Client/Features/Quizzes/TakeQuiz/Api.fs
Normal file
@@ -0,0 +1,47 @@
|
||||
module Client.Features.Quizzes.TakeQuiz.Api
|
||||
|
||||
open Fable.Core.JsInterop
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
open Client.Shared.JsonWire
|
||||
|
||||
let private encResponse (response: StudentResponse) : obj =
|
||||
match response with
|
||||
| SingleChoiceResponse opt -> createObj [ "SingleChoiceResponse" ==> optToJs encOptionId opt ]
|
||||
| MultipleChoiceResponse opts -> createObj [ "MultipleChoiceResponse" ==> (opts |> Set.toArray |> Array.map encOptionId) ]
|
||||
| TrueFalseResponse opt -> createObj [ "TrueFalseResponse" ==> optToJs box opt ]
|
||||
| ShortAnswerResponse text -> createObj [ "ShortAnswerResponse" ==> box text ]
|
||||
| NumericResponse opt -> createObj [ "NumericResponse" ==> optToJs box opt ]
|
||||
|
||||
let private decodeAttemptResult (raw: obj) : AttemptResult =
|
||||
{ AttemptId = decAttemptId raw?AttemptId
|
||||
Score = raw?Score
|
||||
MaxScore = raw?MaxScore
|
||||
Passed = raw?Passed |> optDec unbox<bool> }
|
||||
|
||||
let submitAnswer (token: string option) (req: SubmitAnswerRequest) : Async<Result<unit, string>> =
|
||||
async {
|
||||
let body =
|
||||
createObj [
|
||||
"AttemptId" ==> encAttemptId req.AttemptId
|
||||
"QuestionId" ==> encQuestionId req.QuestionId
|
||||
"Response" ==> encResponse req.Response
|
||||
]
|
||||
|
||||
let! raw = callApi token "POST" "/api/attempts/answer" (Some body)
|
||||
return decodeResult (fun _ -> ()) raw
|
||||
}
|
||||
|
||||
let finishAttempt (token: string option) (attemptId: AttemptId) : Async<Result<AttemptResult, string>> =
|
||||
async {
|
||||
let body = createObj [ "AttemptId" ==> encAttemptId attemptId ]
|
||||
let! raw = callApi token "POST" "/api/attempts/finish" (Some body)
|
||||
return decodeResult decodeAttemptResult raw
|
||||
}
|
||||
|
||||
let reportFocusLoss (token: string option) (attemptId: AttemptId) : Async<Result<unit, string>> =
|
||||
async {
|
||||
let body = createObj [ "AttemptId" ==> encAttemptId attemptId ]
|
||||
let! raw = callApi token "POST" "/api/attempts/focus-loss" (Some body)
|
||||
return decodeResult (fun _ -> ()) raw
|
||||
}
|
||||
111
src/Client/Features/Quizzes/TakeQuiz/State.fs
Normal file
111
src/Client/Features/Quizzes/TakeQuiz/State.fs
Normal file
@@ -0,0 +1,111 @@
|
||||
module Client.Features.Quizzes.TakeQuiz.State
|
||||
|
||||
open System
|
||||
open Elmish
|
||||
open Fable.Core
|
||||
open Browser.Dom
|
||||
open Domain.Contracts
|
||||
open Client.Features.Quizzes.TakeQuiz.Types
|
||||
|
||||
/// Ticks once a second for as long as the browser tab showing this page is
|
||||
/// open. Nothing ever cancels the underlying `setInterval` (there's no page
|
||||
/// lifecycle hook to hang it off in this app's minimal Elmish wiring) — once
|
||||
/// the student finishes and the parent switches away from this page, these
|
||||
/// dispatches just stop matching any case in `App.State.update` and are
|
||||
/// silently dropped, so the only cost is a harmless once-a-second no-op.
|
||||
let startTicking () : Cmd<Msg> = Cmd.ofEffect (fun dispatch -> JS.setInterval (fun () -> dispatch Tick) 1000 |> ignore)
|
||||
|
||||
/// Listens from the moment the attempt page mounts (matching DESIGN.md §3.6 —
|
||||
/// a student who wanders off before answering anything still counts).
|
||||
/// `blur`/`focus` catch switching to another window over the same tab;
|
||||
/// `visibilitychange` catches switching tabs or minimizing. Both can fire for
|
||||
/// the same departure, so `FocusLost`/`FocusRegained` in `update` de-dupe via
|
||||
/// `AwayFromFocus` rather than reporting on every event.
|
||||
let attachFocusTracking () : Cmd<Msg> =
|
||||
Cmd.ofEffect (fun dispatch ->
|
||||
document.addEventListener (
|
||||
"visibilitychange",
|
||||
fun _ -> dispatch (if document.hidden then FocusLost else FocusRegained)
|
||||
)
|
||||
|
||||
window.addEventListener ("blur", fun _ -> dispatch FocusLost)
|
||||
window.addEventListener ("focus", fun _ -> dispatch FocusRegained))
|
||||
|
||||
let rec update (token: string option) (msg: Msg) (model: Model) : Model * Cmd<Msg> =
|
||||
match msg with
|
||||
| AnswerChanged(questionId, response) ->
|
||||
let updated = { model with Answers = model.Answers |> Map.add questionId response }
|
||||
|
||||
let request: SubmitAnswerRequest =
|
||||
{ AttemptId = model.Data.AttemptId
|
||||
QuestionId = questionId
|
||||
Response = response }
|
||||
|
||||
let cmd =
|
||||
Cmd.OfAsync.either
|
||||
(Api.submitAnswer token)
|
||||
request
|
||||
(function
|
||||
| Ok() -> AnswerSaved questionId
|
||||
| Error err -> AnswerSaveFailed(questionId, err))
|
||||
(fun ex -> AnswerSaveFailed(questionId, ex.Message))
|
||||
|
||||
updated, cmd
|
||||
| AnswerSaved _ -> { model with Error = None }, Cmd.none
|
||||
| AnswerSaveFailed(_, err) -> { model with Error = Some err }, Cmd.none
|
||||
| Tick ->
|
||||
let updated = { model with RemainingSeconds = remainingSeconds model.Data DateTimeOffset.UtcNow }
|
||||
// The server is the actual authority (it now rejects any answer
|
||||
// submitted past the deadline — see `SubmitAnswer.fs`); this just
|
||||
// saves the student a click once their own countdown reaches zero,
|
||||
// instead of leaving them stuck looking at a page that silently
|
||||
// stopped accepting changes.
|
||||
if updated.RemainingSeconds = Some 0 && not updated.IsFinishing then
|
||||
update token Finish updated
|
||||
// Backstop for `FocusLost`/`FocusRegained` below: `blur` and
|
||||
// `visibilitychange` are supposed to fire on every departure, but in
|
||||
// practice they can be unreliable — e.g. switching windows inside a
|
||||
// remote-desktop session doesn't always deliver them to the page.
|
||||
// `document.hasFocus()` is a direct, synchronous ground-truth check
|
||||
// that doesn't depend on any event actually being dispatched, so
|
||||
// piggybacking it onto the once-a-second tick catches a departure
|
||||
// within ~1s even when the events themselves go missing.
|
||||
elif not (document.hasFocus ()) && not updated.AwayFromFocus then
|
||||
update token FocusLost updated
|
||||
elif document.hasFocus () && updated.AwayFromFocus then
|
||||
update token FocusRegained updated
|
||||
else
|
||||
updated, Cmd.none
|
||||
| FocusLost ->
|
||||
if model.AwayFromFocus then
|
||||
model, Cmd.none
|
||||
else
|
||||
// Best-effort: whether this ping succeeds or fails, the student
|
||||
// shouldn't see an error banner over something that isn't their
|
||||
// action — the teacher-facing count is server-side and this is
|
||||
// just one report of it.
|
||||
let cmd =
|
||||
Cmd.OfAsync.either
|
||||
(Api.reportFocusLoss token)
|
||||
model.Data.AttemptId
|
||||
(fun _ -> FocusLossReported)
|
||||
(fun _ -> FocusLossReported)
|
||||
|
||||
{ model with AwayFromFocus = true }, cmd
|
||||
| FocusRegained -> { model with AwayFromFocus = false }, Cmd.none
|
||||
| FocusLossReported -> model, Cmd.none
|
||||
| Finish ->
|
||||
let updated = { model with IsFinishing = true }
|
||||
|
||||
let cmd =
|
||||
Cmd.OfAsync.either
|
||||
(Api.finishAttempt token)
|
||||
model.Data.AttemptId
|
||||
(function
|
||||
| Ok result -> Finished result
|
||||
| Error err -> FinishFailed err)
|
||||
(fun ex -> FinishFailed ex.Message)
|
||||
|
||||
updated, cmd
|
||||
| Finished _ -> model, Cmd.none // handled by the parent, which switches pages
|
||||
| FinishFailed err -> { model with Error = Some err; IsFinishing = false }, Cmd.none
|
||||
48
src/Client/Features/Quizzes/TakeQuiz/Types.fs
Normal file
48
src/Client/Features/Quizzes/TakeQuiz/Types.fs
Normal file
@@ -0,0 +1,48 @@
|
||||
module Client.Features.Quizzes.TakeQuiz.Types
|
||||
|
||||
open System
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
|
||||
/// Seconds left until `data.Quiz.TimeLimitMinutes` runs out, as of `now` —
|
||||
/// `None` when the quiz has no time limit at all. The server is the actual
|
||||
/// authority on the deadline (`SubmitAnswer.fs` rejects late answers, the
|
||||
/// background sweeper grades abandoned attempts) — this is purely a display
|
||||
/// convenience so the student doesn't need to guess.
|
||||
let remainingSeconds (data: QuizForAttempt) (now: DateTimeOffset) : int option =
|
||||
data.Quiz.TimeLimitMinutes
|
||||
|> Option.map (fun minutes ->
|
||||
let deadline = data.StartedAt.AddMinutes(float minutes)
|
||||
max 0 (int (ceil (deadline - now).TotalSeconds)))
|
||||
|
||||
type Model =
|
||||
{ Data: QuizForAttempt
|
||||
Answers: Map<QuestionId, StudentResponse>
|
||||
Error: string option
|
||||
IsFinishing: bool
|
||||
RemainingSeconds: int option
|
||||
/// True for as long as the tab has been away (hidden or unfocused)
|
||||
/// since the last time it came back — guards against counting the same
|
||||
/// departure twice from `blur` and `visibilitychange` both firing, and
|
||||
/// against re-reporting every tick while the student is still away.
|
||||
AwayFromFocus: bool }
|
||||
|
||||
let init (data: QuizForAttempt) : Model =
|
||||
{ Data = data
|
||||
Answers = Map.empty
|
||||
Error = None
|
||||
IsFinishing = false
|
||||
RemainingSeconds = remainingSeconds data DateTimeOffset.UtcNow
|
||||
AwayFromFocus = false }
|
||||
|
||||
type Msg =
|
||||
| AnswerChanged of QuestionId * StudentResponse
|
||||
| AnswerSaved of QuestionId
|
||||
| AnswerSaveFailed of QuestionId * string
|
||||
| Tick
|
||||
| FocusLost
|
||||
| FocusRegained
|
||||
| FocusLossReported
|
||||
| Finish
|
||||
| Finished of AttemptResult
|
||||
| FinishFailed of string
|
||||
159
src/Client/Features/Quizzes/TakeQuiz/View.fs
Normal file
159
src/Client/Features/Quizzes/TakeQuiz/View.fs
Normal file
@@ -0,0 +1,159 @@
|
||||
module Client.Features.Quizzes.TakeQuiz.View
|
||||
|
||||
open Feliz
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
open Client.Features.Quizzes.TakeQuiz.Types
|
||||
|
||||
let private questionView (answers: Map<QuestionId, StudentResponse>) dispatch (index: int) (question: QuestionView) =
|
||||
let groupName = string question.Id
|
||||
|
||||
let body =
|
||||
match question.Kind with
|
||||
| SingleChoiceView options ->
|
||||
let selected =
|
||||
match answers.TryFind question.Id with
|
||||
| Some(SingleChoiceResponse opt) -> opt
|
||||
| _ -> None
|
||||
|
||||
Html.div [
|
||||
for optionId, text in options ->
|
||||
let isSelected = selected = Some optionId
|
||||
|
||||
Html.label [
|
||||
prop.className "option"
|
||||
prop.children [
|
||||
Html.input [
|
||||
prop.type'.radio
|
||||
prop.name groupName
|
||||
prop.isChecked isSelected
|
||||
prop.onChange (fun (_: bool) ->
|
||||
dispatch (AnswerChanged(question.Id, SingleChoiceResponse(Some optionId))))
|
||||
]
|
||||
Html.text text
|
||||
]
|
||||
]
|
||||
]
|
||||
| MultipleChoiceView options ->
|
||||
let selected =
|
||||
match answers.TryFind question.Id with
|
||||
| Some(MultipleChoiceResponse opts) -> opts
|
||||
| _ -> Set.empty
|
||||
|
||||
Html.div [
|
||||
for optionId, text in options ->
|
||||
Html.label [
|
||||
prop.className "option"
|
||||
prop.children [
|
||||
Html.input [
|
||||
prop.type'.checkbox
|
||||
prop.isChecked (selected.Contains optionId)
|
||||
prop.onChange (fun (checked': bool) ->
|
||||
let next =
|
||||
if checked' then selected.Add optionId else selected.Remove optionId
|
||||
|
||||
dispatch (AnswerChanged(question.Id, MultipleChoiceResponse next)))
|
||||
]
|
||||
Html.text text
|
||||
]
|
||||
]
|
||||
]
|
||||
| TrueFalseView ->
|
||||
let selected =
|
||||
match answers.TryFind question.Id with
|
||||
| Some(TrueFalseResponse v) -> v
|
||||
| _ -> None
|
||||
|
||||
Html.div [
|
||||
for value, text in [ true, "Верно"; false, "Неверно" ] ->
|
||||
let isSelected = selected = Some value
|
||||
|
||||
Html.label [
|
||||
prop.className "option"
|
||||
prop.children [
|
||||
Html.input [
|
||||
prop.type'.radio
|
||||
prop.name groupName
|
||||
prop.isChecked isSelected
|
||||
prop.onChange (fun (_: bool) ->
|
||||
dispatch (AnswerChanged(question.Id, TrueFalseResponse(Some value))))
|
||||
]
|
||||
Html.text text
|
||||
]
|
||||
]
|
||||
]
|
||||
| ShortAnswerView ->
|
||||
let text =
|
||||
match answers.TryFind question.Id with
|
||||
| Some(ShortAnswerResponse t) -> t
|
||||
| _ -> ""
|
||||
|
||||
Html.input [
|
||||
prop.type'.text
|
||||
prop.value text
|
||||
prop.onChange (fun (v: string) -> dispatch (AnswerChanged(question.Id, ShortAnswerResponse v)))
|
||||
]
|
||||
| NumericView ->
|
||||
let text =
|
||||
match answers.TryFind question.Id with
|
||||
| Some(NumericResponse(Some v)) -> string v
|
||||
| _ -> ""
|
||||
|
||||
Html.input [
|
||||
prop.type'.number
|
||||
prop.value text
|
||||
prop.onChange (fun (v: string) ->
|
||||
let parsed =
|
||||
match System.Double.TryParse v with
|
||||
| true, n -> Some n
|
||||
| false, _ -> None
|
||||
|
||||
dispatch (AnswerChanged(question.Id, NumericResponse parsed)))
|
||||
]
|
||||
|
||||
Html.div [
|
||||
prop.key (string question.Id)
|
||||
prop.className "question"
|
||||
prop.children [
|
||||
Html.span [ prop.className "question-number"; prop.text (sprintf "№ %02d" (index + 1)) ]
|
||||
Html.div [
|
||||
prop.className "question-body"
|
||||
prop.children [ Html.p [ prop.className "question-text"; prop.text question.Text ]; body ]
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
let private timeRemainingBadge (seconds: int) =
|
||||
Html.span [
|
||||
prop.className (if seconds <= 60 then "time-remaining low" else "time-remaining")
|
||||
prop.text (sprintf "Осталось времени: %02d:%02d" (seconds / 60) (seconds % 60))
|
||||
]
|
||||
|
||||
let view (model: Model) (dispatch: Msg -> unit) =
|
||||
Html.div [
|
||||
prop.className "taking-quiz-page"
|
||||
prop.children [
|
||||
Html.h2 model.Data.Quiz.Title
|
||||
match model.Error with
|
||||
| Some err -> Html.p [ prop.className "error"; prop.text err ]
|
||||
| None -> Html.none
|
||||
Html.div [
|
||||
prop.children (model.Data.Questions |> List.mapi (questionView model.Answers dispatch))
|
||||
]
|
||||
Html.div [
|
||||
prop.className "quiz-actions"
|
||||
prop.children [
|
||||
match model.RemainingSeconds with
|
||||
| Some seconds when seconds = 0 ->
|
||||
Html.span [ prop.className "time-remaining low"; prop.text "Время вышло" ]
|
||||
| Some seconds -> timeRemainingBadge seconds
|
||||
| None -> Html.none
|
||||
Html.button [
|
||||
prop.disabled model.IsFinishing
|
||||
prop.onClick (fun _ -> dispatch Finish)
|
||||
prop.text (if model.IsFinishing then "Завершение…" else "Завершить тест")
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
24
src/Client/Features/Quizzes/ViewResult/View.fs
Normal file
24
src/Client/Features/Quizzes/ViewResult/View.fs
Normal file
@@ -0,0 +1,24 @@
|
||||
module Client.Features.Quizzes.ViewResult.View
|
||||
|
||||
open Feliz
|
||||
open Domain.Contracts
|
||||
open Client.Shared
|
||||
|
||||
/// Small enough that it doesn't need its own Types/State — it only ever
|
||||
/// dispatches the parent's "go back to the quiz list" message.
|
||||
let view (result: AttemptResult) (onBackToQuizList: unit -> unit) =
|
||||
Html.div [
|
||||
prop.className "result-page"
|
||||
prop.children [
|
||||
Html.h2 "Результат"
|
||||
match result.Passed with
|
||||
| Some true -> Html.div [ prop.className "grade-stamp passed"; prop.text "Тест пройден" ]
|
||||
| Some false -> Html.div [ prop.className "grade-stamp failed"; prop.text "Тест не пройден" ]
|
||||
| None -> Html.none
|
||||
Html.span [
|
||||
prop.className "score-value"
|
||||
prop.text (sprintf "%s / %s" (Format.points result.Score) (Format.points result.MaxScore))
|
||||
]
|
||||
Html.button [ prop.onClick (fun _ -> onBackToQuizList ()); prop.text "К списку тестов" ]
|
||||
]
|
||||
]
|
||||
50
src/Client/Features/Teacher/Home/State.fs
Normal file
50
src/Client/Features/Teacher/Home/State.fs
Normal file
@@ -0,0 +1,50 @@
|
||||
module Client.Features.Teacher.Home.State
|
||||
|
||||
open Elmish
|
||||
open Domain
|
||||
open Client.Features
|
||||
open Client.Features.Teacher.Home.Types
|
||||
|
||||
/// `role` decides whether the Admin-only "Пользователи" tab is shown/loaded —
|
||||
/// Teacher and Admin otherwise share this exact same page (see DESIGN.md §2:
|
||||
/// Admin = Teacher + user management).
|
||||
let init (role: Role) : Model * Cmd<Msg> =
|
||||
let questionsModel, questionsCmd = Teacher.Questions.State.init ()
|
||||
let testsModel, testsCmd = Teacher.Tests.State.init ()
|
||||
|
||||
let usersCmd =
|
||||
match role with
|
||||
| Admin -> Cmd.map UsersMsg (Cmd.ofMsg Admin.Users.Types.LoadUsers)
|
||||
| Teacher
|
||||
| Student -> Cmd.none
|
||||
|
||||
{ Tab = QuestionsTab
|
||||
Role = role
|
||||
Questions = questionsModel
|
||||
Tests = testsModel
|
||||
Users = Admin.Users.Types.empty },
|
||||
Cmd.batch [ Cmd.map QuestionsMsg questionsCmd; Cmd.map TestsMsg testsCmd; usersCmd ]
|
||||
|
||||
let update (token: string option) (msg: Msg) (model: Model) : Model * Cmd<Msg> =
|
||||
match msg with
|
||||
| SwitchTab tab -> { model with Tab = tab }, Cmd.none
|
||||
| QuestionsMsg(Teacher.Questions.Types.TopicCreated topic as subMsg) ->
|
||||
let m, cmd = Teacher.Questions.State.update token subMsg model.Questions
|
||||
|
||||
{ model with
|
||||
Questions = m
|
||||
// Questions and Tests keep independent `Topics` lists (own VSA
|
||||
// slices, own `LoadTopics` on init) — a topic created in one
|
||||
// must be mirrored into the other, or the quiz question-picker
|
||||
// never sees topics added after the page first loaded.
|
||||
Tests = { model.Tests with Topics = model.Tests.Topics @ [ topic ] } },
|
||||
Cmd.map QuestionsMsg cmd
|
||||
| QuestionsMsg subMsg ->
|
||||
let m, cmd = Teacher.Questions.State.update token subMsg model.Questions
|
||||
{ model with Questions = m }, Cmd.map QuestionsMsg cmd
|
||||
| TestsMsg subMsg ->
|
||||
let m, cmd = Teacher.Tests.State.update token subMsg model.Tests
|
||||
{ model with Tests = m }, Cmd.map TestsMsg cmd
|
||||
| UsersMsg subMsg ->
|
||||
let m, cmd = Admin.Users.State.update token subMsg model.Users
|
||||
{ model with Users = m }, Cmd.map UsersMsg cmd
|
||||
22
src/Client/Features/Teacher/Home/Types.fs
Normal file
22
src/Client/Features/Teacher/Home/Types.fs
Normal file
@@ -0,0 +1,22 @@
|
||||
module Client.Features.Teacher.Home.Types
|
||||
|
||||
open Domain
|
||||
open Client.Features
|
||||
|
||||
type Tab =
|
||||
| QuestionsTab
|
||||
| TestsTab
|
||||
| UsersTab
|
||||
|
||||
type Model =
|
||||
{ Tab: Tab
|
||||
Role: Role
|
||||
Questions: Teacher.Questions.Types.Model
|
||||
Tests: Teacher.Tests.Types.Model
|
||||
Users: Admin.Users.Types.Model }
|
||||
|
||||
type Msg =
|
||||
| SwitchTab of Tab
|
||||
| QuestionsMsg of Teacher.Questions.Types.Msg
|
||||
| TestsMsg of Teacher.Tests.Types.Msg
|
||||
| UsersMsg of Admin.Users.Types.Msg
|
||||
33
src/Client/Features/Teacher/Home/View.fs
Normal file
33
src/Client/Features/Teacher/Home/View.fs
Normal file
@@ -0,0 +1,33 @@
|
||||
module Client.Features.Teacher.Home.View
|
||||
|
||||
open Feliz
|
||||
open Domain
|
||||
open Client.Features
|
||||
open Client.Features.Teacher.Home.Types
|
||||
|
||||
let private tabButton (current: Tab) (tab: Tab) (label: string) dispatch =
|
||||
Html.button [
|
||||
prop.className (if current = tab then "tab-button active" else "tab-button")
|
||||
prop.onClick (fun _ -> dispatch (SwitchTab tab))
|
||||
prop.text label
|
||||
]
|
||||
|
||||
let view (model: Model) (dispatch: Msg -> unit) =
|
||||
Html.div [
|
||||
prop.className "teacher-home"
|
||||
prop.children [
|
||||
Html.div [
|
||||
prop.className "tabs"
|
||||
prop.children [
|
||||
tabButton model.Tab QuestionsTab "Вопросы" dispatch
|
||||
tabButton model.Tab TestsTab "Тесты" dispatch
|
||||
if model.Role = Admin then
|
||||
tabButton model.Tab UsersTab "Пользователи" dispatch
|
||||
]
|
||||
]
|
||||
match model.Tab with
|
||||
| QuestionsTab -> Teacher.Questions.View.view model.Questions (QuestionsMsg >> dispatch)
|
||||
| TestsTab -> Teacher.Tests.View.view model.Tests (TestsMsg >> dispatch)
|
||||
| UsersTab -> Admin.Users.View.view model.Users (UsersMsg >> dispatch)
|
||||
]
|
||||
]
|
||||
136
src/Client/Features/Teacher/Questions/Api.fs
Normal file
136
src/Client/Features/Teacher/Questions/Api.fs
Normal file
@@ -0,0 +1,136 @@
|
||||
module Client.Features.Teacher.Questions.Api
|
||||
|
||||
open Fable.Core.JsInterop
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
open Client.Shared.JsonWire
|
||||
|
||||
let private decodeTopic (raw: obj) : Topic =
|
||||
{ Id = decTopicId raw?Id
|
||||
OwnerId = decUserId raw?OwnerId
|
||||
Name = raw?Name }
|
||||
|
||||
let private encQuestionOption (o: QuestionOption) : obj =
|
||||
createObj [ "Id" ==> encOptionId o.Id; "Text" ==> box o.Text ]
|
||||
|
||||
let private decQuestionOption (raw: obj) : QuestionOption =
|
||||
{ Id = decOptionId raw?Id; Text = raw?Text }
|
||||
|
||||
let private encQuestionTypeView (t: QuestionTypeView) : obj =
|
||||
match t with
|
||||
| SingleChoiceT d ->
|
||||
createObj [
|
||||
"SingleChoiceT"
|
||||
==> createObj [
|
||||
"Options" ==> (d.Options |> List.map encQuestionOption |> List.toArray)
|
||||
"CorrectOptionId" ==> encOptionId d.CorrectOptionId
|
||||
]
|
||||
]
|
||||
| MultipleChoiceT d ->
|
||||
createObj [
|
||||
"MultipleChoiceT"
|
||||
==> createObj [
|
||||
"Options" ==> (d.Options |> List.map encQuestionOption |> List.toArray)
|
||||
"CorrectOptionIds" ==> (d.CorrectOptionIds |> List.map encOptionId |> List.toArray)
|
||||
]
|
||||
]
|
||||
| TrueFalseT b -> createObj [ "TrueFalseT" ==> box b ]
|
||||
| ShortAnswerT d ->
|
||||
createObj [
|
||||
"ShortAnswerT"
|
||||
==> createObj [
|
||||
"AcceptedAnswers" ==> (d.AcceptedAnswers |> List.toArray)
|
||||
"CaseSensitive" ==> box d.CaseSensitive
|
||||
]
|
||||
]
|
||||
| NumericT d ->
|
||||
createObj [ "NumericT" ==> createObj [ "CorrectValue" ==> box d.CorrectValue; "Tolerance" ==> box d.Tolerance ] ]
|
||||
|
||||
let private decodeQuestionTypeView (raw: obj) : QuestionTypeView =
|
||||
if not (isNullOrUndefined raw?SingleChoiceT) then
|
||||
let d = raw?SingleChoiceT
|
||||
|
||||
SingleChoiceT
|
||||
{ Options = (unbox<obj[]> d?Options) |> Array.toList |> List.map decQuestionOption
|
||||
CorrectOptionId = decOptionId d?CorrectOptionId }
|
||||
elif not (isNullOrUndefined raw?MultipleChoiceT) then
|
||||
let d = raw?MultipleChoiceT
|
||||
|
||||
MultipleChoiceT
|
||||
{ Options = (unbox<obj[]> d?Options) |> Array.toList |> List.map decQuestionOption
|
||||
CorrectOptionIds = (unbox<obj[]> d?CorrectOptionIds) |> Array.toList |> List.map decOptionId }
|
||||
elif not (isNullOrUndefined raw?TrueFalseT) then
|
||||
TrueFalseT(unbox<bool> raw?TrueFalseT)
|
||||
elif not (isNullOrUndefined raw?ShortAnswerT) then
|
||||
let d = raw?ShortAnswerT
|
||||
|
||||
ShortAnswerT
|
||||
{ AcceptedAnswers = (unbox<obj[]> d?AcceptedAnswers) |> Array.toList |> List.map unbox<string>
|
||||
CaseSensitive = unbox<bool> d?CaseSensitive }
|
||||
elif not (isNullOrUndefined raw?NumericT) then
|
||||
let d = raw?NumericT
|
||||
NumericT { CorrectValue = d?CorrectValue; Tolerance = d?Tolerance }
|
||||
else
|
||||
failwith "Неизвестный тип вопроса"
|
||||
|
||||
let private decodeQuestionSummary (raw: obj) : QuestionSummary =
|
||||
{ Id = decQuestionId raw?Id
|
||||
TopicId = decTopicId raw?TopicId
|
||||
Text = raw?Text
|
||||
Points = raw?Points
|
||||
Type = decodeQuestionTypeView raw?Type }
|
||||
|
||||
let listTopics (token: string option) : Async<Result<Topic list, string>> =
|
||||
async {
|
||||
let! raw = callApi token "GET" "/api/teacher/topics" None
|
||||
return decodeResult (fun r -> (unbox<obj[]> r) |> Array.toList |> List.map decodeTopic) raw
|
||||
}
|
||||
|
||||
let createTopic (token: string option) (name: string) : Async<Result<Topic, string>> =
|
||||
async {
|
||||
let body = createObj [ "Name" ==> box name ]
|
||||
let! raw = callApi token "POST" "/api/teacher/topics" (Some body)
|
||||
return decodeResult decodeTopic raw
|
||||
}
|
||||
|
||||
let listQuestions (token: string option) (topicId: TopicId) : Async<Result<QuestionSummary list, string>> =
|
||||
async {
|
||||
let body = createObj [ "TopicId" ==> encTopicId topicId ]
|
||||
let! raw = callApi token "POST" "/api/teacher/questions/list" (Some body)
|
||||
return decodeResult (fun r -> (unbox<obj[]> r) |> Array.toList |> List.map decodeQuestionSummary) raw
|
||||
}
|
||||
|
||||
let createQuestion (token: string option) (req: CreateQuestionRequest) : Async<Result<QuestionSummary, string>> =
|
||||
async {
|
||||
let body =
|
||||
createObj [
|
||||
"TopicId" ==> encTopicId req.TopicId
|
||||
"Text" ==> box req.Text
|
||||
"Points" ==> box req.Points
|
||||
"Type" ==> encQuestionTypeView req.Type
|
||||
]
|
||||
|
||||
let! raw = callApi token "POST" "/api/teacher/questions" (Some body)
|
||||
return decodeResult decodeQuestionSummary raw
|
||||
}
|
||||
|
||||
let updateQuestion (token: string option) (req: UpdateQuestionRequest) : Async<Result<QuestionSummary, string>> =
|
||||
async {
|
||||
let body =
|
||||
createObj [
|
||||
"QuestionId" ==> encQuestionId req.QuestionId
|
||||
"Text" ==> box req.Text
|
||||
"Points" ==> box req.Points
|
||||
"Type" ==> encQuestionTypeView req.Type
|
||||
]
|
||||
|
||||
let! raw = callApi token "POST" "/api/teacher/questions/update" (Some body)
|
||||
return decodeResult decodeQuestionSummary raw
|
||||
}
|
||||
|
||||
let deleteQuestion (token: string option) (questionId: QuestionId) : Async<Result<unit, string>> =
|
||||
async {
|
||||
let body = createObj [ "QuestionId" ==> encQuestionId questionId ]
|
||||
let! raw = callApi token "POST" "/api/teacher/questions/delete" (Some body)
|
||||
return decodeResult (fun _ -> ()) raw
|
||||
}
|
||||
265
src/Client/Features/Teacher/Questions/State.fs
Normal file
265
src/Client/Features/Teacher/Questions/State.fs
Normal file
@@ -0,0 +1,265 @@
|
||||
module Client.Features.Teacher.Questions.State
|
||||
|
||||
open Elmish
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
open Client.Features.Teacher.Questions.Types
|
||||
|
||||
let init () : Model * Cmd<Msg> = empty, Cmd.ofMsg LoadTopics
|
||||
|
||||
let private buildRequest (topicId: TopicId) (form: NewQuestionForm) : Result<CreateQuestionRequest, string> =
|
||||
match System.Double.TryParse form.Points with
|
||||
| false, _ -> Error "Баллы должны быть числом"
|
||||
| true, points ->
|
||||
let nonEmptyOptions () =
|
||||
form.Options
|
||||
|> List.filter (fun o -> not (System.String.IsNullOrWhiteSpace o.Text))
|
||||
|> List.map (fun o -> { Id = o.Id; Text = o.Text }: QuestionOption)
|
||||
|
||||
match form.Kind with
|
||||
| KSingleChoice ->
|
||||
let options = nonEmptyOptions ()
|
||||
|
||||
match form.CorrectSingle with
|
||||
| Some correctId when options |> List.exists (fun o -> o.Id = correctId) ->
|
||||
Ok
|
||||
{ TopicId = topicId
|
||||
Text = form.Text
|
||||
Points = points
|
||||
Type = SingleChoiceT { Options = options; CorrectOptionId = correctId } }
|
||||
| _ -> Error "Выберите правильный вариант ответа"
|
||||
| KMultipleChoice ->
|
||||
let options = nonEmptyOptions ()
|
||||
|
||||
if form.CorrectMultiple.IsEmpty then
|
||||
Error "Выберите хотя бы один правильный вариант"
|
||||
else
|
||||
Ok
|
||||
{ TopicId = topicId
|
||||
Text = form.Text
|
||||
Points = points
|
||||
Type = MultipleChoiceT { Options = options; CorrectOptionIds = Set.toList form.CorrectMultiple } }
|
||||
| KTrueFalse ->
|
||||
Ok { TopicId = topicId; Text = form.Text; Points = points; Type = TrueFalseT form.CorrectBool }
|
||||
| KShortAnswer ->
|
||||
let accepted =
|
||||
form.AcceptedAnswersText.Split(',')
|
||||
|> Array.map (fun s -> s.Trim())
|
||||
|> Array.filter (fun s -> s <> "")
|
||||
|> Array.toList
|
||||
|
||||
if accepted.IsEmpty then
|
||||
Error "Укажите хотя бы один допустимый ответ"
|
||||
else
|
||||
Ok
|
||||
{ TopicId = topicId
|
||||
Text = form.Text
|
||||
Points = points
|
||||
Type = ShortAnswerT { AcceptedAnswers = accepted; CaseSensitive = form.CaseSensitive } }
|
||||
| KNumeric ->
|
||||
match System.Double.TryParse form.CorrectValueText, System.Double.TryParse form.ToleranceText with
|
||||
| (true, value), (true, tolerance) ->
|
||||
Ok
|
||||
{ TopicId = topicId
|
||||
Text = form.Text
|
||||
Points = points
|
||||
Type = NumericT { CorrectValue = value; Tolerance = tolerance } }
|
||||
| _ -> Error "Введите корректные числовые значения"
|
||||
|
||||
let private loadQuestionsCmd (token: string option) (topicId: TopicId) =
|
||||
Cmd.OfAsync.either
|
||||
(Api.listQuestions token)
|
||||
topicId
|
||||
(function
|
||||
| Ok questions -> QuestionsLoaded questions
|
||||
| Error err -> QuestionsLoadFailed err)
|
||||
(fun ex -> QuestionsLoadFailed ex.Message)
|
||||
|
||||
let update (token: string option) (msg: Msg) (model: Model) : Model * Cmd<Msg> =
|
||||
match msg with
|
||||
| LoadTopics ->
|
||||
let cmd =
|
||||
Cmd.OfAsync.either
|
||||
Api.listTopics
|
||||
token
|
||||
(function
|
||||
| Ok topics -> TopicsLoaded topics
|
||||
| Error err -> TopicsLoadFailed err)
|
||||
(fun ex -> TopicsLoadFailed ex.Message)
|
||||
|
||||
{ model with TopicsLoading = true; TopicsError = None }, cmd
|
||||
| TopicsLoaded topics -> { model with Topics = topics; TopicsLoading = false }, Cmd.none
|
||||
| TopicsLoadFailed err -> { model with TopicsLoading = false; TopicsError = Some err }, Cmd.none
|
||||
| SetNewTopicName name -> { model with NewTopicForm = { model.NewTopicForm with Name = name } }, Cmd.none
|
||||
| SubmitNewTopic ->
|
||||
let form = { model.NewTopicForm with IsSubmitting = true; Error = None }
|
||||
|
||||
let cmd =
|
||||
Cmd.OfAsync.either
|
||||
(Api.createTopic token)
|
||||
form.Name
|
||||
(function
|
||||
| Ok topic -> TopicCreated topic
|
||||
| Error err -> TopicCreateFailed err)
|
||||
(fun ex -> TopicCreateFailed ex.Message)
|
||||
|
||||
{ model with NewTopicForm = form }, cmd
|
||||
| TopicCreated topic ->
|
||||
{ model with
|
||||
Topics = model.Topics @ [ topic ]
|
||||
NewTopicForm = emptyNewTopicForm },
|
||||
Cmd.none
|
||||
| TopicCreateFailed err ->
|
||||
{ model with
|
||||
NewTopicForm = { model.NewTopicForm with IsSubmitting = false; Error = Some err } },
|
||||
Cmd.none
|
||||
| SelectTopic topicId ->
|
||||
{ model with
|
||||
SelectedTopicId = Some topicId
|
||||
Questions = []
|
||||
QuestionsLoading = true
|
||||
QuestionsError = None
|
||||
NewQuestionForm = emptyNewQuestionForm
|
||||
EditingQuestionId = None },
|
||||
loadQuestionsCmd token topicId
|
||||
| QuestionsLoaded questions -> { model with Questions = questions; QuestionsLoading = false }, Cmd.none
|
||||
| QuestionsLoadFailed err -> { model with QuestionsLoading = false; QuestionsError = Some err }, Cmd.none
|
||||
| SetQuestionText text -> { model with NewQuestionForm = { model.NewQuestionForm with Text = text } }, Cmd.none
|
||||
| SetQuestionPoints points ->
|
||||
{ model with NewQuestionForm = { model.NewQuestionForm with Points = points } }, Cmd.none
|
||||
| SetQuestionKind kind -> { model with NewQuestionForm = { model.NewQuestionForm with Kind = kind } }, Cmd.none
|
||||
| AddOption ->
|
||||
let form = model.NewQuestionForm
|
||||
|
||||
{ model with NewQuestionForm = { form with Options = form.Options @ [ newOptionDraft () ] } }, Cmd.none
|
||||
| RemoveOption optionId ->
|
||||
let form = model.NewQuestionForm
|
||||
|
||||
if form.Options.Length <= 2 then
|
||||
model, Cmd.none
|
||||
else
|
||||
{ model with
|
||||
NewQuestionForm =
|
||||
{ form with
|
||||
Options = form.Options |> List.filter (fun o -> o.Id <> optionId)
|
||||
CorrectSingle = if form.CorrectSingle = Some optionId then None else form.CorrectSingle
|
||||
CorrectMultiple = form.CorrectMultiple |> Set.remove optionId } },
|
||||
Cmd.none
|
||||
| SetOptionText(optionId, text) ->
|
||||
let form = model.NewQuestionForm
|
||||
|
||||
{ model with
|
||||
NewQuestionForm =
|
||||
{ form with
|
||||
Options = form.Options |> List.map (fun o -> if o.Id = optionId then { o with Text = text } else o) } },
|
||||
Cmd.none
|
||||
| SetCorrectSingle optionId ->
|
||||
{ model with NewQuestionForm = { model.NewQuestionForm with CorrectSingle = Some optionId } }, Cmd.none
|
||||
| ToggleCorrectMultiple optionId ->
|
||||
let form = model.NewQuestionForm
|
||||
|
||||
let next =
|
||||
if form.CorrectMultiple.Contains optionId then
|
||||
form.CorrectMultiple.Remove optionId
|
||||
else
|
||||
form.CorrectMultiple.Add optionId
|
||||
|
||||
{ model with NewQuestionForm = { form with CorrectMultiple = next } }, Cmd.none
|
||||
| SetCorrectBool value -> { model with NewQuestionForm = { model.NewQuestionForm with CorrectBool = value } }, Cmd.none
|
||||
| SetAcceptedAnswersText text ->
|
||||
{ model with NewQuestionForm = { model.NewQuestionForm with AcceptedAnswersText = text } }, Cmd.none
|
||||
| SetCaseSensitive value ->
|
||||
{ model with NewQuestionForm = { model.NewQuestionForm with CaseSensitive = value } }, Cmd.none
|
||||
| SetCorrectValueText text ->
|
||||
{ model with NewQuestionForm = { model.NewQuestionForm with CorrectValueText = text } }, Cmd.none
|
||||
| SetToleranceText text ->
|
||||
{ model with NewQuestionForm = { model.NewQuestionForm with ToleranceText = text } }, Cmd.none
|
||||
| SubmitNewQuestion when model.NewQuestionForm.IsSubmitting ->
|
||||
// Guards against a double-click/double-Enter firing this message
|
||||
// twice before React re-renders the disabled submit button — without
|
||||
// this, two requests reuse the same client-generated `OptionId`s for
|
||||
// what the server treats as two different questions, and the second
|
||||
// insert collides with the first on `question_options`'s primary key.
|
||||
model, Cmd.none
|
||||
| SubmitNewQuestion ->
|
||||
match model.SelectedTopicId with
|
||||
| None -> model, Cmd.none
|
||||
| Some topicId ->
|
||||
match buildRequest topicId model.NewQuestionForm with
|
||||
| Error err ->
|
||||
{ model with NewQuestionForm = { model.NewQuestionForm with Error = Some err } }, Cmd.none
|
||||
| Ok req ->
|
||||
let form = { model.NewQuestionForm with IsSubmitting = true; Error = None }
|
||||
|
||||
let cmd =
|
||||
match model.EditingQuestionId with
|
||||
| None ->
|
||||
Cmd.OfAsync.either
|
||||
(Api.createQuestion token)
|
||||
req
|
||||
(function
|
||||
| Ok summary -> QuestionCreated summary
|
||||
| Error err -> QuestionCreateFailed err)
|
||||
(fun ex -> QuestionCreateFailed ex.Message)
|
||||
| Some questionId ->
|
||||
let updateReq: UpdateQuestionRequest =
|
||||
{ QuestionId = questionId; Text = req.Text; Points = req.Points; Type = req.Type }
|
||||
|
||||
Cmd.OfAsync.either
|
||||
(Api.updateQuestion token)
|
||||
updateReq
|
||||
(function
|
||||
| Ok summary -> QuestionUpdated summary
|
||||
| Error err -> QuestionUpdateFailed err)
|
||||
(fun ex -> QuestionUpdateFailed ex.Message)
|
||||
|
||||
{ model with NewQuestionForm = form }, cmd
|
||||
| QuestionCreated summary ->
|
||||
{ model with
|
||||
Questions = model.Questions @ [ summary ]
|
||||
NewQuestionForm = emptyNewQuestionForm },
|
||||
Cmd.none
|
||||
| QuestionCreateFailed err ->
|
||||
{ model with
|
||||
NewQuestionForm = { model.NewQuestionForm with IsSubmitting = false; Error = Some err } },
|
||||
Cmd.none
|
||||
| StartEditQuestion questionId ->
|
||||
match model.Questions |> List.tryFind (fun q -> q.Id = questionId) with
|
||||
| None -> model, Cmd.none
|
||||
| Some summary ->
|
||||
{ model with
|
||||
EditingQuestionId = Some questionId
|
||||
NewQuestionForm = formFromSummary summary },
|
||||
Cmd.none
|
||||
| CancelEditQuestion ->
|
||||
{ model with EditingQuestionId = None; NewQuestionForm = emptyNewQuestionForm }, Cmd.none
|
||||
| QuestionUpdated summary ->
|
||||
{ model with
|
||||
Questions = model.Questions |> List.map (fun q -> if q.Id = summary.Id then summary else q)
|
||||
NewQuestionForm = emptyNewQuestionForm
|
||||
EditingQuestionId = None },
|
||||
Cmd.none
|
||||
| QuestionUpdateFailed err ->
|
||||
{ model with
|
||||
NewQuestionForm = { model.NewQuestionForm with IsSubmitting = false; Error = Some err } },
|
||||
Cmd.none
|
||||
| RequestDeleteQuestion questionId ->
|
||||
let cmd =
|
||||
Cmd.OfAsync.either
|
||||
(Api.deleteQuestion token)
|
||||
questionId
|
||||
(function
|
||||
| Ok() -> QuestionDeleted questionId
|
||||
| Error err -> QuestionDeleteFailed err)
|
||||
(fun ex -> QuestionDeleteFailed ex.Message)
|
||||
|
||||
model, cmd
|
||||
| QuestionDeleted questionId ->
|
||||
let wasEditing = model.EditingQuestionId = Some questionId
|
||||
|
||||
{ model with
|
||||
Questions = model.Questions |> List.filter (fun q -> q.Id <> questionId)
|
||||
EditingQuestionId = if wasEditing then None else model.EditingQuestionId
|
||||
NewQuestionForm = if wasEditing then emptyNewQuestionForm else model.NewQuestionForm },
|
||||
Cmd.none
|
||||
| QuestionDeleteFailed err -> { model with QuestionsError = Some err }, Cmd.none
|
||||
147
src/Client/Features/Teacher/Questions/Types.fs
Normal file
147
src/Client/Features/Teacher/Questions/Types.fs
Normal file
@@ -0,0 +1,147 @@
|
||||
module Client.Features.Teacher.Questions.Types
|
||||
|
||||
open System
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
|
||||
type NewTopicForm =
|
||||
{ Name: string
|
||||
Error: string option
|
||||
IsSubmitting: bool }
|
||||
|
||||
let emptyNewTopicForm = { Name = ""; Error = None; IsSubmitting = false }
|
||||
|
||||
/// A draft option row in the question-authoring form; `Id` is generated
|
||||
/// client-side so radio/checkbox selection has something stable to key on
|
||||
/// before the question is ever sent to the server.
|
||||
type OptionDraft = { Id: OptionId; Text: string }
|
||||
|
||||
let newOptionDraft () : OptionDraft = { Id = OptionId(Guid.NewGuid()); Text = "" }
|
||||
|
||||
type QuestionKind =
|
||||
| KSingleChoice
|
||||
| KMultipleChoice
|
||||
| KTrueFalse
|
||||
| KShortAnswer
|
||||
| KNumeric
|
||||
|
||||
type NewQuestionForm =
|
||||
{ Text: string
|
||||
Points: string
|
||||
Kind: QuestionKind
|
||||
Options: OptionDraft list // SingleChoice / MultipleChoice
|
||||
CorrectSingle: OptionId option // SingleChoice
|
||||
CorrectMultiple: Set<OptionId> // MultipleChoice
|
||||
CorrectBool: bool // TrueFalse
|
||||
AcceptedAnswersText: string // ShortAnswer, comma-separated
|
||||
CaseSensitive: bool // ShortAnswer
|
||||
CorrectValueText: string // Numeric
|
||||
ToleranceText: string // Numeric
|
||||
Error: string option
|
||||
IsSubmitting: bool }
|
||||
|
||||
let emptyNewQuestionForm =
|
||||
{ Text = ""
|
||||
Points = "1"
|
||||
Kind = KSingleChoice
|
||||
Options = [ newOptionDraft (); newOptionDraft () ]
|
||||
CorrectSingle = None
|
||||
CorrectMultiple = Set.empty
|
||||
CorrectBool = true
|
||||
AcceptedAnswersText = ""
|
||||
CaseSensitive = false
|
||||
CorrectValueText = ""
|
||||
ToleranceText = "0"
|
||||
Error = None
|
||||
IsSubmitting = false }
|
||||
|
||||
type Model =
|
||||
{ Topics: Topic list
|
||||
TopicsLoading: bool
|
||||
TopicsError: string option
|
||||
NewTopicForm: NewTopicForm
|
||||
SelectedTopicId: TopicId option
|
||||
Questions: QuestionSummary list
|
||||
QuestionsLoading: bool
|
||||
QuestionsError: string option
|
||||
NewQuestionForm: NewQuestionForm
|
||||
/// `None` = the form creates a new question; `Some id` = it edits
|
||||
/// that existing question instead.
|
||||
EditingQuestionId: QuestionId option }
|
||||
|
||||
let empty =
|
||||
{ Topics = []
|
||||
TopicsLoading = false
|
||||
TopicsError = None
|
||||
NewTopicForm = emptyNewTopicForm
|
||||
SelectedTopicId = None
|
||||
Questions = []
|
||||
QuestionsLoading = false
|
||||
QuestionsError = None
|
||||
NewQuestionForm = emptyNewQuestionForm
|
||||
EditingQuestionId = None }
|
||||
|
||||
type Msg =
|
||||
| LoadTopics
|
||||
| TopicsLoaded of Topic list
|
||||
| TopicsLoadFailed of string
|
||||
| SetNewTopicName of string
|
||||
| SubmitNewTopic
|
||||
| TopicCreated of Topic
|
||||
| TopicCreateFailed of string
|
||||
| SelectTopic of TopicId
|
||||
| QuestionsLoaded of QuestionSummary list
|
||||
| QuestionsLoadFailed of string
|
||||
| SetQuestionText of string
|
||||
| SetQuestionPoints of string
|
||||
| SetQuestionKind of QuestionKind
|
||||
| AddOption
|
||||
| RemoveOption of OptionId
|
||||
| SetOptionText of OptionId * string
|
||||
| SetCorrectSingle of OptionId
|
||||
| ToggleCorrectMultiple of OptionId
|
||||
| SetCorrectBool of bool
|
||||
| SetAcceptedAnswersText of string
|
||||
| SetCaseSensitive of bool
|
||||
| SetCorrectValueText of string
|
||||
| SetToleranceText of string
|
||||
| SubmitNewQuestion
|
||||
| QuestionCreated of QuestionSummary
|
||||
| QuestionCreateFailed of string
|
||||
| StartEditQuestion of QuestionId
|
||||
| CancelEditQuestion
|
||||
| QuestionUpdated of QuestionSummary
|
||||
| QuestionUpdateFailed of string
|
||||
| RequestDeleteQuestion of QuestionId
|
||||
| QuestionDeleted of QuestionId
|
||||
| QuestionDeleteFailed of string
|
||||
|
||||
/// Reverse of `State.buildRequest` — rebuilds a form from an existing
|
||||
/// question so "Изменить" can prefill it. Reuses the question's existing
|
||||
/// `OptionId`s (doesn't regenerate them) so editing doesn't orphan any
|
||||
/// student responses already recorded against those option ids.
|
||||
let formFromSummary (q: QuestionSummary) : NewQuestionForm =
|
||||
let baseForm = { emptyNewQuestionForm with Text = q.Text; Points = string q.Points }
|
||||
|
||||
match q.Type with
|
||||
| SingleChoiceT d ->
|
||||
{ baseForm with
|
||||
Kind = KSingleChoice
|
||||
Options = d.Options |> List.map (fun o -> { Id = o.Id; Text = o.Text })
|
||||
CorrectSingle = Some d.CorrectOptionId }
|
||||
| MultipleChoiceT d ->
|
||||
{ baseForm with
|
||||
Kind = KMultipleChoice
|
||||
Options = d.Options |> List.map (fun o -> { Id = o.Id; Text = o.Text })
|
||||
CorrectMultiple = Set.ofList d.CorrectOptionIds }
|
||||
| TrueFalseT b -> { baseForm with Kind = KTrueFalse; CorrectBool = b }
|
||||
| ShortAnswerT d ->
|
||||
{ baseForm with
|
||||
Kind = KShortAnswer
|
||||
AcceptedAnswersText = String.concat ", " d.AcceptedAnswers
|
||||
CaseSensitive = d.CaseSensitive }
|
||||
| NumericT d ->
|
||||
{ baseForm with
|
||||
Kind = KNumeric
|
||||
CorrectValueText = string d.CorrectValue
|
||||
ToleranceText = string d.Tolerance }
|
||||
292
src/Client/Features/Teacher/Questions/View.fs
Normal file
292
src/Client/Features/Teacher/Questions/View.fs
Normal file
@@ -0,0 +1,292 @@
|
||||
module Client.Features.Teacher.Questions.View
|
||||
|
||||
open Feliz
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
open Client.Shared
|
||||
open Client.Features.Teacher.Questions.Types
|
||||
|
||||
let private topicsView (model: Model) dispatch =
|
||||
Html.div [
|
||||
prop.className "topics-panel"
|
||||
prop.children [
|
||||
Html.h2 "Темы"
|
||||
match model.TopicsError with
|
||||
| Some err -> Html.p [ prop.className "error"; prop.text err ]
|
||||
| None -> Html.none
|
||||
if model.TopicsLoading then
|
||||
Html.p "Загрузка…"
|
||||
else
|
||||
Html.ul [
|
||||
prop.children [
|
||||
for topic in model.Topics ->
|
||||
Html.li [
|
||||
prop.key (string topic.Id)
|
||||
prop.className (
|
||||
if model.SelectedTopicId = Some topic.Id then
|
||||
"topic-item selected"
|
||||
else
|
||||
"topic-item"
|
||||
)
|
||||
prop.onClick (fun _ -> dispatch (SelectTopic topic.Id))
|
||||
prop.text topic.Name
|
||||
]
|
||||
]
|
||||
]
|
||||
Html.form [
|
||||
prop.onSubmit (fun e ->
|
||||
e.preventDefault ()
|
||||
dispatch SubmitNewTopic)
|
||||
prop.children [
|
||||
Html.input [
|
||||
prop.type'.text
|
||||
prop.placeholder "Название новой темы"
|
||||
prop.value model.NewTopicForm.Name
|
||||
prop.onChange (SetNewTopicName >> dispatch)
|
||||
]
|
||||
Html.button [
|
||||
prop.type'.submit
|
||||
prop.disabled model.NewTopicForm.IsSubmitting
|
||||
prop.text "Добавить тему"
|
||||
]
|
||||
match model.NewTopicForm.Error with
|
||||
| Some err -> Html.p [ prop.className "error"; prop.text err ]
|
||||
| None -> Html.none
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
let private kindLabel (t: QuestionTypeView) =
|
||||
match t with
|
||||
| SingleChoiceT _ -> "Один вариант"
|
||||
| MultipleChoiceT _ -> "Несколько вариантов"
|
||||
| TrueFalseT _ -> "Верно/неверно"
|
||||
| ShortAnswerT _ -> "Короткий ответ"
|
||||
| NumericT _ -> "Числовой"
|
||||
|
||||
let private questionsListView (model: Model) dispatch =
|
||||
Html.div [
|
||||
prop.className "questions-list"
|
||||
prop.children [
|
||||
Html.h3 "Вопросы в теме"
|
||||
match model.QuestionsError with
|
||||
| Some err -> Html.p [ prop.className "error"; prop.text err ]
|
||||
| None -> Html.none
|
||||
if model.QuestionsLoading then
|
||||
Html.p "Загрузка…"
|
||||
elif model.Questions.IsEmpty then
|
||||
Html.p "В этой теме пока нет вопросов"
|
||||
else
|
||||
Html.ul [
|
||||
prop.children [
|
||||
for q in model.Questions ->
|
||||
Html.li [
|
||||
prop.key (string q.Id)
|
||||
prop.children [
|
||||
Html.span [ prop.className "question-kind"; prop.text (kindLabel q.Type) ]
|
||||
Html.text (sprintf " %s " q.Text)
|
||||
Html.span [
|
||||
prop.className "tag-mono"
|
||||
prop.text (sprintf "%s б." (Format.points q.Points))
|
||||
]
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun _ -> dispatch (StartEditQuestion q.Id))
|
||||
prop.text "Изменить"
|
||||
]
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun _ -> dispatch (RequestDeleteQuestion q.Id))
|
||||
prop.text "Удалить"
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
let private optionsEditor (form: NewQuestionForm) dispatch (multi: bool) =
|
||||
Html.div [
|
||||
prop.className "options-editor"
|
||||
prop.children [
|
||||
for opt in form.Options do
|
||||
Html.div [
|
||||
prop.key (string opt.Id)
|
||||
prop.className "option-row"
|
||||
prop.children [
|
||||
Html.input [
|
||||
prop.type'.radio
|
||||
prop.name "correct-option"
|
||||
prop.isChecked (not multi && form.CorrectSingle = Some opt.Id)
|
||||
prop.style [ if multi then style.display.none ]
|
||||
prop.onChange (fun (_: bool) -> dispatch (SetCorrectSingle opt.Id))
|
||||
]
|
||||
Html.input [
|
||||
prop.type'.checkbox
|
||||
prop.isChecked (form.CorrectMultiple.Contains opt.Id)
|
||||
prop.style [ if not multi then style.display.none ]
|
||||
prop.onChange (fun (_: bool) -> dispatch (ToggleCorrectMultiple opt.Id))
|
||||
]
|
||||
Html.input [
|
||||
prop.type'.text
|
||||
prop.placeholder "Текст варианта"
|
||||
prop.value opt.Text
|
||||
prop.onChange (fun v -> dispatch (SetOptionText(opt.Id, v)))
|
||||
]
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.disabled (form.Options.Length <= 2)
|
||||
prop.onClick (fun _ -> dispatch (RemoveOption opt.Id))
|
||||
prop.text "Удалить"
|
||||
]
|
||||
]
|
||||
]
|
||||
Html.button [ prop.type'.button; prop.onClick (fun _ -> dispatch AddOption); prop.text "Добавить вариант" ]
|
||||
]
|
||||
]
|
||||
|
||||
let private newQuestionFormView (isEditing: bool) (form: NewQuestionForm) dispatch =
|
||||
Html.form [
|
||||
prop.className "new-question-form"
|
||||
prop.onSubmit (fun e ->
|
||||
e.preventDefault ()
|
||||
dispatch SubmitNewQuestion)
|
||||
prop.children [
|
||||
Html.h3 (if isEditing then "Редактирование вопроса" else "Новый вопрос")
|
||||
Html.label [ prop.text "Текст вопроса" ]
|
||||
Html.input [
|
||||
prop.type'.text
|
||||
prop.value form.Text
|
||||
prop.onChange (SetQuestionText >> dispatch)
|
||||
]
|
||||
Html.label [ prop.text "Баллы" ]
|
||||
Html.input [
|
||||
prop.type'.number
|
||||
prop.value form.Points
|
||||
prop.onChange (SetQuestionPoints >> dispatch)
|
||||
]
|
||||
Html.label [ prop.text "Тип вопроса" ]
|
||||
Html.select [
|
||||
prop.value (
|
||||
match form.Kind with
|
||||
| KSingleChoice -> "single"
|
||||
| KMultipleChoice -> "multiple"
|
||||
| KTrueFalse -> "truefalse"
|
||||
| KShortAnswer -> "short"
|
||||
| KNumeric -> "numeric"
|
||||
)
|
||||
prop.onChange (fun (v: string) ->
|
||||
let kind =
|
||||
match v with
|
||||
| "single" -> KSingleChoice
|
||||
| "multiple" -> KMultipleChoice
|
||||
| "truefalse" -> KTrueFalse
|
||||
| "short" -> KShortAnswer
|
||||
| _ -> KNumeric
|
||||
|
||||
dispatch (SetQuestionKind kind))
|
||||
prop.children [
|
||||
Html.option [ prop.value "single"; prop.text "Один вариант" ]
|
||||
Html.option [ prop.value "multiple"; prop.text "Несколько вариантов" ]
|
||||
Html.option [ prop.value "truefalse"; prop.text "Верно/неверно" ]
|
||||
Html.option [ prop.value "short"; prop.text "Короткий ответ" ]
|
||||
Html.option [ prop.value "numeric"; prop.text "Числовой" ]
|
||||
]
|
||||
]
|
||||
|
||||
match form.Kind with
|
||||
| KSingleChoice -> optionsEditor form dispatch false
|
||||
| KMultipleChoice -> optionsEditor form dispatch true
|
||||
| KTrueFalse ->
|
||||
Html.div [
|
||||
for value, text in [ true, "Верно"; false, "Неверно" ] ->
|
||||
Html.label [
|
||||
prop.children [
|
||||
Html.input [
|
||||
prop.type'.radio
|
||||
prop.name "correct-bool"
|
||||
prop.isChecked (form.CorrectBool = value)
|
||||
prop.onChange (fun (_: bool) -> dispatch (SetCorrectBool value))
|
||||
]
|
||||
Html.text text
|
||||
]
|
||||
]
|
||||
]
|
||||
| KShortAnswer ->
|
||||
Html.div [
|
||||
Html.label [ prop.text "Допустимые ответы (через запятую)" ]
|
||||
Html.input [
|
||||
prop.type'.text
|
||||
prop.value form.AcceptedAnswersText
|
||||
prop.onChange (SetAcceptedAnswersText >> dispatch)
|
||||
]
|
||||
Html.label [
|
||||
prop.children [
|
||||
Html.input [
|
||||
prop.type'.checkbox
|
||||
prop.isChecked form.CaseSensitive
|
||||
prop.onChange (SetCaseSensitive >> dispatch)
|
||||
]
|
||||
Html.text "Учитывать регистр"
|
||||
]
|
||||
]
|
||||
]
|
||||
| KNumeric ->
|
||||
Html.div [
|
||||
Html.label [ prop.text "Правильное значение" ]
|
||||
Html.input [
|
||||
prop.type'.text
|
||||
prop.value form.CorrectValueText
|
||||
prop.onChange (SetCorrectValueText >> dispatch)
|
||||
]
|
||||
Html.label [ prop.text "Допустимая погрешность" ]
|
||||
Html.input [
|
||||
prop.type'.text
|
||||
prop.value form.ToleranceText
|
||||
prop.onChange (SetToleranceText >> dispatch)
|
||||
]
|
||||
]
|
||||
|
||||
match form.Error with
|
||||
| Some err -> Html.p [ prop.className "error"; prop.text err ]
|
||||
| None -> Html.none
|
||||
Html.button [
|
||||
prop.type'.submit
|
||||
prop.disabled form.IsSubmitting
|
||||
prop.text (
|
||||
if form.IsSubmitting then "Сохранение…"
|
||||
elif isEditing then "Сохранить изменения"
|
||||
else "Добавить вопрос"
|
||||
)
|
||||
]
|
||||
if isEditing then
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun _ -> dispatch CancelEditQuestion)
|
||||
prop.text "Отмена"
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
let view (model: Model) (dispatch: Msg -> unit) =
|
||||
Html.div [
|
||||
prop.className "teacher-questions-page"
|
||||
prop.children [
|
||||
Html.h1 "Банк вопросов"
|
||||
Html.div [
|
||||
prop.className "teacher-layout"
|
||||
prop.children [
|
||||
topicsView model dispatch
|
||||
match model.SelectedTopicId with
|
||||
| None -> Html.p "Выберите или создайте тему слева"
|
||||
| Some _ ->
|
||||
Html.div [
|
||||
questionsListView model dispatch
|
||||
newQuestionFormView model.EditingQuestionId.IsSome model.NewQuestionForm dispatch
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
205
src/Client/Features/Teacher/Tests/Api.fs
Normal file
205
src/Client/Features/Teacher/Tests/Api.fs
Normal file
@@ -0,0 +1,205 @@
|
||||
module Client.Features.Teacher.Tests.Api
|
||||
|
||||
open Fable.Core.JsInterop
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
open Client.Shared.JsonWire
|
||||
|
||||
let private encQuizSource (source: QuizQuestionSourceInput) : obj =
|
||||
match source with
|
||||
| FixedQuestionInput qid -> createObj [ "FixedQuestionInput" ==> encQuestionId qid ]
|
||||
| RandomPoolInput rule ->
|
||||
createObj [
|
||||
"RandomPoolInput" ==> createObj [ "TopicId" ==> encTopicId rule.TopicId; "Count" ==> box rule.Count ]
|
||||
]
|
||||
|
||||
let private decQuizSource (raw: obj) : QuizQuestionSourceInput =
|
||||
if not (isNullOrUndefined raw?FixedQuestionInput) then
|
||||
FixedQuestionInput(decQuestionId raw?FixedQuestionInput)
|
||||
elif not (isNullOrUndefined raw?RandomPoolInput) then
|
||||
let d = raw?RandomPoolInput
|
||||
RandomPoolInput { TopicId = decTopicId d?TopicId; Count = unbox<int> d?Count }
|
||||
else
|
||||
failwith "Неизвестный источник вопросов теста"
|
||||
|
||||
let private decodeQuizAdminSummary (raw: obj) : QuizAdminSummary =
|
||||
{ Id = decQuizId raw?Id
|
||||
Title = raw?Title
|
||||
Description = raw?Description
|
||||
TimeLimitMinutes = raw?TimeLimitMinutes |> optDec unbox<int>
|
||||
MaxAttempts = raw?MaxAttempts |> optDec unbox<int>
|
||||
PassingScore = raw?PassingScore |> optDec unbox<float>
|
||||
ShuffleQuestions = raw?ShuffleQuestions
|
||||
ShuffleAnswers = raw?ShuffleAnswers
|
||||
Sources = (unbox<obj[]> raw?Sources) |> Array.toList |> List.map decQuizSource
|
||||
AssignedStudentIds = (unbox<obj[]> raw?AssignedStudentIds) |> Array.toList |> List.map decUserId }
|
||||
|
||||
let private decodeStudentSummary (raw: obj) : StudentSummary =
|
||||
{ Id = decUserId raw?Id; Name = raw?Name; Email = raw?Email }
|
||||
|
||||
let private decodeStudentQuizResult (raw: obj) : StudentQuizResult =
|
||||
{ StudentId = decUserId raw?StudentId
|
||||
StudentName = raw?StudentName
|
||||
StudentEmail = raw?StudentEmail
|
||||
AttemptsCount = raw?AttemptsCount
|
||||
BestScore = raw?BestScore |> optDec unbox<float>
|
||||
MaxScore = raw?MaxScore |> optDec unbox<float>
|
||||
Passed = raw?Passed |> optDec unbox<bool>
|
||||
LastSuccessfulAttemptAt = raw?LastSuccessfulAttemptAt |> optDec (fun v -> System.DateTimeOffset.Parse(unbox<string> v))
|
||||
LastAttemptFocusLossCount = raw?LastAttemptFocusLossCount }
|
||||
|
||||
let private decodeTopic (raw: obj) : Topic =
|
||||
{ Id = decTopicId raw?Id
|
||||
OwnerId = decUserId raw?OwnerId
|
||||
Name = raw?Name }
|
||||
|
||||
let private encQuestionOption (o: QuestionOption) : obj =
|
||||
createObj [ "Id" ==> encOptionId o.Id; "Text" ==> box o.Text ]
|
||||
|
||||
let private decQuestionOption (raw: obj) : QuestionOption =
|
||||
{ Id = decOptionId raw?Id; Text = raw?Text }
|
||||
|
||||
let private decodeQuestionTypeView (raw: obj) : QuestionTypeView =
|
||||
if not (isNullOrUndefined raw?SingleChoiceT) then
|
||||
let d = raw?SingleChoiceT
|
||||
|
||||
SingleChoiceT
|
||||
{ Options = (unbox<obj[]> d?Options) |> Array.toList |> List.map decQuestionOption
|
||||
CorrectOptionId = decOptionId d?CorrectOptionId }
|
||||
elif not (isNullOrUndefined raw?MultipleChoiceT) then
|
||||
let d = raw?MultipleChoiceT
|
||||
|
||||
MultipleChoiceT
|
||||
{ Options = (unbox<obj[]> d?Options) |> Array.toList |> List.map decQuestionOption
|
||||
CorrectOptionIds = (unbox<obj[]> d?CorrectOptionIds) |> Array.toList |> List.map decOptionId }
|
||||
elif not (isNullOrUndefined raw?TrueFalseT) then
|
||||
TrueFalseT(unbox<bool> raw?TrueFalseT)
|
||||
elif not (isNullOrUndefined raw?ShortAnswerT) then
|
||||
let d = raw?ShortAnswerT
|
||||
|
||||
ShortAnswerT
|
||||
{ AcceptedAnswers = (unbox<obj[]> d?AcceptedAnswers) |> Array.toList |> List.map unbox<string>
|
||||
CaseSensitive = unbox<bool> d?CaseSensitive }
|
||||
elif not (isNullOrUndefined raw?NumericT) then
|
||||
let d = raw?NumericT
|
||||
NumericT { CorrectValue = d?CorrectValue; Tolerance = d?Tolerance }
|
||||
else
|
||||
failwith "Неизвестный тип вопроса"
|
||||
|
||||
let private decodeQuestionSummary (raw: obj) : QuestionSummary =
|
||||
{ Id = decQuestionId raw?Id
|
||||
TopicId = decTopicId raw?TopicId
|
||||
Text = raw?Text
|
||||
Points = raw?Points
|
||||
Type = decodeQuestionTypeView raw?Type }
|
||||
|
||||
let listMyQuizzes (token: string option) : Async<Result<QuizAdminSummary list, string>> =
|
||||
async {
|
||||
let! raw = callApi token "GET" "/api/teacher/quizzes" None
|
||||
return decodeResult (fun r -> (unbox<obj[]> r) |> Array.toList |> List.map decodeQuizAdminSummary) raw
|
||||
}
|
||||
|
||||
let listStudents (token: string option) : Async<Result<StudentSummary list, string>> =
|
||||
async {
|
||||
let! raw = callApi token "GET" "/api/teacher/students" None
|
||||
return decodeResult (fun r -> (unbox<obj[]> r) |> Array.toList |> List.map decodeStudentSummary) raw
|
||||
}
|
||||
|
||||
let assignStudents (token: string option) (req: AssignStudentsRequest) : Async<Result<QuizAdminSummary, string>> =
|
||||
async {
|
||||
let body =
|
||||
createObj [
|
||||
"QuizId" ==> encQuizId req.QuizId
|
||||
"StudentIds" ==> (req.StudentIds |> List.map encUserId |> List.toArray)
|
||||
]
|
||||
|
||||
let! raw = callApi token "POST" "/api/teacher/quizzes/assign" (Some body)
|
||||
return decodeResult decodeQuizAdminSummary raw
|
||||
}
|
||||
|
||||
/// Same route as `Teacher/Questions/Api.fs.listTopics` — small, deliberate
|
||||
/// duplication between independent VSA slices instead of a shared module.
|
||||
let listTopics (token: string option) : Async<Result<Topic list, string>> =
|
||||
async {
|
||||
let! raw = callApi token "GET" "/api/teacher/topics" None
|
||||
return decodeResult (fun r -> (unbox<obj[]> r) |> Array.toList |> List.map decodeTopic) raw
|
||||
}
|
||||
|
||||
let listQuestionsInTopic (token: string option) (topicId: TopicId) : Async<Result<QuestionSummary list, string>> =
|
||||
async {
|
||||
let body = createObj [ "TopicId" ==> encTopicId topicId ]
|
||||
let! raw = callApi token "POST" "/api/teacher/questions/list" (Some body)
|
||||
return decodeResult (fun r -> (unbox<obj[]> r) |> Array.toList |> List.map decodeQuestionSummary) raw
|
||||
}
|
||||
|
||||
let private encQuizFields
|
||||
(title: string)
|
||||
(description: string)
|
||||
(timeLimitMinutes: int option)
|
||||
(maxAttempts: int option)
|
||||
(passingScore: float option)
|
||||
(shuffleQuestions: bool)
|
||||
(shuffleAnswers: bool)
|
||||
(sources: QuizQuestionSourceInput list)
|
||||
: (string * obj) list =
|
||||
[ "Title" ==> box title
|
||||
"Description" ==> box description
|
||||
"TimeLimitMinutes" ==> optToJs box timeLimitMinutes
|
||||
"MaxAttempts" ==> optToJs box maxAttempts
|
||||
"PassingScore" ==> optToJs box passingScore
|
||||
"ShuffleQuestions" ==> box shuffleQuestions
|
||||
"ShuffleAnswers" ==> box shuffleAnswers
|
||||
"Sources" ==> (sources |> List.map encQuizSource |> List.toArray) ]
|
||||
|
||||
let createQuiz (token: string option) (req: CreateQuizRequest) : Async<Result<QuizAdminSummary, string>> =
|
||||
async {
|
||||
let body =
|
||||
createObj (
|
||||
encQuizFields
|
||||
req.Title
|
||||
req.Description
|
||||
req.TimeLimitMinutes
|
||||
req.MaxAttempts
|
||||
req.PassingScore
|
||||
req.ShuffleQuestions
|
||||
req.ShuffleAnswers
|
||||
req.Sources
|
||||
)
|
||||
|
||||
let! raw = callApi token "POST" "/api/teacher/quizzes/create" (Some body)
|
||||
return decodeResult decodeQuizAdminSummary raw
|
||||
}
|
||||
|
||||
let updateQuiz (token: string option) (req: UpdateQuizRequest) : Async<Result<QuizAdminSummary, string>> =
|
||||
async {
|
||||
let body =
|
||||
createObj (
|
||||
("QuizId" ==> encQuizId req.QuizId)
|
||||
:: encQuizFields
|
||||
req.Title
|
||||
req.Description
|
||||
req.TimeLimitMinutes
|
||||
req.MaxAttempts
|
||||
req.PassingScore
|
||||
req.ShuffleQuestions
|
||||
req.ShuffleAnswers
|
||||
req.Sources
|
||||
)
|
||||
|
||||
let! raw = callApi token "POST" "/api/teacher/quizzes/update" (Some body)
|
||||
return decodeResult decodeQuizAdminSummary raw
|
||||
}
|
||||
|
||||
let deleteQuiz (token: string option) (quizId: QuizId) : Async<Result<unit, string>> =
|
||||
async {
|
||||
let body = createObj [ "QuizId" ==> encQuizId quizId ]
|
||||
let! raw = callApi token "POST" "/api/teacher/quizzes/delete" (Some body)
|
||||
return decodeResult (fun _ -> ()) raw
|
||||
}
|
||||
|
||||
let getQuizResults (token: string option) (quizId: QuizId) : Async<Result<StudentQuizResult list, string>> =
|
||||
async {
|
||||
let body = createObj [ "QuizId" ==> encQuizId quizId ]
|
||||
let! raw = callApi token "POST" "/api/teacher/quizzes/results" (Some body)
|
||||
return decodeResult (fun r -> (unbox<obj[]> r) |> Array.toList |> List.map decodeStudentQuizResult) raw
|
||||
}
|
||||
368
src/Client/Features/Teacher/Tests/State.fs
Normal file
368
src/Client/Features/Teacher/Tests/State.fs
Normal file
@@ -0,0 +1,368 @@
|
||||
module Client.Features.Teacher.Tests.State
|
||||
|
||||
open Elmish
|
||||
open Domain.Contracts
|
||||
open Client.Features.Teacher.Tests.Types
|
||||
|
||||
let init () : Model * Cmd<Msg> =
|
||||
empty, Cmd.batch [ Cmd.ofMsg LoadQuizzes; Cmd.ofMsg LoadStudents; Cmd.ofMsg LoadTopics ]
|
||||
|
||||
/// Empty string means "not set" for these optional numeric fields; a
|
||||
/// non-empty string that fails to parse is a validation error.
|
||||
let private parseOptionalInt (text: string) : Result<int option, string> =
|
||||
if System.String.IsNullOrWhiteSpace text then
|
||||
Ok None
|
||||
else
|
||||
match System.Int32.TryParse text with
|
||||
| true, v -> Ok(Some v)
|
||||
| false, _ -> Error "Ожидалось целое число"
|
||||
|
||||
let private parseOptionalFloat (text: string) : Result<float option, string> =
|
||||
if System.String.IsNullOrWhiteSpace text then
|
||||
Ok None
|
||||
else
|
||||
match System.Double.TryParse text with
|
||||
| true, v -> Ok(Some v)
|
||||
| false, _ -> Error "Ожидалось число"
|
||||
|
||||
let private buildQuizFields (form: QuizForm) =
|
||||
match parseOptionalInt form.TimeLimitText, parseOptionalInt form.MaxAttemptsText, parseOptionalFloat form.PassingScoreText with
|
||||
| Error err, _, _
|
||||
| _, Error err, _
|
||||
| _, _, Error err -> Error err
|
||||
| Ok timeLimit, Ok maxAttempts, Ok passingScore ->
|
||||
if System.String.IsNullOrWhiteSpace form.Title then
|
||||
Error "Название теста не может быть пустым"
|
||||
elif form.Sources.IsEmpty then
|
||||
Error "Выберите хотя бы один вопрос"
|
||||
else
|
||||
Ok(timeLimit, maxAttempts, passingScore)
|
||||
|
||||
let private toDraft (source: QuizQuestionSourceInput) : QuizSourceDraft =
|
||||
match source with
|
||||
| FixedQuestionInput qid -> FixedDraft qid
|
||||
| RandomPoolInput rule -> PoolDraft(rule.TopicId, rule.Count)
|
||||
|
||||
let private toSourceInput (draft: QuizSourceDraft) : QuizQuestionSourceInput =
|
||||
match draft with
|
||||
| FixedDraft qid -> FixedQuestionInput qid
|
||||
| PoolDraft(topicId, count) -> RandomPoolInput { TopicId = topicId; Count = count }
|
||||
|
||||
let update (token: string option) (msg: Msg) (model: Model) : Model * Cmd<Msg> =
|
||||
match msg with
|
||||
| LoadQuizzes ->
|
||||
let cmd =
|
||||
Cmd.OfAsync.either
|
||||
Api.listMyQuizzes
|
||||
token
|
||||
(function
|
||||
| Ok quizzes -> QuizzesLoaded quizzes
|
||||
| Error err -> QuizzesLoadFailed err)
|
||||
(fun ex -> QuizzesLoadFailed ex.Message)
|
||||
|
||||
{ model with QuizzesLoading = true; QuizzesError = None }, cmd
|
||||
| QuizzesLoaded quizzes -> { model with Quizzes = quizzes; QuizzesLoading = false }, Cmd.none
|
||||
| QuizzesLoadFailed err -> { model with QuizzesLoading = false; QuizzesError = Some err }, Cmd.none
|
||||
| LoadStudents ->
|
||||
let cmd =
|
||||
Cmd.OfAsync.either
|
||||
Api.listStudents
|
||||
token
|
||||
(function
|
||||
| Ok students -> StudentsLoaded students
|
||||
| Error err -> StudentsLoadFailed err)
|
||||
(fun ex -> StudentsLoadFailed ex.Message)
|
||||
|
||||
{ model with StudentsLoading = true; StudentsError = None }, cmd
|
||||
| StudentsLoaded students -> { model with Students = students; StudentsLoading = false }, Cmd.none
|
||||
| StudentsLoadFailed err -> { model with StudentsLoading = false; StudentsError = Some err }, Cmd.none
|
||||
| SelectQuiz quizId ->
|
||||
let assigned =
|
||||
model.Quizzes
|
||||
|> List.tryFind (fun q -> q.Id = quizId)
|
||||
|> Option.map (fun q -> Set.ofList q.AssignedStudentIds)
|
||||
|> Option.defaultValue Set.empty
|
||||
|
||||
{ model with
|
||||
SelectedQuizId = Some quizId
|
||||
SelectedStudentIds = assigned
|
||||
SaveError = None
|
||||
ShowQuizForm = false
|
||||
ResultsQuizId = None },
|
||||
Cmd.none
|
||||
| ToggleStudent studentId ->
|
||||
let next =
|
||||
if model.SelectedStudentIds.Contains studentId then
|
||||
model.SelectedStudentIds.Remove studentId
|
||||
else
|
||||
model.SelectedStudentIds.Add studentId
|
||||
|
||||
{ model with SelectedStudentIds = next }, Cmd.none
|
||||
| SaveAssignments ->
|
||||
match model.SelectedQuizId with
|
||||
| None -> model, Cmd.none
|
||||
| Some quizId ->
|
||||
let request: AssignStudentsRequest =
|
||||
{ QuizId = quizId
|
||||
StudentIds = Set.toList model.SelectedStudentIds }
|
||||
|
||||
let cmd =
|
||||
Cmd.OfAsync.either
|
||||
(Api.assignStudents token)
|
||||
request
|
||||
(function
|
||||
| Ok summary -> AssignmentsSaved summary
|
||||
| Error err -> SaveFailed err)
|
||||
(fun ex -> SaveFailed ex.Message)
|
||||
|
||||
{ model with IsSaving = true; SaveError = None }, cmd
|
||||
| AssignmentsSaved summary ->
|
||||
{ model with
|
||||
Quizzes = model.Quizzes |> List.map (fun q -> if q.Id = summary.Id then summary else q)
|
||||
IsSaving = false },
|
||||
Cmd.none
|
||||
| SaveFailed err -> { model with IsSaving = false; SaveError = Some err }, Cmd.none
|
||||
| LoadTopics ->
|
||||
let cmd =
|
||||
Cmd.OfAsync.either
|
||||
Api.listTopics
|
||||
token
|
||||
(function
|
||||
| Ok topics -> TopicsLoaded topics
|
||||
| Error err -> TopicsLoadFailed err)
|
||||
(fun ex -> TopicsLoadFailed ex.Message)
|
||||
|
||||
{ model with TopicsLoading = true; TopicsError = None }, cmd
|
||||
| TopicsLoaded topics -> { model with Topics = topics; TopicsLoading = false }, Cmd.none
|
||||
| TopicsLoadFailed err -> { model with TopicsLoading = false; TopicsError = Some err }, Cmd.none
|
||||
| StartNewQuiz ->
|
||||
{ model with
|
||||
ShowQuizForm = true
|
||||
EditingQuizId = None
|
||||
QuizForm = emptyQuizForm
|
||||
SelectedQuizId = None
|
||||
ResultsQuizId = None },
|
||||
Cmd.none
|
||||
| StartEditQuiz quizId ->
|
||||
match model.Quizzes |> List.tryFind (fun q -> q.Id = quizId) with
|
||||
| None -> model, Cmd.none
|
||||
| Some quiz ->
|
||||
let form =
|
||||
{ emptyQuizForm with
|
||||
Title = quiz.Title
|
||||
Description = quiz.Description
|
||||
TimeLimitText = quiz.TimeLimitMinutes |> Option.map string |> Option.defaultValue ""
|
||||
MaxAttemptsText = quiz.MaxAttempts |> Option.map string |> Option.defaultValue ""
|
||||
PassingScoreText = quiz.PassingScore |> Option.map string |> Option.defaultValue ""
|
||||
ShuffleQuestions = quiz.ShuffleQuestions
|
||||
ShuffleAnswers = quiz.ShuffleAnswers
|
||||
Sources = quiz.Sources |> List.map toDraft }
|
||||
|
||||
{ model with
|
||||
ShowQuizForm = true
|
||||
EditingQuizId = Some quizId
|
||||
QuizForm = form },
|
||||
Cmd.none
|
||||
| CancelQuizForm -> { model with ShowQuizForm = false; EditingQuizId = None }, Cmd.none
|
||||
| SetQuizTitle text -> { model with QuizForm = { model.QuizForm with Title = text } }, Cmd.none
|
||||
| SetQuizDescription text -> { model with QuizForm = { model.QuizForm with Description = text } }, Cmd.none
|
||||
| SetQuizTimeLimitText text -> { model with QuizForm = { model.QuizForm with TimeLimitText = text } }, Cmd.none
|
||||
| SetQuizMaxAttemptsText text ->
|
||||
{ model with QuizForm = { model.QuizForm with MaxAttemptsText = text } }, Cmd.none
|
||||
| SetQuizPassingScoreText text ->
|
||||
{ model with QuizForm = { model.QuizForm with PassingScoreText = text } }, Cmd.none
|
||||
| SetQuizShuffleQuestions value ->
|
||||
{ model with QuizForm = { model.QuizForm with ShuffleQuestions = value } }, Cmd.none
|
||||
| SetQuizShuffleAnswers value ->
|
||||
{ model with QuizForm = { model.QuizForm with ShuffleAnswers = value } }, Cmd.none
|
||||
| SelectPickerTopic topicId ->
|
||||
let cmd =
|
||||
Cmd.OfAsync.either
|
||||
(Api.listQuestionsInTopic token)
|
||||
topicId
|
||||
(function
|
||||
| Ok questions -> PickerQuestionsLoaded questions
|
||||
| Error err -> PickerQuestionsLoadFailed err)
|
||||
(fun ex -> PickerQuestionsLoadFailed ex.Message)
|
||||
|
||||
let existingPoolCount =
|
||||
model.QuizForm.Sources
|
||||
|> List.tryPick (function
|
||||
| PoolDraft(tid, count) when tid = topicId -> Some count
|
||||
| _ -> None)
|
||||
|
||||
{ model with
|
||||
QuizForm =
|
||||
{ model.QuizForm with
|
||||
PickerTopicId = Some topicId
|
||||
PickerLoading = true
|
||||
PickerQuestions = []
|
||||
PoolCountText = existingPoolCount |> Option.map string |> Option.defaultValue "" } },
|
||||
cmd
|
||||
| PickerQuestionsLoaded questions ->
|
||||
{ model with QuizForm = { model.QuizForm with PickerQuestions = questions; PickerLoading = false } }, Cmd.none
|
||||
| PickerQuestionsLoadFailed err ->
|
||||
{ model with QuizForm = { model.QuizForm with PickerLoading = false; Error = Some err } }, Cmd.none
|
||||
| ToggleQuestionPick questionId ->
|
||||
let form = model.QuizForm
|
||||
|
||||
let next =
|
||||
if form.Sources |> List.exists (function FixedDraft qid -> qid = questionId | _ -> false) then
|
||||
form.Sources
|
||||
|> List.filter (function
|
||||
| FixedDraft qid -> qid <> questionId
|
||||
| _ -> true)
|
||||
else
|
||||
form.Sources @ [ FixedDraft questionId ]
|
||||
|
||||
{ model with QuizForm = { form with Sources = next } }, Cmd.none
|
||||
| SelectAllInTopic ->
|
||||
let form = model.QuizForm
|
||||
|
||||
let alreadySelected =
|
||||
form.Sources
|
||||
|> List.choose (function
|
||||
| FixedDraft qid -> Some qid
|
||||
| _ -> None)
|
||||
|> Set.ofList
|
||||
|
||||
let toAdd =
|
||||
form.PickerQuestions
|
||||
|> List.map (fun q -> q.Id)
|
||||
|> List.filter (alreadySelected.Contains >> not)
|
||||
|> List.map FixedDraft
|
||||
|
||||
{ model with QuizForm = { form with Sources = form.Sources @ toAdd } }, Cmd.none
|
||||
| SetPoolCountText text -> { model with QuizForm = { model.QuizForm with PoolCountText = text } }, Cmd.none
|
||||
| AddRandomPool ->
|
||||
let form = model.QuizForm
|
||||
|
||||
match form.PickerTopicId with
|
||||
| None -> model, Cmd.none
|
||||
| Some topicId ->
|
||||
match System.Int32.TryParse form.PoolCountText with
|
||||
| true, count when count > 0 ->
|
||||
let withoutOldPool =
|
||||
form.Sources
|
||||
|> List.filter (function
|
||||
| PoolDraft(tid, _) -> tid <> topicId
|
||||
| _ -> true)
|
||||
|
||||
{ model with QuizForm = { form with Sources = withoutOldPool @ [ PoolDraft(topicId, count) ]; Error = None } },
|
||||
Cmd.none
|
||||
| _ ->
|
||||
{ model with QuizForm = { form with Error = Some "Количество случайных вопросов должно быть положительным числом" } },
|
||||
Cmd.none
|
||||
| RemoveRandomPool topicId ->
|
||||
let form = model.QuizForm
|
||||
|
||||
let next =
|
||||
form.Sources
|
||||
|> List.filter (function
|
||||
| PoolDraft(tid, _) -> tid <> topicId
|
||||
| _ -> true)
|
||||
|
||||
let poolCountText = if form.PickerTopicId = Some topicId then "" else form.PoolCountText
|
||||
|
||||
{ model with QuizForm = { form with Sources = next; PoolCountText = poolCountText } }, Cmd.none
|
||||
| SubmitQuizForm ->
|
||||
match buildQuizFields model.QuizForm with
|
||||
| Error err -> { model with QuizForm = { model.QuizForm with Error = Some err } }, Cmd.none
|
||||
| Ok(timeLimit, maxAttempts, passingScore) ->
|
||||
let form = { model.QuizForm with IsSubmitting = true; Error = None }
|
||||
let sources = form.Sources |> List.map toSourceInput
|
||||
|
||||
let cmd =
|
||||
match model.EditingQuizId with
|
||||
| None ->
|
||||
let req: CreateQuizRequest =
|
||||
{ Title = form.Title
|
||||
Description = form.Description
|
||||
TimeLimitMinutes = timeLimit
|
||||
MaxAttempts = maxAttempts
|
||||
PassingScore = passingScore
|
||||
ShuffleQuestions = form.ShuffleQuestions
|
||||
ShuffleAnswers = form.ShuffleAnswers
|
||||
Sources = sources }
|
||||
|
||||
Cmd.OfAsync.either
|
||||
(Api.createQuiz token)
|
||||
req
|
||||
(function
|
||||
| Ok summary -> QuizSaved summary
|
||||
| Error err -> QuizSaveFailed err)
|
||||
(fun ex -> QuizSaveFailed ex.Message)
|
||||
| Some quizId ->
|
||||
let req: UpdateQuizRequest =
|
||||
{ QuizId = quizId
|
||||
Title = form.Title
|
||||
Description = form.Description
|
||||
TimeLimitMinutes = timeLimit
|
||||
MaxAttempts = maxAttempts
|
||||
PassingScore = passingScore
|
||||
ShuffleQuestions = form.ShuffleQuestions
|
||||
ShuffleAnswers = form.ShuffleAnswers
|
||||
Sources = sources }
|
||||
|
||||
Cmd.OfAsync.either
|
||||
(Api.updateQuiz token)
|
||||
req
|
||||
(function
|
||||
| Ok summary -> QuizSaved summary
|
||||
| Error err -> QuizSaveFailed err)
|
||||
(fun ex -> QuizSaveFailed ex.Message)
|
||||
|
||||
{ model with QuizForm = form }, cmd
|
||||
| QuizSaved summary ->
|
||||
let alreadyExists = model.Quizzes |> List.exists (fun q -> q.Id = summary.Id)
|
||||
|
||||
{ model with
|
||||
Quizzes =
|
||||
if alreadyExists then
|
||||
model.Quizzes |> List.map (fun q -> if q.Id = summary.Id then summary else q)
|
||||
else
|
||||
model.Quizzes @ [ summary ]
|
||||
ShowQuizForm = false
|
||||
EditingQuizId = None },
|
||||
Cmd.none
|
||||
| QuizSaveFailed err -> { model with QuizForm = { model.QuizForm with IsSubmitting = false; Error = Some err } }, Cmd.none
|
||||
| RequestDeleteQuiz quizId ->
|
||||
let cmd =
|
||||
Cmd.OfAsync.either
|
||||
(Api.deleteQuiz token)
|
||||
quizId
|
||||
(function
|
||||
| Ok() -> QuizDeleted quizId
|
||||
| Error err -> QuizDeleteFailed err)
|
||||
(fun ex -> QuizDeleteFailed ex.Message)
|
||||
|
||||
model, cmd
|
||||
| QuizDeleted quizId ->
|
||||
{ model with
|
||||
Quizzes = model.Quizzes |> List.filter (fun q -> q.Id <> quizId)
|
||||
SelectedQuizId = if model.SelectedQuizId = Some quizId then None else model.SelectedQuizId
|
||||
EditingQuizId = if model.EditingQuizId = Some quizId then None else model.EditingQuizId
|
||||
ShowQuizForm = if model.EditingQuizId = Some quizId then false else model.ShowQuizForm },
|
||||
Cmd.none
|
||||
| QuizDeleteFailed err -> { model with QuizzesError = Some err }, Cmd.none
|
||||
| ShowResults quizId ->
|
||||
let cmd =
|
||||
Cmd.OfAsync.either
|
||||
(Api.getQuizResults token)
|
||||
quizId
|
||||
(function
|
||||
| Ok results -> ResultsLoaded results
|
||||
| Error err -> ResultsLoadFailed err)
|
||||
(fun ex -> ResultsLoadFailed ex.Message)
|
||||
|
||||
{ model with
|
||||
ResultsQuizId = Some quizId
|
||||
ResultsLoading = true
|
||||
ResultsError = None
|
||||
Results = []
|
||||
SelectedQuizId = None
|
||||
ShowQuizForm = false },
|
||||
cmd
|
||||
| ResultsLoaded results -> { model with Results = results; ResultsLoading = false }, Cmd.none
|
||||
| ResultsLoadFailed err -> { model with ResultsLoading = false; ResultsError = Some err }, Cmd.none
|
||||
| CancelResults -> { model with ResultsQuizId = None }, Cmd.none
|
||||
182
src/Client/Features/Teacher/Tests/Types.fs
Normal file
182
src/Client/Features/Teacher/Tests/Types.fs
Normal file
@@ -0,0 +1,182 @@
|
||||
module Client.Features.Teacher.Tests.Types
|
||||
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
|
||||
/// One entry of the quiz-being-built's question source list, in the same
|
||||
/// "either fixed or random-pool" shape as the wire contract
|
||||
/// `QuizQuestionSourceInput` — kept as a separate client type only because
|
||||
/// the picker needs to reason about it per-topic (e.g. "does topic X already
|
||||
/// have a pool rule?"), which is easier against a plain DU than re-deriving
|
||||
/// it from the wire shape every render.
|
||||
type QuizSourceDraft =
|
||||
| FixedDraft of QuestionId
|
||||
| PoolDraft of TopicId: TopicId * Count: int
|
||||
|
||||
type QuizForm =
|
||||
{ Title: string
|
||||
Description: string
|
||||
TimeLimitText: string // minutes, empty = None
|
||||
MaxAttemptsText: string // empty = None
|
||||
PassingScoreText: string // empty = None
|
||||
ShuffleQuestions: bool
|
||||
ShuffleAnswers: bool
|
||||
/// Accumulates across topic switches in the picker below — membership
|
||||
/// alone decides the checkbox state, regardless of which topic's
|
||||
/// questions are currently displayed.
|
||||
Sources: QuizSourceDraft list
|
||||
PickerTopicId: TopicId option
|
||||
PickerQuestions: QuestionSummary list
|
||||
PickerLoading: bool
|
||||
/// Draft text for "N случайных вопросов" of the topic currently open
|
||||
/// in the picker — reset whenever the picker's topic changes.
|
||||
PoolCountText: string
|
||||
Error: string option
|
||||
IsSubmitting: bool }
|
||||
|
||||
let emptyQuizForm =
|
||||
{ Title = ""
|
||||
Description = ""
|
||||
TimeLimitText = ""
|
||||
MaxAttemptsText = ""
|
||||
PassingScoreText = ""
|
||||
ShuffleQuestions = false
|
||||
ShuffleAnswers = false
|
||||
Sources = []
|
||||
PickerTopicId = None
|
||||
PickerQuestions = []
|
||||
PickerLoading = false
|
||||
PoolCountText = ""
|
||||
Error = None
|
||||
IsSubmitting = false }
|
||||
|
||||
/// Ids of `form.PickerQuestions` (the topic currently open in the picker)
|
||||
/// that are individually fixed-selected — used to enforce "fixed selection
|
||||
/// XOR random pool" per topic, one topic at a time.
|
||||
let fixedIdsInCurrentTopic (form: QuizForm) : QuestionId list =
|
||||
let topicIds = form.PickerQuestions |> List.map (fun q -> q.Id) |> Set.ofList
|
||||
|
||||
form.Sources
|
||||
|> List.choose (function
|
||||
| FixedDraft qid when topicIds.Contains qid -> Some qid
|
||||
| _ -> None)
|
||||
|
||||
/// The random-pool count configured for the topic currently open in the
|
||||
/// picker, if any.
|
||||
let poolCountForCurrentTopic (form: QuizForm) : int option =
|
||||
match form.PickerTopicId with
|
||||
| None -> None
|
||||
| Some topicId ->
|
||||
form.Sources
|
||||
|> List.tryPick (function
|
||||
| PoolDraft(tid, count) when tid = topicId -> Some count
|
||||
| _ -> None)
|
||||
|
||||
/// Total number of questions the quiz will actually have: one per fixed
|
||||
/// selection, plus each pool rule's `Count`.
|
||||
let totalSelectedCount (form: QuizForm) : int =
|
||||
form.Sources
|
||||
|> List.sumBy (function
|
||||
| FixedDraft _ -> 1
|
||||
| PoolDraft(_, count) -> count)
|
||||
|
||||
let randomPoolCount (form: QuizForm) : int =
|
||||
form.Sources
|
||||
|> List.sumBy (function
|
||||
| PoolDraft(_, count) -> count
|
||||
| FixedDraft _ -> 0)
|
||||
|
||||
type Model =
|
||||
{ Quizzes: QuizAdminSummary list
|
||||
QuizzesLoading: bool
|
||||
QuizzesError: string option
|
||||
Students: StudentSummary list
|
||||
StudentsLoading: bool
|
||||
StudentsError: string option
|
||||
SelectedQuizId: QuizId option
|
||||
/// Working draft of the checkbox list for `SelectedQuizId`, seeded from
|
||||
/// that quiz's `AssignedStudentIds` when selected.
|
||||
SelectedStudentIds: Set<UserId>
|
||||
SaveError: string option
|
||||
IsSaving: bool
|
||||
Topics: Topic list
|
||||
TopicsLoading: bool
|
||||
TopicsError: string option
|
||||
/// `None` = the quiz form creates a new quiz; `Some id` = it edits
|
||||
/// that existing quiz instead.
|
||||
EditingQuizId: QuizId option
|
||||
ShowQuizForm: bool
|
||||
QuizForm: QuizForm
|
||||
/// The quiz whose per-student results panel is open, if any — mutually
|
||||
/// exclusive with `SelectedQuizId` (assignment panel); opening one
|
||||
/// closes the other.
|
||||
ResultsQuizId: QuizId option
|
||||
ResultsLoading: bool
|
||||
ResultsError: string option
|
||||
Results: StudentQuizResult list }
|
||||
|
||||
let empty =
|
||||
{ Quizzes = []
|
||||
QuizzesLoading = false
|
||||
QuizzesError = None
|
||||
Students = []
|
||||
StudentsLoading = false
|
||||
StudentsError = None
|
||||
SelectedQuizId = None
|
||||
SelectedStudentIds = Set.empty
|
||||
SaveError = None
|
||||
IsSaving = false
|
||||
Topics = []
|
||||
TopicsLoading = false
|
||||
TopicsError = None
|
||||
EditingQuizId = None
|
||||
ShowQuizForm = false
|
||||
QuizForm = emptyQuizForm
|
||||
ResultsQuizId = None
|
||||
ResultsLoading = false
|
||||
ResultsError = None
|
||||
Results = [] }
|
||||
|
||||
type Msg =
|
||||
| LoadQuizzes
|
||||
| QuizzesLoaded of QuizAdminSummary list
|
||||
| QuizzesLoadFailed of string
|
||||
| LoadStudents
|
||||
| StudentsLoaded of StudentSummary list
|
||||
| StudentsLoadFailed of string
|
||||
| SelectQuiz of QuizId
|
||||
| ToggleStudent of UserId
|
||||
| SaveAssignments
|
||||
| AssignmentsSaved of QuizAdminSummary
|
||||
| SaveFailed of string
|
||||
| LoadTopics
|
||||
| TopicsLoaded of Topic list
|
||||
| TopicsLoadFailed of string
|
||||
| StartNewQuiz
|
||||
| StartEditQuiz of QuizId
|
||||
| CancelQuizForm
|
||||
| SetQuizTitle of string
|
||||
| SetQuizDescription of string
|
||||
| SetQuizTimeLimitText of string
|
||||
| SetQuizMaxAttemptsText of string
|
||||
| SetQuizPassingScoreText of string
|
||||
| SetQuizShuffleQuestions of bool
|
||||
| SetQuizShuffleAnswers of bool
|
||||
| SelectPickerTopic of TopicId
|
||||
| PickerQuestionsLoaded of QuestionSummary list
|
||||
| PickerQuestionsLoadFailed of string
|
||||
| ToggleQuestionPick of QuestionId
|
||||
| SelectAllInTopic
|
||||
| SetPoolCountText of string
|
||||
| AddRandomPool
|
||||
| RemoveRandomPool of TopicId
|
||||
| SubmitQuizForm
|
||||
| QuizSaved of QuizAdminSummary
|
||||
| QuizSaveFailed of string
|
||||
| RequestDeleteQuiz of QuizId
|
||||
| QuizDeleted of QuizId
|
||||
| QuizDeleteFailed of string
|
||||
| ShowResults of QuizId
|
||||
| ResultsLoaded of StudentQuizResult list
|
||||
| ResultsLoadFailed of string
|
||||
| CancelResults
|
||||
484
src/Client/Features/Teacher/Tests/View.fs
Normal file
484
src/Client/Features/Teacher/Tests/View.fs
Normal file
@@ -0,0 +1,484 @@
|
||||
module Client.Features.Teacher.Tests.View
|
||||
|
||||
open Feliz
|
||||
open Domain.Contracts
|
||||
open Client.Shared
|
||||
open Client.Features.Teacher.Tests.Types
|
||||
|
||||
let private sourceQuestionCount (source: QuizQuestionSourceInput) : int =
|
||||
match source with
|
||||
| FixedQuestionInput _ -> 1
|
||||
| RandomPoolInput rule -> rule.Count
|
||||
|
||||
let private quizzesView (model: Model) dispatch =
|
||||
Html.div [
|
||||
prop.className "quizzes-panel"
|
||||
prop.children [
|
||||
Html.h2 "Мои тесты"
|
||||
match model.QuizzesError with
|
||||
| Some err -> Html.p [ prop.className "error"; prop.text err ]
|
||||
| None -> Html.none
|
||||
if model.QuizzesLoading then
|
||||
Html.p "Загрузка…"
|
||||
elif model.Quizzes.IsEmpty then
|
||||
Html.p "У вас пока нет тестов"
|
||||
else
|
||||
Html.div [
|
||||
prop.className "quiz-cards"
|
||||
prop.children [
|
||||
for quiz in model.Quizzes ->
|
||||
Html.div [
|
||||
prop.key (string quiz.Id)
|
||||
prop.className (
|
||||
if model.SelectedQuizId = Some quiz.Id || model.ResultsQuizId = Some quiz.Id then
|
||||
"quiz-manage-card selected"
|
||||
else
|
||||
"quiz-manage-card"
|
||||
)
|
||||
prop.onClick (fun _ -> dispatch (SelectQuiz quiz.Id))
|
||||
prop.children [
|
||||
Html.h3 [ prop.className "quiz-manage-card-title"; prop.text quiz.Title ]
|
||||
Html.span [
|
||||
prop.className "tag-mono"
|
||||
prop.text (
|
||||
sprintf
|
||||
"вопросов: %d, назначено: %d"
|
||||
(quiz.Sources |> List.sumBy sourceQuestionCount)
|
||||
quiz.AssignedStudentIds.Length
|
||||
)
|
||||
]
|
||||
Html.div [
|
||||
prop.className "quiz-manage-card-actions"
|
||||
prop.children [
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun e ->
|
||||
e.stopPropagation ()
|
||||
dispatch (SelectQuiz quiz.Id))
|
||||
prop.text "Назначить студентов"
|
||||
]
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun e ->
|
||||
e.stopPropagation ()
|
||||
dispatch (ShowResults quiz.Id))
|
||||
prop.text "Результаты"
|
||||
]
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun e ->
|
||||
e.stopPropagation ()
|
||||
dispatch (StartEditQuiz quiz.Id))
|
||||
prop.text "Изменить"
|
||||
]
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun e ->
|
||||
e.stopPropagation ()
|
||||
dispatch (RequestDeleteQuiz quiz.Id))
|
||||
prop.text "Удалить"
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
let private assignmentView (model: Model) dispatch =
|
||||
Html.div [
|
||||
prop.className "assignment-panel"
|
||||
prop.children [
|
||||
Html.h3 "Назначенные студенты"
|
||||
match model.StudentsError with
|
||||
| Some err -> Html.p [ prop.className "error"; prop.text err ]
|
||||
| None -> Html.none
|
||||
if model.StudentsLoading then
|
||||
Html.p "Загрузка…"
|
||||
elif model.Students.IsEmpty then
|
||||
Html.p "Студентов пока нет"
|
||||
else
|
||||
Html.div [
|
||||
prop.children [
|
||||
for student in model.Students ->
|
||||
Html.label [
|
||||
prop.key (string student.Id)
|
||||
prop.className "student-row"
|
||||
prop.children [
|
||||
Html.input [
|
||||
prop.type'.checkbox
|
||||
prop.isChecked (model.SelectedStudentIds.Contains student.Id)
|
||||
prop.onChange (fun (_: bool) -> dispatch (ToggleStudent student.Id))
|
||||
]
|
||||
Html.text (sprintf "%s (%s)" student.Name student.Email)
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
match model.SaveError with
|
||||
| Some err -> Html.p [ prop.className "error"; prop.text err ]
|
||||
| None -> Html.none
|
||||
Html.button [
|
||||
prop.disabled model.IsSaving
|
||||
prop.onClick (fun _ -> dispatch SaveAssignments)
|
||||
prop.text (if model.IsSaving then "Сохранение…" else "Сохранить назначения")
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
let private formatAttemptTime (t: System.DateTimeOffset) = t.ToLocalTime().ToString("dd.MM.yyyy HH:mm")
|
||||
|
||||
let private resultsView (model: Model) dispatch =
|
||||
Html.div [
|
||||
prop.className "assignment-panel"
|
||||
prop.children [
|
||||
Html.div [
|
||||
prop.className "page-header"
|
||||
prop.children [
|
||||
Html.h3 "Результаты студентов"
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun _ -> dispatch CancelResults)
|
||||
prop.text "Закрыть"
|
||||
]
|
||||
]
|
||||
]
|
||||
match model.ResultsError with
|
||||
| Some err -> Html.p [ prop.className "error"; prop.text err ]
|
||||
| None -> Html.none
|
||||
if model.ResultsLoading then
|
||||
Html.p "Загрузка…"
|
||||
elif model.Results.IsEmpty then
|
||||
Html.p "На этот тест ещё не назначено ни одного студента"
|
||||
else
|
||||
Html.table [
|
||||
prop.className "results-table"
|
||||
prop.children [
|
||||
Html.thead [
|
||||
Html.tr [
|
||||
Html.th [ prop.text "ФИО" ]
|
||||
Html.th [ prop.text "Результат" ]
|
||||
Html.th [ prop.text "Попыток" ]
|
||||
Html.th [ prop.text "Последняя успешная попытка" ]
|
||||
Html.th [ prop.text "Потери фокуса" ]
|
||||
]
|
||||
]
|
||||
Html.tbody [
|
||||
for r in model.Results ->
|
||||
Html.tr [
|
||||
prop.key (string r.StudentId)
|
||||
prop.children [
|
||||
Html.td [ prop.text (sprintf "%s (%s)" r.StudentName r.StudentEmail) ]
|
||||
Html.td [
|
||||
match r.Passed with
|
||||
| Some true -> Html.span [ prop.className "grade-stamp passed"; prop.text "Пройден" ]
|
||||
| Some false -> Html.span [ prop.className "grade-stamp failed"; prop.text "Не пройден" ]
|
||||
| None -> Html.span [ prop.className "hint"; prop.text "—" ]
|
||||
]
|
||||
Html.td [ prop.text (string r.AttemptsCount) ]
|
||||
Html.td [
|
||||
prop.className "tag-mono"
|
||||
prop.text (
|
||||
match r.LastSuccessfulAttemptAt with
|
||||
| Some t -> formatAttemptTime t
|
||||
| None -> "—"
|
||||
)
|
||||
]
|
||||
Html.td [
|
||||
prop.className (
|
||||
if r.LastAttemptFocusLossCount > 0 then
|
||||
"focus-loss-value warn"
|
||||
else
|
||||
"focus-loss-value"
|
||||
)
|
||||
prop.text (string r.LastAttemptFocusLossCount)
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
/// Summary of every configured random-pool rule, across all topics — needed
|
||||
/// because the picker below only shows one topic's questions at a time, so
|
||||
/// without this list, switching the topic dropdown away would make an
|
||||
/// already-configured pool rule invisible.
|
||||
let private poolRulesSummary (model: Model) dispatch =
|
||||
let pools =
|
||||
model.QuizForm.Sources
|
||||
|> List.choose (function
|
||||
| PoolDraft(topicId, count) -> Some(topicId, count)
|
||||
| FixedDraft _ -> None)
|
||||
|
||||
if pools.IsEmpty then
|
||||
Html.none
|
||||
else
|
||||
Html.ul [
|
||||
prop.className "pool-rules-summary"
|
||||
prop.children [
|
||||
for (topicId, count) in pools ->
|
||||
let topicName =
|
||||
model.Topics
|
||||
|> List.tryFind (fun t -> t.Id = topicId)
|
||||
|> Option.map (fun t -> t.Name)
|
||||
|> Option.defaultValue "?"
|
||||
|
||||
Html.li [
|
||||
prop.key (string topicId)
|
||||
prop.children [
|
||||
Html.span [ prop.text (sprintf "%s — случайных вопросов: %d" topicName count) ]
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun _ -> dispatch (RemoveRandomPool topicId))
|
||||
prop.text "Убрать"
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
let private questionPicker (model: Model) dispatch =
|
||||
let form = model.QuizForm
|
||||
let poolForTopic = poolCountForCurrentTopic form
|
||||
let fixedInTopic = fixedIdsInCurrentTopic form
|
||||
|
||||
Html.div [
|
||||
prop.className "question-picker"
|
||||
prop.children [
|
||||
Html.label [ prop.text "Тема" ]
|
||||
Html.select [
|
||||
prop.value (form.PickerTopicId |> Option.map string |> Option.defaultValue "")
|
||||
prop.onChange (fun (v: string) ->
|
||||
model.Topics
|
||||
|> List.tryFind (fun t -> string t.Id = v)
|
||||
|> Option.iter (fun t -> dispatch (SelectPickerTopic t.Id)))
|
||||
prop.children [
|
||||
Html.option [ prop.value ""; prop.text "— выберите тему —" ]
|
||||
for topic in model.Topics do
|
||||
Html.option [ prop.key (string topic.Id); prop.value (string topic.Id); prop.text topic.Name ]
|
||||
]
|
||||
]
|
||||
if form.PickerLoading then
|
||||
Html.p "Загрузка вопросов…"
|
||||
elif form.PickerTopicId.IsSome && form.PickerQuestions.IsEmpty then
|
||||
Html.p "В этой теме нет вопросов"
|
||||
elif form.PickerTopicId.IsSome then
|
||||
match poolForTopic with
|
||||
| Some count ->
|
||||
Html.div [
|
||||
prop.className "pool-picker"
|
||||
prop.children [
|
||||
Html.p (
|
||||
sprintf
|
||||
"Для этой темы используется случайный набор — на каждую попытку студенту достаётся %d случайных вопросов из неё."
|
||||
count
|
||||
)
|
||||
Html.input [
|
||||
prop.type'.text
|
||||
prop.className "pool-count-input"
|
||||
prop.value form.PoolCountText
|
||||
prop.onChange (SetPoolCountText >> dispatch)
|
||||
]
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun _ -> dispatch AddRandomPool)
|
||||
prop.text "Обновить количество"
|
||||
]
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun _ ->
|
||||
form.PickerTopicId |> Option.iter (RemoveRandomPool >> dispatch))
|
||||
prop.text "Убрать случайный набор, выбирать вручную"
|
||||
]
|
||||
]
|
||||
]
|
||||
| None ->
|
||||
Html.div [
|
||||
prop.children [
|
||||
Html.div [
|
||||
prop.children [
|
||||
for q in form.PickerQuestions ->
|
||||
Html.label [
|
||||
prop.key (string q.Id)
|
||||
prop.className "student-row"
|
||||
prop.children [
|
||||
Html.input [
|
||||
prop.type'.checkbox
|
||||
prop.isChecked (fixedInTopic |> List.contains q.Id)
|
||||
prop.onChange (fun (_: bool) -> dispatch (ToggleQuestionPick q.Id))
|
||||
]
|
||||
Html.text q.Text
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun _ -> dispatch SelectAllInTopic)
|
||||
prop.text "Выбрать все вопросы темы"
|
||||
]
|
||||
Html.p "или задать случайный набор вместо ручного выбора:"
|
||||
Html.input [
|
||||
prop.type'.text
|
||||
prop.className "pool-count-input"
|
||||
prop.placeholder "Число вопросов"
|
||||
prop.value form.PoolCountText
|
||||
prop.onChange (SetPoolCountText >> dispatch)
|
||||
]
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.disabled (not fixedInTopic.IsEmpty)
|
||||
prop.onClick (fun _ -> dispatch AddRandomPool)
|
||||
prop.text "Добавить случайный набор из этой темы"
|
||||
]
|
||||
if not fixedInTopic.IsEmpty then
|
||||
Html.p [
|
||||
prop.className "hint"
|
||||
prop.text "Снимите ручной выбор вопросов этой темы, чтобы вместо него задать случайный набор."
|
||||
]
|
||||
]
|
||||
]
|
||||
else
|
||||
Html.none
|
||||
poolRulesSummary model dispatch
|
||||
Html.span [
|
||||
prop.className "tag-mono"
|
||||
prop.text (
|
||||
let total = totalSelectedCount form
|
||||
let pool = randomPoolCount form
|
||||
|
||||
if pool > 0 then
|
||||
sprintf "Выбрано вопросов: %d (из них случайных: %d)" total pool
|
||||
else
|
||||
sprintf "Выбрано вопросов: %d" total
|
||||
)
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
let private quizFormView (isEditing: bool) (model: Model) dispatch =
|
||||
let form = model.QuizForm
|
||||
|
||||
Html.form [
|
||||
prop.className "new-question-form"
|
||||
prop.onSubmit (fun e ->
|
||||
e.preventDefault ()
|
||||
dispatch SubmitQuizForm)
|
||||
prop.children [
|
||||
Html.h3 (if isEditing then "Редактирование теста" else "Новый тест")
|
||||
Html.label [ prop.text "Название" ]
|
||||
Html.input [ prop.type'.text; prop.value form.Title; prop.onChange (SetQuizTitle >> dispatch) ]
|
||||
Html.label [ prop.text "Описание" ]
|
||||
Html.input [
|
||||
prop.type'.text
|
||||
prop.value form.Description
|
||||
prop.onChange (SetQuizDescription >> dispatch)
|
||||
]
|
||||
Html.label [ prop.text "Лимит времени, мин (необязательно)" ]
|
||||
Html.input [
|
||||
prop.type'.text
|
||||
prop.value form.TimeLimitText
|
||||
prop.onChange (SetQuizTimeLimitText >> dispatch)
|
||||
]
|
||||
Html.label [ prop.text "Максимум попыток (необязательно)" ]
|
||||
Html.input [
|
||||
prop.type'.text
|
||||
prop.value form.MaxAttemptsText
|
||||
prop.onChange (SetQuizMaxAttemptsText >> dispatch)
|
||||
]
|
||||
Html.label [ prop.text "Проходной балл (необязательно)" ]
|
||||
Html.input [
|
||||
prop.type'.text
|
||||
prop.value form.PassingScoreText
|
||||
prop.onChange (SetQuizPassingScoreText >> dispatch)
|
||||
]
|
||||
Html.label [
|
||||
prop.children [
|
||||
Html.input [
|
||||
prop.type'.checkbox
|
||||
prop.isChecked form.ShuffleQuestions
|
||||
prop.onChange (SetQuizShuffleQuestions >> dispatch)
|
||||
]
|
||||
Html.text "Перемешивать вопросы"
|
||||
]
|
||||
]
|
||||
Html.label [
|
||||
prop.children [
|
||||
Html.input [
|
||||
prop.type'.checkbox
|
||||
prop.isChecked form.ShuffleAnswers
|
||||
prop.onChange (SetQuizShuffleAnswers >> dispatch)
|
||||
]
|
||||
Html.text "Перемешивать варианты ответов"
|
||||
]
|
||||
]
|
||||
questionPicker model dispatch
|
||||
match form.Error with
|
||||
| Some err -> Html.p [ prop.className "error"; prop.text err ]
|
||||
| None -> Html.none
|
||||
Html.button [
|
||||
prop.type'.submit
|
||||
prop.disabled form.IsSubmitting
|
||||
prop.text (
|
||||
if form.IsSubmitting then "Сохранение…"
|
||||
elif isEditing then "Сохранить изменения"
|
||||
else "Создать тест"
|
||||
)
|
||||
]
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun _ -> dispatch CancelQuizForm)
|
||||
prop.text "Отмена"
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
let view (model: Model) (dispatch: Msg -> unit) =
|
||||
Html.div [
|
||||
prop.className "teacher-tests-page"
|
||||
prop.children [
|
||||
Html.div [
|
||||
prop.className "page-header"
|
||||
prop.children [
|
||||
Html.h1 "Тесты и назначения"
|
||||
Html.button [
|
||||
prop.type'.button
|
||||
prop.onClick (fun _ -> dispatch StartNewQuiz)
|
||||
prop.text "Создать тест"
|
||||
]
|
||||
]
|
||||
]
|
||||
match model.ResultsQuizId, model.ShowQuizForm with
|
||||
| Some _, false ->
|
||||
// The card list shifts into a narrow left column to make
|
||||
// room for the results table, instead of the table stacking
|
||||
// below the full-width cards like the assignment panel does.
|
||||
Html.div [
|
||||
prop.className "results-layout"
|
||||
prop.children [ quizzesView model dispatch; resultsView model dispatch ]
|
||||
]
|
||||
| _ ->
|
||||
quizzesView model dispatch
|
||||
|
||||
if not model.ShowQuizForm then
|
||||
match model.SelectedQuizId with
|
||||
| Some _ -> assignmentView model dispatch
|
||||
| None -> Html.none
|
||||
if model.ShowQuizForm then
|
||||
Html.div [
|
||||
prop.className "modal-backdrop"
|
||||
prop.onClick (fun _ -> dispatch CancelQuizForm)
|
||||
prop.children [
|
||||
Html.div [
|
||||
prop.className "modal-dialog"
|
||||
prop.onClick (fun e -> e.stopPropagation ())
|
||||
prop.children [ quizFormView model.EditingQuizId.IsSome model dispatch ]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
10
src/Client/Program.fs
Normal file
10
src/Client/Program.fs
Normal file
@@ -0,0 +1,10 @@
|
||||
module Client.Program
|
||||
|
||||
open Elmish
|
||||
open Elmish.React
|
||||
open Client.App.State
|
||||
open Client.App.View
|
||||
|
||||
Program.mkProgram init update view
|
||||
|> Program.withReactSynchronous "elmish-app"
|
||||
|> Program.run
|
||||
12
src/Client/Shared/Format.fs
Normal file
12
src/Client/Shared/Format.fs
Normal file
@@ -0,0 +1,12 @@
|
||||
module Client.Shared.Format
|
||||
|
||||
/// Whole-numbered points render without a decimal point ("3"); anything with
|
||||
/// a fractional part renders with one decimal place ("2.5") — points are
|
||||
/// usually whole in this app, but `AverageAttempt` grading or a partial-point
|
||||
/// question config can produce a fractional value that a blanket "%.0f"
|
||||
/// would otherwise silently round away.
|
||||
let points (value: float) : string =
|
||||
if value = System.Math.Round value then
|
||||
sprintf "%.0f" value
|
||||
else
|
||||
sprintf "%.1f" value
|
||||
71
src/Client/Shared/JsonWire.fs
Normal file
71
src/Client/Shared/JsonWire.fs
Normal file
@@ -0,0 +1,71 @@
|
||||
module Client.Shared.JsonWire
|
||||
|
||||
// Fable.Remoting.Client pulls in Fable.Remoting.MsgPack, whose `inline`
|
||||
// helpers reference private functions in a way the current Fable compiler
|
||||
// rejects at build time. Until that's fixed upstream, each feature's `Api.fs`
|
||||
// talks to its own plain Giraffe route by hand, using the helpers below to
|
||||
// POST/GET JSON and decode the {"Ok": ...} / {"Error": ...} shape
|
||||
// Fable.Remoting.Json already produces on the server (see `Server/Json.fs`).
|
||||
open Fable.Core
|
||||
open Fable.Core.JsInterop
|
||||
open Domain
|
||||
|
||||
let private serverUrl = "http://localhost:5144"
|
||||
|
||||
[<Emit("Object.prototype.hasOwnProperty.call($0, $1)")>]
|
||||
let hasKey (_o: obj) (_key: string) : bool = jsNative
|
||||
|
||||
[<Emit("fetch($0, $1).then(r => r.json())")>]
|
||||
let private fetchJson (_url: string) (_init: obj) : JS.Promise<obj> = jsNative
|
||||
|
||||
/// `body = None` for GET-style calls with no request payload.
|
||||
let callApi (token: string option) (httpMethod: string) (path: string) (body: obj option) : Async<obj> =
|
||||
async {
|
||||
let headers =
|
||||
match token with
|
||||
| Some t -> createObj [ "Content-Type" ==> "application/json"; "Authorization" ==> ("Bearer " + t) ]
|
||||
| None -> createObj [ "Content-Type" ==> "application/json" ]
|
||||
|
||||
let baseFields = [ "method" ==> httpMethod; "headers" ==> headers ]
|
||||
|
||||
let fields =
|
||||
match body with
|
||||
| Some b -> baseFields @ [ "body" ==> JS.JSON.stringify b ]
|
||||
| None -> baseFields
|
||||
|
||||
return! fetchJson (serverUrl + path) (createObj fields) |> Async.AwaitPromise
|
||||
}
|
||||
|
||||
// ---- Id encode/decode: wire shape is {"CaseName": "<guid>"} ----
|
||||
|
||||
let encQuizId (QuizId g) : obj = createObj [ "QuizId" ==> string g ]
|
||||
let encTopicId (TopicId g) : obj = createObj [ "TopicId" ==> string g ]
|
||||
let encUserId (UserId g) : obj = createObj [ "UserId" ==> string g ]
|
||||
let encAttemptId (AttemptId g) : obj = createObj [ "AttemptId" ==> string g ]
|
||||
let encQuestionId (QuestionId g) : obj = createObj [ "QuestionId" ==> string g ]
|
||||
let encOptionId (OptionId g) : obj = createObj [ "OptionId" ==> string g ]
|
||||
|
||||
let decUserId (o: obj) : UserId = UserId(System.Guid.Parse(o?UserId: string))
|
||||
let decTopicId (o: obj) : TopicId = TopicId(System.Guid.Parse(o?TopicId: string))
|
||||
let decQuizId (o: obj) : QuizId = QuizId(System.Guid.Parse(o?QuizId: string))
|
||||
let decQuestionId (o: obj) : QuestionId = QuestionId(System.Guid.Parse(o?QuestionId: string))
|
||||
let decOptionId (o: obj) : OptionId = OptionId(System.Guid.Parse(o?OptionId: string))
|
||||
let decAttemptId (o: obj) : AttemptId = AttemptId(System.Guid.Parse(o?AttemptId: string))
|
||||
|
||||
let optToJs (mapper: 'a -> obj) (opt: 'a option) : obj =
|
||||
match opt with
|
||||
| Some x -> mapper x
|
||||
| None -> null
|
||||
|
||||
let optDec (mapper: obj -> 'a) (raw: obj) : 'a option =
|
||||
if isNullOrUndefined raw then None else Some(mapper raw)
|
||||
|
||||
let decodeRole (raw: obj) : Role =
|
||||
match unbox<string> raw with
|
||||
| "Admin" -> Admin
|
||||
| "Teacher" -> Teacher
|
||||
| "Student" -> Student
|
||||
| other -> failwithf "Неизвестная роль: %s" other
|
||||
|
||||
let decodeResult (decodeOk: obj -> 'a) (raw: obj) : Result<'a, string> =
|
||||
if hasKey raw "Ok" then Ok(decodeOk raw?Ok) else Error(unbox<string> raw?Error)
|
||||
46
src/Client/Shared/SessionStorage.fs
Normal file
46
src/Client/Shared/SessionStorage.fs
Normal file
@@ -0,0 +1,46 @@
|
||||
module Client.Shared.SessionStorage
|
||||
|
||||
// Without this, the whole session lives only in the in-memory Elmish Model —
|
||||
// any page refresh (F5, or reopening the tab) resets `Model.Session` to
|
||||
// `None` and drops the user back to the login screen, no matter which page
|
||||
// they were on. Persisting the JWT to localStorage and restoring it on
|
||||
// `App.State.init` fixes that for every page, not just one.
|
||||
open Fable.Core
|
||||
open Fable.Core.JsInterop
|
||||
open Browser.WebStorage
|
||||
open Domain.Contracts
|
||||
open Client.Shared.JsonWire
|
||||
|
||||
let private storageKey = "quizsystem.session"
|
||||
|
||||
let save (session: LoginResponse) : unit =
|
||||
let raw =
|
||||
createObj [
|
||||
"Token" ==> session.Token
|
||||
"UserId" ==> encUserId session.UserId
|
||||
"Name" ==> session.Name
|
||||
"Role" ==> box (string session.Role)
|
||||
]
|
||||
|
||||
localStorage.setItem (storageKey, JS.JSON.stringify raw)
|
||||
|
||||
let clear () : unit = localStorage.removeItem storageKey
|
||||
|
||||
/// `None` on a first visit, a cleared/missing entry, or anything that fails
|
||||
/// to parse (e.g. a stale shape from a previous version of this app) — any
|
||||
/// of those should just fall through to the login page, not crash the app
|
||||
/// on load.
|
||||
let tryLoad () : LoginResponse option =
|
||||
match localStorage.getItem storageKey with
|
||||
| null -> None
|
||||
| json ->
|
||||
try
|
||||
let raw = JS.JSON.parse json
|
||||
|
||||
Some
|
||||
{ Token = raw?Token
|
||||
UserId = decUserId raw?UserId
|
||||
Name = raw?Name
|
||||
Role = decodeRole raw?Role }
|
||||
with _ ->
|
||||
None
|
||||
20
src/Client/index.html
Normal file
20
src/Client/index.html
Normal file
@@ -0,0 +1,20 @@
|
||||
<!doctype html>
|
||||
<html lang="ru">
|
||||
<head>
|
||||
<meta charset="UTF-8" />
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1" />
|
||||
<meta name="description" content="Система тестирования — банк вопросов, тесты и результаты." />
|
||||
<title>Система тестирования</title>
|
||||
<link rel="preconnect" href="https://fonts.googleapis.com" />
|
||||
<link rel="preconnect" href="https://fonts.gstatic.com" crossorigin />
|
||||
<link
|
||||
rel="stylesheet"
|
||||
href="https://fonts.googleapis.com/css2?family=IBM+Plex+Serif:wght@500;600&family=IBM+Plex+Sans:wght@400;500;600&family=IBM+Plex+Mono:wght@400;500&display=swap"
|
||||
/>
|
||||
<link rel="stylesheet" href="./style.css" />
|
||||
</head>
|
||||
<body>
|
||||
<div id="elmish-app"></div>
|
||||
<script type="module" src="./Program.js"></script>
|
||||
</body>
|
||||
</html>
|
||||
8
src/Client/nginx.conf
Normal file
8
src/Client/nginx.conf
Normal file
@@ -0,0 +1,8 @@
|
||||
server {
|
||||
listen 80;
|
||||
root /usr/share/nginx/html;
|
||||
|
||||
location / {
|
||||
try_files $uri $uri/ /index.html;
|
||||
}
|
||||
}
|
||||
880
src/Client/style.css
Normal file
880
src/Client/style.css
Normal file
@@ -0,0 +1,880 @@
|
||||
/* ============================================================
|
||||
Tokens
|
||||
============================================================ */
|
||||
:root {
|
||||
--paper: #ece9e1;
|
||||
--surface: #fbfaf6;
|
||||
--ink: #1d2333;
|
||||
--ink-soft: #565f70;
|
||||
--line: #d6d0c0;
|
||||
--brass: #8c6a28;
|
||||
--brass-soft: #eee3cd;
|
||||
--pass: #1f6f45;
|
||||
--pass-bg: #e4efe7;
|
||||
--fail: #a32b20;
|
||||
--fail-bg: #f6e6e3;
|
||||
|
||||
--font-display: "IBM Plex Serif", Georgia, serif;
|
||||
--font-body: "IBM Plex Sans", system-ui, sans-serif;
|
||||
--font-mono: "IBM Plex Mono", ui-monospace, monospace;
|
||||
|
||||
--radius: 3px;
|
||||
}
|
||||
|
||||
/* ============================================================
|
||||
Reset & base
|
||||
============================================================ */
|
||||
* {
|
||||
box-sizing: border-box;
|
||||
}
|
||||
|
||||
body {
|
||||
font-family: var(--font-body);
|
||||
background: var(--paper);
|
||||
color: var(--ink);
|
||||
margin: 0;
|
||||
line-height: 1.5;
|
||||
-webkit-font-smoothing: antialiased;
|
||||
}
|
||||
|
||||
h1,
|
||||
h2,
|
||||
h3 {
|
||||
font-family: var(--font-display);
|
||||
font-weight: 600;
|
||||
margin: 0 0 0.6em;
|
||||
line-height: 1.2;
|
||||
letter-spacing: -0.01em;
|
||||
}
|
||||
|
||||
h1 {
|
||||
font-size: 1.75rem;
|
||||
}
|
||||
h2 {
|
||||
font-size: 1.3rem;
|
||||
}
|
||||
h3 {
|
||||
font-size: 1.05rem;
|
||||
}
|
||||
|
||||
p {
|
||||
margin: 0 0 0.75em;
|
||||
}
|
||||
|
||||
ul {
|
||||
list-style: none;
|
||||
padding: 0;
|
||||
margin: 0;
|
||||
}
|
||||
|
||||
button {
|
||||
font-family: var(--font-body);
|
||||
font-size: 0.95rem;
|
||||
font-weight: 500;
|
||||
background: var(--ink);
|
||||
color: var(--surface);
|
||||
border: 1px solid var(--ink);
|
||||
border-radius: var(--radius);
|
||||
padding: 0.55rem 1.1rem;
|
||||
cursor: pointer;
|
||||
transition: background-color 150ms ease, transform 100ms ease;
|
||||
}
|
||||
|
||||
button:hover:not(:disabled) {
|
||||
background: #323a52;
|
||||
}
|
||||
|
||||
button:active:not(:disabled) {
|
||||
transform: translateY(1px);
|
||||
}
|
||||
|
||||
button:disabled {
|
||||
cursor: not-allowed;
|
||||
opacity: 0.55;
|
||||
}
|
||||
|
||||
/* Secondary / utility buttons — outline instead of filled */
|
||||
.option-row button,
|
||||
button[type="button"] {
|
||||
background: transparent;
|
||||
color: var(--ink);
|
||||
}
|
||||
|
||||
.option-row button:hover:not(:disabled),
|
||||
button[type="button"]:hover:not(:disabled) {
|
||||
background: var(--brass-soft);
|
||||
}
|
||||
|
||||
input,
|
||||
select,
|
||||
textarea {
|
||||
font-family: var(--font-body);
|
||||
font-size: 0.95rem;
|
||||
color: var(--ink);
|
||||
background: var(--surface);
|
||||
border: 1px solid var(--line);
|
||||
border-radius: var(--radius);
|
||||
padding: 0.5rem 0.6rem;
|
||||
}
|
||||
|
||||
label {
|
||||
display: block;
|
||||
font-weight: 500;
|
||||
font-size: 0.85rem;
|
||||
color: var(--ink-soft);
|
||||
margin-top: 0.85rem;
|
||||
margin-bottom: 0.25rem;
|
||||
}
|
||||
|
||||
/* Full-width block inputs — explicitly excludes radio/checkbox, which must
|
||||
keep their native size wherever they appear inside a <form> (option
|
||||
editors, true/false pickers, student checklists). */
|
||||
form input:not([type="radio"]):not([type="checkbox"]),
|
||||
form select {
|
||||
display: block;
|
||||
width: 100%;
|
||||
}
|
||||
|
||||
.option-row input[type="radio"],
|
||||
.option-row input[type="checkbox"] {
|
||||
width: auto;
|
||||
flex: none;
|
||||
}
|
||||
|
||||
a {
|
||||
color: var(--brass);
|
||||
}
|
||||
|
||||
:focus-visible {
|
||||
outline: 2px solid var(--brass);
|
||||
outline-offset: 2px;
|
||||
}
|
||||
|
||||
.error {
|
||||
color: var(--fail);
|
||||
background: var(--fail-bg);
|
||||
border-left: 3px solid var(--fail);
|
||||
padding: 0.5rem 0.75rem;
|
||||
border-radius: 0 var(--radius) var(--radius) 0;
|
||||
font-size: 0.9rem;
|
||||
}
|
||||
|
||||
.hint {
|
||||
color: var(--ink-soft);
|
||||
font-size: 0.85rem;
|
||||
font-family: var(--font-mono);
|
||||
}
|
||||
|
||||
/* ============================================================
|
||||
Shell: topbar, page container
|
||||
============================================================ */
|
||||
.topbar {
|
||||
position: sticky;
|
||||
top: 0;
|
||||
z-index: 10;
|
||||
display: flex;
|
||||
justify-content: space-between;
|
||||
align-items: center;
|
||||
background: var(--paper);
|
||||
border-bottom: 1px solid var(--line);
|
||||
padding: 0.9rem 1.5rem;
|
||||
}
|
||||
|
||||
.topbar-identity {
|
||||
display: flex;
|
||||
align-items: baseline;
|
||||
gap: 0.6rem;
|
||||
}
|
||||
|
||||
.topbar-name {
|
||||
font-weight: 500;
|
||||
}
|
||||
|
||||
.role-badge {
|
||||
font-family: var(--font-mono);
|
||||
font-size: 0.72rem;
|
||||
letter-spacing: 0.04em;
|
||||
text-transform: uppercase;
|
||||
color: var(--brass);
|
||||
background: var(--brass-soft);
|
||||
border-radius: var(--radius);
|
||||
padding: 0.15rem 0.5rem;
|
||||
}
|
||||
|
||||
.wordmark {
|
||||
font-family: var(--font-display);
|
||||
font-weight: 600;
|
||||
}
|
||||
|
||||
/* Every page under the topbar gets consistent horizontal rhythm */
|
||||
.quiz-list-page,
|
||||
.taking-quiz-page,
|
||||
.result-page,
|
||||
.teacher-home {
|
||||
max-width: 880px;
|
||||
margin: 0 auto;
|
||||
padding: 1.75rem 1.5rem 3rem;
|
||||
}
|
||||
|
||||
.login-page {
|
||||
max-width: 420px;
|
||||
margin: 4rem auto;
|
||||
padding: 0 1.5rem;
|
||||
}
|
||||
|
||||
/* ============================================================
|
||||
Login
|
||||
============================================================ */
|
||||
.login-page .wordmark {
|
||||
font-size: 2rem;
|
||||
margin-bottom: 0.25rem;
|
||||
}
|
||||
|
||||
.login-card {
|
||||
background: var(--surface);
|
||||
border: 1px solid var(--line);
|
||||
border-radius: var(--radius);
|
||||
padding: 1.75rem;
|
||||
margin-top: 1.5rem;
|
||||
}
|
||||
|
||||
.login-card button[type="submit"] {
|
||||
width: 100%;
|
||||
margin-top: 1.25rem;
|
||||
}
|
||||
|
||||
.login-page .hint {
|
||||
margin-top: 1rem;
|
||||
text-align: center;
|
||||
}
|
||||
|
||||
/* ============================================================
|
||||
Quiz list (student)
|
||||
============================================================ */
|
||||
.quiz-card {
|
||||
background: var(--surface);
|
||||
border: 1px solid var(--line);
|
||||
border-radius: var(--radius);
|
||||
padding: 1.25rem 1.5rem;
|
||||
margin-bottom: 1rem;
|
||||
}
|
||||
|
||||
.meta-row {
|
||||
display: flex;
|
||||
flex-wrap: wrap;
|
||||
gap: 1.5rem;
|
||||
margin: 1rem 0;
|
||||
padding-top: 0.85rem;
|
||||
border-top: 1px solid var(--line);
|
||||
}
|
||||
|
||||
.meta-item {
|
||||
display: flex;
|
||||
flex-direction: column;
|
||||
gap: 0.15rem;
|
||||
}
|
||||
|
||||
.meta-label {
|
||||
font-size: 0.72rem;
|
||||
letter-spacing: 0.04em;
|
||||
text-transform: uppercase;
|
||||
color: var(--ink-soft);
|
||||
}
|
||||
|
||||
.meta-value {
|
||||
font-family: var(--font-mono);
|
||||
font-size: 1.05rem;
|
||||
}
|
||||
|
||||
/* Smaller inline mono tag — inherits color so it stays readable both in
|
||||
normal rows and on the dark `.selected` background of topic/quiz items. */
|
||||
.tag-mono {
|
||||
font-family: var(--font-mono);
|
||||
font-size: 0.8rem;
|
||||
opacity: 0.72;
|
||||
}
|
||||
|
||||
/* ============================================================
|
||||
Taking a quiz
|
||||
============================================================ */
|
||||
.question {
|
||||
display: flex;
|
||||
gap: 1rem;
|
||||
border-top: 1px solid var(--line);
|
||||
padding: 1.25rem 0;
|
||||
}
|
||||
|
||||
.question:first-of-type {
|
||||
border-top: none;
|
||||
}
|
||||
|
||||
.question-number {
|
||||
font-family: var(--font-mono);
|
||||
font-size: 0.85rem;
|
||||
color: var(--brass);
|
||||
flex-shrink: 0;
|
||||
padding-top: 0.15rem;
|
||||
}
|
||||
|
||||
.question-body {
|
||||
flex: 1;
|
||||
min-width: 0;
|
||||
}
|
||||
|
||||
.question-text {
|
||||
font-weight: 500;
|
||||
margin-bottom: 0.6rem;
|
||||
}
|
||||
|
||||
.option {
|
||||
display: flex;
|
||||
align-items: center;
|
||||
gap: 0.5rem;
|
||||
font-weight: normal;
|
||||
margin: 0 0 0.35rem;
|
||||
}
|
||||
|
||||
.option input {
|
||||
width: auto;
|
||||
}
|
||||
|
||||
.quiz-actions {
|
||||
position: sticky;
|
||||
bottom: 0;
|
||||
background: var(--paper);
|
||||
border-top: 1px solid var(--line);
|
||||
margin: 0 -1.5rem;
|
||||
padding: 1rem 1.5rem;
|
||||
box-shadow: 0 -6px 12px -8px rgba(29, 35, 51, 0.15);
|
||||
}
|
||||
|
||||
.quiz-actions button {
|
||||
width: 100%;
|
||||
}
|
||||
|
||||
.time-remaining {
|
||||
display: block;
|
||||
text-align: center;
|
||||
font-family: var(--font-mono);
|
||||
font-size: 0.95rem;
|
||||
color: var(--ink-soft);
|
||||
margin-bottom: 0.6rem;
|
||||
}
|
||||
|
||||
.time-remaining.low {
|
||||
color: var(--fail);
|
||||
font-weight: 600;
|
||||
}
|
||||
|
||||
/* ============================================================
|
||||
Result
|
||||
============================================================ */
|
||||
.result-page {
|
||||
text-align: center;
|
||||
}
|
||||
|
||||
.grade-stamp {
|
||||
display: inline-block;
|
||||
font-family: var(--font-display);
|
||||
font-weight: 600;
|
||||
font-size: 1.4rem;
|
||||
text-transform: uppercase;
|
||||
letter-spacing: 0.05em;
|
||||
border: 3px solid currentColor;
|
||||
border-radius: var(--radius);
|
||||
padding: 0.6rem 1.5rem;
|
||||
margin: 1rem 0 1.5rem;
|
||||
transform: rotate(-4deg);
|
||||
animation: stamp-down 260ms ease-out;
|
||||
}
|
||||
|
||||
.grade-stamp.passed {
|
||||
color: var(--pass);
|
||||
background: var(--pass-bg);
|
||||
}
|
||||
|
||||
.grade-stamp.failed {
|
||||
color: var(--fail);
|
||||
background: var(--fail-bg);
|
||||
}
|
||||
|
||||
@keyframes stamp-down {
|
||||
from {
|
||||
opacity: 0;
|
||||
transform: rotate(-4deg) scale(1.4);
|
||||
}
|
||||
to {
|
||||
opacity: 1;
|
||||
transform: rotate(-4deg) scale(1);
|
||||
}
|
||||
}
|
||||
|
||||
.score-value {
|
||||
display: block;
|
||||
font-family: var(--font-mono);
|
||||
font-size: 1.5rem;
|
||||
margin-bottom: 0.5rem;
|
||||
}
|
||||
|
||||
.results-panel {
|
||||
margin-top: 1rem;
|
||||
padding-top: 0.85rem;
|
||||
border-top: 1px solid var(--line);
|
||||
}
|
||||
|
||||
.attempt-row {
|
||||
display: flex;
|
||||
flex-wrap: wrap;
|
||||
align-items: center;
|
||||
gap: 0.75rem;
|
||||
padding: 0.4rem 0;
|
||||
}
|
||||
|
||||
/* Compact, non-animated variant of the big result-page stamp/score, sized
|
||||
for a list row instead of a standalone celebratory screen. */
|
||||
.attempt-row .score-value {
|
||||
display: inline;
|
||||
font-size: 0.95rem;
|
||||
margin-bottom: 0;
|
||||
}
|
||||
|
||||
.attempt-row .grade-stamp {
|
||||
font-size: 0.75rem;
|
||||
border-width: 1px;
|
||||
padding: 0.15rem 0.5rem;
|
||||
margin: 0;
|
||||
transform: none;
|
||||
animation: none;
|
||||
}
|
||||
|
||||
/* ============================================================
|
||||
Teacher admin
|
||||
============================================================ */
|
||||
.tabs {
|
||||
display: flex;
|
||||
gap: 0.5rem;
|
||||
margin-bottom: 1.5rem;
|
||||
border-bottom: 1px solid var(--line);
|
||||
}
|
||||
|
||||
.tab-button {
|
||||
background: transparent;
|
||||
color: var(--ink-soft);
|
||||
border: none;
|
||||
border-bottom: 2px solid transparent;
|
||||
border-radius: 0;
|
||||
padding: 0.6rem 0.25rem;
|
||||
margin-bottom: -1px;
|
||||
margin-right: 1.25rem;
|
||||
}
|
||||
|
||||
.tab-button:hover:not(:disabled) {
|
||||
background: transparent;
|
||||
color: var(--ink);
|
||||
}
|
||||
|
||||
.tab-button.active {
|
||||
color: var(--ink);
|
||||
border-bottom-color: var(--brass);
|
||||
font-weight: 600;
|
||||
}
|
||||
|
||||
.teacher-layout {
|
||||
display: grid;
|
||||
grid-template-columns: 260px 1fr;
|
||||
gap: 2rem;
|
||||
align-items: start;
|
||||
margin-top: 1rem;
|
||||
}
|
||||
|
||||
.topics-panel,
|
||||
.quizzes-panel {
|
||||
background: var(--surface);
|
||||
border: 1px solid var(--line);
|
||||
border-radius: var(--radius);
|
||||
padding: 1.25rem;
|
||||
}
|
||||
|
||||
.topics-panel form {
|
||||
display: flex;
|
||||
flex-wrap: wrap;
|
||||
align-items: center;
|
||||
gap: 0.5rem;
|
||||
margin-top: 0.75rem;
|
||||
}
|
||||
|
||||
.topic-item {
|
||||
padding: 0.5rem 0.6rem;
|
||||
border-radius: var(--radius);
|
||||
cursor: pointer;
|
||||
font-size: 0.92rem;
|
||||
}
|
||||
|
||||
.topic-item:hover {
|
||||
background: var(--brass-soft);
|
||||
}
|
||||
|
||||
.topic-item.selected {
|
||||
background: var(--ink);
|
||||
color: var(--surface);
|
||||
}
|
||||
|
||||
/* Outline buttons default to ink-on-transparent, which is invisible against
|
||||
the dark background above — flip them to light-on-transparent here. */
|
||||
.topic-item.selected button[type="button"] {
|
||||
color: var(--surface);
|
||||
border-color: var(--surface);
|
||||
}
|
||||
|
||||
.topic-item.selected button[type="button"]:hover:not(:disabled) {
|
||||
background: rgba(251, 250, 246, 0.15);
|
||||
}
|
||||
|
||||
/* ---- Tests page: page-level header + quiz card grid ---- */
|
||||
|
||||
.page-header {
|
||||
display: flex;
|
||||
align-items: center;
|
||||
justify-content: space-between;
|
||||
gap: 1rem;
|
||||
margin-bottom: 1.5rem;
|
||||
}
|
||||
|
||||
.page-header h1 {
|
||||
margin: 0;
|
||||
}
|
||||
|
||||
.quiz-cards {
|
||||
display: grid;
|
||||
grid-template-columns: repeat(auto-fill, minmax(240px, 1fr));
|
||||
gap: 1rem;
|
||||
}
|
||||
|
||||
/* Named `-manage-` to avoid colliding with the unrelated `.quiz-card` class
|
||||
used by the student-facing Browse page (Quizzes/Browse/View.fs). */
|
||||
.quiz-manage-card {
|
||||
display: flex;
|
||||
flex-direction: column;
|
||||
gap: 0.6rem;
|
||||
background: var(--surface);
|
||||
border: 1px solid var(--line);
|
||||
border-radius: var(--radius);
|
||||
padding: 1rem 1.25rem;
|
||||
cursor: pointer;
|
||||
}
|
||||
|
||||
.quiz-manage-card:hover {
|
||||
border-color: var(--brass);
|
||||
}
|
||||
|
||||
.quiz-manage-card.selected {
|
||||
background: var(--ink);
|
||||
color: var(--surface);
|
||||
border-color: var(--ink);
|
||||
}
|
||||
|
||||
.quiz-manage-card-title {
|
||||
margin: 0;
|
||||
}
|
||||
|
||||
.quiz-manage-card-actions {
|
||||
display: flex;
|
||||
flex-wrap: wrap;
|
||||
gap: 0.5rem;
|
||||
margin-top: auto;
|
||||
padding-top: 0.4rem;
|
||||
}
|
||||
|
||||
.quiz-manage-card-actions button {
|
||||
flex: 1 1 auto;
|
||||
}
|
||||
|
||||
/* Outline buttons default to ink-on-transparent, which is invisible against
|
||||
the dark background of a selected card — flip them to light-on-transparent. */
|
||||
.quiz-manage-card.selected button[type="button"] {
|
||||
color: var(--surface);
|
||||
border-color: var(--surface);
|
||||
}
|
||||
|
||||
.quiz-manage-card.selected button[type="button"]:hover:not(:disabled) {
|
||||
background: rgba(251, 250, 246, 0.15);
|
||||
}
|
||||
|
||||
/* ---- Tests page: results view (quiz cards shift into a narrow left
|
||||
column, results table takes the rest) ---- */
|
||||
|
||||
.results-layout {
|
||||
display: grid;
|
||||
grid-template-columns: 320px 1fr;
|
||||
gap: 2rem;
|
||||
align-items: start;
|
||||
}
|
||||
|
||||
.results-table {
|
||||
width: 100%;
|
||||
border-collapse: collapse;
|
||||
font-size: 0.9rem;
|
||||
}
|
||||
|
||||
.results-table th,
|
||||
.results-table td {
|
||||
text-align: left;
|
||||
padding: 0.55rem 0.75rem;
|
||||
border-bottom: 1px solid var(--line);
|
||||
}
|
||||
|
||||
.results-table th {
|
||||
font-family: var(--font-mono);
|
||||
font-size: 0.7rem;
|
||||
letter-spacing: 0.04em;
|
||||
text-transform: uppercase;
|
||||
color: var(--ink-soft);
|
||||
}
|
||||
|
||||
.results-table tbody tr:hover {
|
||||
background: var(--brass-soft);
|
||||
}
|
||||
|
||||
.focus-loss-value {
|
||||
font-family: var(--font-mono);
|
||||
}
|
||||
|
||||
.focus-loss-value.warn {
|
||||
color: var(--fail);
|
||||
font-weight: 600;
|
||||
}
|
||||
|
||||
/* Compact, non-animated variant for the "Результат" column — the default
|
||||
`.grade-stamp` is sized/rotated for the standalone result screen and
|
||||
would overflow a table cell. */
|
||||
.results-table .grade-stamp {
|
||||
font-size: 0.75rem;
|
||||
border-width: 1px;
|
||||
padding: 0.15rem 0.5rem;
|
||||
margin: 0;
|
||||
transform: none;
|
||||
animation: none;
|
||||
}
|
||||
|
||||
.questions-list,
|
||||
.assignment-panel {
|
||||
background: var(--surface);
|
||||
border: 1px solid var(--line);
|
||||
border-radius: var(--radius);
|
||||
padding: 1.25rem 1.5rem;
|
||||
margin-bottom: 1.25rem;
|
||||
}
|
||||
|
||||
.questions-list li {
|
||||
display: flex;
|
||||
flex-wrap: wrap;
|
||||
align-items: center;
|
||||
gap: 0.5rem;
|
||||
border-top: 1px solid var(--line);
|
||||
padding: 0.6rem 0;
|
||||
}
|
||||
|
||||
.questions-list li:first-child {
|
||||
border-top: none;
|
||||
}
|
||||
|
||||
.question-kind {
|
||||
font-family: var(--font-mono);
|
||||
font-size: 0.75rem;
|
||||
color: var(--brass);
|
||||
text-transform: uppercase;
|
||||
letter-spacing: 0.03em;
|
||||
margin-right: 0.5rem;
|
||||
}
|
||||
|
||||
.new-question-form {
|
||||
background: var(--surface);
|
||||
border: 1px solid var(--line);
|
||||
border-radius: var(--radius);
|
||||
padding: 1.25rem 1.5rem;
|
||||
}
|
||||
|
||||
.new-question-form > button + button {
|
||||
margin-left: 0.5rem;
|
||||
}
|
||||
|
||||
.pool-picker {
|
||||
display: flex;
|
||||
flex-wrap: wrap;
|
||||
align-items: center;
|
||||
gap: 0.5rem;
|
||||
}
|
||||
|
||||
.pool-picker p {
|
||||
flex-basis: 100%;
|
||||
margin-bottom: 0;
|
||||
}
|
||||
|
||||
.question-picker input[type="text"] + button {
|
||||
margin-left: 0.5rem;
|
||||
}
|
||||
|
||||
/* The global `form input:not([type=radio]):not([type=checkbox]) { width:
|
||||
100% }` rule outweighs a single class here, so this needs !important to
|
||||
keep the field beside its button instead of stacking under it. */
|
||||
.pool-count-input {
|
||||
display: inline-block !important;
|
||||
width: 6rem !important;
|
||||
}
|
||||
|
||||
.pool-rules-summary li {
|
||||
display: flex;
|
||||
align-items: center;
|
||||
justify-content: space-between;
|
||||
gap: 0.75rem;
|
||||
padding: 0.3rem 0;
|
||||
}
|
||||
|
||||
/* ---- Modal overlay (quiz create/edit form) ---- */
|
||||
|
||||
.modal-backdrop {
|
||||
position: fixed;
|
||||
inset: 0;
|
||||
background: rgba(29, 35, 51, 0.55);
|
||||
display: flex;
|
||||
justify-content: center;
|
||||
align-items: flex-start;
|
||||
padding: 3rem 1.5rem;
|
||||
overflow-y: auto;
|
||||
z-index: 100;
|
||||
}
|
||||
|
||||
.modal-dialog {
|
||||
width: 100%;
|
||||
max-width: 560px;
|
||||
}
|
||||
|
||||
.modal-backdrop .new-question-form {
|
||||
box-shadow: 0 20px 48px rgba(29, 35, 51, 0.3);
|
||||
}
|
||||
|
||||
.options-editor {
|
||||
margin: 0.5rem 0 1rem;
|
||||
}
|
||||
|
||||
.option-row {
|
||||
display: flex;
|
||||
align-items: center;
|
||||
gap: 0.5rem;
|
||||
margin-bottom: 0.5rem;
|
||||
}
|
||||
|
||||
.option-row input[type="text"] {
|
||||
flex: 1;
|
||||
}
|
||||
|
||||
.student-row {
|
||||
display: flex;
|
||||
align-items: center;
|
||||
gap: 0.6rem;
|
||||
padding: 0.4rem 0;
|
||||
font-size: 0.92rem;
|
||||
cursor: pointer;
|
||||
}
|
||||
|
||||
.student-row input {
|
||||
width: auto;
|
||||
}
|
||||
|
||||
/* ---- Admin: users list ---- */
|
||||
|
||||
.users-list li {
|
||||
display: flex;
|
||||
flex-wrap: wrap;
|
||||
align-items: center;
|
||||
gap: 0.75rem;
|
||||
border-top: 1px solid var(--line);
|
||||
padding: 0.6rem 0;
|
||||
}
|
||||
|
||||
.users-list li:first-child {
|
||||
border-top: none;
|
||||
}
|
||||
|
||||
.user-row-info {
|
||||
display: flex;
|
||||
flex-direction: column;
|
||||
gap: 0.1rem;
|
||||
flex: 1 1 200px;
|
||||
}
|
||||
|
||||
.user-row-name {
|
||||
font-weight: 500;
|
||||
}
|
||||
|
||||
.user-row-badges {
|
||||
display: flex;
|
||||
flex-wrap: wrap;
|
||||
gap: 0.4rem;
|
||||
margin-top: 0.3rem;
|
||||
}
|
||||
|
||||
.user-row-actions {
|
||||
display: flex;
|
||||
flex-wrap: wrap;
|
||||
gap: 0.5rem;
|
||||
margin-left: auto;
|
||||
}
|
||||
|
||||
.status-badge {
|
||||
font-family: var(--font-mono);
|
||||
font-size: 0.72rem;
|
||||
letter-spacing: 0.04em;
|
||||
text-transform: uppercase;
|
||||
border-radius: var(--radius);
|
||||
padding: 0.15rem 0.5rem;
|
||||
}
|
||||
|
||||
.status-badge.active {
|
||||
color: var(--pass);
|
||||
background: var(--pass-bg);
|
||||
}
|
||||
|
||||
.status-badge.inactive {
|
||||
color: var(--fail);
|
||||
background: var(--fail-bg);
|
||||
}
|
||||
|
||||
/* ============================================================
|
||||
Accessibility & motion
|
||||
============================================================ */
|
||||
@media (prefers-reduced-motion: reduce) {
|
||||
*,
|
||||
*::before,
|
||||
*::after {
|
||||
animation-duration: 0.001ms !important;
|
||||
animation-iteration-count: 1 !important;
|
||||
transition-duration: 0.001ms !important;
|
||||
}
|
||||
}
|
||||
|
||||
/* ============================================================
|
||||
Responsive
|
||||
============================================================ */
|
||||
@media (max-width: 640px) {
|
||||
.teacher-layout,
|
||||
.results-layout {
|
||||
grid-template-columns: 1fr;
|
||||
}
|
||||
|
||||
.topbar {
|
||||
padding: 0.75rem 1rem;
|
||||
}
|
||||
|
||||
.quiz-list-page,
|
||||
.taking-quiz-page,
|
||||
.result-page,
|
||||
.teacher-home {
|
||||
padding: 1.25rem 1rem 3rem;
|
||||
}
|
||||
|
||||
.quiz-actions {
|
||||
margin: 0 -1rem;
|
||||
padding: 1rem;
|
||||
}
|
||||
}
|
||||
77
src/Domain/Core/Attempts.fs
Normal file
77
src/Domain/Core/Attempts.fs
Normal file
@@ -0,0 +1,77 @@
|
||||
namespace Domain
|
||||
|
||||
open System
|
||||
|
||||
/// A student's raw answer to one question, shaped to match its QuestionType.
|
||||
type StudentResponse =
|
||||
| SingleChoiceResponse of OptionId option
|
||||
| MultipleChoiceResponse of Set<OptionId>
|
||||
| TrueFalseResponse of bool option
|
||||
| ShortAnswerResponse of string
|
||||
| NumericResponse of float option
|
||||
|
||||
type AttemptState =
|
||||
| InProgress
|
||||
| Submitted
|
||||
| Graded
|
||||
|
||||
type QuestionGrade =
|
||||
{ QuestionId: QuestionId
|
||||
PointsAwarded: float
|
||||
MaxPoints: float
|
||||
IsCorrect: bool }
|
||||
|
||||
type Attempt =
|
||||
{ Id: AttemptId
|
||||
QuizId: QuizId
|
||||
UserId: UserId
|
||||
StartedAt: DateTimeOffset
|
||||
SubmittedAt: DateTimeOffset option
|
||||
State: AttemptState
|
||||
/// Snapshot of the specific questions dealt to this attempt, resolved
|
||||
/// from the quiz's sources when it started — fixed questions pass
|
||||
/// through as-is, random-pool sources are drawn fresh per attempt, so
|
||||
/// this can differ between attempts of the same quiz. Grading always
|
||||
/// reads this, never the quiz's sources directly.
|
||||
Questions: QuizQuestionRef list
|
||||
Responses: Map<QuestionId, StudentResponse>
|
||||
Grades: Map<QuestionId, QuestionGrade>
|
||||
Score: float option
|
||||
/// How many times the student's browser tab lost focus (switched tab,
|
||||
/// minimized, alt-tabbed away) while this attempt was `InProgress` —
|
||||
/// incremented server-side only (`reportFocusLoss`), never trusted from
|
||||
/// the client directly, so it can't be gamed downward. Purely
|
||||
/// informational for the teacher; the system takes no automatic action
|
||||
/// on it.
|
||||
FocusLossCount: int }
|
||||
|
||||
module Attempt =
|
||||
let start
|
||||
(attemptId: AttemptId)
|
||||
(quiz: Quiz)
|
||||
(questions: QuizQuestionRef list)
|
||||
(userId: UserId)
|
||||
(now: DateTimeOffset)
|
||||
: Attempt =
|
||||
{ Id = attemptId
|
||||
QuizId = quiz.Id
|
||||
UserId = userId
|
||||
StartedAt = now
|
||||
SubmittedAt = None
|
||||
State = InProgress
|
||||
Questions = questions
|
||||
Responses = Map.empty
|
||||
Grades = Map.empty
|
||||
Score = None
|
||||
FocusLossCount = 0 }
|
||||
|
||||
let recordResponse (questionId: QuestionId) (response: StudentResponse) (attempt: Attempt) : Attempt =
|
||||
{ attempt with Responses = attempt.Responses |> Map.add questionId response }
|
||||
|
||||
let submit (now: DateTimeOffset) (attempt: Attempt) : Attempt =
|
||||
{ attempt with State = Submitted; SubmittedAt = Some now }
|
||||
|
||||
let isExpired (quiz: Quiz) (now: DateTimeOffset) (attempt: Attempt) : bool =
|
||||
match quiz.TimeLimit with
|
||||
| None -> false
|
||||
| Some limit -> now - attempt.StartedAt > limit
|
||||
89
src/Domain/Core/Grading.fs
Normal file
89
src/Domain/Core/Grading.fs
Normal file
@@ -0,0 +1,89 @@
|
||||
namespace Domain
|
||||
|
||||
/// Pure grading logic: no I/O, no mutable state. Given a question's
|
||||
/// correctness data and a student's response, decide the awarded points.
|
||||
module Grading =
|
||||
|
||||
let private floatEquals (tolerance: float) (a: float) (b: float) = abs (a - b) <= tolerance
|
||||
|
||||
let private textEquals (caseSensitive: bool) (accepted: string list) (answer: string) =
|
||||
let normalize (s: string) =
|
||||
let trimmed = s.Trim()
|
||||
if caseSensitive then trimmed else trimmed.ToLowerInvariant()
|
||||
|
||||
let answerNorm = normalize answer
|
||||
accepted |> List.exists (fun a -> normalize a = answerNorm)
|
||||
|
||||
/// The response value representing "not answered" for a given question type,
|
||||
/// used to grade skipped questions as incorrect rather than crashing.
|
||||
let emptyResponseFor (questionType: QuestionType) : StudentResponse =
|
||||
match questionType with
|
||||
| SingleChoice _ -> SingleChoiceResponse None
|
||||
| MultipleChoice _ -> MultipleChoiceResponse Set.empty
|
||||
| TrueFalse _ -> TrueFalseResponse None
|
||||
| ShortAnswer _ -> ShortAnswerResponse ""
|
||||
| Numeric _ -> NumericResponse None
|
||||
|
||||
let gradeResponse
|
||||
(questionId: QuestionId)
|
||||
(questionType: QuestionType)
|
||||
(maxPoints: float)
|
||||
(response: StudentResponse)
|
||||
: QuestionGrade =
|
||||
let award isCorrect =
|
||||
{ QuestionId = questionId
|
||||
PointsAwarded = (if isCorrect then maxPoints else 0.0)
|
||||
MaxPoints = maxPoints
|
||||
IsCorrect = isCorrect }
|
||||
|
||||
match questionType, response with
|
||||
| SingleChoice(_, correct), SingleChoiceResponse(Some chosen) -> award (chosen = correct)
|
||||
| SingleChoice _, SingleChoiceResponse None -> award false
|
||||
| MultipleChoice(_, correct), MultipleChoiceResponse chosen -> award (chosen = correct)
|
||||
| TrueFalse correct, TrueFalseResponse(Some chosen) -> award (chosen = correct)
|
||||
| TrueFalse _, TrueFalseResponse None -> award false
|
||||
| ShortAnswer(accepted, caseSensitive), ShortAnswerResponse answer -> award (textEquals caseSensitive accepted answer)
|
||||
| Numeric(correct, tolerance), NumericResponse(Some value) -> award (floatEquals tolerance value correct)
|
||||
| Numeric _, NumericResponse None -> award false
|
||||
| _ -> award false // response shape doesn't match the question type
|
||||
|
||||
/// Grades every question dealt to this attempt (its own `Questions`
|
||||
/// snapshot, not the quiz's sources — those may be random-pool rules
|
||||
/// resolved differently per attempt), treating any question the student
|
||||
/// never answered as an incorrect (zero-point) response.
|
||||
let gradeAttempt (questions: Map<QuestionId, Question>) (attempt: Attempt) : Attempt =
|
||||
let grades =
|
||||
attempt.Questions
|
||||
|> List.choose (fun qref ->
|
||||
match Map.tryFind qref.QuestionId questions with
|
||||
| None -> None
|
||||
| Some q ->
|
||||
let response =
|
||||
attempt.Responses
|
||||
|> Map.tryFind qref.QuestionId
|
||||
|> Option.defaultValue (emptyResponseFor q.Type)
|
||||
|
||||
Some(qref.QuestionId, gradeResponse qref.QuestionId q.Type qref.Points response))
|
||||
|> Map.ofList
|
||||
|
||||
let score = grades |> Map.toList |> List.sumBy (fun (_, g) -> g.PointsAwarded)
|
||||
|
||||
{ attempt with
|
||||
State = Graded
|
||||
Grades = grades
|
||||
Score = Some score }
|
||||
|
||||
/// Picks (or synthesizes) the attempt that represents the student's final
|
||||
/// grade for a quiz, per the quiz's configured grading method.
|
||||
let applyGradingMethod (method: GradingMethod) (attempts: Attempt list) : Attempt option =
|
||||
let graded = attempts |> List.filter (fun a -> a.State = Graded)
|
||||
|
||||
match method, graded with
|
||||
| _, [] -> None
|
||||
| HighestAttempt, xs -> xs |> List.maxBy (fun a -> defaultArg a.Score 0.0) |> Some
|
||||
| FirstAttempt, xs -> xs |> List.minBy (fun a -> a.StartedAt) |> Some
|
||||
| LastAttempt, xs -> xs |> List.maxBy (fun a -> a.StartedAt) |> Some
|
||||
| AverageAttempt, xs ->
|
||||
let avg = xs |> List.averageBy (fun a -> defaultArg a.Score 0.0)
|
||||
let mostRecent = xs |> List.maxBy (fun a -> a.StartedAt)
|
||||
Some { mostRecent with Score = Some avg }
|
||||
29
src/Domain/Core/Ids.fs
Normal file
29
src/Domain/Core/Ids.fs
Normal file
@@ -0,0 +1,29 @@
|
||||
namespace Domain
|
||||
|
||||
open System
|
||||
|
||||
[<Struct>]
|
||||
type UserId = UserId of Guid
|
||||
|
||||
[<Struct>]
|
||||
type TopicId = TopicId of Guid
|
||||
|
||||
[<Struct>]
|
||||
type QuestionId = QuestionId of Guid
|
||||
|
||||
[<Struct>]
|
||||
type OptionId = OptionId of Guid
|
||||
|
||||
[<Struct>]
|
||||
type QuizId = QuizId of Guid
|
||||
|
||||
[<Struct>]
|
||||
type AttemptId = AttemptId of Guid
|
||||
|
||||
module Id =
|
||||
let newUserId () = UserId(Guid.NewGuid())
|
||||
let newTopicId () = TopicId(Guid.NewGuid())
|
||||
let newQuestionId () = QuestionId(Guid.NewGuid())
|
||||
let newOptionId () = OptionId(Guid.NewGuid())
|
||||
let newQuizId () = QuizId(Guid.NewGuid())
|
||||
let newAttemptId () = AttemptId(Guid.NewGuid())
|
||||
22
src/Domain/Core/Questions.fs
Normal file
22
src/Domain/Core/Questions.fs
Normal file
@@ -0,0 +1,22 @@
|
||||
namespace Domain
|
||||
|
||||
type QuestionOption =
|
||||
{ Id: OptionId
|
||||
Text: string }
|
||||
|
||||
/// Type-specific correctness data. Each case is self-contained so the
|
||||
/// grading engine never has to guess how to check an answer.
|
||||
type QuestionType =
|
||||
| SingleChoice of options: QuestionOption list * correctOptionId: OptionId
|
||||
| MultipleChoice of options: QuestionOption list * correctOptionIds: Set<OptionId>
|
||||
| TrueFalse of correctAnswer: bool
|
||||
| ShortAnswer of acceptedAnswers: string list * caseSensitive: bool
|
||||
| Numeric of correctValue: float * tolerance: float
|
||||
|
||||
type Question =
|
||||
{ Id: QuestionId
|
||||
TopicId: TopicId
|
||||
Text: string
|
||||
/// Default point value when used in a quiz; a quiz may override this per-question.
|
||||
Points: float
|
||||
Type: QuestionType }
|
||||
54
src/Domain/Core/Quizzes.fs
Normal file
54
src/Domain/Core/Quizzes.fs
Normal file
@@ -0,0 +1,54 @@
|
||||
namespace Domain
|
||||
|
||||
open System
|
||||
|
||||
type GradingMethod =
|
||||
| HighestAttempt
|
||||
| AverageAttempt
|
||||
| FirstAttempt
|
||||
| LastAttempt
|
||||
|
||||
type QuizQuestionRef =
|
||||
{ QuestionId: QuestionId
|
||||
/// Points awarded for this question within this specific quiz
|
||||
/// (may differ from the question bank's default Points).
|
||||
Points: float
|
||||
Order: int }
|
||||
|
||||
/// One line item of a quiz's composition: a specific bank question snapshot
|
||||
/// at creation time, or a rule that draws `Count` random questions from
|
||||
/// `TopicId` fresh at each attempt. Because the random case isn't resolved
|
||||
/// until an attempt starts (and can differ between attempts of the same
|
||||
/// quiz), the concrete set of questions actually served is snapshotted onto
|
||||
/// the `Attempt` itself (see `Attempt.Questions`), never read back off the
|
||||
/// quiz during grading.
|
||||
type QuizQuestionSource =
|
||||
| FixedQuestion of QuizQuestionRef
|
||||
| RandomFromTopic of TopicId: TopicId * Count: int * Order: int
|
||||
|
||||
type Quiz =
|
||||
{ Id: QuizId
|
||||
OwnerId: UserId
|
||||
Title: string
|
||||
Description: string
|
||||
TimeLimit: TimeSpan option
|
||||
MaxAttempts: int option
|
||||
GradingMethod: GradingMethod
|
||||
ShuffleQuestions: bool
|
||||
ShuffleAnswers: bool
|
||||
OpenFrom: DateTimeOffset option
|
||||
OpenTo: DateTimeOffset option
|
||||
PassingScore: float option
|
||||
QuestionSources: QuizQuestionSource list
|
||||
AssignedStudentIds: Set<UserId> }
|
||||
|
||||
module Quiz =
|
||||
let sourceOrder (source: QuizQuestionSource) =
|
||||
match source with
|
||||
| FixedQuestion r -> r.Order
|
||||
| RandomFromTopic(_, _, order) -> order
|
||||
|
||||
let isOpenAt (now: DateTimeOffset) (quiz: Quiz) =
|
||||
let afterOpen = quiz.OpenFrom |> Option.forall (fun t -> now >= t)
|
||||
let beforeClose = quiz.OpenTo |> Option.forall (fun t -> now <= t)
|
||||
afterOpen && beforeClose
|
||||
4
src/Domain/Core/Topics.fs
Normal file
4
src/Domain/Core/Topics.fs
Normal file
@@ -0,0 +1,4 @@
|
||||
namespace Domain
|
||||
|
||||
/// A private question-bank grouping owned by one Teacher/Admin.
|
||||
type Topic = { Id: TopicId; OwnerId: UserId; Name: string }
|
||||
14
src/Domain/Core/Users.fs
Normal file
14
src/Domain/Core/Users.fs
Normal file
@@ -0,0 +1,14 @@
|
||||
namespace Domain
|
||||
|
||||
type Role =
|
||||
| Admin
|
||||
| Teacher
|
||||
| Student
|
||||
|
||||
type User =
|
||||
{ Id: UserId
|
||||
Name: string
|
||||
Email: string
|
||||
PasswordHash: string
|
||||
Role: Role
|
||||
IsActive: bool }
|
||||
79
src/Domain/Core/Validation.fs
Normal file
79
src/Domain/Core/Validation.fs
Normal file
@@ -0,0 +1,79 @@
|
||||
namespace Domain
|
||||
|
||||
type ValidationError = string
|
||||
|
||||
module QuestionValidation =
|
||||
|
||||
let validate (question: Question) : Result<Question, ValidationError list> =
|
||||
let errors = ResizeArray<string>()
|
||||
|
||||
if System.String.IsNullOrWhiteSpace question.Text then
|
||||
errors.Add "Question text must not be empty"
|
||||
|
||||
if question.Points <= 0.0 then
|
||||
errors.Add "Question points must be positive"
|
||||
|
||||
match question.Type with
|
||||
| SingleChoice(options, correct) ->
|
||||
if options.Length < 2 then
|
||||
errors.Add "Single choice question must have at least 2 options"
|
||||
|
||||
if not (options |> List.exists (fun o -> o.Id = correct)) then
|
||||
errors.Add "Correct option must be one of the provided options"
|
||||
| MultipleChoice(options, correct) ->
|
||||
if options.Length < 2 then
|
||||
errors.Add "Multiple choice question must have at least 2 options"
|
||||
|
||||
if correct.IsEmpty then
|
||||
errors.Add "At least one correct option must be selected"
|
||||
|
||||
let optionIds = options |> List.map (fun o -> o.Id) |> Set.ofList
|
||||
|
||||
if not (Set.isSubset correct optionIds) then
|
||||
errors.Add "Correct options must be a subset of the provided options"
|
||||
| TrueFalse _ -> ()
|
||||
| ShortAnswer(accepted, _) ->
|
||||
if accepted.IsEmpty then
|
||||
errors.Add "At least one accepted answer must be provided"
|
||||
| Numeric(_, tolerance) ->
|
||||
if tolerance < 0.0 then
|
||||
errors.Add "Tolerance must not be negative"
|
||||
|
||||
if errors.Count = 0 then Ok question else Error(List.ofSeq errors)
|
||||
|
||||
module QuizValidation =
|
||||
|
||||
let validate (quiz: Quiz) : Result<Quiz, ValidationError list> =
|
||||
let errors = ResizeArray<string>()
|
||||
|
||||
if System.String.IsNullOrWhiteSpace quiz.Title then
|
||||
errors.Add "Quiz title must not be empty"
|
||||
|
||||
if quiz.QuestionSources.IsEmpty then
|
||||
errors.Add "Quiz must contain at least one question"
|
||||
|
||||
if
|
||||
quiz.QuestionSources
|
||||
|> List.exists (function
|
||||
| FixedQuestion r -> r.Points <= 0.0
|
||||
| RandomFromTopic _ -> false)
|
||||
then
|
||||
errors.Add "All question point values must be positive"
|
||||
|
||||
if
|
||||
quiz.QuestionSources
|
||||
|> List.exists (function
|
||||
| RandomFromTopic(_, count, _) -> count <= 0
|
||||
| FixedQuestion _ -> false)
|
||||
then
|
||||
errors.Add "Random pool count must be positive"
|
||||
|
||||
match quiz.MaxAttempts with
|
||||
| Some n when n <= 0 -> errors.Add "MaxAttempts must be positive when specified"
|
||||
| _ -> ()
|
||||
|
||||
match quiz.OpenFrom, quiz.OpenTo with
|
||||
| Some f, Some t when f > t -> errors.Add "OpenFrom must be before OpenTo"
|
||||
| _ -> ()
|
||||
|
||||
if errors.Count = 0 then Ok quiz else Error(List.ofSeq errors)
|
||||
39
src/Domain/Domain.fsproj
Normal file
39
src/Domain/Domain.fsproj
Normal file
@@ -0,0 +1,39 @@
|
||||
<Project Sdk="Microsoft.NET.Sdk">
|
||||
|
||||
<PropertyGroup>
|
||||
<TargetFramework>net9.0</TargetFramework>
|
||||
<GenerateDocumentationFile>true</GenerateDocumentationFile>
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<Compile Include="Core/Ids.fs" />
|
||||
<Compile Include="Core/Users.fs" />
|
||||
<Compile Include="Core/Topics.fs" />
|
||||
<Compile Include="Core/Questions.fs" />
|
||||
<Compile Include="Core/Quizzes.fs" />
|
||||
<Compile Include="Core/Attempts.fs" />
|
||||
<Compile Include="Core/Grading.fs" />
|
||||
<Compile Include="Core/Validation.fs" />
|
||||
<Compile Include="Features/Login.fs" />
|
||||
<Compile Include="Features/GetAvailableQuizzes.fs" />
|
||||
<Compile Include="Features/StartAttempt.fs" />
|
||||
<Compile Include="Features/SubmitAnswer.fs" />
|
||||
<Compile Include="Features/FinishAttempt.fs" />
|
||||
<Compile Include="Features/GetMyAttempts.fs" />
|
||||
<Compile Include="Features/CreateTopic.fs" />
|
||||
<Compile Include="Features/ListQuestions.fs" />
|
||||
<Compile Include="Features/CreateQuestion.fs" />
|
||||
<Compile Include="Features/ListMyQuizzes.fs" />
|
||||
<Compile Include="Features/ListStudents.fs" />
|
||||
<Compile Include="Features/AssignStudents.fs" />
|
||||
<Compile Include="Features/UpdateQuestion.fs" />
|
||||
<Compile Include="Features/DeleteQuestion.fs" />
|
||||
<Compile Include="Features/CreateQuiz.fs" />
|
||||
<Compile Include="Features/UpdateQuiz.fs" />
|
||||
<Compile Include="Features/DeleteQuiz.fs" />
|
||||
<Compile Include="Features/GetQuizResults.fs" />
|
||||
<Compile Include="Features/ReportFocusLoss.fs" />
|
||||
<Compile Include="Features/AdminUsers.fs" />
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
||||
26
src/Domain/Features/AdminUsers.fs
Normal file
26
src/Domain/Features/AdminUsers.fs
Normal file
@@ -0,0 +1,26 @@
|
||||
namespace Domain.Contracts
|
||||
|
||||
open Domain
|
||||
|
||||
type UserSummary =
|
||||
{ Id: UserId
|
||||
Name: string
|
||||
Email: string
|
||||
Role: Role
|
||||
IsActive: bool }
|
||||
|
||||
type CreateUserRequest =
|
||||
{ Name: string
|
||||
Email: string
|
||||
Password: string
|
||||
Role: Role }
|
||||
|
||||
type UpdateUserRequest =
|
||||
{ Id: UserId
|
||||
Name: string
|
||||
Email: string
|
||||
Role: Role }
|
||||
|
||||
type SetUserActiveRequest = { Id: UserId; IsActive: bool }
|
||||
|
||||
type ResetPasswordRequest = { Id: UserId; NewPassword: string }
|
||||
8
src/Domain/Features/AssignStudents.fs
Normal file
8
src/Domain/Features/AssignStudents.fs
Normal file
@@ -0,0 +1,8 @@
|
||||
namespace Domain.Contracts
|
||||
|
||||
open Domain
|
||||
|
||||
/// Replaces the quiz's whole assigned-student set with `StudentIds`, rather
|
||||
/// than adding/removing one at a time — matches the "tick checkboxes, Save"
|
||||
/// UI in the Teacher "Tests" tab.
|
||||
type AssignStudentsRequest = { QuizId: QuizId; StudentIds: UserId list }
|
||||
9
src/Domain/Features/CreateQuestion.fs
Normal file
9
src/Domain/Features/CreateQuestion.fs
Normal file
@@ -0,0 +1,9 @@
|
||||
namespace Domain.Contracts
|
||||
|
||||
open Domain
|
||||
|
||||
type CreateQuestionRequest =
|
||||
{ TopicId: TopicId
|
||||
Text: string
|
||||
Points: float
|
||||
Type: QuestionTypeView }
|
||||
18
src/Domain/Features/CreateQuiz.fs
Normal file
18
src/Domain/Features/CreateQuiz.fs
Normal file
@@ -0,0 +1,18 @@
|
||||
namespace Domain.Contracts
|
||||
|
||||
open Domain
|
||||
|
||||
/// `Sources` order becomes each entry's `Order` in the quiz. For a
|
||||
/// `FixedQuestionInput`, points are taken from the question bank at save
|
||||
/// time, not sent by the client — no per-quiz point override in this
|
||||
/// version. A `RandomPoolInput` has no points of its own: the actual
|
||||
/// questions (and their bank points) are drawn fresh at each attempt.
|
||||
type CreateQuizRequest =
|
||||
{ Title: string
|
||||
Description: string
|
||||
TimeLimitMinutes: int option
|
||||
MaxAttempts: int option
|
||||
PassingScore: float option
|
||||
ShuffleQuestions: bool
|
||||
ShuffleAnswers: bool
|
||||
Sources: QuizQuestionSourceInput list }
|
||||
3
src/Domain/Features/CreateTopic.fs
Normal file
3
src/Domain/Features/CreateTopic.fs
Normal file
@@ -0,0 +1,3 @@
|
||||
namespace Domain.Contracts
|
||||
|
||||
type CreateTopicRequest = { Name: string }
|
||||
5
src/Domain/Features/DeleteQuestion.fs
Normal file
5
src/Domain/Features/DeleteQuestion.fs
Normal file
@@ -0,0 +1,5 @@
|
||||
namespace Domain.Contracts
|
||||
|
||||
open Domain
|
||||
|
||||
type DeleteQuestionRequest = { QuestionId: QuestionId }
|
||||
5
src/Domain/Features/DeleteQuiz.fs
Normal file
5
src/Domain/Features/DeleteQuiz.fs
Normal file
@@ -0,0 +1,5 @@
|
||||
namespace Domain.Contracts
|
||||
|
||||
open Domain
|
||||
|
||||
type DeleteQuizRequest = { QuizId: QuizId }
|
||||
11
src/Domain/Features/FinishAttempt.fs
Normal file
11
src/Domain/Features/FinishAttempt.fs
Normal file
@@ -0,0 +1,11 @@
|
||||
namespace Domain.Contracts
|
||||
|
||||
open Domain
|
||||
|
||||
type AttemptResult =
|
||||
{ AttemptId: AttemptId
|
||||
Score: float
|
||||
MaxScore: float
|
||||
Passed: bool option }
|
||||
|
||||
type FinishAttemptRequest = { AttemptId: AttemptId }
|
||||
21
src/Domain/Features/GetAvailableQuizzes.fs
Normal file
21
src/Domain/Features/GetAvailableQuizzes.fs
Normal file
@@ -0,0 +1,21 @@
|
||||
namespace Domain.Contracts
|
||||
|
||||
open Domain
|
||||
|
||||
type QuizSummary =
|
||||
{ Id: QuizId
|
||||
Title: string
|
||||
Description: string
|
||||
TotalPoints: float
|
||||
TimeLimitMinutes: int option
|
||||
MaxAttempts: int option
|
||||
/// How many of this student's own attempts have been graded — lets the
|
||||
/// client show a "view results" entry point only when there's
|
||||
/// something to show, without a separate round-trip per quiz.
|
||||
AttemptsCount: int
|
||||
/// True once any of this student's graded attempts cleared
|
||||
/// `Quiz.PassingScore` — always `false` for a quiz with no passing
|
||||
/// score set, since there's no bar to clear. `startAttempt` refuses to
|
||||
/// start a new attempt once this is true, regardless of `MaxAttempts`
|
||||
/// remaining (see `StartAttempt.fs`).
|
||||
AlreadyPassed: bool }
|
||||
15
src/Domain/Features/GetMyAttempts.fs
Normal file
15
src/Domain/Features/GetMyAttempts.fs
Normal file
@@ -0,0 +1,15 @@
|
||||
namespace Domain.Contracts
|
||||
|
||||
open System
|
||||
open Domain
|
||||
|
||||
/// One of the student's own past attempts at a quiz — only graded attempts
|
||||
/// are ever returned (an abandoned in-progress attempt has nothing to show).
|
||||
type MyAttemptSummary =
|
||||
{ AttemptId: AttemptId
|
||||
StartedAt: DateTimeOffset
|
||||
Score: float
|
||||
MaxScore: float
|
||||
Passed: bool option }
|
||||
|
||||
type GetMyAttemptsRequest = { QuizId: QuizId }
|
||||
29
src/Domain/Features/GetQuizResults.fs
Normal file
29
src/Domain/Features/GetQuizResults.fs
Normal file
@@ -0,0 +1,29 @@
|
||||
namespace Domain.Contracts
|
||||
|
||||
open System
|
||||
open Domain
|
||||
|
||||
/// One assigned student's standing on a quiz. `BestScore`/`MaxScore`/`Passed`
|
||||
/// describe whichever attempt the quiz's `GradingMethod` selects as official
|
||||
/// (not necessarily the highest-scoring one, depending on that setting) —
|
||||
/// they're `None` when the student has no graded attempts yet, which is
|
||||
/// still worth showing the teacher, not just who has attempted it.
|
||||
type StudentQuizResult =
|
||||
{ StudentId: UserId
|
||||
StudentName: string
|
||||
StudentEmail: string
|
||||
AttemptsCount: int
|
||||
BestScore: float option
|
||||
MaxScore: float option
|
||||
Passed: bool option
|
||||
/// When the student's most recent *successful* attempt was submitted —
|
||||
/// "successful" means passed `Quiz.PassingScore` if the quiz has one,
|
||||
/// otherwise any graded attempt counts (there's no pass/fail bar to
|
||||
/// clear). `None` when they have no attempt meeting that bar yet.
|
||||
LastSuccessfulAttemptAt: DateTimeOffset option
|
||||
/// `FocusLossCount` of the single most recent attempt (by submit time),
|
||||
/// regardless of whether it passed — the anti-cheating signal is about
|
||||
/// what just happened, not diluted by averaging across older attempts.
|
||||
LastAttemptFocusLossCount: int }
|
||||
|
||||
type GetQuizResultsRequest = { QuizId: QuizId }
|
||||
33
src/Domain/Features/ListMyQuizzes.fs
Normal file
33
src/Domain/Features/ListMyQuizzes.fs
Normal file
@@ -0,0 +1,33 @@
|
||||
namespace Domain.Contracts
|
||||
|
||||
open Domain
|
||||
|
||||
/// A rule that draws `Count` random questions from `TopicId` at each
|
||||
/// attempt, rather than a fixed question id.
|
||||
type RandomPoolRule = { TopicId: TopicId; Count: int }
|
||||
|
||||
/// One line item of a quiz's composition as seen over the wire — reused both
|
||||
/// as the client's request when creating/updating a quiz (`CreateQuiz.fs`,
|
||||
/// `UpdateQuiz.fs`) and as part of `QuizAdminSummary` below, since the shape
|
||||
/// is identical in both directions.
|
||||
type QuizQuestionSourceInput =
|
||||
| FixedQuestionInput of QuestionId
|
||||
| RandomPoolInput of RandomPoolRule
|
||||
|
||||
/// `AssignedStudentIds` travels as a plain list, not `Set` — the same trick
|
||||
/// already used for `CorrectOptionIds` in `QuestionTypeView` (`ListQuestions.fs`):
|
||||
/// avoids relying on an unverified `Set` encoding in Fable.Remoting.Json.
|
||||
type QuizAdminSummary =
|
||||
{ Id: QuizId
|
||||
Title: string
|
||||
Description: string
|
||||
TimeLimitMinutes: int option
|
||||
MaxAttempts: int option
|
||||
PassingScore: float option
|
||||
ShuffleQuestions: bool
|
||||
ShuffleAnswers: bool
|
||||
/// Ordered sources (fixed question ids or random-pool rules) — enough
|
||||
/// to pre-check already-selected questions and already-configured pool
|
||||
/// rules in the quiz edit form while browsing any topic in the picker.
|
||||
Sources: QuizQuestionSourceInput list
|
||||
AssignedStudentIds: UserId list }
|
||||
29
src/Domain/Features/ListQuestions.fs
Normal file
29
src/Domain/Features/ListQuestions.fs
Normal file
@@ -0,0 +1,29 @@
|
||||
namespace Domain.Contracts
|
||||
|
||||
open Domain
|
||||
|
||||
/// Teacher-facing view of a question's type-specific data — like
|
||||
/// `QuestionViewKind` (`StartAttempt.fs`), but correct-answer data isn't
|
||||
/// hidden since the author is allowed to see it. Each case wraps exactly one
|
||||
/// record field (never several positional fields) so it round-trips through
|
||||
/// Fable.Remoting.Json the same way `QuestionViewKind` already does.
|
||||
type SingleChoiceData = { Options: QuestionOption list; CorrectOptionId: OptionId }
|
||||
type MultipleChoiceData = { Options: QuestionOption list; CorrectOptionIds: OptionId list }
|
||||
type ShortAnswerData = { AcceptedAnswers: string list; CaseSensitive: bool }
|
||||
type NumericData = { CorrectValue: float; Tolerance: float }
|
||||
|
||||
type QuestionTypeView =
|
||||
| SingleChoiceT of SingleChoiceData
|
||||
| MultipleChoiceT of MultipleChoiceData
|
||||
| TrueFalseT of bool
|
||||
| ShortAnswerT of ShortAnswerData
|
||||
| NumericT of NumericData
|
||||
|
||||
type QuestionSummary =
|
||||
{ Id: QuestionId
|
||||
TopicId: TopicId
|
||||
Text: string
|
||||
Points: float
|
||||
Type: QuestionTypeView }
|
||||
|
||||
type ListQuestionsRequest = { TopicId: TopicId }
|
||||
5
src/Domain/Features/ListStudents.fs
Normal file
5
src/Domain/Features/ListStudents.fs
Normal file
@@ -0,0 +1,5 @@
|
||||
namespace Domain.Contracts
|
||||
|
||||
open Domain
|
||||
|
||||
type StudentSummary = { Id: UserId; Name: string; Email: string }
|
||||
11
src/Domain/Features/Login.fs
Normal file
11
src/Domain/Features/Login.fs
Normal file
@@ -0,0 +1,11 @@
|
||||
namespace Domain.Contracts
|
||||
|
||||
open Domain
|
||||
|
||||
type LoginRequest = { Email: string; Password: string }
|
||||
|
||||
type LoginResponse =
|
||||
{ Token: string
|
||||
UserId: UserId
|
||||
Name: string
|
||||
Role: Role }
|
||||
10
src/Domain/Features/ReportFocusLoss.fs
Normal file
10
src/Domain/Features/ReportFocusLoss.fs
Normal file
@@ -0,0 +1,10 @@
|
||||
namespace Domain.Contracts
|
||||
|
||||
open Domain
|
||||
|
||||
/// No value carried besides which attempt — the server increments its own
|
||||
/// counter rather than accepting a client-supplied number, so a student
|
||||
/// can't report a lower count than actually happened (they can at most
|
||||
/// under-report by not calling this at all, never claim fewer losses than
|
||||
/// the server already counted).
|
||||
type ReportFocusLossRequest = { AttemptId: AttemptId }
|
||||
31
src/Domain/Features/StartAttempt.fs
Normal file
31
src/Domain/Features/StartAttempt.fs
Normal file
@@ -0,0 +1,31 @@
|
||||
namespace Domain.Contracts
|
||||
|
||||
open System
|
||||
open Domain
|
||||
|
||||
/// Question shape sent to a student taking a quiz — never includes the
|
||||
/// correct-answer data that lives in the server-side QuestionType.
|
||||
type QuestionViewKind =
|
||||
| SingleChoiceView of options: (OptionId * string) list
|
||||
| MultipleChoiceView of options: (OptionId * string) list
|
||||
| TrueFalseView
|
||||
| ShortAnswerView
|
||||
| NumericView
|
||||
|
||||
type QuestionView =
|
||||
{ Id: QuestionId
|
||||
Text: string
|
||||
Points: float
|
||||
Kind: QuestionViewKind }
|
||||
|
||||
type QuizForAttempt =
|
||||
{ AttemptId: AttemptId
|
||||
Quiz: QuizSummary
|
||||
/// When this attempt began, per the server clock — the client combines
|
||||
/// this with `Quiz.TimeLimitMinutes` to show a countdown. This is a
|
||||
/// display convenience only; the server does not yet enforce the time
|
||||
/// limit itself (see DESIGN.md §3.6 on the still-unbuilt expiry check).
|
||||
StartedAt: DateTimeOffset
|
||||
Questions: QuestionView list }
|
||||
|
||||
type StartAttemptRequest = { QuizId: QuizId }
|
||||
8
src/Domain/Features/SubmitAnswer.fs
Normal file
8
src/Domain/Features/SubmitAnswer.fs
Normal file
@@ -0,0 +1,8 @@
|
||||
namespace Domain.Contracts
|
||||
|
||||
open Domain
|
||||
|
||||
type SubmitAnswerRequest =
|
||||
{ AttemptId: AttemptId
|
||||
QuestionId: QuestionId
|
||||
Response: StudentResponse }
|
||||
9
src/Domain/Features/UpdateQuestion.fs
Normal file
9
src/Domain/Features/UpdateQuestion.fs
Normal file
@@ -0,0 +1,9 @@
|
||||
namespace Domain.Contracts
|
||||
|
||||
open Domain
|
||||
|
||||
type UpdateQuestionRequest =
|
||||
{ QuestionId: QuestionId
|
||||
Text: string
|
||||
Points: float
|
||||
Type: QuestionTypeView }
|
||||
14
src/Domain/Features/UpdateQuiz.fs
Normal file
14
src/Domain/Features/UpdateQuiz.fs
Normal file
@@ -0,0 +1,14 @@
|
||||
namespace Domain.Contracts
|
||||
|
||||
open Domain
|
||||
|
||||
type UpdateQuizRequest =
|
||||
{ QuizId: QuizId
|
||||
Title: string
|
||||
Description: string
|
||||
TimeLimitMinutes: int option
|
||||
MaxAttempts: int option
|
||||
PassingScore: float option
|
||||
ShuffleQuestions: bool
|
||||
ShuffleAnswers: bool
|
||||
Sources: QuizQuestionSourceInput list }
|
||||
79
src/Server/Auth.fs
Normal file
79
src/Server/Auth.fs
Normal file
@@ -0,0 +1,79 @@
|
||||
module Server.Auth
|
||||
|
||||
open System
|
||||
open System.Security.Claims
|
||||
open System.Text
|
||||
open System.IdentityModel.Tokens.Jwt
|
||||
open Microsoft.IdentityModel.Tokens
|
||||
open Domain
|
||||
|
||||
let private issuer = "quizsystem"
|
||||
let private audience = "quizsystem-client"
|
||||
|
||||
let private signingKey (secret: string) = SymmetricSecurityKey(Encoding.UTF8.GetBytes secret)
|
||||
|
||||
let issueToken (secret: string) (user: User) : string =
|
||||
let creds = SigningCredentials(signingKey secret, SecurityAlgorithms.HmacSha256)
|
||||
let (UserId rawId) = user.Id
|
||||
|
||||
let claims =
|
||||
[| Claim(JwtRegisteredClaimNames.Sub, string rawId)
|
||||
Claim(ClaimTypes.Name, user.Name)
|
||||
Claim(ClaimTypes.Email, user.Email)
|
||||
Claim(ClaimTypes.Role, string user.Role) |]
|
||||
|
||||
let token =
|
||||
JwtSecurityToken(
|
||||
issuer = issuer,
|
||||
audience = audience,
|
||||
claims = claims,
|
||||
expires = DateTime.UtcNow.AddHours 8.0,
|
||||
signingCredentials = creds
|
||||
)
|
||||
|
||||
JwtSecurityTokenHandler().WriteToken token
|
||||
|
||||
let tokenValidationParameters (secret: string) =
|
||||
TokenValidationParameters(
|
||||
ValidateIssuer = true,
|
||||
ValidIssuer = issuer,
|
||||
ValidateAudience = true,
|
||||
ValidAudience = audience,
|
||||
ValidateIssuerSigningKey = true,
|
||||
IssuerSigningKey = signingKey secret,
|
||||
ValidateLifetime = true,
|
||||
ClockSkew = TimeSpan.FromMinutes 1.0
|
||||
)
|
||||
|
||||
let tryGetUserId (principal: ClaimsPrincipal) : UserId option =
|
||||
match principal.FindFirst(JwtRegisteredClaimNames.Sub) with
|
||||
| null -> None
|
||||
| claim ->
|
||||
match Guid.TryParse claim.Value with
|
||||
| true, guid -> Some(UserId guid)
|
||||
| false, _ -> None
|
||||
|
||||
/// Shared by every handler that requires a signed-in user, so each feature
|
||||
/// doesn't repeat its own "Требуется авторизация" error text.
|
||||
let requireUserId (principal: ClaimsPrincipal) : Result<UserId, string> =
|
||||
match tryGetUserId principal with
|
||||
| Some uid -> Ok uid
|
||||
| None -> Error "Требуется авторизация"
|
||||
|
||||
let private tryGetRole (principal: ClaimsPrincipal) : Role option =
|
||||
match principal.FindFirst(ClaimTypes.Role) with
|
||||
| null -> None
|
||||
| claim ->
|
||||
match claim.Value with
|
||||
| "Admin" -> Some Admin
|
||||
| "Teacher" -> Some Teacher
|
||||
| "Student" -> Some Student
|
||||
| _ -> None
|
||||
|
||||
/// Like `requireUserId`, but also checks the JWT's role claim is one of
|
||||
/// `allowed` — used by Teacher/Admin-only handlers.
|
||||
let requireRole (allowed: Role list) (principal: ClaimsPrincipal) : Result<UserId, string> =
|
||||
match tryGetUserId principal, tryGetRole principal with
|
||||
| Some uid, Some role when List.contains role allowed -> Ok uid
|
||||
| Some _, Some _ -> Error "Доступ запрещён"
|
||||
| _ -> Error "Требуется авторизация"
|
||||
343
src/Server/Db/AttemptRepository.fs
Normal file
343
src/Server/Db/AttemptRepository.fs
Normal file
@@ -0,0 +1,343 @@
|
||||
module Server.Db.AttemptRepository
|
||||
|
||||
open System
|
||||
open Dapper
|
||||
open Npgsql
|
||||
open Domain
|
||||
open Server.Db.Connection
|
||||
|
||||
[<CLIMutable>]
|
||||
type private AttemptRow =
|
||||
{ Id: AttemptId
|
||||
QuizId: QuizId
|
||||
UserId: UserId
|
||||
StartedAt: DateTimeOffset
|
||||
SubmittedAt: DateTimeOffset Nullable
|
||||
State: AttemptState
|
||||
Score: float Nullable
|
||||
FocusLossCount: int }
|
||||
|
||||
[<CLIMutable>]
|
||||
type private AttemptQuestionRow = { QuestionId: QuestionId; Points: float; OrderIndex: int }
|
||||
|
||||
[<CLIMutable>]
|
||||
type private ResponseDiscriminatorRow = { QuestionId: QuestionId; ResponseType: string }
|
||||
|
||||
// `SelectedOptionId` is nullable *and* custom-typed — stored as a raw Guid
|
||||
// here and wrapped to OptionId manually, sidestepping any uncertainty about
|
||||
// whether Dapper applies a TypeHandler<T> through a Nullable<T> property.
|
||||
[<CLIMutable>]
|
||||
type private SingleChoiceResponseRow = { QuestionId: QuestionId; SelectedOptionId: Guid Nullable }
|
||||
|
||||
[<CLIMutable>]
|
||||
type private MultipleChoiceResponseRow = { QuestionId: QuestionId; OptionId: OptionId }
|
||||
|
||||
[<CLIMutable>]
|
||||
type private TrueFalseResponseRow = { QuestionId: QuestionId; Answer: bool Nullable }
|
||||
|
||||
[<CLIMutable>]
|
||||
type private ShortAnswerResponseRow = { QuestionId: QuestionId; AnswerText: string }
|
||||
|
||||
[<CLIMutable>]
|
||||
type private NumericResponseRow = { QuestionId: QuestionId; Value: float Nullable }
|
||||
|
||||
[<CLIMutable>]
|
||||
type private GradeRow =
|
||||
{ QuestionId: QuestionId
|
||||
PointsAwarded: float
|
||||
MaxPoints: float
|
||||
IsCorrect: bool }
|
||||
|
||||
let private attemptSelectColumns =
|
||||
"id AS Id, quiz_id AS QuizId, user_id AS UserId, started_at AS StartedAt,
|
||||
submitted_at AS SubmittedAt, state AS State, score AS Score, focus_loss_count AS FocusLossCount"
|
||||
|
||||
let private loadQuestions (conn: NpgsqlConnection) (attemptId: AttemptId) : QuizQuestionRef list =
|
||||
conn.Query<AttemptQuestionRow>(
|
||||
"SELECT question_id AS QuestionId, points AS Points, order_index AS OrderIndex FROM attempt_questions WHERE attempt_id = @AttemptId ORDER BY order_index",
|
||||
{| AttemptId = attemptId |}
|
||||
)
|
||||
|> Seq.map (fun r -> { QuestionId = r.QuestionId; Points = r.Points; Order = r.OrderIndex })
|
||||
|> List.ofSeq
|
||||
|
||||
let private loadResponses (conn: NpgsqlConnection) (attemptId: AttemptId) : Map<QuestionId, StudentResponse> =
|
||||
let discriminators =
|
||||
conn.Query<ResponseDiscriminatorRow>(
|
||||
"SELECT question_id AS QuestionId, response_type AS ResponseType FROM attempt_responses WHERE attempt_id = @AttemptId",
|
||||
{| AttemptId = attemptId |}
|
||||
)
|
||||
|> List.ofSeq
|
||||
|
||||
if discriminators.IsEmpty then
|
||||
Map.empty
|
||||
else
|
||||
let singleChoice =
|
||||
conn.Query<SingleChoiceResponseRow>(
|
||||
"SELECT question_id AS QuestionId, selected_option_id AS SelectedOptionId FROM attempt_response_single_choice WHERE attempt_id = @AttemptId",
|
||||
{| AttemptId = attemptId |}
|
||||
)
|
||||
|> Seq.map (fun r -> r.QuestionId, r.SelectedOptionId |> Option.ofNullable |> Option.map OptionId)
|
||||
|> dict
|
||||
|
||||
let multipleChoice =
|
||||
conn.Query<MultipleChoiceResponseRow>(
|
||||
"SELECT question_id AS QuestionId, option_id AS OptionId FROM attempt_response_multiple_choice WHERE attempt_id = @AttemptId",
|
||||
{| AttemptId = attemptId |}
|
||||
)
|
||||
|> Seq.groupBy (fun r -> r.QuestionId)
|
||||
|> Seq.map (fun (qid, rs) -> qid, rs |> Seq.map (fun r -> r.OptionId) |> Set.ofSeq)
|
||||
|> dict
|
||||
|
||||
let trueFalse =
|
||||
conn.Query<TrueFalseResponseRow>(
|
||||
"SELECT question_id AS QuestionId, answer AS Answer FROM attempt_response_true_false WHERE attempt_id = @AttemptId",
|
||||
{| AttemptId = attemptId |}
|
||||
)
|
||||
|> Seq.map (fun r -> r.QuestionId, r.Answer |> Option.ofNullable)
|
||||
|> dict
|
||||
|
||||
let shortAnswer =
|
||||
conn.Query<ShortAnswerResponseRow>(
|
||||
"SELECT question_id AS QuestionId, answer_text AS AnswerText FROM attempt_response_short_answer WHERE attempt_id = @AttemptId",
|
||||
{| AttemptId = attemptId |}
|
||||
)
|
||||
|> Seq.map (fun r -> r.QuestionId, r.AnswerText)
|
||||
|> dict
|
||||
|
||||
let numeric =
|
||||
conn.Query<NumericResponseRow>(
|
||||
"SELECT question_id AS QuestionId, value AS Value FROM attempt_response_numeric WHERE attempt_id = @AttemptId",
|
||||
{| AttemptId = attemptId |}
|
||||
)
|
||||
|> Seq.map (fun r -> r.QuestionId, r.Value |> Option.ofNullable)
|
||||
|> dict
|
||||
|
||||
discriminators
|
||||
|> List.map (fun d ->
|
||||
let response =
|
||||
match d.ResponseType with
|
||||
| "SingleChoiceResponse" -> SingleChoiceResponse singleChoice.[d.QuestionId]
|
||||
| "MultipleChoiceResponse" ->
|
||||
match multipleChoice.TryGetValue d.QuestionId with
|
||||
| true, s -> MultipleChoiceResponse s
|
||||
| false, _ -> MultipleChoiceResponse Set.empty
|
||||
| "TrueFalseResponse" -> TrueFalseResponse trueFalse.[d.QuestionId]
|
||||
| "ShortAnswerResponse" -> ShortAnswerResponse shortAnswer.[d.QuestionId]
|
||||
| "NumericResponse" -> NumericResponse numeric.[d.QuestionId]
|
||||
| other -> failwithf "Unknown response_type '%s'" other
|
||||
|
||||
d.QuestionId, response)
|
||||
|> Map.ofList
|
||||
|
||||
let private loadGrades (conn: NpgsqlConnection) (attemptId: AttemptId) : Map<QuestionId, QuestionGrade> =
|
||||
conn.Query<GradeRow>(
|
||||
"SELECT question_id AS QuestionId, points_awarded AS PointsAwarded, max_points AS MaxPoints, is_correct AS IsCorrect FROM attempt_grades WHERE attempt_id = @AttemptId",
|
||||
{| AttemptId = attemptId |}
|
||||
)
|
||||
|> Seq.map (fun r ->
|
||||
let grade: QuestionGrade =
|
||||
{ QuestionId = r.QuestionId
|
||||
PointsAwarded = r.PointsAwarded
|
||||
MaxPoints = r.MaxPoints
|
||||
IsCorrect = r.IsCorrect }
|
||||
|
||||
r.QuestionId, grade)
|
||||
|> Map.ofSeq
|
||||
|
||||
let private assembleAttempt (conn: NpgsqlConnection) (row: AttemptRow) : Attempt =
|
||||
{ Id = row.Id
|
||||
QuizId = row.QuizId
|
||||
UserId = row.UserId
|
||||
StartedAt = row.StartedAt
|
||||
SubmittedAt = row.SubmittedAt |> Option.ofNullable
|
||||
State = row.State
|
||||
Questions = loadQuestions conn row.Id
|
||||
Responses = loadResponses conn row.Id
|
||||
Grades = loadGrades conn row.Id
|
||||
Score = row.Score |> Option.ofNullable
|
||||
FocusLossCount = row.FocusLossCount }
|
||||
|
||||
let private toResponseDiscriminator (r: StudentResponse) : string =
|
||||
match r with
|
||||
| SingleChoiceResponse _ -> "SingleChoiceResponse"
|
||||
| MultipleChoiceResponse _ -> "MultipleChoiceResponse"
|
||||
| TrueFalseResponse _ -> "TrueFalseResponse"
|
||||
| ShortAnswerResponse _ -> "ShortAnswerResponse"
|
||||
| NumericResponse _ -> "NumericResponse"
|
||||
|
||||
/// Upserts the scalar `attempts` row, then delete-then-reinserts its question
|
||||
/// snapshot, responses, and grades — same full-replace semantics the
|
||||
/// in-memory Store already has (`SaveAttempt` is called after every answer
|
||||
/// and again at finish/grade time, always with the complete attempt).
|
||||
let saveAttempt (connString: string) (attempt: Attempt) : unit =
|
||||
use conn = openConnection connString
|
||||
use tx = conn.BeginTransaction()
|
||||
|
||||
// `focus_loss_count` is set on INSERT (a fresh attempt always starts at
|
||||
// 0) but deliberately left out of the `DO UPDATE SET` list below.
|
||||
// `reportFocusLoss` writes that column with its own atomic
|
||||
// `UPDATE ... SET focus_loss_count = focus_loss_count + 1`, outside this
|
||||
// load-mutate-save round trip — if this upsert also overwrote the column
|
||||
// from `attempt.FocusLossCount` (whatever value was in memory when this
|
||||
// particular save started), a focus-loss reported concurrently with an
|
||||
// answer submission could get silently clobbered back to a stale count.
|
||||
conn.Execute(
|
||||
"""INSERT INTO attempts (id, quiz_id, user_id, started_at, submitted_at, state, score, focus_loss_count)
|
||||
VALUES (@Id, @QuizId, @UserId, @StartedAt, @SubmittedAt, @State, @Score, @FocusLossCount)
|
||||
ON CONFLICT (id) DO UPDATE SET
|
||||
submitted_at = EXCLUDED.submitted_at, state = EXCLUDED.state, score = EXCLUDED.score""",
|
||||
{| Id = attempt.Id
|
||||
QuizId = attempt.QuizId
|
||||
UserId = attempt.UserId
|
||||
StartedAt = attempt.StartedAt
|
||||
SubmittedAt = attempt.SubmittedAt |> Option.toNullable
|
||||
State = attempt.State
|
||||
Score = attempt.Score |> Option.toNullable
|
||||
FocusLossCount = attempt.FocusLossCount |},
|
||||
tx
|
||||
)
|
||||
|> ignore
|
||||
|
||||
conn.Execute("DELETE FROM attempt_questions WHERE attempt_id = @Id", {| Id = attempt.Id |}, tx)
|
||||
|> ignore
|
||||
|
||||
attempt.Questions
|
||||
|> List.iter (fun q ->
|
||||
conn.Execute(
|
||||
"INSERT INTO attempt_questions (attempt_id, question_id, points, order_index) VALUES (@AttemptId, @QuestionId, @Points, @OrderIndex)",
|
||||
{| AttemptId = attempt.Id
|
||||
QuestionId = q.QuestionId
|
||||
Points = q.Points
|
||||
OrderIndex = q.Order |},
|
||||
tx
|
||||
)
|
||||
|> ignore)
|
||||
|
||||
// The 5 attempt_response_* detail tables cascade from attempt_responses.
|
||||
conn.Execute("DELETE FROM attempt_responses WHERE attempt_id = @Id", {| Id = attempt.Id |}, tx)
|
||||
|> ignore
|
||||
|
||||
attempt.Responses
|
||||
|> Map.iter (fun questionId response ->
|
||||
conn.Execute(
|
||||
"INSERT INTO attempt_responses (attempt_id, question_id, response_type) VALUES (@AttemptId, @QuestionId, @ResponseType)",
|
||||
{| AttemptId = attempt.Id
|
||||
QuestionId = questionId
|
||||
ResponseType = toResponseDiscriminator response |},
|
||||
tx
|
||||
)
|
||||
|> ignore
|
||||
|
||||
match response with
|
||||
| SingleChoiceResponse optId ->
|
||||
conn.Execute(
|
||||
"INSERT INTO attempt_response_single_choice (attempt_id, question_id, selected_option_id) VALUES (@AttemptId, @QuestionId, @SelectedOptionId)",
|
||||
{| AttemptId = attempt.Id
|
||||
QuestionId = questionId
|
||||
SelectedOptionId = optId |> Option.map (fun (OptionId g) -> g) |> Option.toNullable |},
|
||||
tx
|
||||
)
|
||||
|> ignore
|
||||
| MultipleChoiceResponse optIds ->
|
||||
optIds
|
||||
|> Set.iter (fun optId ->
|
||||
conn.Execute(
|
||||
"INSERT INTO attempt_response_multiple_choice (attempt_id, question_id, option_id) VALUES (@AttemptId, @QuestionId, @OptionId)",
|
||||
{| AttemptId = attempt.Id; QuestionId = questionId; OptionId = optId |},
|
||||
tx
|
||||
)
|
||||
|> ignore)
|
||||
| TrueFalseResponse value ->
|
||||
conn.Execute(
|
||||
"INSERT INTO attempt_response_true_false (attempt_id, question_id, answer) VALUES (@AttemptId, @QuestionId, @Answer)",
|
||||
{| AttemptId = attempt.Id
|
||||
QuestionId = questionId
|
||||
Answer = value |> Option.toNullable |},
|
||||
tx
|
||||
)
|
||||
|> ignore
|
||||
| ShortAnswerResponse text ->
|
||||
conn.Execute(
|
||||
"INSERT INTO attempt_response_short_answer (attempt_id, question_id, answer_text) VALUES (@AttemptId, @QuestionId, @AnswerText)",
|
||||
{| AttemptId = attempt.Id; QuestionId = questionId; AnswerText = text |},
|
||||
tx
|
||||
)
|
||||
|> ignore
|
||||
| NumericResponse value ->
|
||||
conn.Execute(
|
||||
"INSERT INTO attempt_response_numeric (attempt_id, question_id, value) VALUES (@AttemptId, @QuestionId, @Value)",
|
||||
{| AttemptId = attempt.Id
|
||||
QuestionId = questionId
|
||||
Value = value |> Option.toNullable |},
|
||||
tx
|
||||
)
|
||||
|> ignore)
|
||||
|
||||
conn.Execute("DELETE FROM attempt_grades WHERE attempt_id = @Id", {| Id = attempt.Id |}, tx)
|
||||
|> ignore
|
||||
|
||||
attempt.Grades
|
||||
|> Map.iter (fun questionId grade ->
|
||||
conn.Execute(
|
||||
"INSERT INTO attempt_grades (attempt_id, question_id, points_awarded, max_points, is_correct) VALUES (@AttemptId, @QuestionId, @PointsAwarded, @MaxPoints, @IsCorrect)",
|
||||
{| AttemptId = attempt.Id
|
||||
QuestionId = questionId
|
||||
PointsAwarded = grade.PointsAwarded
|
||||
MaxPoints = grade.MaxPoints
|
||||
IsCorrect = grade.IsCorrect |},
|
||||
tx
|
||||
)
|
||||
|> ignore)
|
||||
|
||||
tx.Commit()
|
||||
|
||||
let tryGetAttempt (connString: string) (id: AttemptId) : Attempt option =
|
||||
use conn = openConnection connString
|
||||
|
||||
let row =
|
||||
conn.QuerySingleOrDefault<AttemptRow>($"SELECT {attemptSelectColumns} FROM attempts WHERE id = @Id", {| Id = id |})
|
||||
|
||||
if box row = null then None else Some(assembleAttempt conn row)
|
||||
|
||||
let attemptsForQuiz (connString: string) (quizId: QuizId) (userId: UserId) : Attempt list =
|
||||
use conn = openConnection connString
|
||||
|
||||
conn.Query<AttemptRow>(
|
||||
$"SELECT {attemptSelectColumns} FROM attempts WHERE quiz_id = @QuizId AND user_id = @UserId",
|
||||
{| QuizId = quizId; UserId = userId |}
|
||||
)
|
||||
|> Seq.map (assembleAttempt conn)
|
||||
|> List.ofSeq
|
||||
|
||||
let anyAttemptsForQuiz (connString: string) (quizId: QuizId) : bool =
|
||||
use conn = openConnection connString
|
||||
conn.ExecuteScalar<bool>("SELECT EXISTS (SELECT 1 FROM attempts WHERE quiz_id = @QuizId)", {| QuizId = quizId |})
|
||||
|
||||
/// Ids of `InProgress` attempts whose quiz has a time limit that has already
|
||||
/// passed — picked up by the background expiry sweeper (`ExpirySweeper.fs`)
|
||||
/// for attempts nobody sent a follow-up request for (e.g. an abandoned tab).
|
||||
let findExpiredInProgressAttemptIds (connString: string) : AttemptId list =
|
||||
use conn = openConnection connString
|
||||
|
||||
conn.Query<AttemptId>(
|
||||
"""SELECT a.id
|
||||
FROM attempts a
|
||||
JOIN quizzes q ON q.id = a.quiz_id
|
||||
WHERE a.state = 'InProgress'
|
||||
AND q.time_limit IS NOT NULL
|
||||
AND a.started_at + q.time_limit < now()"""
|
||||
)
|
||||
|> List.ofSeq
|
||||
|
||||
/// Atomic, so it can't race with `saveAttempt`'s full-record upsert (see the
|
||||
/// comment there) or with itself under rapid-fire blur/visibilitychange
|
||||
/// events. Scoped to `InProgress` so a request that arrives just after the
|
||||
/// attempt was graded doesn't keep bumping the count.
|
||||
let incrementFocusLoss (connString: string) (attemptId: AttemptId) : unit =
|
||||
use conn = openConnection connString
|
||||
|
||||
conn.Execute(
|
||||
"UPDATE attempts SET focus_loss_count = focus_loss_count + 1 WHERE id = @Id AND state = 'InProgress'",
|
||||
{| Id = attemptId |}
|
||||
)
|
||||
|> ignore
|
||||
8
src/Server/Db/Connection.fs
Normal file
8
src/Server/Db/Connection.fs
Normal file
@@ -0,0 +1,8 @@
|
||||
module Server.Db.Connection
|
||||
|
||||
open Npgsql
|
||||
|
||||
let openConnection (connectionString: string) : NpgsqlConnection =
|
||||
let conn = new NpgsqlConnection(connectionString)
|
||||
conn.Open()
|
||||
conn
|
||||
35
src/Server/Db/Migrator.fs
Normal file
35
src/Server/Db/Migrator.fs
Normal file
@@ -0,0 +1,35 @@
|
||||
module Server.Db.Migrator
|
||||
|
||||
open System
|
||||
open System.Reflection
|
||||
open System.Threading
|
||||
open DbUp
|
||||
|
||||
/// Applies every embedded `Migrations/*.sql` script against `connectionString`,
|
||||
/// tracked in DbUp's own journal table so re-running is a no-op once a script
|
||||
/// has been applied. Called at server startup, before the app starts serving,
|
||||
/// so a broken migration fails fast instead of running against a stale schema.
|
||||
/// Retries a few times with a short delay — only matters for the Docker
|
||||
/// cold-start case, where Postgres can report "healthy" moments before it's
|
||||
/// actually ready to accept connections.
|
||||
let run (connectionString: string) =
|
||||
let upgrader =
|
||||
DeployChanges.To
|
||||
.PostgresqlDatabase(connectionString)
|
||||
.WithScriptsEmbeddedInAssembly(Assembly.GetExecutingAssembly())
|
||||
.LogToConsole()
|
||||
.Build()
|
||||
|
||||
let rec attempt triesLeft =
|
||||
let result = upgrader.PerformUpgrade()
|
||||
|
||||
if result.Successful then
|
||||
()
|
||||
elif triesLeft > 1 then
|
||||
printfn "Migration attempt failed (%s), retrying…" result.Error.Message
|
||||
Thread.Sleep(TimeSpan.FromSeconds 2.0)
|
||||
attempt (triesLeft - 1)
|
||||
else
|
||||
failwithf "Migration failed: %s" (string result.Error)
|
||||
|
||||
attempt 5
|
||||
309
src/Server/Db/QuestionRepository.fs
Normal file
309
src/Server/Db/QuestionRepository.fs
Normal file
@@ -0,0 +1,309 @@
|
||||
module Server.Db.QuestionRepository
|
||||
|
||||
open Dapper
|
||||
open Npgsql
|
||||
open Domain
|
||||
open Server.Db.Connection
|
||||
|
||||
// [<CLIMutable>] throughout — see QuizRepository.fs for why (Dapper's
|
||||
// constructor-matching materialization doesn't reliably handle `Nullable<'T>`
|
||||
// columns; applying it uniformly avoids depending on which path Dapper picks).
|
||||
[<CLIMutable>]
|
||||
type private QuestionRow =
|
||||
{ Id: QuestionId
|
||||
TopicId: TopicId
|
||||
Text: string
|
||||
Points: float
|
||||
QuestionType: string }
|
||||
|
||||
[<CLIMutable>]
|
||||
type private OptionRow = { QuestionId: QuestionId; Id: OptionId; Text: string }
|
||||
|
||||
[<CLIMutable>]
|
||||
type private NumericRow = { QuestionId: QuestionId; CorrectValue: float; Tolerance: float }
|
||||
|
||||
[<CLIMutable>]
|
||||
type private SingleChoiceCorrectRow = { QuestionId: QuestionId; CorrectOptionId: OptionId }
|
||||
|
||||
[<CLIMutable>]
|
||||
type private MultipleChoiceCorrectRow = { QuestionId: QuestionId; OptionId: OptionId }
|
||||
|
||||
[<CLIMutable>]
|
||||
type private TrueFalseRow = { QuestionId: QuestionId; CorrectAnswer: bool }
|
||||
|
||||
[<CLIMutable>]
|
||||
type private ShortAnswerHeaderRow = { QuestionId: QuestionId; CaseSensitive: bool }
|
||||
|
||||
[<CLIMutable>]
|
||||
type private ShortAnswerAcceptedRow = { QuestionId: QuestionId; AnswerText: string }
|
||||
|
||||
let private questionSelectColumns =
|
||||
"id AS Id, topic_id AS TopicId, text AS Text, points AS Points, question_type AS QuestionType"
|
||||
|
||||
/// Batch-assembles full `Question`s from their scalar rows — one query per
|
||||
/// detail table (filtered to just the ids that need it), not one query per
|
||||
/// question, so listing N questions costs a handful of queries, not ~2N.
|
||||
let private assembleQuestions (conn: NpgsqlConnection) (rows: QuestionRow list) : Question list =
|
||||
if rows.IsEmpty then
|
||||
[]
|
||||
else
|
||||
let ids = rows |> List.map (fun r -> r.Id)
|
||||
|
||||
let optionsByQuestion =
|
||||
conn.Query<OptionRow>(
|
||||
"SELECT question_id AS QuestionId, id AS Id, text AS Text FROM question_options WHERE question_id = ANY(@Ids) ORDER BY question_id, position",
|
||||
{| Ids = ids |> List.map (fun (QuestionId g) -> g) |> List.toArray |}
|
||||
)
|
||||
|> Seq.groupBy (fun o -> o.QuestionId)
|
||||
|> Seq.map (fun (qid, opts) -> qid, opts |> Seq.map (fun o -> { Id = o.Id; Text = o.Text }) |> List.ofSeq)
|
||||
|> dict
|
||||
|
||||
let optionsFor qid =
|
||||
match optionsByQuestion.TryGetValue qid with
|
||||
| true, opts -> opts
|
||||
| false, _ -> []
|
||||
|
||||
let singleChoiceCorrect =
|
||||
conn.Query<SingleChoiceCorrectRow>(
|
||||
"SELECT question_id AS QuestionId, correct_option_id AS CorrectOptionId FROM question_single_choice WHERE question_id = ANY(@Ids)",
|
||||
{| Ids = ids |> List.map (fun (QuestionId g) -> g) |> List.toArray |}
|
||||
)
|
||||
|> Seq.map (fun r -> r.QuestionId, r.CorrectOptionId)
|
||||
|> dict
|
||||
|
||||
let multipleChoiceCorrect =
|
||||
conn.Query<MultipleChoiceCorrectRow>(
|
||||
"SELECT question_id AS QuestionId, option_id AS OptionId FROM question_multiple_choice_correct WHERE question_id = ANY(@Ids)",
|
||||
{| Ids = ids |> List.map (fun (QuestionId g) -> g) |> List.toArray |}
|
||||
)
|
||||
|> Seq.groupBy (fun r -> r.QuestionId)
|
||||
|> Seq.map (fun (qid, rs) -> qid, rs |> Seq.map (fun r -> r.OptionId) |> Set.ofSeq)
|
||||
|> dict
|
||||
|
||||
let trueFalse =
|
||||
conn.Query<TrueFalseRow>(
|
||||
"SELECT question_id AS QuestionId, correct_answer AS CorrectAnswer FROM question_true_false WHERE question_id = ANY(@Ids)",
|
||||
{| Ids = ids |> List.map (fun (QuestionId g) -> g) |> List.toArray |}
|
||||
)
|
||||
|> Seq.map (fun r -> r.QuestionId, r.CorrectAnswer)
|
||||
|> dict
|
||||
|
||||
let shortAnswerCaseSensitive =
|
||||
conn.Query<ShortAnswerHeaderRow>(
|
||||
"SELECT question_id AS QuestionId, case_sensitive AS CaseSensitive FROM question_short_answer WHERE question_id = ANY(@Ids)",
|
||||
{| Ids = ids |> List.map (fun (QuestionId g) -> g) |> List.toArray |}
|
||||
)
|
||||
|> Seq.map (fun r -> r.QuestionId, r.CaseSensitive)
|
||||
|> dict
|
||||
|
||||
let shortAnswerAccepted =
|
||||
conn.Query<ShortAnswerAcceptedRow>(
|
||||
"SELECT question_id AS QuestionId, answer_text AS AnswerText FROM question_short_answer_accepted WHERE question_id = ANY(@Ids) ORDER BY question_id, position",
|
||||
{| Ids = ids |> List.map (fun (QuestionId g) -> g) |> List.toArray |}
|
||||
)
|
||||
|> Seq.groupBy (fun r -> r.QuestionId)
|
||||
|> Seq.map (fun (qid, rs) -> qid, rs |> Seq.map (fun r -> r.AnswerText) |> List.ofSeq)
|
||||
|> dict
|
||||
|
||||
let numeric =
|
||||
conn.Query<NumericRow>(
|
||||
"SELECT question_id AS QuestionId, correct_value AS CorrectValue, tolerance AS Tolerance FROM question_numeric WHERE question_id = ANY(@Ids)",
|
||||
{| Ids = ids |> List.map (fun (QuestionId g) -> g) |> List.toArray |}
|
||||
)
|
||||
|> Seq.map (fun r -> r.QuestionId, r)
|
||||
|> dict
|
||||
|
||||
rows
|
||||
|> List.map (fun row ->
|
||||
let questionType =
|
||||
match row.QuestionType with
|
||||
| "SingleChoice" -> SingleChoice(optionsFor row.Id, singleChoiceCorrect.[row.Id])
|
||||
| "MultipleChoice" ->
|
||||
let correct =
|
||||
match multipleChoiceCorrect.TryGetValue row.Id with
|
||||
| true, s -> s
|
||||
| false, _ -> Set.empty
|
||||
|
||||
MultipleChoice(optionsFor row.Id, correct)
|
||||
| "TrueFalse" -> TrueFalse trueFalse.[row.Id]
|
||||
| "ShortAnswer" ->
|
||||
let accepted =
|
||||
match shortAnswerAccepted.TryGetValue row.Id with
|
||||
| true, a -> a
|
||||
| false, _ -> []
|
||||
|
||||
ShortAnswer(accepted, shortAnswerCaseSensitive.[row.Id])
|
||||
| "Numeric" ->
|
||||
let n = numeric.[row.Id]
|
||||
Numeric(n.CorrectValue, n.Tolerance)
|
||||
| other -> failwithf "Unknown question_type '%s'" other
|
||||
|
||||
{ Id = row.Id
|
||||
TopicId = row.TopicId
|
||||
Text = row.Text
|
||||
Points = row.Points
|
||||
Type = questionType })
|
||||
|
||||
let private toDiscriminator (t: QuestionType) : string =
|
||||
match t with
|
||||
| SingleChoice _ -> "SingleChoice"
|
||||
| MultipleChoice _ -> "MultipleChoice"
|
||||
| TrueFalse _ -> "TrueFalse"
|
||||
| ShortAnswer _ -> "ShortAnswer"
|
||||
| Numeric _ -> "Numeric"
|
||||
|
||||
/// Upserts the scalar `questions` row, then delete-then-reinserts every
|
||||
/// detail table for this question — matches the in-memory Store's existing
|
||||
/// "always a full replace" semantics (no partial-update member exists today).
|
||||
let addQuestion (connString: string) (question: Question) : unit =
|
||||
use conn = openConnection connString
|
||||
use tx = conn.BeginTransaction()
|
||||
|
||||
conn.Execute(
|
||||
"""INSERT INTO questions (id, topic_id, text, points, question_type)
|
||||
VALUES (@Id, @TopicId, @Text, @Points, @QuestionType)
|
||||
ON CONFLICT (id) DO UPDATE SET
|
||||
topic_id = EXCLUDED.topic_id, text = EXCLUDED.text,
|
||||
points = EXCLUDED.points, question_type = EXCLUDED.question_type""",
|
||||
{| Id = question.Id
|
||||
TopicId = question.TopicId
|
||||
Text = question.Text
|
||||
Points = question.Points
|
||||
QuestionType = toDiscriminator question.Type |},
|
||||
tx
|
||||
)
|
||||
|> ignore
|
||||
|
||||
// question_single_choice / question_multiple_choice_correct reference
|
||||
// question_options rows (no ON DELETE CASCADE on that FK), so they must
|
||||
// be cleared *before* question_options itself, not after.
|
||||
conn.Execute("DELETE FROM question_single_choice WHERE question_id = @Id", {| Id = question.Id |}, tx)
|
||||
|> ignore
|
||||
|
||||
conn.Execute("DELETE FROM question_multiple_choice_correct WHERE question_id = @Id", {| Id = question.Id |}, tx)
|
||||
|> ignore
|
||||
|
||||
conn.Execute("DELETE FROM question_options WHERE question_id = @Id", {| Id = question.Id |}, tx)
|
||||
|> ignore
|
||||
|
||||
conn.Execute("DELETE FROM question_true_false WHERE question_id = @Id", {| Id = question.Id |}, tx)
|
||||
|> ignore
|
||||
// question_short_answer_accepted cascades from question_short_answer.
|
||||
conn.Execute("DELETE FROM question_short_answer WHERE question_id = @Id", {| Id = question.Id |}, tx)
|
||||
|> ignore
|
||||
|
||||
conn.Execute("DELETE FROM question_numeric WHERE question_id = @Id", {| Id = question.Id |}, tx)
|
||||
|> ignore
|
||||
|
||||
let insertOptions (options: QuestionOption list) =
|
||||
options
|
||||
|> List.iteri (fun i opt ->
|
||||
conn.Execute(
|
||||
"INSERT INTO question_options (id, question_id, text, position) VALUES (@Id, @QuestionId, @Text, @Position)",
|
||||
{| Id = opt.Id; QuestionId = question.Id; Text = opt.Text; Position = i |},
|
||||
tx
|
||||
)
|
||||
|> ignore)
|
||||
|
||||
match question.Type with
|
||||
| SingleChoice(options, correctId) ->
|
||||
insertOptions options
|
||||
|
||||
conn.Execute(
|
||||
"INSERT INTO question_single_choice (question_id, correct_option_id) VALUES (@QuestionId, @CorrectOptionId)",
|
||||
{| QuestionId = question.Id; CorrectOptionId = correctId |},
|
||||
tx
|
||||
)
|
||||
|> ignore
|
||||
| MultipleChoice(options, correctIds) ->
|
||||
insertOptions options
|
||||
|
||||
correctIds
|
||||
|> Set.iter (fun optId ->
|
||||
conn.Execute(
|
||||
"INSERT INTO question_multiple_choice_correct (question_id, option_id) VALUES (@QuestionId, @OptionId)",
|
||||
{| QuestionId = question.Id; OptionId = optId |},
|
||||
tx
|
||||
)
|
||||
|> ignore)
|
||||
| TrueFalse value ->
|
||||
conn.Execute(
|
||||
"INSERT INTO question_true_false (question_id, correct_answer) VALUES (@QuestionId, @Value)",
|
||||
{| QuestionId = question.Id; Value = value |},
|
||||
tx
|
||||
)
|
||||
|> ignore
|
||||
| ShortAnswer(accepted, caseSensitive) ->
|
||||
conn.Execute(
|
||||
"INSERT INTO question_short_answer (question_id, case_sensitive) VALUES (@QuestionId, @CaseSensitive)",
|
||||
{| QuestionId = question.Id; CaseSensitive = caseSensitive |},
|
||||
tx
|
||||
)
|
||||
|> ignore
|
||||
|
||||
accepted
|
||||
|> List.iteri (fun i text ->
|
||||
conn.Execute(
|
||||
"INSERT INTO question_short_answer_accepted (question_id, answer_text, position) VALUES (@QuestionId, @Text, @Position)",
|
||||
{| QuestionId = question.Id; Text = text; Position = i |},
|
||||
tx
|
||||
)
|
||||
|> ignore)
|
||||
| Numeric(correctValue, tolerance) ->
|
||||
conn.Execute(
|
||||
"INSERT INTO question_numeric (question_id, correct_value, tolerance) VALUES (@QuestionId, @CorrectValue, @Tolerance)",
|
||||
{| QuestionId = question.Id; CorrectValue = correctValue; Tolerance = tolerance |},
|
||||
tx
|
||||
)
|
||||
|> ignore
|
||||
|
||||
tx.Commit()
|
||||
|
||||
let tryGetQuestion (connString: string) (id: QuestionId) : Question option =
|
||||
use conn = openConnection connString
|
||||
|
||||
let row =
|
||||
conn.QuerySingleOrDefault<QuestionRow>($"SELECT {questionSelectColumns} FROM questions WHERE id = @Id", {| Id = id |})
|
||||
|
||||
if box row = null then None else assembleQuestions conn [ row ] |> List.tryHead
|
||||
|
||||
let removeQuestion (connString: string) (id: QuestionId) : unit =
|
||||
use conn = openConnection connString
|
||||
conn.Execute("DELETE FROM questions WHERE id = @Id", {| Id = id |}) |> ignore
|
||||
|
||||
let questionsByIds (connString: string) (ids: QuestionId seq) : Map<QuestionId, Question> =
|
||||
let idList = ids |> List.ofSeq
|
||||
|
||||
if idList.IsEmpty then
|
||||
Map.empty
|
||||
else
|
||||
use conn = openConnection connString
|
||||
|
||||
let rows =
|
||||
conn.Query<QuestionRow>(
|
||||
$"SELECT {questionSelectColumns} FROM questions WHERE id = ANY(@Ids)",
|
||||
{| Ids = idList |> List.map (fun (QuestionId g) -> g) |> List.toArray |}
|
||||
)
|
||||
|> List.ofSeq
|
||||
|
||||
assembleQuestions conn rows |> List.map (fun q -> q.Id, q) |> Map.ofList
|
||||
|
||||
let questionsByTopic (connString: string) (topicId: TopicId) : Question list =
|
||||
use conn = openConnection connString
|
||||
|
||||
let rows =
|
||||
conn.Query<QuestionRow>($"SELECT {questionSelectColumns} FROM questions WHERE topic_id = @TopicId", {| TopicId = topicId |})
|
||||
|> List.ofSeq
|
||||
|
||||
assembleQuestions conn rows
|
||||
|
||||
/// Whether `questionId` is referenced by any quiz's fixed question sources.
|
||||
/// Random-pool sources reference a topic, not a specific question, so they
|
||||
/// never block a delete here even if the question lives in that topic.
|
||||
let isQuestionUsed (connString: string) (questionId: QuestionId) : bool =
|
||||
use conn = openConnection connString
|
||||
|
||||
conn.ExecuteScalar<bool>(
|
||||
"SELECT EXISTS (SELECT 1 FROM quiz_question_source_fixed WHERE question_id = @QuestionId)",
|
||||
{| QuestionId = questionId |}
|
||||
)
|
||||
214
src/Server/Db/QuizRepository.fs
Normal file
214
src/Server/Db/QuizRepository.fs
Normal file
@@ -0,0 +1,214 @@
|
||||
module Server.Db.QuizRepository
|
||||
|
||||
open System
|
||||
open Dapper
|
||||
open Npgsql
|
||||
open Domain
|
||||
open Server.Db.Connection
|
||||
|
||||
// [<CLIMutable>] gives these a parameterless constructor + settable
|
||||
// properties, so Dapper materializes them via property-setting instead of
|
||||
// constructor-matching — the latter doesn't reliably handle `Nullable<'T>`
|
||||
// fields (confirmed by hand: it fails asking for the *non*-nullable
|
||||
// signature instead of binding the nulls it just read).
|
||||
[<CLIMutable>]
|
||||
type private QuizRow =
|
||||
{ Id: QuizId
|
||||
OwnerId: UserId
|
||||
Title: string
|
||||
Description: string
|
||||
TimeLimit: TimeSpan Nullable
|
||||
MaxAttempts: int Nullable
|
||||
GradingMethod: GradingMethod
|
||||
ShuffleQuestions: bool
|
||||
ShuffleAnswers: bool
|
||||
OpenFrom: DateTimeOffset Nullable
|
||||
OpenTo: DateTimeOffset Nullable
|
||||
PassingScore: float Nullable }
|
||||
|
||||
[<CLIMutable>]
|
||||
type private SourceHeaderRow = { Id: Guid; SourceType: string; OrderIndex: int }
|
||||
|
||||
[<CLIMutable>]
|
||||
type private FixedSourceRow = { SourceId: Guid; QuestionId: QuestionId; Points: float }
|
||||
|
||||
[<CLIMutable>]
|
||||
type private RandomSourceRow = { SourceId: Guid; TopicId: TopicId; Count: int }
|
||||
|
||||
let private quizSelectColumns =
|
||||
"id AS Id, owner_id AS OwnerId, title AS Title, description AS Description, time_limit AS TimeLimit,
|
||||
max_attempts AS MaxAttempts, grading_method AS GradingMethod, shuffle_questions AS ShuffleQuestions,
|
||||
shuffle_answers AS ShuffleAnswers, open_from AS OpenFrom, open_to AS OpenTo, passing_score AS PassingScore"
|
||||
|
||||
/// Loads the ordered `QuizQuestionSource` list for one quiz: the header rows
|
||||
/// first (id/type/order — no custom-typed nullable columns involved), then
|
||||
/// one filtered query per detail table, merged in F#. Deliberately avoids a
|
||||
/// single LEFT-JOIN-both-detail-tables query, since that would require
|
||||
/// binding `Nullable<QuestionId>`/`Nullable<TopicId>` through the custom
|
||||
/// Dapper type handlers — untested territory not worth the risk here.
|
||||
let private loadSources (conn: NpgsqlConnection) (quizId: QuizId) : QuizQuestionSource list =
|
||||
let headers =
|
||||
conn.Query<SourceHeaderRow>(
|
||||
"SELECT id AS Id, source_type AS SourceType, order_index AS OrderIndex FROM quiz_question_sources WHERE quiz_id = @QuizId ORDER BY order_index",
|
||||
{| QuizId = quizId |}
|
||||
)
|
||||
|> List.ofSeq
|
||||
|
||||
if headers.IsEmpty then
|
||||
[]
|
||||
else
|
||||
let sourceIds = headers |> List.map (fun h -> h.Id) |> List.toArray
|
||||
|
||||
let fixedById =
|
||||
conn.Query<FixedSourceRow>(
|
||||
"SELECT source_id AS SourceId, question_id AS QuestionId, points AS Points FROM quiz_question_source_fixed WHERE source_id = ANY(@Ids)",
|
||||
{| Ids = sourceIds |}
|
||||
)
|
||||
|> Seq.map (fun r -> r.SourceId, r)
|
||||
|> dict
|
||||
|
||||
let randomById =
|
||||
conn.Query<RandomSourceRow>(
|
||||
"SELECT source_id AS SourceId, topic_id AS TopicId, count AS Count FROM quiz_question_source_random WHERE source_id = ANY(@Ids)",
|
||||
{| Ids = sourceIds |}
|
||||
)
|
||||
|> Seq.map (fun r -> r.SourceId, r)
|
||||
|> dict
|
||||
|
||||
headers
|
||||
|> List.map (fun h ->
|
||||
match h.SourceType with
|
||||
| "Fixed" ->
|
||||
let f = fixedById.[h.Id]
|
||||
FixedQuestion { QuestionId = f.QuestionId; Points = f.Points; Order = h.OrderIndex }
|
||||
| "RandomFromTopic" ->
|
||||
let r = randomById.[h.Id]
|
||||
RandomFromTopic(r.TopicId, r.Count, h.OrderIndex)
|
||||
| other -> failwithf "Unknown source_type '%s'" other)
|
||||
|
||||
let private assembleQuiz (conn: NpgsqlConnection) (row: QuizRow) : Quiz =
|
||||
let assigned =
|
||||
conn.Query<UserId>("SELECT user_id FROM quiz_assigned_students WHERE quiz_id = @Id", {| Id = row.Id |})
|
||||
|> Set.ofSeq
|
||||
|
||||
{ Id = row.Id
|
||||
OwnerId = row.OwnerId
|
||||
Title = row.Title
|
||||
Description = row.Description
|
||||
TimeLimit = row.TimeLimit |> Option.ofNullable
|
||||
MaxAttempts = row.MaxAttempts |> Option.ofNullable
|
||||
GradingMethod = row.GradingMethod
|
||||
ShuffleQuestions = row.ShuffleQuestions
|
||||
ShuffleAnswers = row.ShuffleAnswers
|
||||
OpenFrom = row.OpenFrom |> Option.ofNullable
|
||||
OpenTo = row.OpenTo |> Option.ofNullable
|
||||
PassingScore = row.PassingScore |> Option.ofNullable
|
||||
QuestionSources = loadSources conn row.Id
|
||||
AssignedStudentIds = assigned }
|
||||
|
||||
/// Upserts the scalar `quizzes` row, then delete-then-reinserts its sources
|
||||
/// and assigned-students set — same "always a full replace" semantics the
|
||||
/// in-memory Store already has (no partial-update member exists today).
|
||||
let addQuiz (connString: string) (quiz: Quiz) : unit =
|
||||
use conn = openConnection connString
|
||||
use tx = conn.BeginTransaction()
|
||||
|
||||
conn.Execute(
|
||||
"""INSERT INTO quizzes (id, owner_id, title, description, time_limit, max_attempts,
|
||||
grading_method, shuffle_questions, shuffle_answers,
|
||||
open_from, open_to, passing_score)
|
||||
VALUES (@Id, @OwnerId, @Title, @Description, @TimeLimit, @MaxAttempts,
|
||||
@GradingMethod, @ShuffleQuestions, @ShuffleAnswers, @OpenFrom, @OpenTo, @PassingScore)
|
||||
ON CONFLICT (id) DO UPDATE SET
|
||||
owner_id = EXCLUDED.owner_id, title = EXCLUDED.title, description = EXCLUDED.description,
|
||||
time_limit = EXCLUDED.time_limit, max_attempts = EXCLUDED.max_attempts,
|
||||
grading_method = EXCLUDED.grading_method, shuffle_questions = EXCLUDED.shuffle_questions,
|
||||
shuffle_answers = EXCLUDED.shuffle_answers, open_from = EXCLUDED.open_from,
|
||||
open_to = EXCLUDED.open_to, passing_score = EXCLUDED.passing_score""",
|
||||
{| Id = quiz.Id
|
||||
OwnerId = quiz.OwnerId
|
||||
Title = quiz.Title
|
||||
Description = quiz.Description
|
||||
TimeLimit = quiz.TimeLimit |> Option.toNullable
|
||||
MaxAttempts = quiz.MaxAttempts |> Option.toNullable
|
||||
GradingMethod = quiz.GradingMethod
|
||||
ShuffleQuestions = quiz.ShuffleQuestions
|
||||
ShuffleAnswers = quiz.ShuffleAnswers
|
||||
OpenFrom = quiz.OpenFrom |> Option.toNullable
|
||||
OpenTo = quiz.OpenTo |> Option.toNullable
|
||||
PassingScore = quiz.PassingScore |> Option.toNullable |},
|
||||
tx
|
||||
)
|
||||
|> ignore
|
||||
|
||||
// Cascades into quiz_question_source_fixed/random.
|
||||
conn.Execute("DELETE FROM quiz_question_sources WHERE quiz_id = @Id", {| Id = quiz.Id |}, tx)
|
||||
|> ignore
|
||||
|
||||
quiz.QuestionSources
|
||||
|> List.iter (fun source ->
|
||||
let sourceId = Guid.NewGuid()
|
||||
|
||||
match source with
|
||||
| FixedQuestion r ->
|
||||
conn.Execute(
|
||||
"INSERT INTO quiz_question_sources (id, quiz_id, source_type, order_index) VALUES (@Id, @QuizId, 'Fixed', @Order)",
|
||||
{| Id = sourceId; QuizId = quiz.Id; Order = r.Order |},
|
||||
tx
|
||||
)
|
||||
|> ignore
|
||||
|
||||
conn.Execute(
|
||||
"INSERT INTO quiz_question_source_fixed (source_id, question_id, points) VALUES (@SourceId, @QuestionId, @Points)",
|
||||
{| SourceId = sourceId; QuestionId = r.QuestionId; Points = r.Points |},
|
||||
tx
|
||||
)
|
||||
|> ignore
|
||||
| RandomFromTopic(topicId, count, order) ->
|
||||
conn.Execute(
|
||||
"INSERT INTO quiz_question_sources (id, quiz_id, source_type, order_index) VALUES (@Id, @QuizId, 'RandomFromTopic', @Order)",
|
||||
{| Id = sourceId; QuizId = quiz.Id; Order = order |},
|
||||
tx
|
||||
)
|
||||
|> ignore
|
||||
|
||||
conn.Execute(
|
||||
"INSERT INTO quiz_question_source_random (source_id, topic_id, count) VALUES (@SourceId, @TopicId, @Count)",
|
||||
{| SourceId = sourceId; TopicId = topicId; Count = count |},
|
||||
tx
|
||||
)
|
||||
|> ignore)
|
||||
|
||||
conn.Execute("DELETE FROM quiz_assigned_students WHERE quiz_id = @Id", {| Id = quiz.Id |}, tx)
|
||||
|> ignore
|
||||
|
||||
quiz.AssignedStudentIds
|
||||
|> Set.iter (fun uid ->
|
||||
conn.Execute(
|
||||
"INSERT INTO quiz_assigned_students (quiz_id, user_id) VALUES (@QuizId, @UserId)",
|
||||
{| QuizId = quiz.Id; UserId = uid |},
|
||||
tx
|
||||
)
|
||||
|> ignore)
|
||||
|
||||
tx.Commit()
|
||||
|
||||
let removeQuiz (connString: string) (id: QuizId) : unit =
|
||||
use conn = openConnection connString
|
||||
conn.Execute("DELETE FROM quizzes WHERE id = @Id", {| Id = id |}) |> ignore
|
||||
|
||||
let allQuizzes (connString: string) : Quiz list =
|
||||
use conn = openConnection connString
|
||||
conn.Query<QuizRow>($"SELECT {quizSelectColumns} FROM quizzes") |> Seq.map (assembleQuiz conn) |> List.ofSeq
|
||||
|
||||
let quizzesByOwner (connString: string) (ownerId: UserId) : Quiz list =
|
||||
use conn = openConnection connString
|
||||
|
||||
conn.Query<QuizRow>($"SELECT {quizSelectColumns} FROM quizzes WHERE owner_id = @OwnerId", {| OwnerId = ownerId |})
|
||||
|> Seq.map (assembleQuiz conn)
|
||||
|> List.ofSeq
|
||||
|
||||
let tryGetQuiz (connString: string) (id: QuizId) : Quiz option =
|
||||
use conn = openConnection connString
|
||||
let row = conn.QuerySingleOrDefault<QuizRow>($"SELECT {quizSelectColumns} FROM quizzes WHERE id = @Id", {| Id = id |})
|
||||
if box row = null then None else Some(assembleQuiz conn row)
|
||||
28
src/Server/Db/TopicRepository.fs
Normal file
28
src/Server/Db/TopicRepository.fs
Normal file
@@ -0,0 +1,28 @@
|
||||
module Server.Db.TopicRepository
|
||||
|
||||
open Dapper
|
||||
open Domain
|
||||
open Server.Db.Connection
|
||||
|
||||
let private selectColumns = "id AS Id, owner_id AS OwnerId, name AS Name"
|
||||
|
||||
let addTopic (connString: string) (topic: Topic) : unit =
|
||||
use conn = openConnection connString
|
||||
|
||||
conn.Execute(
|
||||
"""INSERT INTO topics (id, owner_id, name) VALUES (@Id, @OwnerId, @Name)
|
||||
ON CONFLICT (id) DO UPDATE SET owner_id = EXCLUDED.owner_id, name = EXCLUDED.name""",
|
||||
topic
|
||||
)
|
||||
|> ignore
|
||||
|
||||
let tryGetTopic (connString: string) (id: TopicId) : Topic option =
|
||||
use conn = openConnection connString
|
||||
conn.QuerySingleOrDefault<Topic>($"SELECT {selectColumns} FROM topics WHERE id = @Id", {| Id = id |})
|
||||
|> Option.ofObj
|
||||
|
||||
let topicsByOwner (connString: string) (ownerId: UserId) : Topic list =
|
||||
use conn = openConnection connString
|
||||
|
||||
conn.Query<Topic>($"SELECT {selectColumns} FROM topics WHERE owner_id = @OwnerId", {| OwnerId = ownerId |})
|
||||
|> List.ofSeq
|
||||
111
src/Server/Db/TypeHandlers.fs
Normal file
111
src/Server/Db/TypeHandlers.fs
Normal file
@@ -0,0 +1,111 @@
|
||||
/// Dapper has no built-in knowledge of the domain's single-case Guid-wrapper
|
||||
/// id types, nor its payload-less enum unions (`Role`/`GradingMethod`/
|
||||
/// `AttemptState`, stored as plain TEXT columns) — every one of them needs an
|
||||
/// explicit `SqlMapper.TypeHandler<'T>` registered once at startup, or the
|
||||
/// first query touching that type throws at runtime.
|
||||
module Server.Db.TypeHandlers
|
||||
|
||||
open System
|
||||
open System.Data
|
||||
open Dapper
|
||||
open Domain
|
||||
|
||||
type private UserIdHandler() =
|
||||
inherit SqlMapper.TypeHandler<UserId>()
|
||||
override _.SetValue(p: IDbDataParameter, UserId g) = p.Value <- box g
|
||||
override _.Parse(v: obj) = UserId(v :?> Guid)
|
||||
|
||||
type private TopicIdHandler() =
|
||||
inherit SqlMapper.TypeHandler<TopicId>()
|
||||
override _.SetValue(p: IDbDataParameter, TopicId g) = p.Value <- box g
|
||||
override _.Parse(v: obj) = TopicId(v :?> Guid)
|
||||
|
||||
type private QuestionIdHandler() =
|
||||
inherit SqlMapper.TypeHandler<QuestionId>()
|
||||
override _.SetValue(p: IDbDataParameter, QuestionId g) = p.Value <- box g
|
||||
override _.Parse(v: obj) = QuestionId(v :?> Guid)
|
||||
|
||||
type private OptionIdHandler() =
|
||||
inherit SqlMapper.TypeHandler<OptionId>()
|
||||
override _.SetValue(p: IDbDataParameter, OptionId g) = p.Value <- box g
|
||||
override _.Parse(v: obj) = OptionId(v :?> Guid)
|
||||
|
||||
type private QuizIdHandler() =
|
||||
inherit SqlMapper.TypeHandler<QuizId>()
|
||||
override _.SetValue(p: IDbDataParameter, QuizId g) = p.Value <- box g
|
||||
override _.Parse(v: obj) = QuizId(v :?> Guid)
|
||||
|
||||
type private AttemptIdHandler() =
|
||||
inherit SqlMapper.TypeHandler<AttemptId>()
|
||||
override _.SetValue(p: IDbDataParameter, AttemptId g) = p.Value <- box g
|
||||
override _.Parse(v: obj) = AttemptId(v :?> Guid)
|
||||
|
||||
type private RoleHandler() =
|
||||
inherit SqlMapper.TypeHandler<Role>()
|
||||
|
||||
override _.SetValue(p: IDbDataParameter, role) =
|
||||
p.Value <-
|
||||
box (
|
||||
match role with
|
||||
| Admin -> "Admin"
|
||||
| Teacher -> "Teacher"
|
||||
| Student -> "Student"
|
||||
)
|
||||
|
||||
override _.Parse(v: obj) =
|
||||
match v :?> string with
|
||||
| "Admin" -> Admin
|
||||
| "Teacher" -> Teacher
|
||||
| "Student" -> Student
|
||||
| other -> failwithf "Unknown role '%s'" other
|
||||
|
||||
type private GradingMethodHandler() =
|
||||
inherit SqlMapper.TypeHandler<GradingMethod>()
|
||||
|
||||
override _.SetValue(p: IDbDataParameter, method) =
|
||||
p.Value <-
|
||||
box (
|
||||
match method with
|
||||
| HighestAttempt -> "HighestAttempt"
|
||||
| AverageAttempt -> "AverageAttempt"
|
||||
| FirstAttempt -> "FirstAttempt"
|
||||
| LastAttempt -> "LastAttempt"
|
||||
)
|
||||
|
||||
override _.Parse(v: obj) =
|
||||
match v :?> string with
|
||||
| "HighestAttempt" -> HighestAttempt
|
||||
| "AverageAttempt" -> AverageAttempt
|
||||
| "FirstAttempt" -> FirstAttempt
|
||||
| "LastAttempt" -> LastAttempt
|
||||
| other -> failwithf "Unknown grading method '%s'" other
|
||||
|
||||
type private AttemptStateHandler() =
|
||||
inherit SqlMapper.TypeHandler<AttemptState>()
|
||||
|
||||
override _.SetValue(p: IDbDataParameter, state) =
|
||||
p.Value <-
|
||||
box (
|
||||
match state with
|
||||
| InProgress -> "InProgress"
|
||||
| Submitted -> "Submitted"
|
||||
| Graded -> "Graded"
|
||||
)
|
||||
|
||||
override _.Parse(v: obj) =
|
||||
match v :?> string with
|
||||
| "InProgress" -> InProgress
|
||||
| "Submitted" -> Submitted
|
||||
| "Graded" -> Graded
|
||||
| other -> failwithf "Unknown attempt state '%s'" other
|
||||
|
||||
let register () =
|
||||
SqlMapper.AddTypeHandler(UserIdHandler())
|
||||
SqlMapper.AddTypeHandler(TopicIdHandler())
|
||||
SqlMapper.AddTypeHandler(QuestionIdHandler())
|
||||
SqlMapper.AddTypeHandler(OptionIdHandler())
|
||||
SqlMapper.AddTypeHandler(QuizIdHandler())
|
||||
SqlMapper.AddTypeHandler(AttemptIdHandler())
|
||||
SqlMapper.AddTypeHandler(RoleHandler())
|
||||
SqlMapper.AddTypeHandler(GradingMethodHandler())
|
||||
SqlMapper.AddTypeHandler(AttemptStateHandler())
|
||||
44
src/Server/Db/UserRepository.fs
Normal file
44
src/Server/Db/UserRepository.fs
Normal file
@@ -0,0 +1,44 @@
|
||||
module Server.Db.UserRepository
|
||||
|
||||
open Dapper
|
||||
open Domain
|
||||
open Server.Db.Connection
|
||||
|
||||
let private selectColumns =
|
||||
"id AS Id, name AS Name, email AS Email, password_hash AS PasswordHash, role AS Role, is_active AS IsActive"
|
||||
|
||||
let addUser (connString: string) (user: User) : unit =
|
||||
use conn = openConnection connString
|
||||
|
||||
conn.Execute(
|
||||
"""INSERT INTO users (id, name, email, password_hash, role, is_active)
|
||||
VALUES (@Id, @Name, @Email, @PasswordHash, @Role, @IsActive)
|
||||
ON CONFLICT (id) DO UPDATE SET
|
||||
name = EXCLUDED.name, email = EXCLUDED.email,
|
||||
password_hash = EXCLUDED.password_hash, role = EXCLUDED.role,
|
||||
is_active = EXCLUDED.is_active""",
|
||||
user
|
||||
)
|
||||
|> ignore
|
||||
|
||||
let listUsers (connString: string) : User list =
|
||||
use conn = openConnection connString
|
||||
conn.Query<User>($"SELECT {selectColumns} FROM users ORDER BY name") |> List.ofSeq
|
||||
|
||||
let tryGetUserByEmail (connString: string) (email: string) : User option =
|
||||
use conn = openConnection connString
|
||||
|
||||
conn.QuerySingleOrDefault<User>(
|
||||
$"SELECT {selectColumns} FROM users WHERE lower(email) = lower(@Email)",
|
||||
{| Email = email |}
|
||||
)
|
||||
|> Option.ofObj
|
||||
|
||||
let tryGetUser (connString: string) (id: UserId) : User option =
|
||||
use conn = openConnection connString
|
||||
conn.QuerySingleOrDefault<User>($"SELECT {selectColumns} FROM users WHERE id = @Id", {| Id = id |})
|
||||
|> Option.ofObj
|
||||
|
||||
let usersByRole (connString: string) (role: Role) : User list =
|
||||
use conn = openConnection connString
|
||||
conn.Query<User>($"SELECT {selectColumns} FROM users WHERE role = @Role", {| Role = role |}) |> List.ofSeq
|
||||
17
src/Server/Dockerfile
Normal file
17
src/Server/Dockerfile
Normal file
@@ -0,0 +1,17 @@
|
||||
# Build context is the repo root (see docker-compose.yml) so both src/Domain
|
||||
# and src/Server are reachable.
|
||||
FROM mcr.microsoft.com/dotnet/sdk:9.0 AS build
|
||||
WORKDIR /src
|
||||
COPY src/Domain/Domain.fsproj src/Domain/
|
||||
COPY src/Server/Server.fsproj src/Server/
|
||||
RUN dotnet restore src/Server/Server.fsproj
|
||||
COPY src/Domain/ src/Domain/
|
||||
COPY src/Server/ src/Server/
|
||||
RUN dotnet publish src/Server/Server.fsproj -c Release -o /app/publish --no-restore
|
||||
|
||||
FROM mcr.microsoft.com/dotnet/aspnet:9.0 AS runtime
|
||||
WORKDIR /app
|
||||
COPY --from=build /app/publish .
|
||||
# The base image already sets ASPNETCORE_HTTP_PORTS=8080.
|
||||
EXPOSE 8080
|
||||
ENTRYPOINT ["dotnet", "Server.dll"]
|
||||
33
src/Server/ExpirySweeper.fs
Normal file
33
src/Server/ExpirySweeper.fs
Normal file
@@ -0,0 +1,33 @@
|
||||
module Server.ExpirySweeper
|
||||
|
||||
open System
|
||||
open System.Threading
|
||||
open System.Threading.Tasks
|
||||
open Microsoft.Extensions.Hosting
|
||||
open Microsoft.Extensions.Logging
|
||||
open Server.Store
|
||||
open Server.Features.Attempts
|
||||
|
||||
/// Catches `InProgress` attempts whose time limit has passed but nobody sent
|
||||
/// a follow-up request for (e.g. the student just closed the tab) —
|
||||
/// `SubmitAnswer.fs` only catches expiry on the *next* request against a
|
||||
/// given attempt, so an abandoned one would otherwise sit "in progress"
|
||||
/// forever without ever being graded. Polls every 30s per DESIGN.md §3.6.
|
||||
type ExpirySweeperService(store: Store, logger: ILogger<ExpirySweeperService>) =
|
||||
inherit BackgroundService()
|
||||
|
||||
override _.ExecuteAsync(stoppingToken: CancellationToken) =
|
||||
task {
|
||||
while not stoppingToken.IsCancellationRequested do
|
||||
try
|
||||
for attempt in store.ExpiredInProgressAttempts() do
|
||||
AutoFinish.finishExpired store attempt |> ignore
|
||||
with ex ->
|
||||
logger.LogError(ex, "Expiry sweep failed")
|
||||
|
||||
try
|
||||
do! Task.Delay(TimeSpan.FromSeconds 30.0, stoppingToken)
|
||||
with :? TaskCanceledException ->
|
||||
()
|
||||
}
|
||||
:> Task
|
||||
39
src/Server/Features/Admin/CreateUser.fs
Normal file
39
src/Server/Features/Admin/CreateUser.fs
Normal file
@@ -0,0 +1,39 @@
|
||||
module Server.Features.Admin.CreateUser
|
||||
|
||||
open Giraffe
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
open Server.Store
|
||||
open Server.Features.Admin.ListUsers
|
||||
|
||||
let private create (store: Store) (req: CreateUserRequest) : Result<UserSummary, string> =
|
||||
if System.String.IsNullOrWhiteSpace req.Name then
|
||||
Error "Имя не может быть пустым"
|
||||
elif System.String.IsNullOrWhiteSpace req.Email then
|
||||
Error "Email не может быть пустым"
|
||||
elif req.Password.Length < 6 then
|
||||
Error "Пароль должен быть не короче 6 символов"
|
||||
else
|
||||
match store.TryGetUserByEmail req.Email with
|
||||
| Some _ -> Error "Пользователь с таким email уже существует"
|
||||
| None ->
|
||||
let user: User =
|
||||
{ Id = Id.newUserId ()
|
||||
Name = req.Name
|
||||
Email = req.Email
|
||||
PasswordHash = BCrypt.Net.BCrypt.HashPassword req.Password
|
||||
Role = req.Role
|
||||
IsActive = true }
|
||||
|
||||
store.AddUser user
|
||||
Ok(toSummary user)
|
||||
|
||||
let handler (store: Store) : HttpHandler =
|
||||
bindJson<CreateUserRequest> (fun req next ctx ->
|
||||
task {
|
||||
let result =
|
||||
Server.Auth.requireRole [ Admin ] ctx.User
|
||||
|> Result.bind (fun _ -> create store req)
|
||||
|
||||
return! json result next ctx
|
||||
})
|
||||
23
src/Server/Features/Admin/ListUsers.fs
Normal file
23
src/Server/Features/Admin/ListUsers.fs
Normal file
@@ -0,0 +1,23 @@
|
||||
module Server.Features.Admin.ListUsers
|
||||
|
||||
open Giraffe
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
open Server.Store
|
||||
|
||||
let toSummary (u: User) : UserSummary =
|
||||
{ Id = u.Id
|
||||
Name = u.Name
|
||||
Email = u.Email
|
||||
Role = u.Role
|
||||
IsActive = u.IsActive }
|
||||
|
||||
let handler (store: Store) : HttpHandler =
|
||||
fun next ctx ->
|
||||
task {
|
||||
let result =
|
||||
Server.Auth.requireRole [ Admin ] ctx.User
|
||||
|> Result.map (fun _ -> store.AllUsers() |> List.map toSummary)
|
||||
|
||||
return! json result next ctx
|
||||
}
|
||||
26
src/Server/Features/Admin/ResetPassword.fs
Normal file
26
src/Server/Features/Admin/ResetPassword.fs
Normal file
@@ -0,0 +1,26 @@
|
||||
module Server.Features.Admin.ResetPassword
|
||||
|
||||
open Giraffe
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
open Server.Store
|
||||
|
||||
let private reset (store: Store) (req: ResetPasswordRequest) : Result<unit, string> =
|
||||
if req.NewPassword.Length < 6 then
|
||||
Error "Пароль должен быть не короче 6 символов"
|
||||
else
|
||||
match store.TryGetUser req.Id with
|
||||
| None -> Error "Пользователь не найден"
|
||||
| Some existing ->
|
||||
store.AddUser { existing with PasswordHash = BCrypt.Net.BCrypt.HashPassword req.NewPassword }
|
||||
Ok()
|
||||
|
||||
let handler (store: Store) : HttpHandler =
|
||||
bindJson<ResetPasswordRequest> (fun req next ctx ->
|
||||
task {
|
||||
let result =
|
||||
Server.Auth.requireRole [ Admin ] ctx.User
|
||||
|> Result.bind (fun _ -> reset store req)
|
||||
|
||||
return! json result next ctx
|
||||
})
|
||||
28
src/Server/Features/Admin/SetUserActive.fs
Normal file
28
src/Server/Features/Admin/SetUserActive.fs
Normal file
@@ -0,0 +1,28 @@
|
||||
module Server.Features.Admin.SetUserActive
|
||||
|
||||
open Giraffe
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
open Server.Store
|
||||
open Server.Features.Admin.ListUsers
|
||||
|
||||
let private setActive (store: Store) (callerId: UserId) (req: SetUserActiveRequest) : Result<UserSummary, string> =
|
||||
if req.Id = callerId && not req.IsActive then
|
||||
Error "Нельзя деактивировать свою учётную запись"
|
||||
else
|
||||
match store.TryGetUser req.Id with
|
||||
| None -> Error "Пользователь не найден"
|
||||
| Some existing ->
|
||||
let updated = { existing with IsActive = req.IsActive }
|
||||
store.AddUser updated
|
||||
Ok(toSummary updated)
|
||||
|
||||
let handler (store: Store) : HttpHandler =
|
||||
bindJson<SetUserActiveRequest> (fun req next ctx ->
|
||||
task {
|
||||
let result =
|
||||
Server.Auth.requireRole [ Admin ] ctx.User
|
||||
|> Result.bind (fun uid -> setActive store uid req)
|
||||
|
||||
return! json result next ctx
|
||||
})
|
||||
38
src/Server/Features/Admin/UpdateUser.fs
Normal file
38
src/Server/Features/Admin/UpdateUser.fs
Normal file
@@ -0,0 +1,38 @@
|
||||
module Server.Features.Admin.UpdateUser
|
||||
|
||||
open Giraffe
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
open Server.Store
|
||||
open Server.Features.Admin.ListUsers
|
||||
|
||||
let private update (store: Store) (req: UpdateUserRequest) : Result<UserSummary, string> =
|
||||
match store.TryGetUser req.Id with
|
||||
| None -> Error "Пользователь не найден"
|
||||
| Some existing ->
|
||||
if System.String.IsNullOrWhiteSpace req.Name then
|
||||
Error "Имя не может быть пустым"
|
||||
elif System.String.IsNullOrWhiteSpace req.Email then
|
||||
Error "Email не может быть пустым"
|
||||
else
|
||||
let emailTaken =
|
||||
match store.TryGetUserByEmail req.Email with
|
||||
| Some other -> other.Id <> req.Id
|
||||
| None -> false
|
||||
|
||||
if emailTaken then
|
||||
Error "Пользователь с таким email уже существует"
|
||||
else
|
||||
let updated = { existing with Name = req.Name; Email = req.Email; Role = req.Role }
|
||||
store.AddUser updated
|
||||
Ok(toSummary updated)
|
||||
|
||||
let handler (store: Store) : HttpHandler =
|
||||
bindJson<UpdateUserRequest> (fun req next ctx ->
|
||||
task {
|
||||
let result =
|
||||
Server.Auth.requireRole [ Admin ] ctx.User
|
||||
|> Result.bind (fun _ -> update store req)
|
||||
|
||||
return! json result next ctx
|
||||
})
|
||||
17
src/Server/Features/Attempts/AutoFinish.fs
Normal file
17
src/Server/Features/Attempts/AutoFinish.fs
Normal file
@@ -0,0 +1,17 @@
|
||||
module Server.Features.Attempts.AutoFinish
|
||||
|
||||
open System
|
||||
open Domain
|
||||
open Server.Store
|
||||
|
||||
/// Grades and saves an attempt whose time limit has already passed,
|
||||
/// transitioning it out of `InProgress` exactly like a normal manual finish
|
||||
/// would — shared by `SubmitAnswer.fs` (checked on every request against a
|
||||
/// specific attempt) and `Server.ExpirySweeper` (catches attempts nobody
|
||||
/// sent a follow-up request for, e.g. an abandoned tab).
|
||||
let finishExpired (store: Store) (attempt: Attempt) : Attempt =
|
||||
let questionMap = store.QuestionsByIds(attempt.Questions |> List.map (fun q -> q.QuestionId))
|
||||
let submitted = attempt |> Attempt.submit DateTimeOffset.UtcNow
|
||||
let graded = Grading.gradeAttempt questionMap submitted
|
||||
store.SaveAttempt graded
|
||||
graded
|
||||
40
src/Server/Features/Attempts/FinishAttempt.fs
Normal file
40
src/Server/Features/Attempts/FinishAttempt.fs
Normal file
@@ -0,0 +1,40 @@
|
||||
module Server.Features.Attempts.FinishAttempt
|
||||
|
||||
open System
|
||||
open Giraffe
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
open Server.Store
|
||||
|
||||
let private finish (store: Store) (userId: UserId) (req: FinishAttemptRequest) : Result<AttemptResult, string> =
|
||||
match store.TryGetAttempt req.AttemptId with
|
||||
| None -> Error "Попытка не найдена"
|
||||
| Some attempt when attempt.UserId <> userId -> Error "Доступ запрещён"
|
||||
| Some attempt ->
|
||||
match store.TryGetQuiz attempt.QuizId with
|
||||
| None -> Error "Тест не найден"
|
||||
| Some quiz ->
|
||||
let submitted = attempt |> Attempt.submit DateTimeOffset.UtcNow
|
||||
let questionMap = store.QuestionsByIds(attempt.Questions |> List.map (fun q -> q.QuestionId))
|
||||
let graded = Grading.gradeAttempt questionMap submitted
|
||||
store.SaveAttempt graded
|
||||
|
||||
let maxScore = attempt.Questions |> List.sumBy (fun q -> q.Points)
|
||||
let score = defaultArg graded.Score 0.0
|
||||
let passed = quiz.PassingScore |> Option.map (fun p -> score >= p)
|
||||
|
||||
Ok
|
||||
{ AttemptId = graded.Id
|
||||
Score = score
|
||||
MaxScore = maxScore
|
||||
Passed = passed }
|
||||
|
||||
let handler (store: Store) : HttpHandler =
|
||||
bindJson<FinishAttemptRequest> (fun req next ctx ->
|
||||
task {
|
||||
let result =
|
||||
Server.Auth.requireUserId ctx.User
|
||||
|> Result.bind (fun userId -> finish store userId req)
|
||||
|
||||
return! json result next ctx
|
||||
})
|
||||
29
src/Server/Features/Attempts/ReportFocusLoss.fs
Normal file
29
src/Server/Features/Attempts/ReportFocusLoss.fs
Normal file
@@ -0,0 +1,29 @@
|
||||
module Server.Features.Attempts.ReportFocusLoss
|
||||
|
||||
open Giraffe
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
open Server.Store
|
||||
|
||||
let private report (store: Store) (userId: UserId) (req: ReportFocusLossRequest) : Result<unit, string> =
|
||||
match store.TryGetAttempt req.AttemptId with
|
||||
| None -> Error "Попытка не найдена"
|
||||
| Some attempt when attempt.UserId <> userId -> Error "Доступ запрещён"
|
||||
| Some attempt when attempt.State <> InProgress ->
|
||||
// The attempt already ended (manual finish, expiry, ...) — a
|
||||
// straggling event from a page the student hasn't closed yet isn't
|
||||
// worth surfacing as an error, it just has nothing left to count.
|
||||
Ok()
|
||||
| Some _ ->
|
||||
store.IncrementFocusLoss req.AttemptId
|
||||
Ok()
|
||||
|
||||
let handler (store: Store) : HttpHandler =
|
||||
bindJson<ReportFocusLossRequest> (fun req next ctx ->
|
||||
task {
|
||||
let result =
|
||||
Server.Auth.requireUserId ctx.User
|
||||
|> Result.bind (fun userId -> report store userId req)
|
||||
|
||||
return! json result next ctx
|
||||
})
|
||||
39
src/Server/Features/Attempts/SubmitAnswer.fs
Normal file
39
src/Server/Features/Attempts/SubmitAnswer.fs
Normal file
@@ -0,0 +1,39 @@
|
||||
module Server.Features.Attempts.SubmitAnswer
|
||||
|
||||
open System
|
||||
open Giraffe
|
||||
open Domain
|
||||
open Domain.Contracts
|
||||
open Server.Store
|
||||
|
||||
let private submit (store: Store) (userId: UserId) (req: SubmitAnswerRequest) : Result<unit, string> =
|
||||
match store.TryGetAttempt req.AttemptId with
|
||||
| None -> Error "Попытка не найдена"
|
||||
| Some attempt when attempt.UserId <> userId -> Error "Доступ запрещён"
|
||||
| Some attempt when attempt.State <> InProgress -> Error "Попытка уже завершена"
|
||||
| Some attempt ->
|
||||
match store.TryGetQuiz attempt.QuizId with
|
||||
| None -> Error "Тест не найден"
|
||||
| Some quiz when Attempt.isExpired quiz DateTimeOffset.UtcNow attempt ->
|
||||
// The deadline already passed — grade whatever was answered so
|
||||
// far instead of silently accepting one more change, and reject
|
||||
// *this* answer. Reaching `InProgress` again after this is
|
||||
// impossible, so every subsequent call (from this student
|
||||
// clicking around a stale page) falls through to the
|
||||
// "already finished" branch above instead of re-checking expiry.
|
||||
Server.Features.Attempts.AutoFinish.finishExpired store attempt |> ignore
|
||||
Error "Время вышло — тест завершён автоматически"
|
||||
| Some _ ->
|
||||
let updated = attempt |> Attempt.recordResponse req.QuestionId req.Response
|
||||
store.SaveAttempt updated
|
||||
Ok()
|
||||
|
||||
let handler (store: Store) : HttpHandler =
|
||||
bindJson<SubmitAnswerRequest> (fun req next ctx ->
|
||||
task {
|
||||
let result =
|
||||
Server.Auth.requireUserId ctx.User
|
||||
|> Result.bind (fun userId -> submit store userId req)
|
||||
|
||||
return! json result next ctx
|
||||
})
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user