{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-missing-fields #-}
{-# language DefaultSignatures #-}
{-# language DeriveGeneric #-}
{-# language LambdaCase #-}
{-# language OverloadedStrings #-}
{-# language StandaloneDeriving #-}
{-# language TypeOperators #-}

module FlexTask.Generic.FormInternal
  (
    -- * Data Types
    Alignment(..)
  , FieldInfo
  , SingleChoiceSelection
  , MultipleChoiceSelection
  , Hidden(..)
  , SingleInputList(..)
    -- * Type Classes
  , BaseForm(..)
  , Formify(..)
  , formify
  , formifyComponents
  , formifyComponentsFlat
    -- * Anonymous Enum Type Builders and Accessors.
  , getAnswer
  , getAnswers
  , multipleChoiceAnswer
  , multipleChoiceEmpty
  , singleChoiceAnswer
  , singleChoiceEmpty

    -- * Field Builders
  , buttons
  , buttonsEnum
  , dropdown
  , dropdownEnum
  , list
  , listWithoutLabels
  , repeatFieldInfo
  , repeatBuilderOn
  , single

    -- * Formify Convenience Functions
  , formifyInstanceBasicField
  , formifyInstanceOptionalField
  , formifyInstanceSingleChoice
  , formifyInstanceMultiChoice
  ) where


import Data.List.Extra      (intercalate, nubOrd, nubSort, singleton, uncons, unsnoc)
import Data.Maybe           (fromMaybe)
import GHC.Generics         (Generic(..), K1(..), M1(..), (:*:)(..))
import GHC.Utils.Misc       (equalLength)
import Data.Text            (Text, pack, unpack)
import Yesod

import FlexTask.FormUtil    (applyToWidget)
import FlexTask.Widgets
  ( checkboxField
  , horizontalRadioField
  , joinWidgets
  , renderForm
  )
import FlexTask.YesodConfig (FlexForm(..), Handler, Rendered, Widget)


{- $setup
>>> :set -XTypeApplications
>>> import FlexTask.FormUtil
>>> data MyType = One | Two | Three deriving (Bounded, Enum, Eq, Show)
>>> newtype MyCoolType = CType { getString :: String}
>>> let toCool = CType
>>> let fromCool = getString
>>> let basisField = baseForm
-}


{- |
Data type representing a prebuilt input field.
This type is used to determine the structure of a generated form.
The form is represented by a @[[FieldInfo]]@ type value.
Each FieldInfo value is an individual form element.
Inner lists represent the rows of the form.
All FieldInfo values in an inner list are rendered besides each other.
Inner lists are rendered below each other.

__Examples__

Input

@
[[single \"field1\", single \"field2\"]]
@

Renders as:

@
field1     field2
@

Input

@
[[single \"field1\"], [single \"field2\"]]
@

Renders as:

@
field1

field2
@

__Caution: Not all horizontal alignments work as one would expect.__
__If an element uses inner `Alignment` parameters,__
__then the next form will only be rendered besides the last form component of the former.__

Input

@
[[listWithoutLabels Vertical 2 []],[listWithoutLabels Vertical 2 []]]
@

will __not__ result in

@
list11      list21

list12      list22
@

but instead in

@
list11

list12     list21

list22
@
-}
data FieldInfo
  = Single (FieldSettings FlexForm)
  | List Alignment [FieldInfo]
  | ChoicesDropdown (FieldSettings FlexForm) [SomeMessage FlexForm]
  | ChoicesButtons Alignment (FieldSettings FlexForm) [SomeMessage FlexForm]
  deriving (Int -> FieldInfo -> ShowS
[FieldInfo] -> ShowS
FieldInfo -> String
(Int -> FieldInfo -> ShowS)
-> (FieldInfo -> String)
-> ([FieldInfo] -> ShowS)
-> Show FieldInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FieldInfo -> ShowS
showsPrec :: Int -> FieldInfo -> ShowS
$cshow :: FieldInfo -> String
show :: FieldInfo -> String
$cshowList :: [FieldInfo] -> ShowS
showList :: [FieldInfo] -> ShowS
Show)


-- For tests; TODO: Move completely into test suite
deriving instance Show (FieldSettings FlexForm)

instance Show (SomeMessage FlexForm) where
  show :: SomeMessage FlexForm -> String
show SomeMessage FlexForm
m = Char
'('Char -> ShowS
forall a. a -> [a] -> [a]
: String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", "
      [ String
"German: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
inLang Text
"de"
      , String
"English: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
inLang Text
"en"
      ]
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
    where
      inLang :: Text -> String
inLang Text
l = Text -> String
forall a. Show a => a -> String
show (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ FlexForm -> [Text] -> SomeMessage FlexForm -> Text
forall master message.
RenderMessage master message =>
master -> [Text] -> message -> Text
renderMessage FlexForm{} [Text
l] SomeMessage FlexForm
m


-- | Inner alignment of input field elements.
data Alignment = Horizontal | Vertical deriving (Alignment -> Alignment -> Bool
(Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool) -> Eq Alignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Alignment -> Alignment -> Bool
== :: Alignment -> Alignment -> Bool
$c/= :: Alignment -> Alignment -> Bool
/= :: Alignment -> Alignment -> Bool
Eq,Int -> Alignment -> ShowS
[Alignment] -> ShowS
Alignment -> String
(Int -> Alignment -> ShowS)
-> (Alignment -> String)
-> ([Alignment] -> ShowS)
-> Show Alignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Alignment -> ShowS
showsPrec :: Int -> Alignment -> ShowS
$cshow :: Alignment -> String
show :: Alignment -> String
$cshowList :: [Alignment] -> ShowS
showList :: [Alignment] -> ShowS
Show)


{- |
Wrapper type for generating hidden fields.
This can be used to transfer static information through the form to parsing.
Note that the generated field still has a label.
If the label is not left blank, then it will be displayed as normal.
=== __Example__
>>> printWidget "en" $ formify (Just $ Hidden 3) [[single ""]]
<div class="flex-form-div">
...
    <label for="flexident1">
    </label>
    <input type="hidden" id="flexident1" ... value="3">
...
</div>
-}
newtype Hidden a = Hidden {forall a. Hidden a -> a
getHidden :: a} deriving (Hidden a -> Hidden a -> Bool
(Hidden a -> Hidden a -> Bool)
-> (Hidden a -> Hidden a -> Bool) -> Eq (Hidden a)
forall a. Eq a => Hidden a -> Hidden a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Hidden a -> Hidden a -> Bool
== :: Hidden a -> Hidden a -> Bool
$c/= :: forall a. Eq a => Hidden a -> Hidden a -> Bool
/= :: Hidden a -> Hidden a -> Bool
Eq,Int -> Hidden a -> ShowS
[Hidden a] -> ShowS
Hidden a -> String
(Int -> Hidden a -> ShowS)
-> (Hidden a -> String) -> ([Hidden a] -> ShowS) -> Show (Hidden a)
forall a. Show a => Int -> Hidden a -> ShowS
forall a. Show a => [Hidden a] -> ShowS
forall a. Show a => Hidden a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Hidden a -> ShowS
showsPrec :: Int -> Hidden a -> ShowS
$cshow :: forall a. Show a => Hidden a -> String
show :: Hidden a -> String
$cshowList :: forall a. Show a => [Hidden a] -> ShowS
showList :: [Hidden a] -> ShowS
Show)


{- |
Wrapper type for lists. Use for a single field list input.
Normally, lists are interpreted as multiple fields instead.
=== __Example__
>>> printWidget "en" $ formify (Nothing @(SingleInputList String)) [[single "Input comma separated sentences"]]
<div class="flex-form-div">
...
    <label for="flexident1">
      Input comma separated sentences
    </label>
    <input id="flexident1" ... type="text" ...>
...
</div>

Note that this does not actually enforce any kind of input syntax.
The generated input itself is a simple text field.
The comma separation is checked only when parsing with the matching `FlexTask.Generic.Parse.formParser`.
-}
newtype SingleInputList a = SingleInputList {forall a. SingleInputList a -> [a]
getList :: [a]} deriving (SingleInputList a -> SingleInputList a -> Bool
(SingleInputList a -> SingleInputList a -> Bool)
-> (SingleInputList a -> SingleInputList a -> Bool)
-> Eq (SingleInputList a)
forall a. Eq a => SingleInputList a -> SingleInputList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => SingleInputList a -> SingleInputList a -> Bool
== :: SingleInputList a -> SingleInputList a -> Bool
$c/= :: forall a. Eq a => SingleInputList a -> SingleInputList a -> Bool
/= :: SingleInputList a -> SingleInputList a -> Bool
Eq,Int -> SingleInputList a -> ShowS
[SingleInputList a] -> ShowS
SingleInputList a -> String
(Int -> SingleInputList a -> ShowS)
-> (SingleInputList a -> String)
-> ([SingleInputList a] -> ShowS)
-> Show (SingleInputList a)
forall a. Show a => Int -> SingleInputList a -> ShowS
forall a. Show a => [SingleInputList a] -> ShowS
forall a. Show a => SingleInputList a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> SingleInputList a -> ShowS
showsPrec :: Int -> SingleInputList a -> ShowS
$cshow :: forall a. Show a => SingleInputList a -> String
show :: SingleInputList a -> String
$cshowList :: forall a. Show a => [SingleInputList a] -> ShowS
showList :: [SingleInputList a] -> ShowS
Show)

{- |
Generic single choice answer type.
Use if both of the following is true:
  - You want an input that presents multiple answer choices, but only allows a single selection.
  - There's no specific data type associated with this selection.
=== __Example__
>>> let labels = ["First Option", "Second Option", "Third Option"]
>>> printWidget "en" $ formify (Just $ singleChoiceAnswer 3) [[dropdown "Choose one" labels]]
<div class="flex-form-div">
...
    <label for="flexident1">
      Choose one
    </label>
    <select id="flexident1" ...>
      <option value="1">
        First Option
      </option>
      <option value="2">
        Second Option
      </option>
      <option value="3" selected>
        Third Option
      </option>
    </select>
...
</div>
-}
newtype SingleChoiceSelection = SingleChoiceSelection
  {SingleChoiceSelection -> Maybe Int
getAnswer :: Maybe Int -- ^ Retrieve the selected option. @Nothing@ if none.
  } deriving (Int -> SingleChoiceSelection -> ShowS
[SingleChoiceSelection] -> ShowS
SingleChoiceSelection -> String
(Int -> SingleChoiceSelection -> ShowS)
-> (SingleChoiceSelection -> String)
-> ([SingleChoiceSelection] -> ShowS)
-> Show SingleChoiceSelection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SingleChoiceSelection -> ShowS
showsPrec :: Int -> SingleChoiceSelection -> ShowS
$cshow :: SingleChoiceSelection -> String
show :: SingleChoiceSelection -> String
$cshowList :: [SingleChoiceSelection] -> ShowS
showList :: [SingleChoiceSelection] -> ShowS
Show,SingleChoiceSelection -> SingleChoiceSelection -> Bool
(SingleChoiceSelection -> SingleChoiceSelection -> Bool)
-> (SingleChoiceSelection -> SingleChoiceSelection -> Bool)
-> Eq SingleChoiceSelection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SingleChoiceSelection -> SingleChoiceSelection -> Bool
== :: SingleChoiceSelection -> SingleChoiceSelection -> Bool
$c/= :: SingleChoiceSelection -> SingleChoiceSelection -> Bool
/= :: SingleChoiceSelection -> SingleChoiceSelection -> Bool
Eq,(forall x. SingleChoiceSelection -> Rep SingleChoiceSelection x)
-> (forall x. Rep SingleChoiceSelection x -> SingleChoiceSelection)
-> Generic SingleChoiceSelection
forall x. Rep SingleChoiceSelection x -> SingleChoiceSelection
forall x. SingleChoiceSelection -> Rep SingleChoiceSelection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SingleChoiceSelection -> Rep SingleChoiceSelection x
from :: forall x. SingleChoiceSelection -> Rep SingleChoiceSelection x
$cto :: forall x. Rep SingleChoiceSelection x -> SingleChoiceSelection
to :: forall x. Rep SingleChoiceSelection x -> SingleChoiceSelection
Generic)
{- |
Same as `SingleChoiceSelection`, but for multiple choice input.
Use if both of the following is true:
  - You want an input that presents multiple answer choices and allows selecting any number of them.
  - There's no specific data type associated with this selection.
=== __Example__
>>> let labels = ["First Option", "Second Option", "Third Option"]
>>> printWidget "en" $ formify (Just $ multipleChoiceAnswer [1,2]) [[dropdown "Choose one" labels]]
<div class="flex-form-div">
...
    <label for="flexident1">
      Choose one
    </label>
    <select id="flexident1" ... multiple>
      <option value="1" selected>
        First Option
      </option>
      <option value="2" selected>
        Second Option
      </option>
      <option value="3">
        Third Option
      </option>
    </select>
...
</div>
-}
newtype MultipleChoiceSelection = MultipleChoiceSelection
  { MultipleChoiceSelection -> [Int]
getAnswers :: [Int] -- ^ Retrieve the list of selected options. @[]@ if none.
  } deriving (Int -> MultipleChoiceSelection -> ShowS
[MultipleChoiceSelection] -> ShowS
MultipleChoiceSelection -> String
(Int -> MultipleChoiceSelection -> ShowS)
-> (MultipleChoiceSelection -> String)
-> ([MultipleChoiceSelection] -> ShowS)
-> Show MultipleChoiceSelection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MultipleChoiceSelection -> ShowS
showsPrec :: Int -> MultipleChoiceSelection -> ShowS
$cshow :: MultipleChoiceSelection -> String
show :: MultipleChoiceSelection -> String
$cshowList :: [MultipleChoiceSelection] -> ShowS
showList :: [MultipleChoiceSelection] -> ShowS
Show,MultipleChoiceSelection -> MultipleChoiceSelection -> Bool
(MultipleChoiceSelection -> MultipleChoiceSelection -> Bool)
-> (MultipleChoiceSelection -> MultipleChoiceSelection -> Bool)
-> Eq MultipleChoiceSelection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MultipleChoiceSelection -> MultipleChoiceSelection -> Bool
== :: MultipleChoiceSelection -> MultipleChoiceSelection -> Bool
$c/= :: MultipleChoiceSelection -> MultipleChoiceSelection -> Bool
/= :: MultipleChoiceSelection -> MultipleChoiceSelection -> Bool
Eq,(forall x.
 MultipleChoiceSelection -> Rep MultipleChoiceSelection x)
-> (forall x.
    Rep MultipleChoiceSelection x -> MultipleChoiceSelection)
-> Generic MultipleChoiceSelection
forall x. Rep MultipleChoiceSelection x -> MultipleChoiceSelection
forall x. MultipleChoiceSelection -> Rep MultipleChoiceSelection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MultipleChoiceSelection -> Rep MultipleChoiceSelection x
from :: forall x. MultipleChoiceSelection -> Rep MultipleChoiceSelection x
$cto :: forall x. Rep MultipleChoiceSelection x -> MultipleChoiceSelection
to :: forall x. Rep MultipleChoiceSelection x -> MultipleChoiceSelection
Generic)


-- | Value with no option selected.
singleChoiceEmpty :: SingleChoiceSelection
singleChoiceEmpty :: SingleChoiceSelection
singleChoiceEmpty = Maybe Int -> SingleChoiceSelection
SingleChoiceSelection Maybe Int
forall a. Maybe a
Nothing


-- | Value with given number option selected.
singleChoiceAnswer :: Int -> SingleChoiceSelection
singleChoiceAnswer :: Int -> SingleChoiceSelection
singleChoiceAnswer = Maybe Int -> SingleChoiceSelection
SingleChoiceSelection (Maybe Int -> SingleChoiceSelection)
-> (Int -> Maybe Int) -> Int -> SingleChoiceSelection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall a. a -> Maybe a
Just


-- | Value with no options selected.
multipleChoiceEmpty :: MultipleChoiceSelection
multipleChoiceEmpty :: MultipleChoiceSelection
multipleChoiceEmpty = [Int] -> MultipleChoiceSelection
MultipleChoiceSelection []

{- |
Value with given list of options selected.
The order of list elements is inconsequential.
-}
multipleChoiceAnswer :: [Int] -> MultipleChoiceSelection
multipleChoiceAnswer :: [Int] -> MultipleChoiceSelection
multipleChoiceAnswer = [Int] -> MultipleChoiceSelection
MultipleChoiceSelection ([Int] -> MultipleChoiceSelection)
-> ([Int] -> [Int]) -> [Int] -> MultipleChoiceSelection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
nubSort



{- |
Members have a basic Yesod field representing Html input fields.
A `BaseForm` instance of type @a@ is needed for generically producing forms
for @[a]@ and @Maybe a@ types.
An instance can be given manually with the `Field` constructor
or using the `convertField` function on an existing `Field`.

=== __Example__

>>> instance BaseForm MyCoolType where baseForm = convertField toCool fromCool basisField
-}
class BaseForm a where
  baseForm :: Field Handler a


instance BaseForm Integer where
  baseForm :: Field Handler Integer
baseForm = Field Handler Integer
forall (m :: * -> *) i.
(Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) =>
Field m i
intField

instance BaseForm Int where
  baseForm :: Field Handler Int
baseForm = Field Handler Int
forall (m :: * -> *) i.
(Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) =>
Field m i
intField

instance BaseForm Text where
  baseForm :: Field Handler Text
baseForm = Field Handler Text
forall (m :: * -> *).
(Monad m, RenderMessage (HandlerSite m) FormMessage) =>
Field m Text
textField


instance BaseForm String where
  baseForm :: Field Handler String
baseForm = (Text -> String)
-> (String -> Text) -> Field Handler Text -> Field Handler String
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> (b -> a) -> Field m a -> Field m b
convertField Text -> String
unpack String -> Text
pack Field Handler Text
forall (m :: * -> *).
(Monad m, RenderMessage (HandlerSite m) FormMessage) =>
Field m Text
textField


instance BaseForm Textarea where
  baseForm :: Field Handler Textarea
baseForm = Field Handler Textarea
forall (m :: * -> *).
(Monad m, RenderMessage (HandlerSite m) FormMessage) =>
Field m Textarea
textareaField


instance BaseForm Bool where
  baseForm :: Field Handler Bool
baseForm = Field Handler Bool
forall (m :: * -> *).
(Monad m, RenderMessage (HandlerSite m) FormMessage) =>
Field m Bool
boolField


instance BaseForm Double where
  baseForm :: Field Handler Double
baseForm = Field Handler Double
forall (m :: * -> *).
(Monad m, RenderMessage (HandlerSite m) FormMessage) =>
Field m Double
doubleField


instance PathPiece a => PathPiece (Hidden a) where
  fromPathPiece :: Text -> Maybe (Hidden a)
fromPathPiece = (a -> Hidden a) -> Maybe a -> Maybe (Hidden a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Hidden a
forall a. a -> Hidden a
Hidden (Maybe a -> Maybe (Hidden a))
-> (Text -> Maybe a) -> Text -> Maybe (Hidden a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe a
forall s. PathPiece s => Text -> Maybe s
fromPathPiece
  toPathPiece :: Hidden a -> Text
toPathPiece = a -> Text
forall s. PathPiece s => s -> Text
toPathPiece (a -> Text) -> (Hidden a -> a) -> Hidden a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hidden a -> a
forall a. Hidden a -> a
getHidden


instance PathPiece a => BaseForm (Hidden a) where
  baseForm :: Field Handler (Hidden a)
baseForm = Field Handler (Hidden a)
forall (m :: * -> *) p.
(Monad m, PathPiece p,
 RenderMessage (HandlerSite m) FormMessage) =>
Field m p
hiddenField


-- This indicates I should probably change this class to something more succinct.
-- The first function is never used, since it normally handles the parsing.
instance Show a => BaseForm (SingleInputList a) where
  baseForm :: Field Handler (SingleInputList a)
baseForm = (Text -> SingleInputList a)
-> (SingleInputList a -> Text)
-> Field Handler Text
-> Field Handler (SingleInputList a)
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> (b -> a) -> Field m a -> Field m b
convertField Text -> SingleInputList a
forall a. HasCallStack => a
undefined (String -> Text
pack (String -> Text)
-> (SingleInputList a -> String) -> SingleInputList a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String)
-> (SingleInputList a -> [String]) -> SingleInputList a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show ([a] -> [String])
-> (SingleInputList a -> [a]) -> SingleInputList a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleInputList a -> [a]
forall a. SingleInputList a -> [a]
getList) Field Handler Text
forall (m :: * -> *).
(Monad m, RenderMessage (HandlerSite m) FormMessage) =>
Field m Text
textField


{- |
Class for generic generation of Html input forms for a given type.
Bodyless instances can be declared for any type instancing Generic.
__Exception: Types with multiple constructors.__
Use utility functions for those or provide your own instance.
-}
class Formify a where
  {- |
  __Direct use of this function is not recommended__
  __due to possible undetected invalidity of the result.__
  It should only be used when writing manual instances of `Formify`.
  Use `formify` or its variants instead.
  -}
  formifyImplementation
      :: Maybe a -- ^ Optional default value for form.
      -> [[FieldInfo]] -- ^ Structure and type of form.
      -> ([[FieldInfo]], Rendered [[Widget]]) -- ^ remaining form structure and completed sub-renders.

  default formifyImplementation
      :: (Generic a, GFormify (Rep a))
      => Maybe a
      -> [[FieldInfo]]
      -> ([[FieldInfo]], Rendered [[Widget]])
  formifyImplementation Maybe a
mDefault = Maybe (Rep a Any)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
Maybe (Rep a a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall (f :: * -> *) a.
GFormify f =>
Maybe (f a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
gformify (Maybe (Rep a Any)
 -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]]))
-> Maybe (Rep a Any)
-> [[FieldInfo]]
-> ([[FieldInfo]], Rendered [[Widget]])
forall a b. (a -> b) -> a -> b
$ a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from (a -> Rep a Any) -> Maybe a -> Maybe (Rep a Any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mDefault



class GFormify f where
  gformify :: Maybe (f a) -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])



instance (GFormify a, GFormify b) => GFormify (a :*: b) where
  gformify :: forall a.
Maybe ((:*:) a b a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
gformify Maybe ((:*:) a b a)
mDefault [[FieldInfo]]
xs = ([[FieldInfo]]
rightRest, Rendered [[Widget]]
Reader
  Html
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Text])
     Enctype
     Ints
     Handler
     ([[Text]], [[Widget]]))
renders)
    where
      (Maybe (a a)
left,Maybe (b a)
right) = case Maybe ((:*:) a b a)
mDefault of
        Maybe ((:*:) a b a)
Nothing        -> (Maybe (a a)
forall a. Maybe a
Nothing,Maybe (b a)
forall a. Maybe a
Nothing)
        Just (a a
a :*: b a
b) -> (a a -> Maybe (a a)
forall a. a -> Maybe a
Just a a
a, b a -> Maybe (b a)
forall a. a -> Maybe a
Just b a
b)
      ([[FieldInfo]]
leftRest, Rendered [[Widget]]
leftRender) = Maybe (a a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
Maybe (a a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall (f :: * -> *) a.
GFormify f =>
Maybe (f a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
gformify Maybe (a a)
left [[FieldInfo]]
xs
      ([[FieldInfo]]
rightRest, Reader
  Html
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Text])
     Enctype
     Ints
     Handler
     ([[Text]], [[Widget]]))
rightRender) = Maybe (b a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
Maybe (b a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall (f :: * -> *) a.
GFormify f =>
Maybe (f a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
gformify Maybe (b a)
right [[FieldInfo]]
rightFieldInfo
      ([[FieldInfo]]
rightFieldInfo,Reader
  Html
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Text])
     Enctype
     Ints
     Handler
     ([[Text]], [[Widget]]))
renders) = case [[FieldInfo]]
leftRest of
        ([]:[[FieldInfo]]
xss) -> ([[FieldInfo]]
xss, Rendered [[Widget]]
Reader
  Html
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Text])
     Enctype
     Ints
     Handler
     ([[Text]], [[Widget]]))
leftRender Rendered [[Widget]] -> Rendered [[Widget]] -> Rendered [[Widget]]
forall a. Rendered [[a]] -> Rendered [[a]] -> Rendered [[a]]
`vertically` Rendered [[Widget]]
Reader
  Html
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Text])
     Enctype
     Ints
     Handler
     ([[Text]], [[Widget]]))
rightRender)
        [[FieldInfo]]
rest   -> ([[FieldInfo]]
rest, Rendered [[Widget]]
Reader
  Html
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Text])
     Enctype
     Ints
     Handler
     ([[Text]], [[Widget]]))
leftRender Rendered [[Widget]] -> Rendered [[Widget]] -> Rendered [[Widget]]
forall a. Rendered [[a]] -> Rendered [[a]] -> Rendered [[a]]
`horizontally` Rendered [[Widget]]
Reader
  Html
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Text])
     Enctype
     Ints
     Handler
     ([[Text]], [[Widget]]))
