{-# 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) where

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

-- 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 :: 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. Renders as a single checkbox that the
respondent can tick or leave unticked.
-}
questionCheckbox :: Text -> FormBuilder ()
questionCheckbox :: Text -> FormBuilder ()
questionCheckbox =
    Question -> FormBuilder ()
forall (m :: * -> *). MonadWriter (Endo Form) m => Question -> m ()
addQuestion (Question -> FormBuilder ())
-> (Text -> Question) -> Text -> FormBuilder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Question
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 :: Text -> FormBuilder ()
questionLikert = Question -> FormBuilder ()
forall (m :: * -> *). MonadWriter (Endo Form) m => Question -> m ()
addQuestion (Question -> FormBuilder ())
-> (Text -> Question) -> Text -> FormBuilder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Question
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 :: Text -> [Text] -> FormBuilder ()
questionChoice Text
title [Text]
qOptions =
    Question -> FormBuilder ()
forall (m :: * -> *). MonadWriter (Endo Form) m => Question -> m ()
addQuestion (Question -> FormBuilder ()) -> Question -> FormBuilder ()
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Question
QuestionChoice Text
title [Text]
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 :: Text -> FormBuilder ()
questionDate = Question -> FormBuilder ()
forall (m :: * -> *). MonadWriter (Endo Form) m => Question -> m ()
addQuestion (Question -> FormBuilder ())
-> (Text -> Question) -> Text -> FormBuilder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Question
QuestionDate

{- | Add a time-picker question. Renders as an HTML time input and stores the
answer in @HH:MM@ format.
-}
questionTime :: Text -> FormBuilder ()
questionTime :: Text -> FormBuilder ()
questionTime = Question -> FormBuilder ()
forall (m :: * -> *). MonadWriter (Endo Form) m => Question -> m ()
addQuestion (Question -> FormBuilder ())
-> (Text -> Question) -> Text -> FormBuilder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Question
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 :: Text -> QuestionBuilder () -> FormBuilder ()
questionInteger Text
title QuestionBuilder ()
questionBuilder = do
    let questionOptions :: QuestionOptions
questionOptions = Endo QuestionOptions -> QuestionOptions -> QuestionOptions
forall a. Endo a -> a -> a
appEndo (QuestionBuilder () -> Endo QuestionOptions
forall w a. Writer w a -> w
execWriter QuestionBuilder ()
questionBuilder) (QuestionOptions -> QuestionOptions)
-> QuestionOptions -> QuestionOptions
forall a b. (a -> b) -> a -> b
$ QuestionOptions{lowerBoundInclusive :: Maybe Integer
lowerBoundInclusive = Maybe Integer
forall a. Maybe a
Nothing, upperBoundInclusive :: Maybe Integer
upperBoundInclusive = Maybe Integer
forall a. Maybe a
Nothing}
    Question -> FormBuilder ()
forall (m :: * -> *). MonadWriter (Endo Form) m => Question -> m ()
addQuestion (Question -> FormBuilder ()) -> Question -> FormBuilder ()
forall a b. (a -> b) -> a -> b
$ Text -> QuestionOptions -> Question
QuestionInteger Text
title QuestionOptions
questionOptions

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

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