{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
Module      : DevForms
Description : A builder DSL for creating HTML survey forms

DevForms lets you define multi-page survey forms using a concise monadic
builder DSL. Forms are served via a built-in web server (Scotty), and
submissions are stored as JSONL files.

Each question type comes in two variants:

* A plain version (e.g. 'questionLikert') that uses default options.
* A @With@ version (e.g. 'questionLikertWith') that accepts a builder block
  for configuring options like 'setOptional' or bounds.

=== Example

@
main :: IO ()
main = devFormServer 9000 $ do
    form "Animal Survey" "animals" $ do
        questionLikert "I enjoy seeing animals"
        questionChoice "Favourite animal"
            ["Alpaca", "Bumblebee", "Camel", "Duck"]
        questionDateWith "When would you like to visit the zoo?" $ setOptional
        questionIntegerWith "How many tickets?" $ do
            setLowerBoundInclusive 1
            setUpperBoundInclusive 10
@
-}
module DevForms (
    ServerBuilder,
    FormBuilder,
    QuestionBuilder,
    IntegerQuestionBuilder,
    HasOptional (..),
    HasBounds (..),
    devFormServer,
    form,
    questionCheckbox,
    questionCheckboxWith,
    questionLikert,
    questionLikertWith,
    questionChoice,
    questionChoiceWith,
    questionDate,
    questionDateWith,
    questionTime,
    questionTimeWith,
    questionInteger,
    questionIntegerWith,
    questionFreeText,
    questionFreeTextWith,
    questionRegexText,
    questionRegexTextWith,
) where

import Control.Monad.Writer
import Form (Form (..), FormBuilder)
import Question (
    HasBounds (..),
    HasOptional (..),
    IntegerQuestionBuilder,
    Question (..),
    QuestionBuilder,
    QuestionType (..),
    runIntegerQuestionBuilder,
    runQuestionBuilder,
 )
import Server (Server (..), ServerBuilder, runServer)

{- | Start the devforms web server on the given port.

This is the top-level entry point for a devforms application. The second
argument is a 'ServerBuilder' block in which you define one or more forms
using 'form'. The server provides:

* Individual form pages with client-side validation
* A submission endpoint that stores answers in @answers-\<formId\>.jsonl@
-}
devFormServer :: Int -> ServerBuilder () -> IO ()
devFormServer :: Int -> ServerBuilder () -> IO ()
devFormServer = Int -> ServerBuilder () -> IO ()
runServer

{- | Define a survey form.

The first argument is the human-readable title displayed at the top of the
form page. The second argument is a form identifier used for:

* URL routing — the form is served at @/form/\<formId\>@
* Persistent storage — submissions are appended to @answers-\<formId\>.jsonl@

The third argument is a 'FormBuilder' block where you add questions using
the @question*@ functions.
-}
form :: Text -> Text -> FormBuilder () -> ServerBuilder ()
form :: Text -> Text -> FormBuilder () -> ServerBuilder ()
form Text
title Text
formId FormBuilder ()
formBuilder = do
    let f :: Form
f = Endo Form -> Form -> Form
forall a. Endo a -> a -> a
appEndo (FormBuilder () -> Endo Form
forall w a. Writer w a -> w
execWriter FormBuilder ()
formBuilder) (Form -> Form) -> Form -> Form
forall a b. (a -> b) -> a -> b
$ Form{title :: Text
title = Text
title, formId :: Text
formId = Text
formId, questions :: [Question]
questions = []}
    Endo Server -> ServerBuilder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Endo Server -> ServerBuilder ())
-> Endo Server -> ServerBuilder ()
forall a b. (a -> b) -> a -> b
$ (Server -> Server) -> Endo Server
forall a. (a -> a) -> Endo a
Endo ((Server -> Server) -> Endo Server)
-> (Server -> Server) -> Endo Server
forall a b. (a -> b) -> a -> b
$ \server :: Server
server@Server{[Form]
forms :: [Form]
forms :: Server -> [Form]
forms} -> Server
server{forms = forms <> [f]}

addQuestion :: (MonadWriter (Endo Form) m) => Question -> m ()
addQuestion :: forall (m :: * -> *). MonadWriter (Endo Form) m => Question -> m ()
addQuestion Question
question =
    Endo Form -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Endo Form -> m ()) -> Endo Form -> m ()