rightRender)



horizontally
  :: Rendered [[a]]
  -> Rendered [[a]]
  -> Rendered [[a]]
Rendered [[a]]
f1 horizontally :: forall a. Rendered [[a]] -> Rendered [[a]] -> Rendered [[a]]
`horizontally` Rendered [[a]]
f2 = do
    RWST
  (Maybe (Env, FileEnv), FlexForm, [Text])
  Enctype
  Ints
  Handler
  ([[Text]], [[a]])
res1 <- Rendered [[a]]
ReaderT
  Html
  Identity
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Text])
     Enctype
     Ints
     Handler
     ([[Text]], [[a]]))
f1
    RWST
  (Maybe (Env, FileEnv), FlexForm, [Text])
  Enctype
  Ints
  Handler
  ([[Text]], [[a]])
res2 <- Rendered [[a]]
ReaderT
  Html
  Identity
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Text])
     Enctype
     Ints
     Handler
     ([[Text]], [[a]]))
f2
    RWST
  (Maybe (Env, FileEnv), FlexForm, [Text])
  Enctype
  Ints
  Handler
  ([[Text]], [[a]])
-> ReaderT
     Html
     Identity
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Text])
        Enctype
        Ints
        Handler
        ([[Text]], [[a]]))
forall a. a -> ReaderT Html Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RWST
   (Maybe (Env, FileEnv), FlexForm, [Text])
   Enctype
   Ints
   Handler
   ([[Text]], [[a]])
 -> ReaderT
      Html
      Identity
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Text])
         Enctype
         Ints
         Handler
         ([[Text]], [[a]])))
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Text])
     Enctype
     Ints
     Handler
     ([[Text]], [[a]])
