devforms-0.1.2.0: src/DevForms.hs

{-# 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.

=== Example

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

import Control.Monad.Writer
import Form (Form (..), FormBuilder)
import Question (Question (..), QuestionBuilder, QuestionOptions (..), QuestionType (..))
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 = runServer

-- devFormServer serverBuilder = do
--     let forms = appEndo (execWriter serverBuilder) $ Server{forms = []}
--     print $ forms

{- | 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 title formId formBuilder = do
    let f = appEndo (execWriter formBuilder) $ Form{title = title, formId = formId, questions = []}
    tell $ Endo $ \server@Server{forms} -> server{forms = forms <> [f]}

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

{- | Add a yes\/no checkbox question. Renders as a single checkbox that the
respondent can tick or leave unticked.
-}
questionCheckbox :: Text -> FormBuilder ()
questionCheckbox questionText =
    addQuestion $ Question questionText QuestionCheckbox

{- | Add a Likert-scale question. Renders as a 5-point agreement scale
(Strongly disagree … Strongly agree) plus a \"Cannot say\" option.
-}
questionLikert :: Text -> FormBuilder ()
questionLikert questionText = addQuestion $ Question questionText QuestionLikert

{- | Add a multiple-choice question. 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 title qOptions =
    addQuestion $ Question title (QuestionChoice qOptions)

{- | Add a date-picker question. Renders as an HTML date input and stores the
answer in @YYYY-MM-DD@ format.
-}
questionDate :: Text -> FormBuilder ()
questionDate questionText = addQuestion $ Question questionText QuestionDate

{- | Add a time-picker question. Renders as an HTML time input and stores the
answer in @HH:MM@ format.
-}
questionTime :: Text -> FormBuilder ()
questionTime questionText = addQuestion $ Question questionText QuestionTime

{- | Add an integer input question. The second argument is a 'QuestionBuilder'
block where you can optionally configure bounds using
'setLowerBoundInclusive' and 'setUpperBoundInclusive'. Bounds are enforced
both client-side (via HTML attributes) and server-side on submission.

=== Example

@
questionInteger "How many pets do you have?" $ do
    setLowerBoundInclusive 0
    setUpperBoundInclusive 50
@
-}
questionInteger :: Text -> QuestionBuilder () -> FormBuilder ()
questionInteger title questionBuilder = do
    let questionOptions = appEndo (execWriter questionBuilder) $ QuestionOptions{lowerBoundInclusive = Nothing, upperBoundInclusive = Nothing}
    addQuestion $ Question title (QuestionInteger questionOptions)

-- | Set the minimum allowed value (inclusive) for a 'questionInteger'.
setLowerBoundInclusive :: Integer -> QuestionBuilder ()
setLowerBoundInclusive bound = tell $ Endo $ \questionOptions -> questionOptions{lowerBoundInclusive = Just bound}

-- | Set the maximum allowed value (inclusive) for a 'questionInteger'.
setUpperBoundInclusive :: Integer -> QuestionBuilder ()
setUpperBoundInclusive bound = tell $ Endo $ \questionOptions -> questionOptions{upperBoundInclusive = Just bound}

questionFreeText :: Text -> FormBuilder ()
questionFreeText questionText = addQuestion $ Question questionText QuestionFreeText