devforms-0.1.0.0: src/DevForms.hs

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

module DevForms (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)

devFormServer :: Int -> ServerBuilder () -> IO ()
devFormServer = runServer

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

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]}

questionCheckbox :: Text -> FormBuilder ()
questionCheckbox =
    addQuestion . QuestionCheckbox

questionLikert :: Text -> FormBuilder ()
questionLikert = addQuestion . QuestionLikert

questionChoice :: Text -> [Text] -> FormBuilder ()
questionChoice title qOptions =
    addQuestion $ QuestionChoice title qOptions

questionDate :: Text -> FormBuilder ()
questionDate = addQuestion . QuestionDate

questionTime :: Text -> FormBuilder ()
questionTime = addQuestion . QuestionTime

questionInteger :: Text -> QuestionBuilder () -> FormBuilder ()
questionInteger title questionBuilder = do
    let questionOptions = appEndo (execWriter questionBuilder) $ QuestionOptions{lowerBoundInclusive = Nothing, upperBoundInclusive = Nothing}
    addQuestion $ QuestionInteger title questionOptions

setLowerBoundInclusive :: Integer -> QuestionBuilder ()
setLowerBoundInclusive bound = tell $ Endo $ \questionOptions -> questionOptions{lowerBoundInclusive = Just bound}
setUpperBoundInclusive :: Integer -> QuestionBuilder ()
setUpperBoundInclusive bound = tell $ Endo $ \questionOptions -> questionOptions{upperBoundInclusive = Just bound}