-> ReaderT
     Html
     Identity
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Text])
        Enctype
        Ints
        Handler
        ([[Text]], [[a]]))
forall a b. (a -> b) -> a -> b
$ do
      ([[Text]]
names1,[[a]]
xss) <- RWST
  (Maybe (Env, FileEnv), FlexForm, [Text])
  Enctype
  Ints
  Handler
  ([[Text]], [[a]])
res1
      ([[Text]]
names2,[[a]]
yss) <- RWST
  (Maybe (Env, FileEnv), FlexForm, [Text])
  Enctype
  Ints
  Handler
  ([[Text]], [[a]])
res2
      let
        ([[a]]
leftInit, [a]
leftLast) = ([[a]], [a]) -> Maybe ([[a]], [a]) -> ([[a]], [a])
forall a. a -> Maybe a -> a
fromMaybe ([[a]]
xss,[]) (Maybe ([[a]], [a]) -> ([[a]], [a]))
-> Maybe ([[a]], [a]) -> ([[a]], [a])
forall a b. (a -> b) -> a -> b
$ [[a]] -> Maybe ([[a]], [a])
forall a. [a] -> Maybe ([a], a)
unsnoc [[a]]
xss
        ([a]
rightHead, [[a]]
rightTail) = ([a], [[a]]) -> Maybe ([a], [[a]]) -> ([a], [[a]])
forall a. a -> Maybe a -> a
fromMaybe ([],[[a]]
yss) (Maybe ([a], [[a]]) -> ([a], [[a]]))
-> Maybe ([a], [[a]]) -> ([a], [[a]])
forall a b. (a -> b) -> a -> b
$ [[a]] -> Maybe ([a], [[a]])
forall a. [a] -> Maybe (a, [a])
uncons [[a]]
yss
      ([[Text]], [[a]])
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Text])
     Enctype
     Ints
     Handler
     ([[Text]], [[a]])
forall a.
a
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Text]) Enctype Ints Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[Text]] -> [[Text]]
forall a. Ord a => [a] -> [a]
nubOrd ([[Text]] -> [[Text]]) -> [[Text]] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ [[Text]]
names1 [[Text]] -> [[Text]] -> [[Text]]
forall a. [a] -> [a] -> [a]
++ [[Text]]
names2, [[a]]
leftInit [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]
leftLast [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
rightHead] [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]]
rightTail)



vertically
  :: Rendered [[a]]
  -> Rendered [[a]]
  -> Rendered [[a]]
Rendered [[a]]
f1 vertically :: forall a. Rendered [[a]] -> Rendered [[a]] -> Rendered [[a]]
`vertically` Rendered [[a]]
f2 = do
    RWST
  (Maybe (Env, FileEnv), FlexForm, [Text])
  Enctype
  Ints
  Handler
  ([[Text]], [[a]])
res1 <- Rendered [[a]]
ReaderT
  Html
  Identity
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Text])
     Enctype
     Ints
     Handler
     ([[Text]], [[a]]))
f1
    RWST
  (Maybe (Env, FileEnv), FlexForm, [Text])
  Enctype
  Ints
  Handler
  ([[Text]], [[a]])
res2 <- Rendered [[a]]
ReaderT
  Html
  Identity
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Text])
     Enctype
     Ints
     Handler
     ([[Text]], [[a]]))
