{-# LANGUAGE 
    ScopedTypeVariables
  , TypeFamilies
#-}

-- | This module provides helper functions for HTML input elements. These helper functions are not specific to any particular web framework or html library.
--
-- Additionally, the inputs generated with the functions from this module will have their names/ids automatically enumerated.
--
-- For named formlets, see @Ditto.Generalized.Named@
module Ditto.Generalized.Unnamed
  ( G.Choice(..)
  , input
  , inputMaybe
  , inputNoData
  , inputFile
  , inputMulti
  , inputChoice
  , inputList
  , label
  , errors
  , childErrors
  , withErrors
  , G.withChildErrors
  ) where

import Data.List.NonEmpty (NonEmpty(..))
import Ditto.Backend
import Ditto.Core
import Ditto.Types
import qualified Ditto.Generalized.Internal as G

-- | used for constructing elements like @\<input type=\"text\"\>@, which pure a single input value.
input :: (Environment m input, FormError input err) 
  => (input -> Either err a) 
  -> (FormId -> a -> view) 
  -> a 
  -> Form m input err view a
input :: (input -> Either err a)
-> (FormId -> a -> view) -> a -> Form m input err view a
input = FormState m FormId
-> (input -> Either err a)
-> (FormId -> a -> view)
-> a
-> Form m input err view a
forall (m :: * -> *) input err a view.
(Environment m input, FormError input err) =>
FormState m FormId
-> (input -> Either err a)
-> (FormId -> a -> view)
-> a
-> Form m input err view a
G.input FormState m FormId
forall (m :: * -> *). Monad m => FormState m FormId
getFormId

-- | used for elements like @\<input type=\"submit\"\>@ which are not always present in the form submission data.
inputMaybe :: (Environment m input, FormError input err)
  => (input -> Either err a)
  -> (FormId -> Maybe a -> view)
  -> Maybe a
  -> Form m input err view (Maybe a)
inputMaybe :: (input -> Either err a)
-> (FormId -> Maybe a -> view)
-> Maybe a
-> Form m input err view (Maybe a)
inputMaybe = FormState m FormId
-> (input -> Either err a)
-> (FormId -> Maybe a -> view)
-> Maybe a
-> Form m input err view (Maybe a)
forall (m :: * -> *) input err a view.
(Monad m, FormError input err, Environment m input) =>
FormState m FormId
-> (input -> Either err a)
-> (FormId -> Maybe a -> view)
-> Maybe a
-> Form m input err view (Maybe a)
G.inputMaybe FormState m FormId
forall (m :: * -> *). Monad m => FormState m FormId
getFormId

-- | used for elements like @\<input type=\"reset\"\>@ which take a value, but are never present in the form data set.
inputNoData :: (Environment m input)
  => (FormId -> view)
  -> Form m input err view ()
inputNoData :: (FormId -> view) -> Form m input err view ()
inputNoData = FormState m FormId -> (FormId -> view) -> Form m input err view ()
forall (m :: * -> *) view input err.
Monad m =>
FormState m FormId -> (FormId -> view) -> Form m input err view ()
G.inputNoData FormState m FormId
forall (m :: * -> *). Monad m => FormState m FormId
getFormId

-- | used for @\<input type=\"file\"\>@
inputFile :: forall m input err view ft. (Environment m input, FormInput input, FormError input err, ft ~ FileType input, Monoid ft)
  => (FormId -> view)
  -> Form m input err view (FileType input)
inputFile :: (FormId -> view) -> Form m input err view (FileType input)
inputFile = FormState m FormId
-> (FormId -> view) -> Form m input err view (FileType input)
forall (m :: * -> *) ft input err view.
(Monad m, FormInput input, FormError input err,
 Environment m input, ft ~ FileType input, Monoid ft) =>
FormState m FormId
-> (FormId -> view) -> Form m input err view (FileType input)
G.inputFile FormState m FormId
forall (m :: * -> *). Monad m => FormState m FormId
getFormId

-- | used for groups of checkboxes, @\<select multiple=\"multiple\"\>@ boxes
inputMulti :: forall m input err view a lbl. (FormError input err, FormInput input, Environment m input, Eq a)
  => [(a, lbl)] -- ^ value, label, initially checked
  -> (input -> Either err [a])
  -> (FormId -> [G.Choice lbl a] -> view) -- ^ function which generates the view
  -> (a -> Bool) -- ^ isChecked/isSelected initially
  -> Form m input err view [a]
inputMulti :: [(a, lbl)]
-> (input -> Either err [a])
-> (FormId -> [Choice lbl a] -> view)
-> (a -> Bool)
-> Form m input err view [a]
inputMulti = FormState m FormId
-> [(a, lbl)]
-> (input -> Either err [a])
-> (FormId -> [Choice lbl a] -> view)
-> (a -> Bool)
-> Form m input err view [a]
forall (m :: * -> *) input err view a lbl.
(FormError input err, FormInput input, Environment m input,
 Eq a) =>
FormState m FormId
-> [(a, lbl)]
-> (input -> Either err [a])
-> (FormId -> [Choice lbl a] -> view)
-> (a -> Bool)
-> Form m input err view [a]
G.inputMulti FormState m FormId
forall (m :: * -> *). Monad m => FormState m FormId
getFormId

-- | radio buttons, single @\<select\>@ boxes
inputChoice :: forall a m err input lbl view. (FormError input err, FormInput input, Environment m input, Eq a, Monoid view)
  => (a -> Bool) -- ^ is default
  -> NonEmpty (a, lbl) -- ^ value, label
  -> (input -> Either err a)
  -> (FormId -> [G.Choice lbl a] -> view) -- ^ function which generates the view
  -> Form m input err view a
inputChoice :: (a -> Bool)
-> NonEmpty (a, lbl)
-> (input -> Either err a)
-> (FormId -> [Choice lbl a] -> view)
-> Form m input err view a
inputChoice = FormState m FormId
-> (a -> Bool)
-> NonEmpty (a, lbl)
-> (input -> Either err a)
-> (FormId -> [Choice lbl a] -> view)
-> Form m input err view a
forall a (m :: * -> *) err input lbl view.
(FormError input err, FormInput input, Monad m, Eq a, Monoid view,
 Environment m input) =>
FormState m FormId
-> (a -> Bool)
-> NonEmpty (a, lbl)
-> (input -> Either err a)
-> (FormId -> [Choice lbl a] -> view)
-> Form m input err view a
G.inputChoice FormState m FormId
forall (m :: * -> *). Monad m => FormState m FormId
getFormId

-- | this is necessary in order to basically map over the decoding function
inputList :: forall m input err a view. (Monad m, FormError input err, Environment m input)
  => (input -> m (Either err [a])) -- ^ decoding function for the list
  -> ([view] -> view) -- ^ how to concatenate views
  -> [a] -- ^ initial values
  -> view -- ^ view to generate in the fail case
  -> (a -> Form m input err view a)
  -> Form m input err view [a]
inputList :: (input -> m (Either err [a]))
-> ([view] -> view)
-> [a]
-> view
-> (a -> Form m input err view a)
-> Form m input err view [a]
inputList = FormState m FormId
-> (input -> m (Either err [a]))
-> ([view] -> view)
-> [a]
-> view
-> (a -> Form m input err view a)
-> Form m input err view [a]
forall (m :: * -> *) input err a view view'.
(Monad m, FormError input err, Environment m input) =>
FormState m FormId
-> (input -> m (Either err [a]))
-> ([view] -> view')
-> [a]
-> view'
-> (a -> Form m input err view a)
-> Form m input err view' [a]
G.inputList FormState m FormId
forall (m :: * -> *). Monad m => FormState m FormId
getFormId

-- | used to create @\<label\>@ elements
label :: Environment m input
  => (FormId -> view)
  -> Form m input err view ()
label :: (FormId -> view) -> Form m input err view ()
label = FormState m FormId -> (FormId -> view) -> Form m input err view ()
forall (m :: * -> *) view input err.
Monad m =>
FormState m FormId -> (FormId -> view) -> Form m input err view ()
G.label FormState m FormId
forall (m :: * -> *). Monad m => FormState m FormId
getFormId

-- | used to add a list of err messages to a 'Form'
--
-- This function automatically takes care of extracting only the
-- errors that are relevent to the form element it is attached to via
-- '<*' or '*>'.
errors :: Environment m input
  => ([err] -> view) -- ^ function to convert the err messages into a view
  -> Form m input err view ()
errors :: ([err] -> view) -> Form m input err view ()
errors = ([err] -> view) -> Form m input err view ()
forall (m :: * -> *) err view input.
Monad m =>
([err] -> view) -> Form m input err view ()
G.errors

-- | similar to 'errors' but includes err messages from children of the form as well.
childErrors :: Environment m input
  => ([err] -> view)
  -> Form m input err view ()
childErrors :: ([err] -> view) -> Form m input err view ()
childErrors = ([err] -> view) -> Form m input err view ()
forall (m :: * -> *) err view input.
Monad m =>
([err] -> view) -> Form m input err view ()
G.childErrors

-- | modify the view of a form based on its errors
withErrors :: Environment m input
  => (view -> [err] -> view)
  -> Form m input err view a
  -> Form m input err view a
withErrors :: (view -> [err] -> view)
-> Form m input err view a -> Form m input err view a
withErrors = (view -> [err] -> view)
-> Form m input err view a -> Form m input err view a
forall (m :: * -> *) view err input a.
Monad m =>
(view -> [err] -> view)
-> Form m input err view a -> Form m input err view a
G.withErrors