module Form (Form (..), FormBuilder, renderForm, getSubmitUrl, getFormUrl) where

import Control.Monad.Writer
import Htmx.Lucid.Core
import Lucid
import Question (Question, renderQuestion)

data Form = Form {Form -> Text
title :: Text, Form -> Text
formId :: Text, Form -> [Question]
questions :: [Question]} deriving (Int -> Form -> ShowS
[Form] -> ShowS
Form -> String
(Int -> Form -> ShowS)
-> (Form -> String) -> ([Form] -> ShowS) -> Show Form
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Form -> ShowS
showsPrec :: Int -> Form -> ShowS
$cshow :: Form -> String
show :: Form -> String
$cshowList :: [Form] -> ShowS
showList :: [Form] -> ShowS
Show)

-- | A builder monad for adding questions to a form. Use the @question*@ functions to add questions.
type FormBuilder = Writer (Endo Form)

renderForm :: Form -> Html ()
renderForm :: Form -> HtmlT Identity ()
renderForm form :: Form
form@Form{Text
title :: Form -> Text
title :: Text
title, [Question]
questions :: Form -> [Question]
questions :: [Question]
questions} = do
    HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
main_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ do
        HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
h2_ (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ Text -> HtmlT Identity ()
forall a (m :: * -> *). (ToHtml a, Monad m) => a -> HtmlT m ()
forall (m :: * -> *). Monad m => Text -> HtmlT m ()
toHtml Text
title
        [Attributes] -> HtmlT Identity () -> HtmlT Identity ()
forall arg result. Term arg result => arg -> result
form_ [Text -> Attributes
hxPost_ (Text -> Attributes) -> Text -> Attributes
forall a b. (a -> b) -> a -> b
$ Form -> Text
forall a. IsString a => Form -> a
getSubmitUrl Form
form, Text -> Attributes
forall arg result. TermRaw arg result => arg -> result
script_ Text
"on keydown[key is 'Enter'] from <input/> halt"] (HtmlT Identity () -> HtmlT Identity ())
-> HtmlT Identity () -> HtmlT Identity ()
forall a b. (a -> b) -> a -> b
$ do
            [Question] -> (Question -> HtmlT Identity ()) -> HtmlT Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Question] -> [Question]
forall a. [a] -> [a]
reverse [Question]
questions) Question -> HtmlT Identity ()
renderQuestion
            [Attributes] -> HtmlT Identity ()
forall (m :: * -> *). Monad m => [Attributes] -> HtmlT m ()
input_ [Text -> Attributes
type_ Text
"submit"]

getFormUrl :: (IsString a) => Form -> a
getFormUrl :: forall a. IsString a => Form -> a
getFormUrl Form{Text
formId :: Form -> Text
formId :: Text
formId} = String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
formId

getSubmitUrl :: (IsString a) => Form -> a
getSubmitUrl :: forall a. IsString a => Form -> a
getSubmitUrl Form{Text
formId :: Form -> Text
formId :: Text
formId} = String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"/api/submit/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. ToString a => a -> String
toString Text
formId