f2
    RWST
  (Maybe (Env, FileEnv), FlexForm, [Text])
  Enctype
  Ints
  Handler
  ([[Text]], [[a]])
-> ReaderT
     Html
     Identity
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Text])
        Enctype
        Ints
        Handler
        ([[Text]], [[a]]))
forall a. a -> ReaderT Html Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RWST
   (Maybe (Env, FileEnv), FlexForm, [Text])
   Enctype
   Ints
   Handler
   ([[Text]], [[a]])
 -> ReaderT
      Html
      Identity
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Text])
         Enctype
         Ints
         Handler
         ([[Text]], [[a]])))
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Text])
     Enctype
     Ints
     Handler
     ([[Text]], [[a]])
-> ReaderT
     Html
     Identity
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Text])
        Enctype
        Ints
        Handler
        ([[Text]], [[a]]))
forall a b. (a -> b) -> a -> b
$ do
      ([[Text]]
names1,[[a]]
xss) <- RWST
  (Maybe (Env, FileEnv), FlexForm, [Text])
  Enctype
  Ints
  Handler
  ([[Text]], [[a]])
res1
      ([[Text]]
names2,[[a]]
yss) <- RWST
  (Maybe (Env, FileEnv), FlexForm, [Text])
  Enctype
  Ints
  Handler
  ([[Text]], [[a]])
res2
      ([[Text]], [[a]])
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Text])
     Enctype
     Ints
     Handler
     ([[Text]], [[a]])
forall a.
a
-> RWST
     (Maybe (Env, FileEnv), FlexForm, [Text]) Enctype Ints Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[Text]] -> [[Text]]
forall a. Ord a => [a] -> [a]
nubOrd ([[Text]] -> [[Text]]) -> [[Text]] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ [[Text]]
names1 [[Text]] -> [[Text]] -> [[Text]]
forall a. [a] -> [a] -> [a]
++ [[Text]]
names2, [[a]]
xss [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]]
yss)



instance GFormify a => GFormify (M1 i c a) where
  gformify :: forall a.
Maybe (M1 i c a a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
gformify Maybe (M1 i c a a)
mDefault = Maybe (a a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
Maybe (a a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall (f :: * -> *) a.
GFormify f =>
Maybe (f a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
gformify (Maybe (a a)
 -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]]))
-> Maybe (a a)
-> [[FieldInfo]]
-> ([[FieldInfo]], Rendered [[Widget]])
forall a b. (a -> b) -> a -> b
$ M1 i c a a -> a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (M1 i c a a -> a a) -> Maybe (M1 i c a a) -> Maybe (a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (M1 i c a a)
mDefault



instance Formify a => GFormify (K1 i a) where
  gformify :: forall a.
Maybe (K1 i a a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
gformify Maybe (K1 i a a)
mDefault = Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
Formify a =>
Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyImplementation (Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]]))
-> Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a b. (a -> b) -> a -> b
$ K1 i a a -> a
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 i a a -> a) -> Maybe (K1 i a a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (K1 i a a)
mDefault


instance Formify Integer where
  formifyImplementation :: Maybe Integer
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyImplementation = Maybe Integer
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
BaseForm a =>
Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceBasicField

instance Formify Int where
  formifyImplementation :: Maybe Int -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyImplementation = Maybe Int -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
BaseForm a =>
Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceBasicField

instance Formify Text where
  formifyImplementation :: Maybe Text -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyImplementation = Maybe Text -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
BaseForm a =>
Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceBasicField


instance Formify String where
  formifyImplementation :: Maybe String
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyImplementation = Maybe String
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
BaseForm a =>
Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceBasicField


instance Formify Textarea where
  formifyImplementation :: Maybe Textarea
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyImplementation = Maybe Textarea
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
BaseForm a =>
Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceBasicField


instance Formify Bool where
  formifyImplementation :: Maybe Bool -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyImplementation = Maybe Bool -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
BaseForm a =>
Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceBasicField



instance Formify Double where
  formifyImplementation :: Maybe Double
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyImplementation = Maybe Double
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
BaseForm a =>
Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceBasicField


instance PathPiece a => Formify (Hidden a) where
  formifyImplementation :: Maybe (Hidden a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyImplementation = Maybe (Hidden a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
BaseForm a =>
Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceBasicField


instance Show a => Formify (SingleInputList a) where
  formifyImplementation :: Maybe (SingleInputList a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyImplementation = Maybe (SingleInputList a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
BaseForm a =>
Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceBasicField


instance (Formify a, Formify b) => Formify (a,b)

instance (Formify a, Formify b, Formify c) => Formify (a,b,c)

instance (Formify a, Formify b, Formify c, Formify d) => Formify (a,b,c,d)

instance (Formify a, Formify b, Formify c, Formify d, Formify e) => Formify (a,b,c,d,e)

instance (Formify a, Formify b, Formify c, Formify d, Formify e, Formify f) => Formify (a,b,c,d,e,f)


instance {-# Overlappable #-} Formify a => Formify [a] where
  formifyImplementation :: Maybe [a] -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyImplementation = Maybe [a] -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
Formify a =>
Maybe [a] -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceList

instance Formify [String] where
  formifyImplementation :: Maybe [String]
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyImplementation = Maybe [String]
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
Formify a =>
Maybe [a] -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceList


instance (BaseForm a, Formify a) => Formify (Maybe a) where
  formifyImplementation :: Maybe (Maybe a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyImplementation = Maybe (Maybe a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
BaseForm a =>
Maybe (Maybe a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceOptionalField


instance Formify (Maybe a) => Formify [Maybe a] where
  formifyImplementation :: Maybe [Maybe a]
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyImplementation = Maybe [Maybe a]
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
Formify a =>
Maybe [a] -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceList


instance Formify SingleChoiceSelection where
  formifyImplementation :: Maybe SingleChoiceSelection
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyImplementation = ([SomeMessage FlexForm] -> [(SomeMessage FlexForm, Int)])
-> Maybe Int
-> [[FieldInfo]]
-> ([[FieldInfo]], Rendered [[Widget]])
forall a.
Eq a =>
([SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)])
-> Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
renderNextSingleChoiceField ([SomeMessage FlexForm] -> [Int] -> [(SomeMessage FlexForm, Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Int
1..]) (Maybe Int
 -> [[FieldInfo]]
 -> ([[FieldInfo]],
     Reader
       Html
       (RWST
          (Maybe (Env, FileEnv), FlexForm, [Text])
          Enctype
          Ints
          Handler
          ([[Text]], [[Widget]]))))
-> (Maybe SingleChoiceSelection -> Maybe Int)
-> Maybe SingleChoiceSelection
-> [[FieldInfo]]
-> ([[FieldInfo]],
    Reader
      Html
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Text])
         Enctype
         Ints
         Handler
         ([[Text]], [[Widget]])))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SingleChoiceSelection -> Maybe Int)
-> Maybe SingleChoiceSelection -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) SingleChoiceSelection -> Maybe Int
getAnswer


instance Formify MultipleChoiceSelection where
  formifyImplementation :: Maybe MultipleChoiceSelection
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyImplementation = ([SomeMessage FlexForm] -> [(SomeMessage FlexForm, Int)])
-> Maybe [Int]
-> [[FieldInfo]]
-> ([[FieldInfo]], Rendered [[Widget]])
forall a.
Eq a =>
([SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)])
-> Maybe [a]
-> [[FieldInfo]]
-> ([[FieldInfo]], Rendered [[Widget]])
renderNextMultipleChoiceField ([SomeMessage FlexForm] -> [Int] -> [(SomeMessage FlexForm, Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Int
1..]) (Maybe [Int]
 -> [[FieldInfo]]
 -> ([[FieldInfo]],
     Reader
       Html
       (RWST
          (Maybe (Env, FileEnv), FlexForm, [Text])
          Enctype
          Ints
          Handler
          ([[Text]], [[Widget]]))))
-> (Maybe MultipleChoiceSelection -> Maybe [Int])
-> Maybe MultipleChoiceSelection
-> [[FieldInfo]]
-> ([[FieldInfo]],
    Reader
      Html
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Text])
         Enctype
         Ints
         Handler
         ([[Text]], [[Widget]])))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MultipleChoiceSelection -> [Int])
-> Maybe MultipleChoiceSelection -> Maybe [Int]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MultipleChoiceSelection -> [Int]
getAnswers



{- |
This is the main way to build generic forms.
Use in conjunction with `FieldInfo` builders to generate a form.

Will fail if remaining `FieldInfo` structure is not empty,
indicating the form is faulty.


=== __Examples__

Renders an input field with /type=number/ attribute, no default value and label /Age/.

>>> printWidget "en" $ formify (Nothing @Int) [[single "Age"]]
<div class="flex-form-div">
...
    <label for="flexident1">
      Age
    </label>
    <input id="flexident1" name="flex1" type="number" step="1" required="" value="">
...
</div>

Renders a series of four input fields, each for the type String
and organized vertically beneath each other.
They are prefilled with the values given above,
are assigned the Css class \"helloInput\" and have no labels attached to them.

>>> let defaults = ["Hallo", "Hello", "Hola", "Ciao"]
>>> printWidget "en" $ formify (Just defaults) [[listWithoutLabels Vertical 4 [("class","helloInput")]]]
<div class="flex-form-div">
...
    <input id="flexident1" ... type="text" ... value="Hallo" class="helloInput">
...
</div>
<div class="flex-form-div">
...
    <input id="flexident2" ... type="text" ... value="Hello" class="helloInput">
...
</div>
<div class="flex-form-div">
...
    <input id="flexident3" ... type="text" ... value="Hola" class="helloInput">
...
</div>
<div class="flex-form-div">
...
    <input id="flexident4" ... type="text" ... value="Ciao" class="helloInput">
...
</div>

Renders a radio button field with the given title and option labels attached.
No option is selected when the form is loaded.

>>> let labels = ["this one", "or rather that one", "I just cannot decide"]
>>> printWidget "en" $ formify (Nothing @SingleChoiceSelection) [[buttons Vertical "Make your choice" labels]]
<div class="flex-form-div">
...
    <label for="flexident1">
      Make your choice
    </label>
...
        <label for="flexident1-1">
          <div>
            <input id="flexident1-1" type="radio" ... value="1" ...>
            this one
          </div>
        </label>
...
        <label for="flexident1-2">
          <div>
            <input id="flexident1-2" type="radio" ... value="2" ...>
            or rather that one
          </div>
        </label>
...
        <label for="flexident1-3">
          <div>
            <input id="flexident1-3" type="radio" ... value="3" ...>
            I just cannot decide
          </div>
        </label>
...
</div>
-}
formify
  :: (Formify a)
  => Maybe a -- ^ Optional default value for form.
  -> [[FieldInfo]] -- ^ Structure of form.
  -> Rendered Widget -- ^ Rendered form.