forall a b. (a -> b) -> a -> b
$ (Form -> Form) -> Endo Form
forall a. (a -> a) -> Endo a
Endo ((Form -> Form) -> Endo Form) -> (Form -> Form) -> Endo Form
forall a b. (a -> b) -> a -> b
$ \f :: Form
f@Form{[Question]
questions :: Form -> [Question]
questions :: [Question]
questions} -> Form
f{questions = questions <> [question]}

{- | Add a yes\/no checkbox question with default options. Renders as a single
checkbox that the respondent can tick or leave unticked.
-}
questionCheckbox :: Text -> FormBuilder ()
questionCheckbox :: Text -> FormBuilder ()
questionCheckbox Text
label = Text -> QuestionBuilder () -> FormBuilder ()
questionCheckboxWith Text
label (() -> QuestionBuilder ()
forall a. a -> QuestionBuilder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

{- | Add a yes\/no checkbox question with custom options. Renders as a single
checkbox that the respondent can tick or leave unticked.

The second argument is a 'QuestionBuilder' block where you can configure
shared options such as 'setOptional'.
-}
questionCheckboxWith :: Text -> QuestionBuilder () -> FormBuilder ()
questionCheckboxWith :: Text -> QuestionBuilder () -> FormBuilder ()
questionCheckboxWith Text
questionText QuestionBuilder ()
builder =
    Question -> FormBuilder ()
forall (m :: * -> *). MonadWriter (Endo Form) m => Question -> m ()
addQuestion (Question -> FormBuilder ()) -> Question -> FormBuilder ()
forall a b. (a -> b) -> a -> b
$ Text -> QuestionType -> QuestionOptions -> Question
Question Text
questionText QuestionType
QuestionCheckbox (QuestionBuilder () -> QuestionOptions
runQuestionBuilder QuestionBuilder ()
builder)

{- | Add a Likert-scale question with default options. Renders as a 5-point
agreement scale (Strongly disagree … Strongly agree) plus a \"Cannot say\"
option.
-}
questionLikert :: Text -> FormBuilder ()
questionLikert :: Text -> FormBuilder ()
questionLikert Text
label = Text -> QuestionBuilder () -> FormBuilder ()
questionLikertWith Text
label (() -> QuestionBuilder ()
forall a. a -> QuestionBuilder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

{- | Add a Likert-scale question with custom options. Renders as a 5-point
agreement scale (Strongly disagree … Strongly agree) plus a \"Cannot say\"
option.

The second argument is a 'QuestionBuilder' block where you can configure
shared options such as 'setOptional'.
-}
questionLikertWith :: Text -> QuestionBuilder () -> FormBuilder ()
questionLikertWith :: Text -> QuestionBuilder () -> FormBuilder ()
questionLikertWith Text
questionText QuestionBuilder ()
builder =
    Question -> FormBuilder ()
forall (m :: * -> *). MonadWriter (Endo Form) m => Question -> m ()
addQuestion (Question -> FormBuilder ()) -> Question -> FormBuilder ()
forall a b. (a -> b) -> a -> b
$ Text -> QuestionType -> QuestionOptions -> Question
Question Text
questionText QuestionType
QuestionLikert (QuestionBuilder () -> QuestionOptions
runQuestionBuilder QuestionBuilder ()
builder)

{- | Add a multiple-choice question with default options. Renders as a group of
radio buttons — the respondent must select exactly one of the provided
options.

The first argument is the question label; the second is the list of choices.
-}
questionChoice :: Text -> [Text] -> FormBuilder ()
questionChoice :: Text -> [Text] -> FormBuilder ()
questionChoice Text
label [Text]
options = Text -> [Text] -> QuestionBuilder () -> FormBuilder ()
questionChoiceWith Text
label [Text]
options (() -> QuestionBuilder ()
forall a. a -> QuestionBuilder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

{- | Add a multiple-choice question with custom options. Renders as a group of
radio buttons — the respondent must select exactly one of the provided
options.

The first argument is the question label; the second is the list of choices.
The third argument is a 'QuestionBuilder' block where you can configure
shared options such as 'setOptional'.
-}
questionChoiceWith :: Text -> [Text] -> QuestionBuilder () -> FormBuilder ()
questionChoiceWith :: Text -> [Text] -> QuestionBuilder () -> FormBuilder ()
questionChoiceWith Text
title [Text]
qOptions QuestionBuilder ()
builder =
    Question -> FormBuilder ()
forall (m :: * -> *). MonadWriter (Endo Form) m => Question -> m ()
addQuestion (Question -> FormBuilder ()) -> Question -> FormBuilder ()
forall a b. (a -> b) -> a -> b
$ Text -> QuestionType -> QuestionOptions -> Question
Question Text
title ([Text] -> QuestionType
QuestionChoice [Text]
qOptions) (QuestionBuilder () -> QuestionOptions
runQuestionBuilder QuestionBuilder ()
builder)

{- | Add a date-picker question with default options. Renders as an HTML date
input and stores the answer in @YYYY-MM-DD@ format.
-}
questionDate :: Text -> FormBuilder ()
questionDate :: Text -> FormBuilder ()
questionDate Text
label = Text -> QuestionBuilder () -> FormBuilder ()
questionDateWith Text
label (() -> QuestionBuilder ()
forall a. a -> QuestionBuilder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

{- | Add a date-picker question with custom options. Renders as an HTML date
input and stores the answer in @YYYY-MM-DD@ format.

The second argument is a 'QuestionBuilder' block where you can configure
shared options such as 'setOptional'.
-}
questionDateWith :: Text -> QuestionBuilder () -> FormBuilder ()
questionDateWith :: Text -> QuestionBuilder () -> FormBuilder ()
questionDateWith Text
questionText QuestionBuilder ()
builder =
    Question -> FormBuilder ()
forall (m :: * -> *). MonadWriter (Endo Form) m => Question -> m ()
addQuestion (Question -> FormBuilder ()) -> Question -> FormBuilder ()
forall a b. (a -> b) -> a -> b
$ Text -> QuestionType -> QuestionOptions -> Question
Question Text
questionText QuestionType
QuestionDate (QuestionBuilder () -> QuestionOptions
runQuestionBuilder QuestionBuilder ()
builder)

{- | Add a time-picker question with default options. Renders as an HTML time
input and stores the answer in @HH:MM@ format.
-}
questionTime :: Text -> FormBuilder ()
questionTime :: Text -> FormBuilder ()
questionTime Text
label = Text -> QuestionBuilder () -> FormBuilder ()
questionTimeWith Text
label (() -> QuestionBuilder ()
forall a. a -> QuestionBuilder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

{- | Add a time-picker question with custom options. Renders as an HTML time
input and stores the answer in @HH:MM@ format.

The second argument is a 'QuestionBuilder' block where you can configure
shared options such as 'setOptional'.
-}
questionTimeWith :: Text -> QuestionBuilder () -> FormBuilder ()
questionTimeWith :: Text -> QuestionBuilder () -> FormBuilder ()
questionTimeWith Text
questionText QuestionBuilder ()
builder =
    Question -> FormBuilder ()
forall (m :: * -> *). MonadWriter (Endo Form) m => Question -> m ()
addQuestion (Question -> FormBuilder ()) -> Question -> FormBuilder ()
forall a b. (a -> b) -> a -> b
$ Text -> QuestionType -> QuestionOptions -> Question
Question Text
questionText QuestionType
QuestionTime (QuestionBuilder () -> QuestionOptions
runQuestionBuilder QuestionBuilder ()
builder)

-- | Add an integer input question with default options (no bounds).
questionInteger :: Text -> FormBuilder ()
questionInteger :: Text -> FormBuilder ()
questionInteger Text
label = Text -> IntegerQuestionBuilder () -> FormBuilder ()
questionIntegerWith Text
label (() -> IntegerQuestionBuilder ()
forall a. a -> IntegerQuestionBuilder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

{- | Add an integer input question with custom options. The second argument is
an 'IntegerQuestionBuilder' block where you can configure bounds using
'setLowerBoundInclusive' and 'setUpperBoundInclusive', as well as shared
options like 'setOptional'. Bounds are enforced both client-side (via HTML
attributes) and server-side on submission.

=== Example

@
questionIntegerWith "How many pets do you have?" $ do
    setLowerBoundInclusive 0
    setUpperBoundInclusive 50
    setOptional
@
-}
questionIntegerWith :: Text -> IntegerQuestionBuilder () -> FormBuilder ()
questionIntegerWith :: Text -> IntegerQuestionBuilder () -> FormBuilder ()
questionIntegerWith Text
title IntegerQuestionBuilder ()
builder =
    Question -> FormBuilder ()
forall (m :: * -> *). MonadWriter (Endo Form) m => Question -> m ()
addQuestion (Question -> FormBuilder ()) -> Question -> FormBuilder ()
forall a b. (a -> b) -> a -> b
$ Text -> QuestionType -> QuestionOptions -> Question
Question Text
title QuestionType
QuestionInteger (IntegerQuestionBuilder () -> QuestionOptions
runIntegerQuestionBuilder IntegerQuestionBuilder ()
builder)

{- | Add a free-text textarea question with default options. The respondent can
enter arbitrary text.
-}
questionFreeText :: Text -> FormBuilder ()
questionFreeText :: Text -> FormBuilder ()
questionFreeText Text
label = Text -> QuestionBuilder () -> FormBuilder ()
questionFreeTextWith Text
label (() -> QuestionBuilder ()
forall a. a -> QuestionBuilder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

{- | Add a free-text textarea question with custom options. The respondent can
enter arbitrary text.

The second argument is a 'QuestionBuilder' block where you can configure
shared options such as 'setOptional'.
-}
questionFreeTextWith :: Text -> QuestionBuilder () -> FormBuilder ()
questionFreeTextWith :: Text -> QuestionBuilder () -> FormBuilder ()
questionFreeTextWith Text
questionText QuestionBuilder ()
builder =
    Question -> FormBuilder ()
forall (m :: * -> *). MonadWriter (Endo Form) m => Question -> m ()
addQuestion (Question -> FormBuilder ()) -> Question -> FormBuilder ()
forall a b. (a -> b) -> a -> b
$ Text -> QuestionType -> QuestionOptions -> Question
Question Text
questionText QuestionType
QuestionFreeText (QuestionBuilder () -> QuestionOptions
runQuestionBuilder QuestionBuilder ()
builder)

{- | Add a regex-validated text input question with default options. The
respondent's answer must match the given POSIX extended regex pattern.

The first argument is the question label; the second is the regex pattern.
-}
questionRegexText :: Text -> Text -> FormBuilder ()
questionRegexText :: Text -> Text -> FormBuilder ()
questionRegexText Text
label Text
regexPattern = Text -> Text -> QuestionBuilder () -> FormBuilder ()
questionRegexTextWith Text
label Text
regexPattern (() -> QuestionBuilder ()
forall a. a -> QuestionBuilder a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

{- | Add a regex-validated text input question with custom options. The
respondent's answer must match the given POSIX extended regex pattern. The
pattern is also set as the HTML @pattern@ attribute for client-side
validation.

The first argument is the question label; the second is the regex pattern.
The third argument is a 'QuestionBuilder' block where you can configure
shared options such as 'setOptional'.

=== Example

@
questionRegexTextWith "SemVer number" "^v\\d+.\\d+.\\d+$" $ setOptional
@
-}
questionRegexTextWith :: Text -> Text -> QuestionBuilder () -> FormBuilder ()
questionRegexTextWith :: Text -> Text -> QuestionBuilder () -> FormBuilder ()
questionRegexTextWith Text
questionText Text
regexPattern QuestionBuilder ()
builder =
    Question -> FormBuilder ()
forall (m :: * -> *). MonadWriter (Endo Form) m => Question -> m ()
addQuestion (Question -> FormBuilder ()) -> Question -> FormBuilder ()
forall a b. (a -> b) -> a -> b
$ Text -> QuestionType -> QuestionOptions -> Question
Question Text
questionText (Text -> QuestionType
QuestionRegexText Text
regexPattern) (QuestionBuilder () -> QuestionOptions
runQuestionBuilder QuestionBuilder ()
builder)