module Surveys
using Dates
using Genie.Renderers.Html
import Base: show, isvalid, isempty
export Survey, SurveyPart, Question,
Answer, Response, update!, clear!,
nonempty, wordlimit, charlimit,
SurveyID, ResponseID,
Checkbox, TextInput, DateInput, NumberInput, IntegerInput,
TextArea, Dropdown, RadioSelect, MultiSelect, RangeSelect
# ---------------------
# Main Types
# ---------------------
# Input Field
abstract type FormField{T} end
# Question
struct Question{F <: FormField}
id::Symbol
prompt::AbstractString
field::F
validators::Vector{Function}
postprocessors::Vector{Function}
function Question(id::Symbol, prompt::AbstractString,
field::F, validators::Vector{Function},
postprocessors::Vector{Function}) where {F<:FormField}
if id in (:uid, :page)
@warn "Question uses a reserved id $id, this is likely to cause issues"
end
postprocessors = map(p -> if p == last; lastsoftfail else p end, postprocessors)
new{F}(id, prompt, field, validators, postprocessors)
end
end
function nonempty(value::AbstractString)
if ismissing(value) || (isa(value, AbstractString) && isempty(strip(value)))
"Must be answered"
end
end
function nonempty(values::Vector{<:AbstractString})
if length(values) == 0 || all(isempty, strip.(values))
"Must be answered"
end
end
nonempty(::Bool) = nothing
nonempty(::Number) = nothing
nonempty(::Date) = nothing
lastsoftfail(v::Vector) =
if length(v) > 0
last(v)
else "" end
wordlimit(min::Int, max::Int) = function(text::AbstractString)
wordcount = length(split(text))
if wordcount < min
string("Need at least ", min, if min > 1 " words" else " word" end,
" (currently ", wordcount, ")")
elseif wordcount > max
string("No more than ", max, if max > 1 " words" else " word" end,
" are permitted (currently ", wordcount, ")")
end
end
wordlimit(max::Int) = wordlimit(0, max)
charlimit(min::Int, max::Int) = function(text::AbstractString)
charcount = length(split(text))
if charcount < min
string("Need at least ", min, if min > 1 " characters" else " character" end,
" (currently ", charcount, ")")
elseif charcount > max
string("No more than ", max, if max > 1 " characters" else " character" end,
" are permitted (currently ", charcount, ")")
end
end
charlimit(max::Int) = charlimit(0, max)
default_postprocessors(::FormField) = Function[last, strip]
default_validators(::FormField) = Function[]
function Question(id::Symbol, prompt::AbstractString, field::FormField;
postprocessors::Union{Function, Vector{<:Function}} =
default_postprocessors(field),
validators::Union{Function, Vector{<:Function}} =
default_validators(field),
mandatory::Bool = true)
fullvalidators = if mandatory
vcat(nonempty, validators)
else
vcat(validators)
end |> Vector{Function}
Question(id, prompt, field, fullvalidators, postprocessors)
end
function prompttoid(prompt::String)
prompt |>
p -> replace(p, r"[^A-Za-z0-9\s]" => "") |>
p -> replace(p, r"\s+" => "_") |>
lowercase |>
Symbol
end
Question(prompt::AbstractString, field::FormField; kargs...) =
Question(prompttoid(prompttoid), prompt, field; kargs...)
# Field-based question constructors
function (F::Type{<:FormField})(id::Symbol, prompt::AbstractString,
args...; kwargs...)
question_extra_kwargs = (:postprocessors, :validators, :mandatory)
question_kwargs = filter(kw -> kw.first ∈ question_extra_kwargs, kwargs)
field_kwargs = filter(kw -> kw.first ∉ question_extra_kwargs, kwargs)
try
Question(id, prompt, F(args...; field_kwargs...); question_kwargs...)
catch e
print(stderr, "\nError while processing question $id\n")
rethrow(e)
end
end
function (F::Type{<:FormField})(prompt::AbstractString, args...; kwargs...)
F(prompttoid(prompt), prompt, args...; kwargs...)
end
# Survey Part
struct SurveyPart
label::Union{AbstractString, Nothing}
description::Union{AbstractString, Nothing}
questions::Vector{Question}
end
Base.getindex(p::SurveyPart, id::Symbol) = findfirst(q -> q.id == id, p.questions)
Base.getindex(p::SurveyPart, index::Integer) = p.questions[index]
Base.length(p::SurveyPart) = length(p.questions)
SurveyPart(label::Union{AbstractString, Nothing}, description::Union{AbstractString, Nothing}, questions::Question...) =
SurveyPart(label, description, questions |> collect)
SurveyPart(label::Union{AbstractString, Nothing}, questions::Question...) =
SurveyPart(label, nothing, questions |> collect)
SurveyPart(questions::Question...) =
SurveyPart(nothing, nothing, questions |> collect)
# Survey
const SurveyID = UInt32
struct Survey
id::SurveyID
name::AbstractString
description::Union{AbstractString, Nothing}
parts::Vector{Pair{Tuple{Union{AbstractString, Nothing}, Union{AbstractString, Nothing}}, Vector{Symbol}}}
questions::Dict{Symbol, Question}
function Survey(name::AbstractString,
description::Union{AbstractString, Nothing},
parts::Vector{<:Pair{<:Any, <:Vector{Symbol}}},
questions::Dict{Symbol, Question})
# Create an id that only depends on:
# 1. Question IDs
# 2. Question field types
# These are the two essential components to hash, as the database interactions
# rely on the assumption that these two components are stable.
# Hopefully memhashing a Tuple of Symbols and Strings is somewhat stable,
# I checked this on Julia 1.3 and 1.6 and it looked alright.
function qhash(q::Question{<:FormField{T}}) where {T}
hash((q.id, string(T)))
end
id = xor(map(qhash, values(questions))...) |>
h -> xor(reinterpret(SurveyID, [h])...)
typedparts = parts |> Vector{Pair{Tuple{Union{AbstractString, Nothing}, Union{AbstractString, Nothing}}, Vector{Symbol}}}
new(id, name, description, typedparts, questions)
end
end
Base.getindex(s::Survey, id::Symbol) = s.questions[id]
Base.getindex(s::Survey, part::Integer) =
SurveyPart(s.parts[part].first[1], s.parts[part].first[2],
getindex.(Ref(s.questions), s.parts[part].second))
Base.length(s::Survey) = length(s.parts)
Survey(name::AbstractString,
description::Union{AbstractString, Nothing},
parts::SurveyPart...) =
Survey(name, description,
map(parts) do p
(p.label, p.description) => getfield.(p.questions, :id)
end |> collect,
Dict(q.id => q for q in
Iterators.flatten(getfield.(parts, :questions))))
Survey(name::AbstractString, parts::SurveyPart...) =
Survey(name, nothing, parts...)
Survey(name::AbstractString,
description::Union{AbstractString, Nothing},
questions::Question...) =
Survey(name, description,
[nothing => getfield.(questions, :id) |> collect],
Dict(q.id => q for q in questions))
Survey(name::AbstractString, questions::Question...) =
Survey(name, nothing, questions...)
# Answer to a Question
struct Answer{T}
value::Union{T, Missing}
error::Union{AbstractString, Nothing}
end
Answer{T}() where {T <: Any} = Answer{T}(missing, nothing)
isempty(a::Answer) = ismissing(a.value)
isempty(a::Answer{<:AbstractString}) = ismissing(a.value) || isempty(a.value)
# Survey Response
const ResponseID = UInt32
mutable struct Response
survey::SurveyID
id::ResponseID
page::Integer
answers::Dict{Symbol, Answer}
started::DateTime
completed::Union{DateTime, Nothing}
end
Base.getindex(r::Response, id::Symbol) = r.answers[id]
# ---------------------
# Handling responses
# ---------------------
# Response templates
Answer(::Question{<:FormField{T}}) where {T} = Answer{T}(missing, nothing)
Response(s::Survey, id::ResponseID=rand(ResponseID)) =
Response(s.id, id, 1,
Dict(q.id => Answer(q) for q in
Iterators.flatten([s[i].questions for i in 1:length(s)])),
now(), nothing)
function Response(s::Survey, oldids::Vector{ResponseID})
newid = rand(ResponseID)
while newid in oldids
newid = rand(ResponseID)
end
Response(s, newid)
end
interpret(::FormField{<:AbstractString}, value::AbstractString) = value
interpret(::FormField{Integer}, value::AbstractString) =
if isempty(value)
missing
else
something(tryparse(Int64, value), value)
end
default_validators(::FormField{Integer}) = function(unparseable::String)
"Integer required. \"$unparseable\" could not be parsed as an integer."
end
interpret(::FormField{Number}, value::AbstractString) =
if isempty(value)
missing
else
something(tryparse(Int64, value), tryparse(Float64, value), value)
end
default_validators(::FormField{Number}) = function(unparseable::String)
"Number required. \"$unparseable\" could not be parsed as a number."
end
interpret(::FormField{T}, value::AbstractString) where {T} = parse(T, value)
# Response interpretation
function Answer(q::Question{<:FormField{T}}, value::Vector{String}) where {T}
try
processedvalue = interpret(q.field, ∘(identity, reverse(q.postprocessors)...)(value))
error = nothing
for validator in q.validators
if applicable(validator, processedvalue)
error = validator(processedvalue)
end
isnothing(error) || break
end
Answer{T}(processedvalue, error)
catch e
construction_error = nothing
try
for validator in q.validators
if hasmethod(validator, Tuple{String})
construction_error = validator(last(value))
elseif hasmethod(validator, Tuple{Vector{String}})
construction_error = validator(value)
end
isnothing(construction_error) || break
end
catch _
end
if isnothing(construction_error)
@warn "Answer construction failure" exception = (e, catch_backtrace())
construction_error = first(split(sprint(showerror, e), '\n'))
end
Answer{T}(missing, construction_error)
end
end
function Answer(q::Question{<:FormField{T}}, ::Missing) where {T}
if nonempty in q.validators
Answer{T}(missing, nonempty(""))
else
Answer{T}(missing, nothing)
end
end
# Response updating
function update!(r::Response, s::Survey, datum::Pair{Symbol, <:Any})
id, value = datum
if haskey(r.answers, id) && haskey(s.questions, id)
r.answers[id] = Answer(s.questions[id], value)
else
@warn "$id not in response"
end
end
function update!(r::Response, s::Survey, data::Dict{Symbol, <:Any})
foreach(data) do datum
update!(r, s, datum)
end
end
clear!(r::Response, ids::Vector{Symbol}) =
foreach(ids) do id
r.answers[id] = Answer{typeof(r.answers[id])}()
end
clear!(r::Response, q::Question) = clear!(r, [q.id])
clear!(r::Response, p::SurveyPart) = clear!(r, keys(p.questions))
clear!(r::Response, s::Survey) = clear!(r, keys(s.questions))
clear!(r::Response) = clear!(r, keys(r.answers))
# Response validity
isvalid(a::Answer) = isnothing(a.error)
isvalid(a::Answer, q::Question) =
isvalid(a) && !(isempty(a) && nonempty in q.validators)
isvalid(r::Response, q::Question) = isvalid(r.answers[q.id], q)
isvalid(r::Response, p::SurveyPart) = all(isvalid.(Ref(r), p.questions))
isvalid(r::Response, s::Survey) =
all(isvalid.(Ref(r), Iterators.flatten([s[i].questions for i in 1:length(s)])))
# ---------------------
# General htmlrenderer
# ---------------------
html_content(::FormField, value) = ""
html_element(::FormField) = "?"
html_attrs(::FormField, value) = []
html_voidelem(::FormField) = false
html_postprocess(::FormField, ::Symbol) = identity
elem(e::AbstractString, content::AbstractString="", attrs::Pair{Symbol,<:Any}...) =
Html.normal_element(content, e, [], attrs...)
elem(e::AbstractString, attrs::Pair{Symbol,<:Any}...) = elem(e, "", attrs...)
velem(e::AbstractString, attrs::Pair{Symbol,<:Any}...) =
Html.void_element(e, [], Vector{Pair{Symbol,Any}}(collect(attrs)))
const html_escape_characters =
Dict('"' => """,
'&' => "&",
'<' => "<",
'>' => ">")
html_escape(s::String) = replace(s, r"\"|&|<|>" => c -> html_escape_characters[c[1]])
html_escape(::Missing) = ""
function htmlrender(field::FormField, value::Any, id, mandatory, invalid)
element = html_element(field)
attrs = vcat(html_attrs(field, value),
[:id => string("qn-", id),
:name => id,
Symbol("aria-invalid") => invalid,
:required => mandatory && !isa(field, Checkbox)])
if html_voidelem(field)
velem(element, attrs...)
else
content = html_content(field, value)
elem(element, if ismissing(content) "" else string(content) end,
attrs...)
end |> html_postprocess(field, id)
end
# ---------------------
# Form fields & html rendering
# ---------------------
#
struct FormInput{T} <: FormField{T}
FormInput{T}() where {T} =
if T <: Union{Bool, String, Integer, Number, Date}
new()
else
TypeError(:FormInput, Union{Bool, String, Integer, Number, Date}, T)
end
end
html_element(::FormInput) = "input"
html_voidelem(::FormInput) = true
html_attrs(::FormInput, value) =
[:value => if ismissing(value) false else html_escape(string(value)) end]
#
interpret(::FormInput{Bool}, value::AbstractString) = value == "yes"
html_attrs(::FormInput{Bool}, value::Union{Bool, Missing}) =
[:type => "checkbox", :value => "yes", :checked => !ismissing(value) && value === true]
html_postprocess(::FormInput{Bool}, id::Symbol) =
s -> string(input(type="hidden", name=id, value="no"), s)
#
function html_attrs(::FormInput{T}, value) where {T <: Union{Date, Number, Integer, String}}
type = Dict(Date => "date",
Number => "number",
Integer => "number",
String => "text")[T]
[:type => type,
:value => if ismissing(value) false else html_escape(string(value)) end]
end
const Checkbox = FormInput{Bool}
const TextInput = FormInput{String}
const DateInput = FormInput{Date}
const NumberInput = FormInput{Number}
const IntegerInput = FormInput{Integer}
default_validators(::TextInput) = Function[wordlimit(100), charlimit(500)]
#