formify :: forall a. Formify a => Maybe a -> [[FieldInfo]] -> Rendered Widget
formify = ([[Widget]] -> Widget)
-> Maybe a -> [[FieldInfo]] -> Rendered Widget
forall a b.
Formify a =>
([[Widget]] -> b) -> Maybe a -> [[FieldInfo]] -> Rendered b
checkAndApply [[Widget]] -> Widget
joinWidgets


{- |
like `formify`, but yields the individual sub-renders instead of a combined form.
Retains the layout structure given by the `FieldInfo` list argument.
This can be used in custom forms to incorporate generated inputs.
-}
formifyComponents :: Formify a => Maybe a -> [[FieldInfo]] -> Rendered [[Widget]]
formifyComponents :: forall a.
Formify a =>
Maybe a -> [[FieldInfo]] -> Rendered [[Widget]]
formifyComponents = ([[Widget]] -> [[Widget]])
-> Maybe a -> [[FieldInfo]] -> Rendered [[Widget]]
forall a b.
Formify a =>
([[Widget]] -> b) -> Maybe a -> [[FieldInfo]] -> Rendered b
checkAndApply [[Widget]] -> [[Widget]]
forall a. a -> a
id


{- |
like `formifyComponents`, but takes a simple list of `FieldInfo` values.
The sub-renders will also be returned as a flat list without any additional structure.
-}
formifyComponentsFlat :: Formify a => Maybe a -> [FieldInfo] -> Rendered [Widget]
formifyComponentsFlat :: forall a. Formify a => Maybe a -> [FieldInfo] -> Rendered [Widget]
formifyComponentsFlat Maybe a
ma = ([[Widget]] -> [Widget])
-> Maybe a -> [[FieldInfo]] -> Rendered [Widget]
forall a b.
Formify a =>
([[Widget]] -> b) -> Maybe a -> [[FieldInfo]] -> Rendered b
checkAndApply [[Widget]] -> [Widget]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat Maybe a
ma ([[FieldInfo]]
 -> ReaderT
      Html
      Identity
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Text])
         Enctype
         Ints
         Handler
         ([[Text]], [Widget])))
-> ([FieldInfo] -> [[FieldInfo]])
-> [FieldInfo]
-> ReaderT
     Html
     Identity
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Text])
        Enctype
        Ints
        Handler
        ([[Text]], [Widget]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FieldInfo] -> [[FieldInfo]] -> [[FieldInfo]]
forall a. a -> [a] -> [a]
:[])


checkAndApply
  :: Formify a
  => ([[Widget]] -> b)
  -> Maybe a
  -> [[FieldInfo]]
  -> Rendered b
checkAndApply :: forall a b.
Formify a =>
([[Widget]] -> b) -> Maybe a -> [[FieldInfo]] -> Rendered b
checkAndApply [[Widget]] -> b
toOutput Maybe a
ma [[FieldInfo]]
xs = case [[FieldInfo]]
rest of
    ([]:[[FieldInfo]]
ns)
      | [[FieldInfo]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[FieldInfo]]
ns   -> ([[Widget]] -> b) -> Rendered [[Widget]] -> Rendered b
forall (m :: * -> *) w w'.
Functor m =>
(w -> w') -> Rendered' m w -> Rendered' m w'
applyToWidget [[Widget]] -> b
toOutput Rendered [[Widget]]
Reader
  Html
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Text])
     Enctype
     Ints
     Handler
     ([[Text]], [[Widget]]))
renders
    [[FieldInfo]]
_ -> String -> Rendered b
forall a. HasCallStack => String -> a
error (String -> Rendered b) -> String -> Rendered b
forall a b. (a -> b) -> a -> b
$
      String
"The form generation did not use up all supplied FieldSettings values. " String -> ShowS
forall a. [a] -> [a] -> [a]
++
      String
"Confirm your field type make sense with the amount of given FieldInfo values."
  where
    ([[FieldInfo]]
rest, Rendered [[Widget]]
renders) = Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
Formify a =>
Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyImplementation Maybe a
ma [[FieldInfo]]
xs


renderNextField
  :: ( FieldInfo ->
        ( FieldSettings FlexForm
        , FieldSettings FlexForm -> Maybe a -> AForm Handler a
        )
      )
  -> Maybe a
  -> [[FieldInfo]]
  -> ([[FieldInfo]], Rendered [[Widget]])
renderNextField :: forall a.
(FieldInfo
 -> (FieldSettings FlexForm,
     FieldSettings FlexForm -> Maybe a -> AForm Handler a))
-> Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
renderNextField FieldInfo
-> (FieldSettings FlexForm,
    FieldSettings FlexForm -> Maybe a -> AForm Handler a)
_ Maybe a
_ [] = String
-> ([[FieldInfo]],
    Reader
      Html
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Text])
         Enctype
         Ints
         Handler
         ([[Text]], [[Widget]])))
forall a. HasCallStack => String -> a
error String
"Ran out of FieldInfo values before finishing the form!"
renderNextField FieldInfo
-> (FieldSettings FlexForm,
    FieldSettings FlexForm -> Maybe a -> AForm Handler a)
h Maybe a
ma ((FieldInfo
x : [FieldInfo]
xs) : [[FieldInfo]]
xss) =
  let
    (FieldSettings FlexForm
lab, FieldSettings FlexForm -> Maybe a -> AForm Handler a
g) = FieldInfo
-> (FieldSettings FlexForm,
    FieldSettings FlexForm -> Maybe a -> AForm Handler a)
h FieldInfo
x
  in
    ([FieldInfo]
xs[FieldInfo] -> [[FieldInfo]] -> [[FieldInfo]]
forall a. a -> [a] -> [a]
:[[FieldInfo]]
xss, (Widget -> [[Widget]]) -> Rendered Widget -> Rendered [[Widget]]
forall (m :: * -> *) w w'.
Functor m =>
(w -> w') -> Rendered' m w -> Rendered' m w'
applyToWidget ([Widget] -> [[Widget]]
forall a. a -> [a]
singleton ([Widget] -> [[Widget]])
-> (Widget -> [Widget]) -> Widget -> [[Widget]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget -> [Widget]
forall a. a -> [a]
singleton) (Rendered Widget -> Rendered [[Widget]])
-> Rendered Widget -> Rendered [[Widget]]
forall a b. (a -> b) -> a -> b
$ (FieldSettings FlexForm -> AForm Handler a)
-> FieldSettings FlexForm -> Rendered Widget
forall a.
(FieldSettings FlexForm -> AForm Handler a)
-> FieldSettings FlexForm -> Rendered Widget
renderForm (FieldSettings FlexForm -> Maybe a -> AForm Handler a
`g` Maybe a
ma) FieldSettings FlexForm
lab)
renderNextField FieldInfo
-> (FieldSettings FlexForm,
    FieldSettings FlexForm -> Maybe a -> AForm Handler a)
_ Maybe a
_ [[FieldInfo]]
_ = String
-> ([[FieldInfo]],
    Reader
      Html
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Text])
         Enctype
         Ints
         Handler
         ([[Text]], [[Widget]])))
forall a. HasCallStack => String -> a
error String
"Incorrect FieldInfo for a field or single/multi choice!"

{- |
Premade `formifyImplementation` for types with `BaseForm` instances.
Use within manual instances of `Formify`.

=== __Example__

>>> instance BaseForm MyCoolType where baseForm = convertField toCool fromCool basisField
>>> instance Formify MyCoolType where formifyImplementation = formifyInstanceBasicField
-}
formifyInstanceBasicField
    :: BaseForm a
    => Maybe a
    -> [[FieldInfo]]
    -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceBasicField :: forall a.
BaseForm a =>
Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceBasicField = (FieldInfo
 -> (FieldSettings FlexForm,
     FieldSettings FlexForm -> Maybe a -> AForm Handler a))
-> Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
(FieldInfo
 -> (FieldSettings FlexForm,
     FieldSettings FlexForm -> Maybe a -> AForm Handler a))
-> Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
renderNextField
  (\case
      Single FieldSettings FlexForm
fs -> (FieldSettings FlexForm
fs, Field Handler a
-> FieldSettings FlexForm -> Maybe a -> AForm Handler a
forall site (m :: * -> *) a.
(RenderMessage site FormMessage, HandlerSite m ~ site,
 MonadHandler m) =>
Field m a -> FieldSettings site -> Maybe a -> AForm m a
areq Field Handler a
forall a. BaseForm a => Field Handler a
baseForm)
      FieldInfo
_ -> String
-> (FieldSettings FlexForm,
    FieldSettings FlexForm -> Maybe a -> AForm Handler a)
forall a. HasCallStack => String -> a
error String
"Incorrect FieldInfo for a basic field. Use 'single'!"
  )

{- |
Same as `formifyInstanceBasicField`, but for optional fields with `Maybe` wrapping.

=== __Example__

>>> instance BaseForm MyCoolType where baseForm = convertField toCool fromCool basisField
>>> instance Formify (Maybe MyCoolType) where formifyImplementation = formifyInstanceOptionalField
-}
formifyInstanceOptionalField
    :: BaseForm a
    => Maybe (Maybe a)
    -> [[FieldInfo]]
    -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceOptionalField :: forall a.
BaseForm a =>
Maybe (Maybe a)
-> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceOptionalField = (FieldInfo
 -> (FieldSettings FlexForm,
     FieldSettings FlexForm
     -> Maybe (Maybe a) -> AForm Handler (Maybe a)))
-> Maybe (Maybe a)
-> [[FieldInfo]]
-> ([[FieldInfo]], Rendered [[Widget]])
forall a.
(FieldInfo
 -> (FieldSettings FlexForm,
     FieldSettings FlexForm -> Maybe a -> AForm Handler a))
-> Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
renderNextField
  (\case
      Single FieldSettings FlexForm
fs -> (FieldSettings FlexForm
fs, Field Handler a
-> FieldSettings (HandlerSite Handler)
-> Maybe (Maybe a)
-> AForm Handler (Maybe a)
forall (m :: * -> *) a.
MonadHandler m =>
Field m a
-> FieldSettings (HandlerSite m)
-> Maybe (Maybe a)
-> AForm m (Maybe a)
aopt Field Handler a
forall a. BaseForm a => Field Handler a
baseForm)
      FieldInfo
_ -> String
-> (FieldSettings FlexForm,
    FieldSettings FlexForm
    -> Maybe (Maybe a) -> AForm Handler (Maybe a))
forall a. HasCallStack => String -> a
error String
"Incorrect FieldInfo for an optional basic field. Use 'single'!"
  )


formifyInstanceList
    :: (Formify a)
    => Maybe [a]
    -> [[FieldInfo]]
    -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceList :: forall a.
Formify a =>
Maybe [a] -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceList Maybe [a]
_ [] = String
-> ([[FieldInfo]],
    Reader
      Html
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Text])
         Enctype
         Ints
         Handler
         ([[Text]], [[Widget]])))
forall a. HasCallStack => String -> a
error String
"Ran out of FieldInfo values before finishing the form!"
formifyInstanceList Maybe [a]
_ ((List Alignment
_ [] : [FieldInfo]
_) : [[FieldInfo]]
_) = String
-> ([[FieldInfo]],
    Reader
      Html
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Text])
         Enctype
         Ints
         Handler
         ([[Text]], [[Widget]])))
forall a. HasCallStack => String -> a
error String
"List used without supplying any FieldInfo values!"
formifyInstanceList Maybe [a]
mas ((List Alignment
align [FieldInfo]
fs : [FieldInfo]
xs) : [[FieldInfo]]
xss) =
    ( [FieldInfo]
xs[FieldInfo] -> [[FieldInfo]] -> [[FieldInfo]]
forall a. a -> [a] -> [a]
:[[FieldInfo]]
xss
    , (Reader
   Html
   (RWST
      (Maybe (Env, FileEnv), FlexForm, [Text])
      Enctype
      Ints
      Handler
      ([[Text]], [[Widget]]))
 -> Reader
      Html
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Text])
         Enctype
         Ints
         Handler
         ([[Text]], [[Widget]]))
 -> Reader
      Html
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Text])
         Enctype
         Ints
         Handler
         ([[Text]], [[Widget]])))
-> [Reader
      Html
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Text])
         Enctype
         Ints
         Handler
         ([[Text]], [[Widget]]))]
-> Reader
     Html
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Text])
        Enctype
        Ints
        Handler
        ([[Text]], [[Widget]]))
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Reader
  Html
  (RWST
     (Maybe (Env, FileEnv), FlexForm, [Text])
     Enctype
     Ints
     Handler
     ([[Text]], [[Widget]]))
-> Reader
     Html
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Text])
        Enctype
        Ints
        Handler
        ([[Text]], [[Widget]]))
-> Reader
     Html
     (RWST
        (Maybe (Env, FileEnv), FlexForm, [Text])
        Enctype
        Ints
        Handler
        ([[Text]], [[Widget]]))
forall {m :: * -> *} {m :: * -> *} {a} {a}.
(Monad m, Monad m, Ord a) =>
m (m ([[a]], [[a]]))
-> m (m ([[a]], [[a]])) -> m (m ([[a]], [[a]]))
addParams
        [([[FieldInfo]], Rendered [[Widget]]) -> Rendered [[Widget]]
forall a b. (a, b) -> b
snd (([[FieldInfo]], Rendered [[Widget]]) -> Rendered [[Widget]])
-> ([[FieldInfo]], Rendered [[Widget]]) -> Rendered [[Widget]]
forall a b. (a -> b) -> a -> b
$ Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
Formify a =>
Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyImplementation Maybe a
d [[FieldInfo
f]] | (Maybe a
d,FieldInfo
f) <- [Maybe a] -> [FieldInfo] -> [(Maybe a, FieldInfo)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe a]
defaults [FieldInfo]
fs]
    )
  where
    defaults :: [Maybe a]
defaults = case Maybe [a]
mas of
      Maybe [a]
Nothing -> Maybe a -> [Maybe a]
forall a. a -> [a]
repeat Maybe a
forall a. Maybe a
Nothing
      Just [a]
ds
        | [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ds Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [FieldInfo] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FieldInfo]
fs
          -> String -> [Maybe a]
forall a. HasCallStack => String -> a
error (String -> [Maybe a]) -> String -> [Maybe a]
forall a b. (a -> b) -> a -> b
$
              String
"The default value contains too many/few individual values. " String -> ShowS
forall a. [a] -> [a] -> [a]
++
              String
"It does not match the amount of FieldInfo supplied."
        | Bool
otherwise
          -> Maybe [a] -> [Maybe a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => Maybe (m a) -> m (Maybe a)
sequence Maybe [a]
mas

    addParams :: m (m ([[a]], [[a]]))
-> m (m ([[a]], [[a]])) -> m (m ([[a]], [[a]]))
addParams m (m ([[a]], [[a]]))
f1 m (m ([[a]], [[a]]))
f2 = do
      m ([[a]], [[a]])
res1 <- m (m ([[a]], [[a]]))
f1
      m ([[a]], [[a]])
res2 <- m (m ([[a]], [[a]]))
f2
      m ([[a]], [[a]]) -> m (m ([[a]], [[a]]))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m ([[a]], [[a]]) -> m (m ([[a]], [[a]])))
-> m ([[a]], [[a]]) -> m (m ([[a]], [[a]]))
forall a b. (a -> b) -> a -> b
$ do
        ([[a]]
names1,[[a]]
wid1) <- m ([[a]], [[a]])
res1
        ([[a]]
names2,[[a]]
wid2) <- m ([[a]], [[a]])
res2
        ([[a]], [[a]]) -> m ([[a]], [[a]])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          ( [[a] -> [a]
forall a. Ord a => [a] -> [a]
nubOrd ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ [[a]]
names1 [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]]
names2]
          , case Alignment
align of
              Alignment
Vertical   -> [[a]]
wid1 [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]]
wid2
              Alignment
Horizontal -> [[[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]]
wid1 [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [[a]]
wid2)]
          )

formifyInstanceList Maybe [a]
_ [[FieldInfo]]
_ = String
-> ([[FieldInfo]],
    Reader
      Html
      (RWST
         (Maybe (Env, FileEnv), FlexForm, [Text])
         Enctype
         Ints
         Handler
         ([[Text]], [[Widget]])))
forall a. HasCallStack => String -> a
error String
"Incorrect FieldInfo for a list of fields! Use one of the list builders."



{- |
Premade `formifyImplementation` for "single choice" forms of enum types.
Use within manual instances of `Formify`.

Intended for use with types such as

@
data MyType = One | Two | Three deriving (Bounded, Enum, Eq, Show)
@

that cannot use a bodyless `Formify` instance.

=== __Examples__

>>> instance Formify MyType where formifyImplementation = formifyInstanceSingleChoice
>>> printWidget "en" $ formify (Just Two) [[buttonsEnum Horizontal "Choose one" (showToUniversalLabel @MyType)]]
...
<div class="flex-form-div">
...
    <label for="flexident1">
      Choose one
    </label>
...
        <label for="flexident1-1">
          <input id="flexident1-1" type="radio" ... value="1" ...>
          One
        </label>
        <label for="flexident1-2">
          <input id="flexident1-2" type="radio" ... value="2" checked ...>
          Two
        </label>
        <label for="flexident1-3">
          <input id="flexident1-3" type="radio" ... value="3" ...>
          Three
        </label>
...
</div>

>>> printWidget "en" $ formify (Just Two) [[dropdownEnum "Choose one" (showToUniversalLabel @MyType)]]
<div class="flex-form-div">
...
    <label for="flexident1">
      Choose one
    </label>
    <select id="flexident1" ...>
      <option value="1">
        One
      </option>
      <option value="2" selected>
        Two
      </option>
      <option value="3">
        Three
      </option>
    </select>
...
</div>
-}
formifyInstanceSingleChoice
    :: (Bounded a, Enum a, Eq a)
    => Maybe a
    -> [[FieldInfo]]
    -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceSingleChoice :: forall a.
(Bounded a, Enum a, Eq a) =>
Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceSingleChoice = ([SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)])
-> Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
Eq a =>
([SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)])
-> Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
renderNextSingleChoiceField [SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)]
forall a.
(Bounded a, Enum a) =>
[SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)]
zipWithEnum

renderNextSingleChoiceField
    :: Eq a
    => ([SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)])
    -> Maybe a
    -> [[FieldInfo]]
    -> ([[FieldInfo]], Rendered [[Widget]])
renderNextSingleChoiceField :: forall a.
Eq a =>
([SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)])
-> Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
renderNextSingleChoiceField [SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)]
pairsWith =
  (FieldInfo
 -> (FieldSettings FlexForm,
     FieldSettings FlexForm -> Maybe a -> AForm Handler a))
-> Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
forall a.
(FieldInfo
 -> (FieldSettings FlexForm,
     FieldSettings FlexForm -> Maybe a -> AForm Handler a))
-> Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
renderNextField
  (\case
      ChoicesDropdown FieldSettings FlexForm
fs [SomeMessage FlexForm]
opts ->
        ( FieldSettings FlexForm
fs
        , Field Handler a
-> FieldSettings FlexForm -> Maybe a -> AForm Handler a
forall site (m :: * -> *) a.
(RenderMessage site FormMessage, HandlerSite m ~ site,
 MonadHandler m) =>
Field m a -> FieldSettings site -> Maybe a -> AForm m a
areq (Field Handler a
 -> FieldSettings FlexForm -> Maybe a -> AForm Handler a)
-> Field Handler a
-> FieldSettings FlexForm
-> Maybe a
-> AForm Handler a
forall a b. (a -> b) -> a -> b
$ HandlerFor FlexForm (OptionList a) -> Field Handler a
forall a site.
(Eq a, RenderMessage site FormMessage) =>
HandlerFor site (OptionList a) -> Field (HandlerFor site) a
selectField (HandlerFor FlexForm (OptionList a) -> Field Handler a)
-> HandlerFor FlexForm (OptionList a) -> Field Handler a
forall a b. (a -> b) -> a -> b
$ [SomeMessage FlexForm] -> HandlerFor FlexForm (OptionList a)
withOptions [SomeMessage FlexForm]
opts
        )
      ChoicesButtons Alignment
align FieldSettings FlexForm
fs [SomeMessage FlexForm]
opts ->
        ( FieldSettings FlexForm
fs
        , Field Handler a
-> FieldSettings FlexForm -> Maybe a -> AForm Handler a
forall site (m :: * -> *) a.
(RenderMessage site FormMessage, HandlerSite m ~ site,
 MonadHandler m) =>
Field m a -> FieldSettings site -> Maybe a -> AForm m a
areq (Field Handler a
 -> FieldSettings FlexForm -> Maybe a -> AForm Handler a)
-> Field Handler a
-> FieldSettings FlexForm
-> Maybe a
-> AForm Handler a
forall a b. (a -> b) -> a -> b
$ case Alignment
align of
            Alignment
Vertical -> HandlerFor FlexForm (OptionList a) -> Field Handler a
forall a site.
(Eq a, RenderMessage site FormMessage) =>
HandlerFor site (OptionList a) -> Field (HandlerFor site) a
radioField
            Alignment
Horizontal -> HandlerFor FlexForm (OptionList a) -> Field Handler a
forall a. Eq a => Handler (OptionList a) -> Field Handler a
horizontalRadioField
          (HandlerFor FlexForm (OptionList a) -> Field Handler a)
-> HandlerFor FlexForm (OptionList a) -> Field Handler a
forall a b. (a -> b) -> a -> b
$ [SomeMessage FlexForm] -> HandlerFor FlexForm (OptionList a)
withOptions [SomeMessage FlexForm]
opts
        )
      FieldInfo
_ -> String
-> (FieldSettings FlexForm,
    FieldSettings FlexForm -> Maybe a -> AForm Handler a)
forall a. HasCallStack => String -> a
error String
"Incorrect FieldInfo for a single choice field! Use one of the 'buttons' or 'dropdown' functions."
  )
  where withOptions :: [SomeMessage FlexForm] -> HandlerFor FlexForm (OptionList a)
withOptions = [(SomeMessage FlexForm, a)] -> HandlerFor FlexForm (OptionList a)
forall (m :: * -> *) msg a.
(MonadHandler m, RenderMessage (HandlerSite m) msg) =>
[(msg, a)] -> m (OptionList a)
optionsPairs ([(SomeMessage FlexForm, a)] -> HandlerFor FlexForm (OptionList a))
-> ([SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)])
-> [SomeMessage FlexForm]
-> HandlerFor FlexForm (OptionList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)]
pairsWith

renderNextMultipleChoiceField
    :: Eq a
    => ([SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)])
    -> Maybe [a]
    -> [[FieldInfo]]
    -> ([[FieldInfo]], Rendered [[Widget]])
renderNextMultipleChoiceField :: forall a.
Eq a =>
([SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)])
-> Maybe [a]
-> [[FieldInfo]]
-> ([[FieldInfo]], Rendered [[Widget]])
renderNextMultipleChoiceField [SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)]
pairsWith =
  (FieldInfo
 -> (FieldSettings FlexForm,
     FieldSettings FlexForm -> Maybe [a] -> AForm Handler [a]))
-> Maybe [a]
-> [[FieldInfo]]
-> ([[FieldInfo]], Rendered [[Widget]])
forall a.
(FieldInfo
 -> (FieldSettings FlexForm,
     FieldSettings FlexForm -> Maybe a -> AForm Handler a))
-> Maybe a -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
renderNextField
  (\case
      ChoicesDropdown FieldSettings FlexForm
fs [SomeMessage FlexForm]
opts ->
        ( FieldSettings FlexForm
fs
        , Field Handler [a]
-> FieldSettings FlexForm -> Maybe [a] -> AForm Handler [a]
forall site (m :: * -> *) a.
(RenderMessage site FormMessage, HandlerSite m ~ site,
 MonadHandler m) =>
Field m a -> FieldSettings site -> Maybe a -> AForm m a
areq (Field Handler [a]
 -> FieldSettings FlexForm -> Maybe [a] -> AForm Handler [a])
-> Field Handler [a]
-> FieldSettings FlexForm
-> Maybe [a]
-> AForm Handler [a]
forall a b. (a -> b) -> a -> b
$ HandlerFor FlexForm (OptionList a) -> Field Handler [a]
forall a site.
Eq a =>
HandlerFor site (OptionList a) -> Field (HandlerFor site) [a]
multiSelectField (HandlerFor FlexForm (OptionList a) -> Field Handler [a])
-> HandlerFor FlexForm (OptionList a) -> Field Handler [a]
forall a b. (a -> b) -> a -> b
$ [SomeMessage FlexForm] -> HandlerFor FlexForm (OptionList a)
withOptions [SomeMessage FlexForm]
opts
        )
      ChoicesButtons Alignment
align FieldSettings FlexForm
fs [SomeMessage FlexForm]
opts ->
        ( FieldSettings FlexForm
fs
        , Field Handler [a]
-> FieldSettings FlexForm -> Maybe [a] -> AForm Handler [a]
forall site (m :: * -> *) a.
(RenderMessage site FormMessage, HandlerSite m ~ site,
 MonadHandler m) =>
Field m a -> FieldSettings site -> Maybe a -> AForm m a
areq (Field Handler [a]
 -> FieldSettings FlexForm -> Maybe [a] -> AForm Handler [a])
-> Field Handler [a]
-> FieldSettings FlexForm
-> Maybe [a]
-> AForm Handler [a]
forall a b. (a -> b) -> a -> b
$ case Alignment
align of
            Alignment
Vertical   -> Bool -> HandlerFor FlexForm (OptionList a) -> Field Handler [a]
forall a.
Eq a =>
Bool -> Handler (OptionList a) -> Field Handler [a]
checkboxField Bool
True
            Alignment
Horizontal -> Bool -> HandlerFor FlexForm (OptionList a) -> Field Handler [a]
forall a.
Eq a =>
Bool -> Handler (OptionList a) -> Field Handler [a]
checkboxField Bool
False
          (HandlerFor FlexForm (OptionList a) -> Field Handler [a])
-> HandlerFor FlexForm (OptionList a) -> Field Handler [a]
forall a b. (a -> b) -> a -> b
$ [SomeMessage FlexForm] -> HandlerFor FlexForm (OptionList a)
withOptions [SomeMessage FlexForm]
opts
        )
      FieldInfo
_ -> String
-> (FieldSettings FlexForm,
    FieldSettings FlexForm -> Maybe [a] -> AForm Handler [a])
forall a. HasCallStack => String -> a
error String
"Incorrect FieldInfo for a multiple choice field! Use one of the 'buttons' or 'dropdown' functions."
  )
  where withOptions :: [SomeMessage FlexForm] -> HandlerFor FlexForm (OptionList a)
withOptions = [(SomeMessage FlexForm, a)] -> HandlerFor FlexForm (OptionList a)
forall (m :: * -> *) msg a.
(MonadHandler m, RenderMessage (HandlerSite m) msg) =>
[(msg, a)] -> m (OptionList a)
optionsPairs ([(SomeMessage FlexForm, a)] -> HandlerFor FlexForm (OptionList a))
-> ([SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)])
-> [SomeMessage FlexForm]
-> HandlerFor FlexForm (OptionList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)]
pairsWith



{- |
Same as `formifyInstanceSingleChoice`, but for multiple choice.
This means the rendered input form will accept any number of inputs, resulting in a list of values.
Possible builders to use with instances are `buttonsEnum` (checkboxes) and `dropdownEnum` (select list).

=== __Examples__

>>> instance Formify [MyType] where formifyImplementation = formifyInstanceMultiChoice
>>> printWidget "en" $ formify (Just [Two,Three]) [[buttonsEnum Horizontal "Choose" (showToUniversalLabel @MyType)]]
<div class="flex-form-div">
...
    <label for="flexident1">
      Choose
    </label>
...
...
      <label>
        <input type="checkbox" ... value="1">
        One
      </label>
      <label>
        <input type="checkbox" ... value="2" checked>
        Two
      </label>
      <label>
        <input type="checkbox" ... value="3" checked>
        Three
      </label>
...
</div>

>>> printWidget "en" $ formify (Just [Two,Three]) [[dropdownEnum "Choose some" (showToUniversalLabel @MyType)]]
<div class="flex-form-div">
...
    <label for="flexident1">
      Choose some
    </label>
    <select id="flexident1" ... multiple>
      <option value="1">
        One
      </option>
      <option value="2" selected>
        Two
      </option>
      <option value="3" selected>
        Three
      </option>
    </select>
...
</div>
-}
formifyInstanceMultiChoice
    :: (Bounded a, Enum a, Eq a)
    => Maybe [a]
    -> [[FieldInfo]]
    -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceMultiChoice :: forall a.
(Bounded a, Enum a, Eq a) =>
Maybe [a] -> [[FieldInfo]] -> ([[FieldInfo]], Rendered [[Widget]])
formifyInstanceMultiChoice = ([SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)])
-> Maybe [a]
-> [[FieldInfo]]
-> ([[FieldInfo]], Rendered [[Widget]])
forall a.
Eq a =>
([SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)])
-> Maybe [a]
-> [[FieldInfo]]
-> ([[FieldInfo]], Rendered [[Widget]])
renderNextMultipleChoiceField [SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)]
forall a.
(Bounded a, Enum a) =>
[SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)]
zipWithEnum



zipWithEnum :: forall a. (Bounded a, Enum a) => [SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)]
zipWithEnum :: forall a.
(Bounded a, Enum a) =>
[SomeMessage FlexForm] -> [(SomeMessage FlexForm, a)]
zipWithEnum [SomeMessage FlexForm]
labels
  | [SomeMessage FlexForm] -> [a] -> Bool
forall a b. [a] -> [b] -> Bool
equalLength [SomeMessage FlexForm]
labels [a]
options = [SomeMessage FlexForm] -> [a] -> [(SomeMessage FlexForm, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SomeMessage FlexForm]
labels [a]
options
  | Bool
otherwise = String -> [(SomeMessage FlexForm, a)]
forall a. HasCallStack => String -> a
error String
"Labels list and options list are of different lengths in an Enum choice form."
  where options :: [a]
options = [a
forall a. Bounded a => a
minBound .. a
forall a. Bounded a => a
maxBound :: a]






{- |
Same as `buttons`, but using an explicit enum type.
Use this with custom enum types to automatically create labels
for all constructors according to the given showing scheme.

See `formifyInstanceSingleChoice`, `formifyInstanceMultiChoice` for example use.
-}
buttonsEnum
  :: (Bounded a, Enum a)
  => Alignment
  -> FieldSettings FlexForm      -- ^ FieldSettings for option input
  -> (a -> SomeMessage FlexForm) -- ^ Function from enum type values to labels.
  -> FieldInfo
buttonsEnum :: forall a.
(Bounded a, Enum a) =>
Alignment
-> FieldSettings FlexForm
-> (a -> SomeMessage FlexForm)
-> FieldInfo
buttonsEnum Alignment
align FieldSettings FlexForm
t a -> SomeMessage FlexForm
f = Alignment
-> FieldSettings FlexForm -> [SomeMessage FlexForm] -> FieldInfo
ChoicesButtons Alignment
align FieldSettings FlexForm
t ([SomeMessage FlexForm] -> FieldInfo)
-> [SomeMessage FlexForm] -> FieldInfo
forall a b. (a -> b) -> a -> b
$ (a -> SomeMessage FlexForm) -> [a] -> [SomeMessage FlexForm]
forall a b. (a -> b) -> [a] -> [b]
map a -> SomeMessage FlexForm
f [a
forall a. Bounded a => a
minBound .. a
forall a. Bounded a => a
maxBound]



{- |
Create FieldInfo for a button field.
Will turn into either radio buttons or checkboxes
depending on the form type.
Use with `SingleChoiceSelection` or `MultipleChoiceSelection`.
__Do not use with custom enum types.__
__Use `buttonsEnum` instead.__

See `SingleChoiceSelection`, `MultipleChoiceSelection` for example use.
-}
buttons
  :: Alignment
  -> FieldSettings FlexForm -- ^ FieldSettings for option input
  -> [SomeMessage FlexForm] -- ^ Option labels
  -> FieldInfo
buttons :: Alignment
-> FieldSettings FlexForm -> [SomeMessage FlexForm] -> FieldInfo
buttons = Alignment
-> FieldSettings FlexForm -> [SomeMessage FlexForm] -> FieldInfo
ChoicesButtons



{- |
Same as `dropdown`, but using an explicit enum type.
Use this with custom enum types to automatically create labels
for all constructors according to the given showing scheme.

See `formifyInstanceSingleChoice`, `formifyInstanceMultiChoice` for example use.
-}
dropdownEnum
  :: (Bounded a, Enum a)
  => FieldSettings FlexForm      -- ^ FieldSettings for select input
  -> (a -> SomeMessage FlexForm) -- ^ Function from enum type values to labels.
  -> FieldInfo
dropdownEnum :: forall a.
(Bounded a, Enum a) =>
FieldSettings FlexForm -> (a -> SomeMessage FlexForm) -> FieldInfo
dropdownEnum FieldSettings FlexForm
t a -> SomeMessage FlexForm
f = FieldSettings FlexForm -> [SomeMessage FlexForm] -> FieldInfo
ChoicesDropdown FieldSettings FlexForm
t ([SomeMessage FlexForm] -> FieldInfo)
-> [SomeMessage FlexForm] -> FieldInfo
forall a b. (a -> b) -> a -> b
$ (a -> SomeMessage FlexForm) -> [a] -> [SomeMessage FlexForm]
forall a b. (a -> b) -> [a] -> [b]
map a -> SomeMessage FlexForm
f [a
forall a. Bounded a => a
minBound .. a
forall a. Bounded a => a
maxBound]



{- |
Create FieldInfo for a dropdown menu field.
Will turn into either single or multiple selection field
depending on the form type.
Use with `SingleChoiceSelection` or `MultipleChoiceSelection`.
__Do not use with custom enum types.__
__Use `dropdownEnum` instead.__

See `SingleChoiceSelection`, `MultipleChoiceSelection` for example use.
-}
dropdown
  :: FieldSettings FlexForm  -- ^ FieldSettings for select input
  -> [SomeMessage FlexForm]  -- ^ Option labels
  -> FieldInfo
dropdown :: FieldSettings FlexForm -> [SomeMessage FlexForm] -> FieldInfo
dropdown = FieldSettings FlexForm -> [SomeMessage FlexForm] -> FieldInfo
ChoicesDropdown



{- |
Create FieldInfo for a number of basic fields.
Their result will be handled as a list of values.
Use for lists of BaseForm fields like `Int`, `String`, `Double`.
The length of the list is equal to the amount of labels provided.

=== __Example__

>>> let labels = ["Input 1", "Input 2", "Input 3"]
>>> printWidget "en" $ formify (Nothing @[Double]) [[list Horizontal labels]]
<div class="flex-form-div">
...
    <label for="flexident1">
      Input 1
    </label>
    <input id="flexident1" ... type="number" step="any" ...>
...
    <label for="flexident2">
      Input 2
    </label>
    <input id="flexident2" ... type="number" step="any" ...>
...
    <label for="flexident3">
      Input 3
    </label>
    <input id="flexident3" ... type="number" step="any" ...>
...
</div>
-}
list
  :: Alignment
  -> [FieldSettings FlexForm] -- ^ FieldSettings of individual fields
  -> FieldInfo
list :: Alignment -> [FieldSettings FlexForm] -> FieldInfo
list Alignment
align = Alignment
-> (FieldSettings FlexForm -> FieldInfo)
-> [FieldSettings FlexForm]
-> FieldInfo
forall a. Alignment -> (a -> FieldInfo) -> [a] -> FieldInfo
repeatBuilderOn Alignment
align FieldSettings FlexForm -> FieldInfo
single


{- |
Same as `list`, but without using any field labels.
Attributes and CSS classes for each field cannot be set with this function.
Instead, all fields share the given list of attributes.
Use `list` if individual configuration is required.

See `formify` for example use.
-}
listWithoutLabels
  :: Alignment
  -> Int           -- ^ Amount of fields
  -> [(Text,Text)] -- ^ List of attribute and value pairs (attribute "class" for classes)
  -> FieldInfo
listWithoutLabels :: Alignment -> Int -> [(Text, Text)] -> FieldInfo
listWithoutLabels Alignment
align Int
amount [(Text, Text)]
attrs = Alignment -> [FieldInfo] -> FieldInfo
List Alignment
align ([FieldInfo] -> FieldInfo) -> [FieldInfo] -> FieldInfo
forall a b. (a -> b) -> a -> b
$ Int -> FieldInfo -> [FieldInfo]
forall a. Int -> a -> [a]
replicate Int
amount (FieldInfo -> [FieldInfo]) -> FieldInfo -> [FieldInfo]
forall a b. (a -> b) -> a -> b
$ FieldSettings FlexForm -> FieldInfo
single FieldSettings FlexForm
"" {fsAttrs = attrs}


{- |
Create FieldInfo for a number of arbitrary fields.
Takes the builder to repeatedly use for each field
and a list of values to use it on.
Their result will be handled as a list of values.
Use to render lists of dropdown or button fields with different labels.
-}
repeatBuilderOn
  :: Alignment
  -> (a -> FieldInfo) -- ^ FieldInfo builder to use
  -> [a]              -- ^ List of values to use builder on
  -> FieldInfo
repeatBuilderOn :: forall a. Alignment -> (a -> FieldInfo) -> [a] -> FieldInfo
repeatBuilderOn Alignment
align a -> FieldInfo
builder = Alignment -> [FieldInfo] -> FieldInfo
List Alignment
align ([FieldInfo] -> FieldInfo)
-> ([a] -> [FieldInfo]) -> [a] -> FieldInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> FieldInfo) -> [a] -> [FieldInfo]
forall a b. (a -> b) -> [a] -> [b]
map a -> FieldInfo
builder


{- |
Create FieldInfo for a list containing exact copies the specified field.
The results of the copies will be handled as a list of values.
Use to render lists of dropdown or button fields with identical labels.
-}
repeatFieldInfo
  :: Alignment
  -> Int       -- ^ How many copies
  -> FieldInfo -- ^ The field to multiply
  -> FieldInfo
repeatFieldInfo :: Alignment -> Int -> FieldInfo -> FieldInfo
repeatFieldInfo Alignment
alignment Int
amount = Alignment -> [FieldInfo] -> FieldInfo
List Alignment
alignment ([FieldInfo] -> FieldInfo)
-> (FieldInfo -> [FieldInfo]) -> FieldInfo -> FieldInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FieldInfo -> [FieldInfo]
forall a. Int -> a -> [a]
replicate Int
amount



{- |
Create FieldInfo for a standalone field.
See `formify` for example use.
-}
single :: FieldSettings FlexForm -> FieldInfo
single :: FieldSettings FlexForm -> FieldInfo
single = FieldSettings FlexForm -> FieldInfo
Single